Drop the redundant build rule for literate Perl scripts
[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 builder = do
153 path <- H.builderPath builder
154 case builder of
155 Configure dir -> need [dir -/- "configure"]
156 Hsc2Hs -> need [path, templateHscPath]
157 Make dir -> need [dir -/- "Makefile"]
158 _ -> when (isJust $ builderProvenance builder) $ 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 echo env [Cwd dir] ["sh", 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 echo path ["-C", dir] buildArgs
199
200 Xelatex -> do
201 unit $ cmd [Cwd output] [path] buildArgs
202 unit $ cmd [Cwd output] [path] buildArgs
203 unit $ cmd [Cwd output] [path] buildArgs
204 unit $ cmd [Cwd output] ["makeindex"] (input -<.> "idx")
205 unit $ cmd [Cwd output] [path] buildArgs
206 unit $ cmd [Cwd output] [path] buildArgs
207
208 _ -> cmd echo [path] buildArgs
209
210 -- TODO: Some builders are required only on certain platforms. For example,
211 -- Objdump is only required on OpenBSD and AIX, as mentioned in #211. Add
212 -- support for platform-specific optional builders as soon as we can reliably
213 -- test this feature.
214 isOptional :: Builder -> Bool
215 isOptional = \case
216 Objdump -> True
217 _ -> False
218
219 -- | Determine the location of a system 'Builder'.
220 systemBuilderPath :: Builder -> Action FilePath
221 systemBuilderPath builder = case builder of
222 Alex -> fromKey "alex"
223 Ar _ Stage0 -> fromKey "system-ar"
224 Ar _ _ -> fromKey "ar"
225 Cc _ Stage0 -> fromKey "system-cc"
226 Cc _ _ -> fromKey "cc"
227 -- We can't ask configure for the path to configure!
228 Configure _ -> return "configure"
229 Ghc _ Stage0 -> fromKey "system-ghc"
230 GhcPkg _ Stage0 -> fromKey "system-ghc-pkg"
231 Happy -> fromKey "happy"
232 HsCpp -> fromKey "hs-cpp"
233 Ld -> fromKey "ld"
234 Make _ -> fromKey "make"
235 Nm -> fromKey "nm"
236 Objdump -> fromKey "objdump"
237 Patch -> fromKey "patch"
238 Perl -> fromKey "perl"
239 Ranlib -> fromKey "ranlib"
240 Sphinx _ -> fromKey "sphinx-build"
241 Tar _ -> fromKey "tar"
242 Xelatex -> fromKey "xelatex"
243 _ -> error $ "No entry for " ++ show builder ++ inCfg
244 where
245 inCfg = " in " ++ quote configFile ++ " file."
246 fromKey key = do
247 let unpack = fromMaybe . error $ "Cannot find path to builder "
248 ++ quote key ++ inCfg ++ " Did you skip configure?"
249 path <- unpack <$> lookupValue configFile key
250 if null path
251 then do
252 unless (isOptional builder) . error $ "Non optional builder "
253 ++ quote key ++ " is not specified" ++ inCfg
254 return "" -- TODO: Use a safe interface.
255 else fixAbsolutePathOnWindows =<< lookupInPath path
256
257 -- | Was the path to a given system 'Builder' specified in configuration files?
258 isSpecified :: Builder -> Action Bool
259 isSpecified = fmap (not . null) . systemBuilderPath
260
261 -- | Apply a patch by executing the 'Patch' builder in a given directory.
262 applyPatch :: FilePath -> FilePath -> Action ()
263 applyPatch dir patch = do
264 let file = dir -/- patch
265 needBuilder Patch
266 path <- builderPath Patch
267 putBuild $ "| Apply patch " ++ file
268 quietly $ cmd [Cwd dir, FileStdin file] [path, "-p0"]
269
270 -- | Install a directory.
271 installDirectory :: FilePath -> Action ()
272 installDirectory dir = do
273 path <- fixAbsolutePathOnWindows =<< setting InstallDir
274 putBuild $ "| Install directory " ++ dir
275 quietly $ cmd path dir
276
277 -- | Install data files to a directory and track them.
278 installData :: [FilePath] -> FilePath -> Action ()
279 installData fs dir = do
280 path <- fixAbsolutePathOnWindows =<< setting InstallData
281 need fs
282 forM_ fs $ \f -> putBuild $ "| Install data " ++ f ++ " to " ++ dir
283 quietly $ cmd path fs dir
284
285 -- | Install an executable file to a directory and track it.
286 installProgram :: FilePath -> FilePath -> Action ()
287 installProgram f dir = do
288 path <- fixAbsolutePathOnWindows =<< setting InstallProgram
289 need [f]
290 putBuild $ "| Install program " ++ f ++ " to " ++ dir
291 quietly $ cmd path f dir
292
293 -- | Install an executable script to a directory and track it.
294 installScript :: FilePath -> FilePath -> Action ()
295 installScript f dir = do
296 path <- fixAbsolutePathOnWindows =<< setting InstallScript
297 need [f]
298 putBuild $ "| Install script " ++ f ++ " to " ++ dir
299 quietly $ cmd path f dir
300
301 -- | Create a symbolic link from source file to target file (when symbolic links
302 -- are supported) and track the source file.
303 linkSymbolic :: FilePath -> FilePath -> Action ()
304 linkSymbolic source target = do
305 lns <- setting LnS
306 unless (null lns) $ do
307 need [source] -- Guarantee source is built before printing progress info.
308 let dir = takeDirectory target
309 liftIO $ IO.createDirectoryIfMissing True dir
310 putProgressInfo =<< renderAction "Create symbolic link" source target
311 quietly $ cmd lns source target