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