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