6377d9bb93fbd59ce488280b09ca30ebed503932
[hadrian.git] / src / Context.hs
1 module Context (
2 -- * Context
3 Context (..), vanillaContext, stageContext,
4
5 -- * Expressions
6 getStage, getPackage, getWay, getStagedSettingList, getBuildPath,
7 withHsPackage,
8
9 -- * Paths
10 contextDir, buildPath, pkgInplaceConfig, pkgDataFile, pkgSetupConfigFile,
11 pkgHaddockFile, pkgLibraryFile, pkgLibraryFile0, pkgGhciLibraryFile,
12 pkgConfFile, objectPath
13 ) where
14
15 import Context.Type
16 import Hadrian.Expression
17 import Hadrian.Haskell.Cabal
18
19 import Base
20 import Oracles.Setting
21
22 -- | Most targets are built only one way, hence the notion of 'vanillaContext'.
23 vanillaContext :: Stage -> Package -> Context
24 vanillaContext s p = Context s p vanilla
25
26 -- | Partial context with undefined 'Package' field. Useful for 'Packages'
27 -- expressions that only read the environment and current 'Stage'.
28 stageContext :: Stage -> Context
29 stageContext s = vanillaContext s $ error "stageContext: package not set"
30
31 -- | Get the 'Stage' of the current 'Context'.
32 getStage :: Expr Context b Stage
33 getStage = stage <$> getContext
34
35 -- | Get the 'Package' of the current 'Context'.
36 getPackage :: Expr Context b Package
37 getPackage = package <$> getContext
38
39 -- | Get the 'Way' of the current 'Context'.
40 getWay :: Expr Context b Way
41 getWay = way <$> getContext
42
43 -- | Get a list of configuration settings for the current stage.
44 getStagedSettingList :: (Stage -> SettingList) -> Args Context b
45 getStagedSettingList f = getSettingList . f =<< getStage
46
47 -- | Construct an expression that depends on the Cabal file of the current
48 -- package and is empty in a non-Haskell context.
49 withHsPackage :: (Monoid a, Semigroup a) => (FilePath -> Expr Context b a) -> Expr Context b a
50 withHsPackage expr = do
51 pkg <- getPackage
52 case pkgCabalFile pkg of
53 Just file -> expr file
54 Nothing -> mempty
55
56 -- | The directory in 'buildRoot' containing build artefacts of a given 'Context'.
57 contextDir :: Context -> FilePath
58 contextDir Context {..} = stageString stage -/- pkgPath package
59
60 -- | Path to the directory containing build artefacts of a given 'Context'.
61 buildPath :: Context -> Action FilePath
62 buildPath context = buildRoot <&> (-/- contextDir context)
63
64 -- | Get the build path of the current 'Context'.
65 getBuildPath :: Expr Context b FilePath
66 getBuildPath = expr . buildPath =<< getContext
67
68 pkgId :: Package -> Action FilePath
69 pkgId package = case pkgCabalFile package of
70 Just file -> pkgIdentifier file
71 Nothing -> return (pkgName package) -- Non-Haskell packages, e.g. rts
72
73 pkgFile :: Context -> String -> String -> Action FilePath
74 pkgFile context@Context {..} prefix suffix = do
75 path <- buildPath context
76 pid <- pkgId package
77 return $ path -/- prefix ++ pid ++ suffix
78
79 -- | Path to inplace package configuration file of a given 'Context'.
80 pkgInplaceConfig :: Context -> Action FilePath
81 pkgInplaceConfig context = do
82 path <- buildPath context
83 return $ path -/- "inplace-pkg-config"
84
85 -- | Path to the @package-data.mk@ of a given 'Context'.
86 pkgDataFile :: Context -> Action FilePath
87 pkgDataFile context = do
88 path <- buildPath context
89 return $ path -/- "package-data.mk"
90
91 -- | Path to the @setup-config@ of a given 'Context'.
92 pkgSetupConfigFile :: Context -> Action FilePath
93 pkgSetupConfigFile context = do
94 path <- buildPath context
95 return $ path -/- "setup-config"
96
97 -- | Path to the haddock file of a given 'Context', e.g.:
98 -- @_build/stage1/libraries/array/doc/html/array/array.haddock@.
99 pkgHaddockFile :: Context -> Action FilePath
100 pkgHaddockFile Context {..} = do
101 root <- buildRoot
102 let name = pkgName package
103 return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock"
104
105 -- | Path to the library file of a given 'Context', e.g.:
106 -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.
107 pkgLibraryFile :: Context -> Action FilePath
108 pkgLibraryFile context@Context {..} = do
109 extension <- libsuf way
110 pkgFile context "libHS" extension
111
112 -- | Path to the auxiliary library file of a given 'Context', e.g.:
113 -- @_build/stage1/compiler/build/libHSghc-8.1-0.a@.
114 pkgLibraryFile0 :: Context -> Action FilePath
115 pkgLibraryFile0 context@Context {..} = do
116 extension <- libsuf way
117 pkgFile context "libHS" ("-0" ++ extension)
118
119 -- | Path to the GHCi library file of a given 'Context', e.g.:
120 -- @_build/stage1/libraries/array/build/HSarray-0.5.1.0.o@.
121 pkgGhciLibraryFile :: Context -> Action FilePath
122 pkgGhciLibraryFile context = pkgFile context "HS" ".o"
123
124 -- | Path to the configuration file of a given 'Context'.
125 pkgConfFile :: Context -> Action FilePath
126 pkgConfFile Context {..} = do
127 root <- buildRoot
128 pid <- pkgId package
129 let dbDir | stage == Stage0 = root -/- stage0PackageDbDir
130 | otherwise = inplacePackageDbPath
131 return $ dbDir -/- pid <.> "conf"
132
133 -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
134 -- to its object file. For example:
135 -- * "Task.c" -> "_build/stage1/rts/Task.thr_o"
136 -- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
137 objectPath :: Context -> FilePath -> Action FilePath
138 objectPath context@Context {..} src = do
139 isGenerated <- isGeneratedSource src
140 path <- buildPath context
141 let extension = drop 1 $ takeExtension src
142 obj = src -<.> osuf way
143 result | isGenerated = obj
144 | "*hs*" ?== extension = path -/- obj
145 | otherwise = path -/- extension -/- obj
146 return result