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