3269714c2907cb24aeb6ecd2115ce22d127ae2e9
[ghc.git] / hadrian / src / Context.hs
1 module Context (
2 -- * Context
3 Context (..), vanillaContext, stageContext,
4
5 -- * Expressions
6 getStage, getPackage, getWay, getStagedSettingList, getBuildPath,
7
8 -- * Paths
9 contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
10 pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile, pkgConfFile, objectPath,
11 contextPath, getContextPath, libDir, libPath
12 ) where
13
14 import Base
15 import Context.Path
16 import Context.Type
17 import Hadrian.Expression
18 import Hadrian.Haskell.Cabal
19 import Oracles.Setting
20
21 -- | Most targets are built only one way, hence the notion of 'vanillaContext'.
22 vanillaContext :: Stage -> Package -> Context
23 vanillaContext s p = Context s p vanilla
24
25 -- | Partial context with undefined 'Package' field. Useful for 'Packages'
26 -- expressions that only read the environment and current 'Stage'.
27 stageContext :: Stage -> Context
28 stageContext s = vanillaContext s $ error "stageContext: package not set"
29
30 -- | Get the 'Stage' of the current 'Context'.
31 getStage :: Expr Context b Stage
32 getStage = stage <$> getContext
33
34 -- | Get the 'Package' of the current 'Context'.
35 getPackage :: Expr Context b Package
36 getPackage = package <$> getContext
37
38 -- | Get the 'Way' of the current 'Context'.
39 getWay :: Expr Context b Way
40 getWay = way <$> getContext
41
42 -- | Get a list of configuration settings for the current stage.
43 getStagedSettingList :: (Stage -> SettingList) -> Args Context b
44 getStagedSettingList f = getSettingList . f =<< getStage
45
46 libDir :: Context -> FilePath
47 libDir Context {..} = stageString stage -/- "lib"
48
49 -- | Path to the directory containg the final artifact in a given 'Context'
50 libPath :: Context -> Action FilePath
51 libPath context = buildRoot <&> (-/- libDir context)
52
53 pkgFile :: Context -> String -> String -> Action FilePath
54 pkgFile context@Context {..} prefix suffix = do
55 path <- buildPath context
56 pid <- pkgIdentifier package
57 return $ path -/- prefix ++ pid ++ suffix
58
59 -- | Path to inplace package configuration file of a given 'Context'.
60 pkgInplaceConfig :: Context -> Action FilePath
61 pkgInplaceConfig context = do
62 path <- contextPath context
63 return $ path -/- "inplace-pkg-config"
64
65 -- TODO: Add a @Rules FilePath@ alternative.
66 -- | Path to the @setup-config@ of a given 'Context'.
67 pkgSetupConfigFile :: Context -> Action FilePath
68 pkgSetupConfigFile context = do
69 path <- contextPath context
70 return $ path -/- "setup-config"
71
72 -- | Path to the haddock file of a given 'Context', e.g.:
73 -- @_build/stage1/libraries/array/doc/html/array/array.haddock@.
74 pkgHaddockFile :: Context -> Action FilePath
75 pkgHaddockFile Context {..} = do
76 root <- buildRoot
77 let name = pkgName package
78 return $ root -/- "docs/html/libraries" -/- name -/- name <.> "haddock"
79
80 -- | Path to the library file of a given 'Context', e.g.:
81 -- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.
82 pkgLibraryFile :: Context -> Action FilePath
83 pkgLibraryFile context@Context {..} = do
84 extension <- libsuf way
85 pkgFile context "libHS" extension
86
87 -- | Path to the GHCi library file of a given 'Context', e.g.:
88 -- @_build/stage1/libraries/array/build/HSarray-0.5.1.0.o@.
89 pkgGhciLibraryFile :: Context -> Action FilePath
90 pkgGhciLibraryFile context = pkgFile context "HS" ".o"
91
92 -- | Path to the configuration file of a given 'Context'.
93 pkgConfFile :: Context -> Action FilePath
94 pkgConfFile Context {..} = do
95 root <- buildRoot
96 pid <- pkgIdentifier package
97 return $ root -/- relativePackageDbPath stage -/- pid <.> "conf"
98
99 -- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
100 -- to its object file. For example:
101 -- * "Task.c" -> "_build/stage1/rts/Task.thr_o"
102 -- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
103 objectPath :: Context -> FilePath -> Action FilePath
104 objectPath context@Context {..} src = do
105 isGenerated <- isGeneratedSource src
106 path <- buildPath context
107 let extension = drop 1 $ takeExtension src
108 obj = src -<.> osuf way
109 result | isGenerated = obj
110 | "*hs*" ?== extension = path -/- obj
111 | otherwise = path -/- extension -/- obj
112 return result