805685179188f6efeaaf29f1db343e3774a0a27d
[ghc.git] / src / Settings.hs
1 module Settings (
2 getArgs, getLibraryWays, getRtsWays, flavour, knownPackages,
3 findKnownPackage, getPkgData, getPkgDataList, isLibrary, stagePackages,
4 builderPath, getBuilderPath, isSpecified, latestBuildStage, programPath,
5 programContext, integerLibraryName, getDestDir, stage1Only, buildDll0
6 ) where
7
8 import Context
9 import CommandLine
10 import Expression
11 import Flavour
12 import GHC
13 import {-# SOURCE #-} Settings.Default
14 import Settings.Flavours.Development
15 import Settings.Flavours.Performance
16 import Settings.Flavours.Profiled
17 import Settings.Flavours.Quick
18 import Settings.Flavours.Quickest
19 import UserSettings
20
21 getArgs :: Args
22 getArgs = expr flavour >>= args
23
24 getLibraryWays :: Ways
25 getLibraryWays = expr flavour >>= libraryWays
26
27 getRtsWays :: Ways
28 getRtsWays = expr flavour >>= rtsWays
29
30 stagePackages :: Stage -> Action [Package]
31 stagePackages stage = do
32 f <- flavour
33 packages f stage
34
35 hadrianFlavours :: [Flavour]
36 hadrianFlavours =
37 [ defaultFlavour, developmentFlavour Stage1, developmentFlavour Stage2
38 , performanceFlavour, profiledFlavour, quickFlavour, quickestFlavour ]
39
40 flavour :: Action Flavour
41 flavour = do
42 flavourName <- fromMaybe "default" <$> cmdFlavour
43 let unknownFlavour = error $ "Unknown build flavour: " ++ flavourName
44 flavours = hadrianFlavours ++ userFlavours
45 return $ fromMaybe unknownFlavour $ find ((== flavourName) . name) flavours
46
47 integerLibraryName :: Action String
48 integerLibraryName = pkgName <$> (integerLibrary =<< flavour)
49
50 programContext :: Stage -> Package -> Action Context
51 programContext stage pkg = do
52 profiled <- ghcProfiled <$> flavour
53 return $ if pkg == ghc && profiled && stage > Stage0
54 then Context stage pkg profiling
55 else vanillaContext stage pkg
56
57 -- TODO: switch to Set Package as the order of packages should not matter?
58 -- Otherwise we have to keep remembering to sort packages from time to time.
59 knownPackages :: [Package]
60 knownPackages = sort $ defaultKnownPackages ++ userKnownPackages
61
62 -- TODO: Speed up? Switch to Set?
63 -- Note: this is slow but we keep it simple as there are just ~50 packages
64 findKnownPackage :: PackageName -> Maybe Package
65 findKnownPackage name = find (\pkg -> pkgName pkg == name) knownPackages
66
67 -- | Determine the location of a 'Builder'.
68 builderPath :: Builder -> Action FilePath
69 builderPath builder = case builderProvenance builder of
70 Nothing -> systemBuilderPath builder
71 Just context -> do
72 maybePath <- programPath context
73 let msg = error $ show builder ++ " is never built by Hadrian."
74 return $ fromMaybe msg maybePath
75
76 getBuilderPath :: Builder -> Expr FilePath
77 getBuilderPath = expr . builderPath
78
79 -- | Was the path to a given 'Builder' specified in configuration files?
80 isSpecified :: Builder -> Action Bool
81 isSpecified = fmap (not . null) . builderPath
82
83 -- | Determine the latest 'Stage' in which a given 'Package' is built. Returns
84 -- Nothing if the package is never built.
85 latestBuildStage :: Package -> Action (Maybe Stage)
86 latestBuildStage pkg = do
87 stages <- filterM (fmap (pkg `elem`) . stagePackages) [Stage0 ..]
88 return $ if null stages then Nothing else Just $ maximum stages
89
90 -- | The 'FilePath' to a program executable in a given 'Context'.
91 programPath :: Context -> Action (Maybe FilePath)
92 programPath context@Context {..} = do
93 maybeLatest <- latestBuildStage package
94 path <- buildPath context
95 return $ do
96 install <- (\l -> l == stage || package == ghc) <$> maybeLatest
97 let installPath = if install then inplaceInstallPath package else path
98 return $ installPath -/- programName context <.> exe
99
100 -- TODO: Set this from command line
101 -- | Stage1Only flag.
102 stage1Only :: Bool
103 stage1Only = defaultStage1Only
104
105 -- | Install's DESTDIR setting.
106 getDestDir :: Action FilePath
107 getDestDir = fromMaybe "" <$> cmdInstallDestDir