5ca6c2077d835328e75720c5f0aa5b1ef8ec8dc7
[hadrian.git] / src / Builder.hs
1 {-# LANGUAGE InstanceSigs #-}
2 module Builder (
3 -- * Data types
4 ArMode (..), CcMode (..), GhcCabalMode (..), 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 -- | GHC cabal mode. Can configure, copy and register packages.
57 data GhcCabalMode = Conf | HsColour | Check | Sdist
58 deriving (Eq, Generic, Show)
59
60 instance Binary GhcCabalMode
61 instance Hashable GhcCabalMode
62 instance NFData GhcCabalMode
63
64 -- | GhcPkg can initialise a package database and register packages in it.
65 data GhcPkgMode = Init -- initialize a new database.
66 | Update -- update a package.
67 | Clone -- clone a package from one pkg database into another. @Copy@ is already taken by GhcCabalMode.
68 | Unregister -- unregister a package
69 | Dependencies -- compute package dependencies.
70 deriving (Eq, Generic, Show)
71
72 instance Binary GhcPkgMode
73 instance Hashable GhcPkgMode
74 instance NFData GhcPkgMode
75
76 -- | Haddock can be used in two different modes:
77 -- * Generate documentation for a single package
78 -- * Generate an index page for a collection of packages
79 data HaddockMode = BuildPackage | BuildIndex deriving (Eq, Generic, Show)
80
81 instance Binary HaddockMode
82 instance Hashable HaddockMode
83 instance NFData HaddockMode
84
85 -- | A 'Builder' is an external command invoked in a separate process via 'cmd'.
86 -- @Ghc Stage0@ is the bootstrapping compiler.
87 -- @Ghc StageN@, N > 0, is the one built in stage (N - 1).
88 -- @GhcPkg Stage0@ is the bootstrapping @GhcPkg@.
89 -- @GhcPkg Stage1@ is the one built in Stage0.
90 data Builder = Alex
91 | Ar ArMode Stage
92 | DeriveConstants
93 | Cc CcMode Stage
94 | Configure FilePath
95 | GenApply
96 | GenPrimopCode
97 | Ghc GhcMode Stage
98 | GhcCabal GhcCabalMode Stage
99 | GhcPkg GhcPkgMode Stage
100 | Haddock HaddockMode
101 | Happy
102 | Hpc
103 | Hp2Ps
104 | HsCpp
105 | Hsc2Hs Stage
106 | Ld Stage
107 | Make FilePath
108 | Nm
109 | Objdump
110 | Patch
111 | Perl
112 | Python
113 | Ranlib
114 | RunTest
115 | Sphinx SphinxMode
116 | Tar TarMode
117 | Unlit
118 | Xelatex
119 | CabalFlags Stage
120 -- ^ A \"virtual\" builder (not backed by a program),
121 -- used a lot in Settings.Packages, that allows us to
122 -- toggle cabal flags of packages depending on some `Args`
123 -- predicates, and then collect all those when we are about to
124 -- configure the said packages, in Hadrian.Haskell.Cabal.Parse,
125 -- so that we end up passing the appropriate flags to the Cabal
126 -- library. For example:
127 --
128 -- > package rts
129 -- > ? builder CabalFlags
130 -- > ? any (wayUnit Profiling) rtsWays
131 -- > ? arg "profiling"
132 --
133 -- (from Settings.Packages) specifies that if we're
134 -- processing the rts package with the `CabalFlag` builder,
135 -- and if we're building a profiling-enabled way of the rts,
136 -- then we pass the @profiling@ argument to the builder. This
137 -- argument is then collected by the code that performs the
138 -- package configuration, and @rts.cabal@ is processed as if
139 -- we were passing @-fprofiling@ to our build tool.
140
141 deriving (Eq, Generic, Show)
142
143 instance Binary Builder
144 instance Hashable Builder
145 instance NFData Builder
146
147 -- | Some builders are built by this very build system, in which case
148 -- 'builderProvenance' returns the corresponding build 'Context' (which includes
149 -- 'Stage' and GHC 'Package').
150 builderProvenance :: Builder -> Maybe Context
151 builderProvenance = \case
152 DeriveConstants -> context Stage0 deriveConstants
153 GenApply -> context Stage0 genapply
154 GenPrimopCode -> context Stage0 genprimopcode
155 Ghc _ Stage0 -> Nothing
156 Ghc _ stage -> context (pred stage) ghc
157 GhcCabal _ _ -> context Stage1 ghcCabal
158 GhcPkg _ Stage0 -> Nothing
159 GhcPkg _ _ -> context Stage0 ghcPkg
160 Haddock _ -> context Stage1 haddock
161 Hpc -> context Stage1 hpcBin
162 Hp2Ps -> context Stage0 hp2ps
163 Hsc2Hs _ -> context Stage0 hsc2hs
164 Unlit -> context Stage0 unlit
165 _ -> Nothing
166 where
167 context s p = Just $ vanillaContext s p
168
169 instance H.Builder Builder where
170 builderPath :: Builder -> Action FilePath
171 builderPath builder = case builderProvenance builder of
172 Nothing -> systemBuilderPath builder
173 Just context -> programPath context
174
175 runtimeDependencies :: Builder -> Action [FilePath]
176 runtimeDependencies = \case
177 Configure dir -> return [dir -/- "configure"]
178
179 Ghc _ Stage0 -> return []
180 Ghc _ stage -> do
181 root <- buildRoot
182 win <- windowsHost
183 touchyPath <- programPath (vanillaContext Stage0 touchy)
184 unlitPath <- builderPath Unlit
185 ghcdeps <- ghcDeps stage
186 return $ [ root -/- ghcSplitPath stage -- TODO: Make conditional on --split-objects
187 , unlitPath ]
188 ++ ghcdeps
189 ++ [ touchyPath | win ]
190
191 Hsc2Hs stage -> (\p -> [p]) <$> templateHscPath stage
192 Make dir -> return [dir -/- "Makefile"]
193 _ -> return []
194
195 -- query the builder for some information.
196 -- contrast this with runBuilderWith, which returns @Action ()@
197 -- this returns the @stdout@ from running the builder.
198 -- For now this only implements asking @ghc-pkg@ about package
199 -- dependencies.
200 askBuilderWith :: Builder -> BuildInfo -> Action String
201 askBuilderWith builder BuildInfo {..} = case builder of
202 GhcPkg Dependencies _ -> do
203 let input = fromSingleton msgIn buildInputs
204 msgIn = "[askBuilder] Exactly one input file expected."
205 needBuilder builder
206 path <- H.builderPath builder
207 need [path]
208 Stdout stdout <- cmd [path] ["--no-user-package-db", "field", input, "depends"]
209 return stdout
210 _ -> error $ "Builder " ++ show builder ++ " can not be asked!"
211
212 runBuilderWith :: Builder -> BuildInfo -> Action ()
213 runBuilderWith builder BuildInfo {..} = do
214 path <- builderPath builder
215 withResources buildResources $ do
216 verbosity <- getVerbosity
217 let input = fromSingleton msgIn buildInputs
218 msgIn = "[runBuilderWith] Exactly one input file expected."
219 output = fromSingleton msgOut buildOutputs
220 msgOut = "[runBuilderWith] Exactly one output file expected."
221 -- Suppress stdout depending on the Shake's verbosity setting.
222 echo = EchoStdout (verbosity >= Loud)
223 -- Capture stdout and write it to the output file.
224 captureStdout = do
225 Stdout stdout <- cmd [path] buildArgs
226 writeFileChanged output stdout
227 case builder of
228 Ar Pack _ -> do
229 useTempFile <- flag ArSupportsAtFile
230 if useTempFile then runAr path buildArgs
231 else runArWithoutTempFile path buildArgs
232
233 Ar Unpack _ -> cmd echo [Cwd output] [path] buildArgs
234
235 Configure dir -> do
236 -- Inject /bin/bash into `libtool`, instead of /bin/sh,
237 -- otherwise Windows breaks. TODO: Figure out why.
238 bash <- bashPath
239 let env = AddEnv "CONFIG_SHELL" bash
240 cmd echo env [Cwd dir] ["sh", path] buildOptions buildArgs
241
242 HsCpp -> captureStdout
243 GenApply -> captureStdout
244
245 GenPrimopCode -> do
246 stdin <- readFile' input
247 Stdout stdout <- cmd (Stdin stdin) [path] buildArgs
248 writeFileChanged output stdout
249
250 Make dir -> cmd echo path ["-C", dir] buildArgs
251
252 Xelatex -> do
253 unit $ cmd [Cwd output] [path] buildArgs
254 unit $ cmd [Cwd output] [path] buildArgs
255 unit $ cmd [Cwd output] [path] buildArgs
256 unit $ cmd [Cwd output] ["makeindex"] (input -<.> "idx")
257 unit $ cmd [Cwd output] [path] buildArgs
258 unit $ cmd [Cwd output] [path] buildArgs
259
260 GhcPkg Clone _ -> do
261 Stdout pkgDesc <- cmd [path]
262 [ "--expand-pkgroot"
263 , "--no-user-package-db"
264 , "describe"
265 , input -- the package name
266 ]
267 cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"])
268
269 GhcPkg Unregister _ -> do
270 Exit _ <- cmd echo [path] (buildArgs ++ [input])
271 return ()
272
273 _ -> cmd echo [path] buildArgs
274
275 -- TODO: Some builders are required only on certain platforms. For example,
276 -- 'Objdump' is only required on OpenBSD and AIX. Add support for platform
277 -- specific optional builders as soon as we can reliably test this feature.
278 -- See https://github.com/snowleopard/hadrian/issues/211.
279 isOptional :: Builder -> Bool
280 isOptional = \case
281 Objdump -> True
282 _ -> False
283
284 -- | Determine the location of a system 'Builder'.
285 systemBuilderPath :: Builder -> Action FilePath
286 systemBuilderPath builder = case builder of
287 Alex -> fromKey "alex"
288 Ar _ Stage0 -> fromKey "system-ar"
289 Ar _ _ -> fromKey "ar"
290 Cc _ Stage0 -> fromKey "system-cc"
291 Cc _ _ -> fromKey "cc"
292 -- We can't ask configure for the path to configure!
293 Configure _ -> return "configure"
294 Ghc _ Stage0 -> fromKey "system-ghc"
295 GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
296 Happy -> fromKey "happy"
297 HsCpp -> fromKey "hs-cpp"
298 Ld _ -> fromKey "ld"
299 Make _ -> fromKey "make"
300 Nm -> fromKey "nm"
301 Objdump -> fromKey "objdump"
302 Patch -> fromKey "patch"
303 Perl -> fromKey "perl"
304 Python -> fromKey "python"
305 Ranlib -> fromKey "ranlib"
306 RunTest -> fromKey "python"
307 Sphinx _ -> fromKey "sphinx-build"
308 Tar _ -> fromKey "tar"
309 Xelatex -> fromKey "xelatex"
310 _ -> error $ "No entry for " ++ show builder ++ inCfg
311 where
312 inCfg = " in " ++ quote configFile ++ " file."
313 fromKey key = do
314 let unpack = fromMaybe . error $ "Cannot find path to builder "
315 ++ quote key ++ inCfg ++ " Did you skip configure?"
316 path <- unpack <$> lookupValue configFile key
317 if null path
318 then do
319 unless (isOptional builder) . error $ "Non optional builder "
320 ++ quote key ++ " is not specified" ++ inCfg
321 return "" -- TODO: Use a safe interface.
322 else do
323 win <- windowsHost
324 fullPath <- lookupInPath path
325 case (win, hasExtension fullPath) of
326 (False, _ ) -> return fullPath
327 (True , True ) -> fixAbsolutePathOnWindows fullPath
328 (True , False) -> fixAbsolutePathOnWindows fullPath <&> (<.> exe)
329
330 -- | Was the path to a given system 'Builder' specified in configuration files?
331 isSpecified :: Builder -> Action Bool
332 isSpecified = fmap (not . null) . systemBuilderPath
333
334 -- | Apply a patch by executing the 'Patch' builder in a given directory.
335 applyPatch :: FilePath -> FilePath -> Action ()
336 applyPatch dir patch = do
337 let file = dir -/- patch
338 needBuilder Patch
339 path <- builderPath Patch
340 putBuild $ "| Apply patch " ++ file
341 quietly $ cmd [Cwd dir, FileStdin file] [path, "-p0"]
342
343 -- | Install a directory.
344 installDirectory :: FilePath -> Action ()
345 installDirectory dir = do
346 path <- fixAbsolutePathOnWindows =<< setting InstallDir
347 putBuild $ "| Install directory " ++ dir
348 quietly $ cmd path dir
349
350 -- | Install data files to a directory and track them.
351 installData :: [FilePath] -> FilePath -> Action ()
352 installData fs dir = do
353 path <- fixAbsolutePathOnWindows =<< setting InstallData
354 need fs
355 forM_ fs $ \f -> putBuild $ "| Install data " ++ f ++ " to " ++ dir
356 quietly $ cmd path fs dir
357
358 -- | Install an executable file to a directory and track it.
359 installProgram :: FilePath -> FilePath -> Action ()
360 installProgram f dir = do
361 path <- fixAbsolutePathOnWindows =<< setting InstallProgram
362 need [f]
363 putBuild $ "| Install program " ++ f ++ " to " ++ dir
364 quietly $ cmd path f dir
365
366 -- | Install an executable script to a directory and track it.
367 installScript :: FilePath -> FilePath -> Action ()
368 installScript f dir = do
369 path <- fixAbsolutePathOnWindows =<< setting InstallScript
370 need [f]
371 putBuild $ "| Install script " ++ f ++ " to " ++ dir
372 quietly $ cmd path f dir
373
374 -- | Create a symbolic link from source file to target file (when symbolic links
375 -- are supported) and track the source file.
376 linkSymbolic :: FilePath -> FilePath -> Action ()
377 linkSymbolic source target = do
378 lns <- setting LnS
379 unless (null lns) $ do
380 need [source] -- Guarantee source is built before printing progress info.
381 let dir = takeDirectory target
382 liftIO $ IO.createDirectoryIfMissing True dir
383 putProgressInfo =<< renderAction "Create symbolic link" source target
384 quietly $ cmd lns source target