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