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