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