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
|
module Context (
-- * Context
Context (..), vanillaContext, stageContext,
-- * Expressions
getStage, getPackage, getWay, getStagedSettingList, getBuildPath,
-- * Paths
contextDir, buildPath, buildDir, pkgInplaceConfig, pkgSetupConfigFile,
pkgHaddockFile, pkgRegisteredLibraryFile, pkgLibraryFile, pkgGhciLibraryFile,
pkgConfFile, objectPath, contextPath, getContextPath, libPath, distDir
) 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
-- | 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
-- | 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 containg 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 accomodate Cabal's slightly different naming
-- conventions (see 'cabalOsString' and 'cabalArchString').
distDir :: Stage -> Action FilePath
distDir st = do
version <- ghcVersionStage st
hostOs <- cabalOsString <$> setting BuildOs
hostArch <- cabalArchString <$> setting BuildArch
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")
-- | Path to the @setup-config@ of a given 'Context'.
pkgSetupConfigFile :: Context -> Action FilePath
pkgSetupConfigFile context = contextPath 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
let name = pkgName package
return $ root -/- "docs/html/libraries" -/- name -/- name <.> "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
extension <- libsuf stage way
fileName <- pkgFileName package "libHS" extension
distDir <- distDir stage
return $ if Dynamic `wayUnit` way
then libDir -/- distDir -/- fileName
else libDir -/- distDir -/- pkgId -/- fileName
-- | 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 stage
return $ dbPath -/- pid <.> "conf"
-- | 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
|
