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