Drop Oracles.Dependencies moving code to the library and Utilities (former Util)
[hadrian.git] / src / Settings.hs
1 module Settings (
2 getArgs, getPackages, getLibraryWays, getRtsWays, flavour, knownPackages,
3 findKnownPackage, getPkgData, getPkgDataList, isLibrary,
4 getBuildPath, stagePackages, builderPath,
5 getBuilderPath, isSpecified, latestBuildStage, programPath, programContext,
6 integerLibraryName, destDir, pkgConfInstallPath, stage1Only, buildDll0
7 ) where
8
9 import Hadrian.Oracles.KeyValue
10 import Hadrian.Oracles.Path
11
12 import Base
13 import Context
14 import CmdLineFlag
15 import Expression
16 import Flavour
17 import GHC
18 import Oracles.PackageData
19 import Oracles.Setting
20 import {-# SOURCE #-} Settings.Default
21 import Settings.Flavours.Development
22 import Settings.Flavours.Performance
23 import Settings.Flavours.Profiled
24 import Settings.Flavours.Quick
25 import Settings.Flavours.Quickest
26 import Settings.Path
27 import UserSettings
28
29 getArgs :: Args
30 getArgs = args flavour
31
32 getLibraryWays :: Ways
33 getLibraryWays = libraryWays flavour
34
35 getRtsWays :: Ways
36 getRtsWays = rtsWays flavour
37
38 getPackages :: Packages
39 getPackages = packages flavour
40
41 stagePackages :: Stage -> Action [Package]
42 stagePackages stage = interpretInContext (stageContext stage) getPackages
43
44 getBuildPath :: Expr FilePath
45 getBuildPath = buildPath <$> getContext
46
47 getPkgData :: (FilePath -> PackageData) -> Expr String
48 getPkgData key = expr . pkgData . key =<< getBuildPath
49
50 getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
51 getPkgDataList key = expr . pkgDataList . key =<< getBuildPath
52
53 hadrianFlavours :: [Flavour]
54 hadrianFlavours =
55 [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2
56 , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour ]
57
58 flavour :: Flavour
59 flavour = fromMaybe unknownFlavour $ find ((== flavourName) . name) flavours
60 where
61 unknownFlavour = error $ "Unknown build flavour: " ++ flavourName
62 flavours = hadrianFlavours ++ userFlavours
63 flavourName = fromMaybe "default" cmdFlavour
64
65 integerLibraryName :: String
66 integerLibraryName = pkgNameString $ integerLibrary flavour
67
68 programContext :: Stage -> Package -> Context
69 programContext stage pkg
70 | pkg == ghc && ghcProfiled flavour && stage > Stage0 = Context stage pkg profiling
71 | otherwise = vanillaContext stage pkg
72
73 -- TODO: switch to Set Package as the order of packages should not matter?
74 -- Otherwise we have to keep remembering to sort packages from time to time.
75 knownPackages :: [Package]
76 knownPackages = sort $ defaultKnownPackages ++ userKnownPackages
77
78 -- TODO: Speed up? Switch to Set?
79 -- Note: this is slow but we keep it simple as there are just ~50 packages
80 findKnownPackage :: PackageName -> Maybe Package
81 findKnownPackage name = find (\pkg -> pkgName pkg == name) knownPackages
82
83 -- | Determine the location of a system 'Builder'.
84 systemBuilderPath :: Builder -> Action FilePath
85 systemBuilderPath builder = case builder of
86 Alex -> fromKey "alex"
87 Ar Stage0 -> fromKey "system-ar"
88 Ar _ -> fromKey "ar"
89 Cc _ Stage0 -> fromKey "system-cc"
90 Cc _ _ -> fromKey "cc"
91 -- We can't ask configure for the path to configure!
92 Configure _ -> return "sh configure"
93 Ghc _ Stage0 -> fromKey "system-ghc"
94 GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
95 Happy -> fromKey "happy"
96 HsColour -> fromKey "hscolour"
97 HsCpp -> fromKey "hs-cpp"
98 Ld -> fromKey "ld"
99 Make _ -> fromKey "make"
100 Nm -> fromKey "nm"
101 Objdump -> fromKey "objdump"
102 Patch -> fromKey "patch"
103 Perl -> fromKey "perl"
104 Ranlib -> fromKey "ranlib"
105 Tar -> fromKey "tar"
106 _ -> error $ "No system.config entry for " ++ show builder
107 where
108 fromKey key = do
109 let unpack = fromMaybe . error $ "Cannot find path to builder "
110 ++ quote key ++ " in system.config file. Did you skip configure?"
111 path <- unpack <$> lookupValue configFile key
112 if null path
113 then do
114 unless (isOptional builder) . error $ "Non optional builder "
115 ++ quote key ++ " is not specified in system.config file."
116 return "" -- TODO: Use a safe interface.
117 else fixAbsolutePathOnWindows =<< lookupInPath path
118
119 -- | Determine the location of a 'Builder'.
120 builderPath :: Builder -> Action FilePath
121 builderPath builder = case builderProvenance builder of
122 Nothing -> systemBuilderPath builder
123 Just context -> do
124 maybePath <- programPath context
125 let msg = error $ show builder ++ " is never built by Hadrian."
126 return $ fromMaybe msg maybePath
127
128 getBuilderPath :: Builder -> Expr FilePath
129 getBuilderPath = expr . builderPath
130
131 -- | Was the path to a given 'Builder' specified in configuration files?
132 isSpecified :: Builder -> Action Bool
133 isSpecified = fmap (not . null) . builderPath
134
135 -- | Determine the latest 'Stage' in which a given 'Package' is built. Returns
136 -- Nothing if the package is never built.
137 latestBuildStage :: Package -> Action (Maybe Stage)
138 latestBuildStage pkg = do
139 stages <- filterM (fmap (pkg `elem`) . stagePackages) [Stage0 ..]
140 return $ if null stages then Nothing else Just $ maximum stages
141
142 -- | The 'FilePath' to a program executable in a given 'Context'.
143 programPath :: Context -> Action (Maybe FilePath)
144 programPath context@Context {..} = do
145 maybeLatest <- latestBuildStage package
146 return $ do
147 install <- (\l -> l == stage || package == ghc) <$> maybeLatest
148 let path = if install then inplaceInstallPath package else buildPath context
149 return $ path -/- programName context <.> exe
150
151 pkgConfInstallPath :: FilePath
152 pkgConfInstallPath = buildPath (vanillaContext Stage0 rts) -/- "package.conf.install"
153
154 -- TODO: Set this from command line
155 -- | Stage1Only flag.
156 stage1Only :: Bool
157 stage1Only = defaultStage1Only
158
159 -- TODO: Set this from command line
160 -- | Install's DESTDIR setting.
161 destDir :: FilePath
162 destDir = defaultDestDir
163
164 buildDll0 :: Context -> Action Bool
165 buildDll0 Context {..} = do
166 windows <- windowsHost
167 return $ windows && stage == Stage1 && package == compiler