18dd15be0ed75723a76497f79dfa9192211ff0e0
[hadrian.git] / src / Settings.hs
1 module Settings (
2 getArgs, getPackages, getLibraryWays, getRtsWays, flavour, knownPackages,
3 findKnownPackage, getPkgData, getPkgDataList, isLibrary, getPackagePath,
4 getContextDirectory, getBuildPath, stagePackages, builderPath,
5 getBuilderPath, isSpecified, latestBuildStage, programPath
6 ) where
7
8 import Base
9 import Context
10 import CmdLineFlag
11 import Expression
12 import Flavour
13 import GHC
14 import Oracles.PackageData
15 import Oracles.Path
16 import {-# SOURCE #-} Settings.Default
17 import Settings.Flavours.Perf
18 import Settings.Flavours.Quick
19 import Settings.Flavours.Quickest
20 import Settings.Path
21 import UserSettings
22
23 getArgs :: Expr [String]
24 getArgs = fromDiffExpr $ args flavour
25
26 getLibraryWays :: Expr [Way]
27 getLibraryWays = fromDiffExpr $ libraryWays flavour
28
29 getRtsWays :: Expr [Way]
30 getRtsWays = fromDiffExpr $ rtsWays flavour
31
32 getPackages :: Expr [Package]
33 getPackages = fromDiffExpr $ packages flavour
34
35 stagePackages :: Stage -> Action [Package]
36 stagePackages stage = interpretInContext (stageContext stage) getPackages
37
38 getPackagePath :: Expr FilePath
39 getPackagePath = pkgPath <$> getPackage
40
41 getContextDirectory :: Expr FilePath
42 getContextDirectory = stageDirectory <$> getStage
43
44 getBuildPath :: Expr FilePath
45 getBuildPath = buildPath <$> getContext
46
47 getPkgData :: (FilePath -> PackageData) -> Expr String
48 getPkgData key = lift . pkgData . key =<< getBuildPath
49
50 getPkgDataList :: (FilePath -> PackageDataList) -> Expr [String]
51 getPkgDataList key = lift . pkgDataList . key =<< getBuildPath
52
53 hadrianFlavours :: [Flavour]
54 hadrianFlavours = [defaultFlavour, perfFlavour, quickFlavour, quickestFlavour]
55
56 flavour :: Flavour
57 flavour = fromMaybe unknownFlavour $ find ((== flavourName) . name) flavours
58 where
59 unknownFlavour = error $ "Unknown build flavour: " ++ flavourName
60 flavours = hadrianFlavours ++ userFlavours
61 flavourName = fromMaybe "default" cmdFlavour
62
63 -- TODO: switch to Set Package as the order of packages should not matter?
64 -- Otherwise we have to keep remembering to sort packages from time to time.
65 knownPackages :: [Package]
66 knownPackages = sort $ defaultKnownPackages ++ userKnownPackages
67
68 -- TODO: Speed up?
69 -- Note: this is slow but we keep it simple as there are just ~50 packages
70 findKnownPackage :: PackageName -> Maybe Package
71 findKnownPackage name = find (\pkg -> pkgName pkg == name) knownPackages
72
73 -- | Determine the location of a 'Builder'.
74 builderPath :: Builder -> Action FilePath
75 builderPath builder = case builderProvenance builder of
76 Nothing -> systemBuilderPath builder
77 Just context -> do
78 maybePath <- programPath context
79 let msg = error $ show builder ++ " is never built by Hadrian."
80 return $ fromMaybe msg maybePath
81
82 getBuilderPath :: Builder -> ReaderT a Action FilePath
83 getBuilderPath = lift . builderPath
84
85 -- | Was the path to a given 'Builder' specified in configuration files?
86 isSpecified :: Builder -> Action Bool
87 isSpecified = fmap (not . null) . builderPath
88
89 -- | Determine the latest 'Stage' in which a given 'Package' is built. Returns
90 -- Nothing if the package is never built.
91 latestBuildStage :: Package -> Action (Maybe Stage)
92 latestBuildStage pkg = do
93 stages <- filterM (fmap (pkg `elem`) . stagePackages) [Stage0 ..]
94 return $ if null stages then Nothing else Just $ maximum stages
95
96 -- | The 'FilePath' to a program executable in a given 'Context'.
97 programPath :: Context -> Action (Maybe FilePath)
98 programPath context@Context {..} = do
99 maybeLatest <- latestBuildStage package
100 return $ do
101 install <- (\l -> l == stage || package == ghc) <$> maybeLatest
102 let path = if install then installPath package else buildPath context
103 return $ path -/- programName context <.> exe