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