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