67e16344539a9122b6736e6c51f78601e8840c12
[hadrian.git] / src / Builder.hs
1 {-# LANGUAGE InstanceSigs #-}
2 module Builder (
3 -- * Data types
4 ArMode (..), CcMode (..), GhcMode (..), GhcPkgMode (..), HaddockMode (..),
5 SphinxMode (..), TarMode (..), Builder (..),
6
7 -- * Builder properties
8 builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder,
9 runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath,
10 builderEnvironment,
11
12 -- * Ad hoc builder invokation
13 applyPatch, installDirectory, installData, installScript, installProgram,
14 linkSymbolic
15 ) where
16
17 import Development.Shake.Classes
18 import GHC.Generics
19 import qualified Hadrian.Builder as H
20 import Hadrian.Builder hiding (Builder)
21 import Hadrian.Builder.Ar
22 import Hadrian.Builder.Sphinx
23 import Hadrian.Builder.Tar
24 import Hadrian.Oracles.Path
25 import Hadrian.Oracles.TextFile
26 import Hadrian.Utilities
27 import qualified System.Directory.Extra as IO
28
29 import Base
30 import Context
31 import GHC
32 import Oracles.Flag
33 import Oracles.Setting
34
35 -- | C compiler can be used in two different modes:
36 -- * Compile or preprocess a source file.
37 -- * Extract source dependencies by passing @-MM@ command line argument.
38 data CcMode = CompileC | FindCDependencies deriving (Eq, Generic, Show)
39
40 instance Binary CcMode
41 instance Hashable CcMode
42 instance NFData CcMode
43
44 -- | GHC can be used in four different modes:
45 -- * Compile a Haskell source file.
46 -- * Compile a C source file.
47 -- * Extract source dependencies by passing @-M@ command line argument.
48 -- * Link object files & static libraries into an executable.
49 data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs
50 deriving (Eq, Generic, Show)
51
52 instance Binary GhcMode
53 instance Hashable GhcMode
54 instance NFData GhcMode
55
56 -- | GhcPkg can initialise a package database and register packages in it.
57 data GhcPkgMode = Init | Update deriving (Eq, Generic, Show)
58
59 instance Binary GhcPkgMode
60 instance Hashable GhcPkgMode
61 instance NFData GhcPkgMode
62
63 -- | Haddock can be used in two different modes:
64 -- * Generate documentation for a single package
65 -- * Generate an index page for a collection of packages
66 data HaddockMode = BuildPackage | BuildIndex deriving (Eq, Generic, Show)
67
68 instance Binary HaddockMode
69 instance Hashable HaddockMode
70 instance NFData HaddockMode
71
72 -- | A 'Builder' is an external command invoked in a separate process via 'cmd'.
73 -- @Ghc Stage0@ is the bootstrapping compiler.
74 -- @Ghc StageN@, N > 0, is the one built in stage (N - 1).
75 -- @GhcPkg Stage0@ is the bootstrapping @GhcPkg@.
76 -- @GhcPkg Stage1@ is the one built in Stage0.
77 data Builder = Alex
78 | Ar ArMode Stage
79 | DeriveConstants
80 | Cc CcMode Stage
81 | Configure FilePath
82 | GenApply
83 | GenPrimopCode
84 | Ghc GhcMode Stage
85 | GhcCabal
86 | GhcPkg GhcPkgMode Stage
87 | Haddock HaddockMode
88 | Happy
89 | Hpc
90 | Hp2Ps
91 | HsCpp
92 | Hsc2Hs
93 | Ld
94 | Make FilePath
95 | Nm
96 | Objdump
97 | Patch
98 | Perl
99 | Python
100 | Ranlib
101 | RunTest
102 | Sphinx SphinxMode
103 | Tar TarMode
104 | Unlit
105 | Xelatex
106 deriving (Eq, Generic, Show)
107
108 instance Binary Builder
109 instance Hashable Builder
110 instance NFData Builder
111
112 -- | Some builders are built by this very build system, in which case
113 -- 'builderProvenance' returns the corresponding build 'Context' (which includes
114 -- 'Stage' and GHC 'Package').
115 builderProvenance :: Builder -> Maybe Context
116 builderProvenance = \case
117 DeriveConstants -> context Stage0 deriveConstants
118 GenApply -> context Stage0 genapply
119 GenPrimopCode -> context Stage0 genprimopcode
120 Ghc _ Stage0 -> Nothing
121 Ghc _ stage -> context (pred stage) ghc
122 GhcCabal -> context Stage0 ghcCabal
123 GhcPkg _ Stage0 -> Nothing
124 GhcPkg _ _ -> context Stage0 ghcPkg
125 Haddock _ -> context Stage2 haddock
126 Hpc -> context Stage1 hpcBin
127 Hp2Ps -> context Stage0 hp2ps
128 Hsc2Hs -> context Stage0 hsc2hs
129 Unlit -> context Stage0 unlit
130 _ -> Nothing
131 where
132 context s p = Just $ vanillaContext s p
133
134 instance H.Builder Builder where
135 builderPath :: Builder -> Action FilePath
136 builderPath builder = case builderProvenance builder of
137 Nothing -> systemBuilderPath builder
138 Just context -> programPath context
139
140 runtimeDependencies :: Builder -> Action [FilePath]
141 runtimeDependencies = \case
142 Configure dir -> return [dir -/- "configure"]
143
144 Ghc _ Stage0 -> return []
145 Ghc _ _ -> do
146 win <- windowsHost
147 touchyPath <- programPath (vanillaContext Stage0 touchy)
148 unlitPath <- builderPath Unlit
149 return $ [ ghcSplitPath -- TODO: Make conditional on --split-objects
150 , inplaceLibPath -/- "ghc-usage.txt"
151 , inplaceLibPath -/- "ghci-usage.txt"
152 , inplaceLibPath -/- "llvm-targets"
153 , inplaceLibPath -/- "platformConstants"
154 , inplaceLibPath -/- "settings"
155 , unlitPath ]
156 ++ [ touchyPath | win ]
157
158 Haddock _ -> return [haddockHtmlResourcesStamp]
159 Hsc2Hs -> return [templateHscPath]
160 Make dir -> return [dir -/- "Makefile"]
161 _ -> return []
162
163 runBuilderWith :: Builder -> BuildInfo -> Action ()
164 runBuilderWith builder BuildInfo {..} = do
165 path <- builderPath builder
166 withResources buildResources $ do
167 verbosity <- getVerbosity
168 let input = fromSingleton msgIn buildInputs
169 msgIn = "[runBuilderWith] Exactly one input file expected."
170 output = fromSingleton msgOut buildOutputs
171 msgOut = "[runBuilderWith] Exactly one output file expected."
172 -- Suppress stdout depending on the Shake's verbosity setting.
173 echo = EchoStdout (verbosity >= Loud)
174 -- Capture stdout and write it to the output file.
175 captureStdout = do
176 Stdout stdout <- cmd [path] buildArgs
177 writeFileChanged output stdout
178 case builder of
179 Ar Pack _ -> do
180 useTempFile <- flag ArSupportsAtFile
181 if useTempFile then runAr path buildArgs
182 else runArWithoutTempFile path buildArgs
183
184 Ar Unpack _ -> cmd echo [Cwd output] [path] buildArgs
185
186 Configure dir -> do
187 -- Inject /bin/bash into `libtool`, instead of /bin/sh,
188 -- otherwise Windows breaks. TODO: Figure out why.
189 bash <- bashPath
190 let env = AddEnv "CONFIG_SHELL" bash
191 cmd echo env [Cwd dir] ["sh", path] buildOptions buildArgs
192
193 HsCpp -> captureStdout
194 GenApply -> captureStdout
195
196 GenPrimopCode -> do
197 stdin <- readFile' input
198 Stdout stdout <- cmd (Stdin stdin) [path] buildArgs
199 writeFileChanged output stdout
200
201 Make dir -> cmd echo path ["-C", dir] buildArgs
202
203 Xelatex -> do
204 unit $ cmd [Cwd output] [path] buildArgs
205 unit $ cmd [Cwd output] [path] buildArgs
206 unit $ cmd [Cwd output] [path] buildArgs
207 unit $ cmd [Cwd output] ["makeindex"] (input -<.> "idx")
208 unit $ cmd [Cwd output] [path] buildArgs
209 unit $ cmd [Cwd output] [path] buildArgs
210
211 _ -> cmd echo [path] buildArgs
212
213 -- TODO: Some builders are required only on certain platforms. For example,
214 -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform
215 -- specific optional builders as soon as we can reliably test this feature.
216 -- See https://github.com/snowleopard/hadrian/issues/211.
217 isOptional :: Builder -> Bool
218 isOptional = \case
219 Objdump -> True
220 _ -> False
221
222 -- | Determine the location of a system 'Builder'.
223 systemBuilderPath :: Builder -> Action FilePath
224 systemBuilderPath builder = case builder of
225 Alex -> fromKey "alex"
226 Ar _ Stage0 -> fromKey "system-ar"
227 Ar _ _ -> fromKey "ar"
228 Cc _ Stage0 -> fromKey "system-cc"
229 Cc _ _ -> fromKey "cc"
230 -- We can't ask configure for the path to configure!
231 Configure _ -> return "configure"
232 Ghc _ Stage0 -> fromKey "system-ghc"
233 GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
234 Happy -> fromKey "happy"
235 HsCpp -> fromKey "hs-cpp"
236 Ld -> fromKey "ld"
237 Make _ -> fromKey "make"
238 Nm -> fromKey "nm"
239 Objdump -> fromKey "objdump"
240 Patch -> fromKey "patch"
241 Perl -> fromKey "perl"
242 Python -> fromKey "python"
243 Ranlib -> fromKey "ranlib"
244 RunTest -> fromKey "python"
245 Sphinx _ -> fromKey "sphinx-build"
246 Tar _ -> fromKey "tar"
247 Xelatex -> fromKey "xelatex"
248 _ -> error $ "No entry for " ++ show builder ++ inCfg
249 where
250 inCfg = " in " ++ quote configFile ++ " file."
251 fromKey key = do
252 let unpack = fromMaybe . error $ "Cannot find path to builder "
253 ++ quote key ++ inCfg ++ " Did you skip configure?"
254 path <- unpack <$> lookupValue configFile key
255 if null path
256 then do
257 unless (isOptional builder) . error $ "Non optional builder "
258 ++ quote key ++ " is not specified" ++ inCfg
259 return "" -- TODO: Use a safe interface.
260 else do
261 win <- windowsHost
262 fullPath <- lookupInPath path
263 case (win, hasExtension fullPath) of
264 (False, _ ) -> return fullPath
265 (True , True ) -> fixAbsolutePathOnWindows fullPath
266 (True , False) -> fixAbsolutePathOnWindows fullPath <&> (<.> exe)
267
268 -- | Was the path to a given system 'Builder' specified in configuration files?
269 isSpecified :: Builder -> Action Bool
270 isSpecified = fmap (not . null) . systemBuilderPath
271
272 -- | Apply a patch by executing the 'Patch' builder in a given directory.
273 applyPatch :: FilePath -> FilePath -> Action ()
274 applyPatch dir patch = do
275 let file = dir -/- patch
276 needBuilder Patch
277 path <- builderPath Patch
278 putBuild $ "| Apply patch " ++ file
279 quietly $ cmd [Cwd dir, FileStdin file] [path, "-p0"]
280
281 -- | Install a directory.
282 installDirectory :: FilePath -> Action ()
283 installDirectory dir = do
284 path <- fixAbsolutePathOnWindows =<< setting InstallDir
285 putBuild $ "| Install directory " ++ dir
286 quietly $ cmd path dir
287
288 -- | Install data files to a directory and track them.
289 installData :: [FilePath] -> FilePath -> Action ()
290 installData fs dir = do
291 path <- fixAbsolutePathOnWindows =<< setting InstallData
292 need fs
293 forM_ fs $ \f -> putBuild $ "| Install data " ++ f ++ " to " ++ dir
294 quietly $ cmd path fs dir
295
296 -- | Install an executable file to a directory and track it.
297 installProgram :: FilePath -> FilePath -> Action ()
298 installProgram f dir = do
299 path <- fixAbsolutePathOnWindows =<< setting InstallProgram
300 need [f]
301 putBuild $ "| Install program " ++ f ++ " to " ++ dir
302 quietly $ cmd path f dir
303
304 -- | Install an executable script to a directory and track it.
305 installScript :: FilePath -> FilePath -> Action ()
306 installScript f dir = do
307 path <- fixAbsolutePathOnWindows =<< setting InstallScript
308 need [f]
309 putBuild $ "| Install script " ++ f ++ " to " ++ dir
310 quietly $ cmd path f dir
311
312 -- | Create a symbolic link from source file to target file (when symbolic links
313 -- are supported) and track the source file.
314 linkSymbolic :: FilePath -> FilePath -> Action ()
315 linkSymbolic source target = do
316 lns <- setting LnS
317 unless (null lns) $ do
318 need [source] -- Guarantee source is built before printing progress info.
319 let dir = takeDirectory target
320 liftIO $ IO.createDirectoryIfMissing True dir
321 putProgressInfo =<< renderAction "Create symbolic link" source target
322 quietly $ cmd lns source target