1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
module Context (
-- * Context
Context (..), vanillaContext, stageContext,
-- * Expressions
getStage, getPackage, getWay, getStagedSettingList, getBuildPath, getPackageDbLoc,
-- * Paths
contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile, pkgSetupConfigDir,
pkgHaddockFile, pkgRegisteredLibraryFile, pkgRegisteredLibraryFileName,
pkgLibraryFile, pkgGhciLibraryFile,
pkgConfFile, pkgStampFile, resourcePath, objectPath, contextPath, getContextPath, libPath, distDir,
haddockStatsFilesDir
) where
import Base
import Context.Path
import Context.Type
import Hadrian.Expression
import Hadrian.Haskell.Cabal
import Oracles.Setting
-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
vanillaContext :: Stage -> Package -> Context
vanillaContext s p = Context s p vanilla Final
-- | Partial context with undefined 'Package' field. Useful for 'Packages'
-- expressions that only read the environment and current 'Stage'.
stageContext :: Stage -> Context
stageContext s = vanillaContext s $ error "stageContext: package not set"
-- | Get the 'Stage' of the current 'Context'.
getStage :: Expr Context b Stage
getStage = stage <$> getContext
getInplace :: Expr Context b Inplace
getInplace = iplace <$> getContext
getPackageDbLoc :: Expr Context b PackageDbLoc
getPackageDbLoc = PackageDbLoc <$> getStage <*> getInplace
-- | Get the 'Package' of the current 'Context'.
getPackage :: Expr Context b Package
getPackage = package <$> getContext
-- | Get the 'Way' of the current 'Context'.
getWay :: Expr Context b Way
getWay = way <$> getContext
-- | Get a list of configuration settings for the current stage.
getStagedSettingList :: (Stage -> SettingList) -> Args Context b
getStagedSettingList f = getSettingList . f =<< getStage
-- | Path to the directory containing the final artifact in a given 'Context'.
libPath :: Context -> Action FilePath
libPath Context {..} = buildRoot <&> (-/- (stageString stage -/- "lib"))
-- | Get the directory name for binary distribution files
-- @<arch>-<os>-ghc-<version>@.
--
-- We preform some renaming to accommodate Cabal's slightly different naming
-- conventions (see 'cabalOsString' and 'cabalArchString').
distDir :: Stage -> Action FilePath
distDir st = do
let (os,arch) = case st of
Stage0 {} -> (HostOs , HostArch)
_ -> (TargetOs, TargetArch)
version <- ghcVersionStage st
hostOs <- cabalOsString <$> setting os
hostArch <- cabalArchString <$> setting arch
return $ hostArch ++ "-" ++ hostOs ++ "-ghc-" ++ version
pkgFileName :: Package -> String -> String -> Action FilePath
pkgFileName package prefix suffix = do
pid <- pkgIdentifier package
return $ prefix ++ pid ++ suffix
pkgFile :: Context -> String -> String -> Action FilePath
pkgFile context@Context {..} prefix suffix = do
path <- buildPath context
fileName <- pkgFileName package prefix suffix
return $ path -/- fileName
-- | Path to inplace package configuration file of a given 'Context'.
pkgInplaceConfig :: Context -> Action FilePath
pkgInplaceConfig context = contextPath context <&> (-/- "inplace-pkg-config")
pkgSetupConfigDir :: Context -> Action FilePath
pkgSetupConfigDir context = contextPath context
-- | Path to the @setup-config@ of a given 'Context'.
pkgSetupConfigFile :: Context -> Action FilePath
pkgSetupConfigFile context = pkgSetupConfigDir context <&> (-/- "setup-config")
-- | Path to the haddock file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/doc/html/array/array.haddock@.
pkgHaddockFile :: Context -> Action FilePath
pkgHaddockFile Context {..} = do
root <- buildRoot
version <- pkgIdentifier package
return $ root -/- "doc/html/libraries" -/- version -/- pkgName package <.> "haddock"
-- | Path to the registered ghc-pkg library file of a given 'Context', e.g.:
-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/libHSarray-0.5.1.0-ghc8.9.0.so@
-- @_build/stage1/lib/x86_64-linux-ghc-8.9.0/array-0.5.1.0/libHSarray-0.5.4.0.a@
pkgRegisteredLibraryFile :: Context -> Action FilePath
pkgRegisteredLibraryFile context@Context {..} = do
libDir <- libPath context
pkgId <- pkgIdentifier package
fileName <- pkgRegisteredLibraryFileName context
distDir <- distDir stage
return $ if Dynamic `wayUnit` way
then libDir -/- distDir -/- fileName
else libDir -/- distDir -/- pkgId -/- fileName
-- | Just the final filename portion of pkgRegisteredLibraryFile
pkgRegisteredLibraryFileName :: Context -> Action FilePath
pkgRegisteredLibraryFileName Context{..} = do
extension <- libsuf stage way
pkgFileName package "libHS" extension
-- | Path to the library file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/build/libHSarray-0.5.1.0.a@.
pkgLibraryFile :: Context -> Action FilePath
pkgLibraryFile context@Context {..} = do
extension <- libsuf stage way
pkgFile context "libHS" extension
-- | Path to the GHCi library file of a given 'Context', e.g.:
-- @_build/stage1/libraries/array/build/HSarray-0.5.1.0.o@.
pkgGhciLibraryFile :: Context -> Action FilePath
pkgGhciLibraryFile context@Context {..} = do
let extension = "" <.> osuf way
pkgFile context "HS" extension
-- | Path to the configuration file of a given 'Context'.
pkgConfFile :: Context -> Action FilePath
pkgConfFile Context {..} = do
pid <- pkgIdentifier package
dbPath <- packageDbPath (PackageDbLoc stage iplace)
return $ dbPath -/- pid <.> "conf"
-- | Path to the stamp file for a given 'Context'. The stamp file records if
-- we have built all the objects necessary for a certain way or not.
pkgStampFile :: Context -> Action FilePath
pkgStampFile c@Context{..} = do
let extension = waySuffix way
pkgFile c "stamp-" extension
-- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
-- to its object file. For example:
-- * "Task.c" -> "_build/stage1/rts/Task.thr_o"
-- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
objectPath :: Context -> FilePath -> Action FilePath
objectPath context@Context {..} src = do
isGenerated <- isGeneratedSource src
path <- buildPath context
let extension = drop 1 $ takeExtension src
obj = src -<.> osuf way
result | isGenerated = obj
| "*hs*" ?== extension = path -/- obj
| otherwise = path -/- extension -/- obj
return result
resourcePath :: Context -> FilePath -> Action FilePath
resourcePath context src = do
path <- buildPath context
let extension = drop 1 $ takeExtension src
return (path -/- extension -/- src)
|
