diff options
Diffstat (limited to 'hadrian/src/Builder.hs')
| -rw-r--r-- | hadrian/src/Builder.hs | 340 |
1 files changed, 340 insertions, 0 deletions
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs new file mode 100644 index 0000000000..85c2c4c280 --- /dev/null +++ b/hadrian/src/Builder.hs @@ -0,0 +1,340 @@ +{-# LANGUAGE InstanceSigs #-} +module Builder ( + -- * Data types + ArMode (..), CcMode (..), ConfigurationInfo (..), GhcMode (..), + GhcPkgMode (..), HaddockMode (..), SphinxMode (..), TarMode (..), + Builder (..), + + -- * Builder properties + builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder, + runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath, + builderEnvironment, + + -- * Ad hoc builder invocation + applyPatch + ) where + +import Development.Shake.Classes +import GHC.Generics +import qualified Hadrian.Builder as H +import Hadrian.Builder hiding (Builder) +import Hadrian.Builder.Ar +import Hadrian.Builder.Sphinx +import Hadrian.Builder.Tar +import Hadrian.Oracles.Path +import Hadrian.Oracles.TextFile +import Hadrian.Utilities + +import Base +import Context +import Oracles.Flag +import Oracles.Setting +import Packages + +-- | C compiler can be used in two different modes: +-- * Compile or preprocess a source file. +-- * Extract source dependencies by passing @-MM@ command line argument. +data CcMode = CompileC | FindCDependencies deriving (Eq, Generic, Show) + +instance Binary CcMode +instance Hashable CcMode +instance NFData CcMode + +-- | GHC can be used in four different modes: +-- * Compile a Haskell source file. +-- * Compile a C source file. +-- * Extract source dependencies by passing @-M@ command line argument. +-- * Link object files & static libraries into an executable. +data GhcMode = CompileHs | CompileCWithGhc | FindHsDependencies | LinkHs + deriving (Eq, Generic, Show) + +instance Binary GhcMode +instance Hashable GhcMode +instance NFData GhcMode + +-- | To configure a package we need two pieces of information, which we choose +-- to record separately for convenience. +-- +-- * Command line arguments to be passed to the setup script. +-- +-- * Package configuration flags that enable/disable certain package features. +-- Here is an example from "Settings.Packages": +-- +-- > package rts +-- > ? builder (Cabal Flags) +-- > ? any (wayUnit Profiling) rtsWays +-- > ? arg "profiling" +-- +-- This instructs package configuration functions (such as 'configurePackage') +-- to enable the @profiling@ Cabal flag when processing @rts.cabal@ and +-- building RTS with profiling information. +data ConfigurationInfo = Setup | Flags deriving (Eq, Generic, Show) + +instance Binary ConfigurationInfo +instance Hashable ConfigurationInfo +instance NFData ConfigurationInfo + +-- TODO: Do we really need all these modes? Why do we need 'Dependencies'? We +-- can extract dependencies using the Cabal library. +-- | 'GhcPkg' can initialise a package database and register packages in it. +data GhcPkgMode = Init -- ^ Initialize a new database. + | Update -- ^ Update a package. + | Copy -- ^ Copy a package from one database to another. + | Unregister -- ^ Unregister a package. + | Dependencies -- ^ Compute package dependencies. + deriving (Eq, Generic, Show) + +instance Binary GhcPkgMode +instance Hashable GhcPkgMode +instance NFData GhcPkgMode + +-- | Haddock can be used in two different modes: +-- * Generate documentation for a single package +-- * Generate an index page for a collection of packages +data HaddockMode = BuildPackage | BuildIndex deriving (Eq, Generic, Show) + +instance Binary HaddockMode +instance Hashable HaddockMode +instance NFData HaddockMode + +-- | A 'Builder' is a (usually external) command invoked in a separate process +-- via 'cmd'. Here are some examples: +-- * 'Alex' is a lexical analyser generator that builds @Lexer.hs@ from @Lexer.x@. +-- * 'Ghc' 'Stage0' is the bootstrapping Haskell compiler used in 'Stage0'. +-- * 'Ghc' @StageN@ (N > 0) is the GHC built in stage (N - 1) and used in @StageN@. +-- +-- The 'Cabal' builder is unusual in that it does not correspond to an external +-- program but instead relies on the Cabal library for package configuration. +data Builder = Alex + | Ar ArMode Stage + | Autoreconf FilePath + | DeriveConstants + | Cabal ConfigurationInfo Stage + | Cc CcMode Stage + | Configure FilePath + | GenApply + | GenPrimopCode + | Ghc GhcMode Stage + | GhcPkg GhcPkgMode Stage + | Haddock HaddockMode + | Happy + | Hpc + | Hp2Ps + | HsCpp + | Hsc2Hs Stage + | Ld Stage + | Make FilePath + | Nm + | Objdump + | Patch + | Perl + | Python + | Ranlib + | RunTest + | Sphinx SphinxMode + | Tar TarMode + | Unlit + | Xelatex + deriving (Eq, Generic, Show) + +instance Binary Builder +instance Hashable Builder +instance NFData Builder + +-- | Some builders are built by this very build system, in which case +-- 'builderProvenance' returns the corresponding build 'Context' (which includes +-- 'Stage' and GHC 'Package'). +builderProvenance :: Builder -> Maybe Context +builderProvenance = \case + DeriveConstants -> context Stage0 deriveConstants + GenApply -> context Stage0 genapply + GenPrimopCode -> context Stage0 genprimopcode + Ghc _ Stage0 -> Nothing + Ghc _ stage -> context (pred stage) ghc + GhcPkg _ Stage0 -> Nothing + GhcPkg _ _ -> context Stage0 ghcPkg + Haddock _ -> context Stage2 haddock + Hpc -> context Stage1 hpcBin + Hp2Ps -> context Stage0 hp2ps + Hsc2Hs _ -> context Stage0 hsc2hs + Unlit -> context Stage0 unlit + _ -> Nothing + where + context s p = Just $ vanillaContext s p + +instance H.Builder Builder where + builderPath :: Builder -> Action FilePath + builderPath builder = case builderProvenance builder of + Nothing -> systemBuilderPath builder + Just context -> programPath context + + runtimeDependencies :: Builder -> Action [FilePath] + runtimeDependencies = \case + Autoreconf dir -> return [dir -/- "configure.ac"] + Configure dir -> return [dir -/- "configure"] + + Ghc _ Stage0 -> return [] + Ghc _ stage -> do + root <- buildRoot + win <- windowsHost + touchyPath <- programPath (vanillaContext Stage0 touchy) + unlitPath <- builderPath Unlit + ghcdeps <- ghcDeps stage + return $ [ root -/- ghcSplitPath stage -- TODO: Make conditional on --split-objects + , unlitPath ] + ++ ghcdeps + ++ [ touchyPath | win ] + + Hsc2Hs stage -> (\p -> [p]) <$> templateHscPath stage + Make dir -> return [dir -/- "Makefile"] + _ -> return [] + + -- query the builder for some information. + -- contrast this with runBuilderWith, which returns @Action ()@ + -- this returns the @stdout@ from running the builder. + -- For now this only implements asking @ghc-pkg@ about package + -- dependencies. + askBuilderWith :: Builder -> BuildInfo -> Action String + askBuilderWith builder BuildInfo {..} = case builder of + GhcPkg Dependencies _ -> do + let input = fromSingleton msgIn buildInputs + msgIn = "[askBuilder] Exactly one input file expected." + needBuilder builder + path <- H.builderPath builder + need [path] + Stdout stdout <- cmd [path] ["--no-user-package-db", "field", input, "depends"] + return stdout + _ -> error $ "Builder " ++ show builder ++ " can not be asked!" + + runBuilderWith :: Builder -> BuildInfo -> Action () + runBuilderWith builder BuildInfo {..} = do + path <- builderPath builder + withResources buildResources $ do + verbosity <- getVerbosity + let input = fromSingleton msgIn buildInputs + msgIn = "[runBuilderWith] Exactly one input file expected." + output = fromSingleton msgOut buildOutputs + msgOut = "[runBuilderWith] Exactly one output file expected." + -- Suppress stdout depending on the Shake's verbosity setting. + echo = EchoStdout (verbosity >= Loud) + -- Capture stdout and write it to the output file. + captureStdout = do + Stdout stdout <- cmd [path] buildArgs + writeFileChanged output stdout + case builder of + Ar Pack _ -> do + useTempFile <- flag ArSupportsAtFile + if useTempFile then runAr path buildArgs + else runArWithoutTempFile path buildArgs + + Ar Unpack _ -> cmd echo [Cwd output] [path] buildArgs + + Autoreconf dir -> cmd echo [Cwd dir] [path] buildArgs + Configure dir -> do + -- Inject /bin/bash into `libtool`, instead of /bin/sh, + -- otherwise Windows breaks. TODO: Figure out why. + bash <- bashPath + let env = AddEnv "CONFIG_SHELL" bash + cmd echo env [Cwd dir] ["sh", path] buildOptions buildArgs + + HsCpp -> captureStdout + GenApply -> captureStdout + + GenPrimopCode -> do + stdin <- readFile' input + Stdout stdout <- cmd (Stdin stdin) [path] buildArgs + writeFileChanged output stdout + + Make dir -> cmd echo path ["-C", dir] buildArgs + + Xelatex -> do + unit $ cmd [Cwd output] [path] buildArgs + unit $ cmd [Cwd output] [path] buildArgs + unit $ cmd [Cwd output] [path] buildArgs + unit $ cmd [Cwd output] ["makeindex"] (input -<.> "idx") + unit $ cmd [Cwd output] [path] buildArgs + unit $ cmd [Cwd output] [path] buildArgs + + GhcPkg Copy _ -> do + Stdout pkgDesc <- cmd [path] + [ "--expand-pkgroot" + , "--no-user-package-db" + , "describe" + , input -- the package name + ] + cmd (Stdin pkgDesc) [path] (buildArgs ++ ["-"]) + + GhcPkg Unregister _ -> do + Exit _ <- cmd echo [path] (buildArgs ++ [input]) + return () + + _ -> cmd echo [path] buildArgs + +-- TODO: Some builders are required only on certain platforms. For example, +-- 'Objdump' is only required on OpenBSD and AIX. Add support for platform +-- specific optional builders as soon as we can reliably test this feature. +-- See https://github.com/snowleopard/hadrian/issues/211. +isOptional :: Builder -> Bool +isOptional = \case + Objdump -> True + _ -> False + +-- | Determine the location of a system 'Builder'. +systemBuilderPath :: Builder -> Action FilePath +systemBuilderPath builder = case builder of + Alex -> fromKey "alex" + Ar _ Stage0 -> fromKey "system-ar" + Ar _ _ -> fromKey "ar" + Autoreconf _ -> fromKey "autoreconf" + Cc _ Stage0 -> fromKey "system-cc" + Cc _ _ -> fromKey "cc" + -- We can't ask configure for the path to configure! + Configure _ -> return "configure" + Ghc _ Stage0 -> fromKey "system-ghc" + GhcPkg _ Stage0 -> fromKey "system-ghc-pkg" + Happy -> fromKey "happy" + HsCpp -> fromKey "hs-cpp" + Ld _ -> fromKey "ld" + Make _ -> fromKey "make" + Nm -> fromKey "nm" + Objdump -> fromKey "objdump" + Patch -> fromKey "patch" + Perl -> fromKey "perl" + Python -> fromKey "python" + Ranlib -> fromKey "ranlib" + RunTest -> fromKey "python" + Sphinx _ -> fromKey "sphinx-build" + Tar _ -> fromKey "tar" + Xelatex -> fromKey "xelatex" + _ -> error $ "No entry for " ++ show builder ++ inCfg + where + inCfg = " in " ++ quote configFile ++ " file." + fromKey key = do + let unpack = fromMaybe . error $ "Cannot find path to builder " + ++ quote key ++ inCfg ++ " Did you skip configure?" + path <- unpack <$> lookupValue configFile key + if null path + then do + unless (isOptional builder) . error $ "Non optional builder " + ++ quote key ++ " is not specified" ++ inCfg + return "" -- TODO: Use a safe interface. + else do + win <- windowsHost + fullPath <- lookupInPath path + case (win, hasExtension fullPath) of + (False, _ ) -> return fullPath + (True , True ) -> fixAbsolutePathOnWindows fullPath + (True , False) -> fixAbsolutePathOnWindows fullPath <&> (<.> exe) + +-- | Was the path to a given system 'Builder' specified in configuration files? +isSpecified :: Builder -> Action Bool +isSpecified = fmap (not . null) . systemBuilderPath + +-- | Apply a patch by executing the 'Patch' builder in a given directory. +applyPatch :: FilePath -> FilePath -> Action () +applyPatch dir patch = do + let file = dir -/- patch + needBuilder Patch + path <- builderPath Patch + putBuild $ "| Apply patch " ++ file + quietly $ cmd [Cwd dir, FileStdin file] [path, "-p0"] |