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