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