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