Factor out common builder-related functionality into the library
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Thu, 31 Aug 2017 02:24:11 +0000 (03:24 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Thu, 31 Aug 2017 02:24:11 +0000 (03:24 +0100)
See #347

14 files changed:
hadrian.cabal
src/Builder.hs
src/Hadrian/Builder.hs [new file with mode: 0644]
src/Hadrian/Expression.hs
src/Hadrian/Utilities.hs
src/Main.hs
src/Rules/Configure.hs
src/Rules/Install.hs
src/Rules/Perl.hs
src/Rules/Selftest.hs
src/Rules/SourceDist.hs
src/Settings/Builders/Ar.hs
src/UserSettings.hs
src/Utilities.hs

index 66072a2..497bb67 100644 (file)
@@ -26,6 +26,7 @@ executable hadrian
                        , Expression
                        , Flavour
                        , GHC
+                       , Hadrian.Builder
                        , Hadrian.Expression
                        , Hadrian.Haskell.Cabal
                        , Hadrian.Haskell.Cabal.Parse
index 822629b..bb4e0ed 100644 (file)
@@ -1,18 +1,26 @@
+{-# LANGUAGE InstanceSigs #-}
 module Builder (
+    -- * Data types
     CcMode (..), GhcMode (..), GhcPkgMode (..), Builder (..),
-    builderProvenance, systemBuilderPath, builderPath, getBuilderPath,
-    isSpecified, needBuilder,
+
+    -- * Builder properties
+    builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder,
+    runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath
     ) where
 
 import Development.Shake.Classes
 import GHC.Generics
-import Hadrian.Expression
+import qualified Hadrian.Builder as H
+import Hadrian.Builder hiding (Builder)
 import Hadrian.Oracles.Path
 import Hadrian.Oracles.TextFile
+import Hadrian.Utilities
 
 import Base
 import Context
 import GHC
+import Oracles.Flag
+import Oracles.Setting
 
 -- | C compiler can be used in two different modes:
 -- * Compile or preprocess a source file.
@@ -48,7 +56,7 @@ instance NFData   GhcPkgMode
 -- @GhcPkg Stage0@ is the bootstrapping @GhcPkg@.
 -- @GhcPkg Stage1@ is the one built in Stage0.
 data Builder = Alex
-             | Ar Stage
+             | Ar Stage -- TODO: Add ArMode = Pack | Unpack
              | DeriveConstants
              | Cc CcMode Stage
              | Configure FilePath
@@ -101,13 +109,69 @@ builderProvenance = \case
   where
     context s p = Just $ vanillaContext s p
 
--- | Make sure a 'Builder' exists and rebuild it if out of date.
-needBuilder :: Builder -> Action ()
-needBuilder (Configure dir) = need [dir -/- "configure"]
-needBuilder (Make      dir) = need [dir -/- "Makefile"]
-needBuilder builder         = when (isJust $ builderProvenance builder) $ do
-    path <- builderPath builder
-    need [path]
+instance H.Builder Builder where
+    builderPath :: Builder -> Action FilePath
+    builderPath builder = case builderProvenance builder of
+        Nothing      -> systemBuilderPath builder
+        Just context -> programPath context
+
+    needBuilder :: Builder -> Action ()
+    needBuilder (Configure dir) = need [dir -/- "configure"]
+    needBuilder (Make      dir) = need [dir -/- "Makefile"]
+    needBuilder builder         = when (isJust $ builderProvenance builder) $ do
+        path <- H.builderPath builder
+        need [path]
+
+    runBuilderWith :: Builder -> BuildInfo -> Action ()
+    runBuilderWith builder BuildInfo {..} = do
+        path <- builderPath builder
+        withResources buildResources $ do
+            let input  = fromSingleton msgIn buildInputs
+                msgIn  = "[runBuilderWith] Exactly one input file expected."
+                output = fromSingleton msgOut buildOutputs
+                msgOut = "[runBuilderWith] Exactly one output file expected."
+                captureStdout = do
+                    Stdout stdout <- cmd [path] buildArgs
+                    writeFileChanged output stdout
+
+            case builder of
+                Ar _ -> do
+                    if "//*.a" ?== output
+                    then arCmd path buildArgs
+                    else do
+                        top   <- topDirectory
+                        echo  <- cmdEcho
+                        cmd echo [Cwd output] [path] "x" (top -/- input)
+
+                Configure dir -> do
+                    -- Inject /bin/bash into `libtool`, instead of /bin/sh,
+                    -- otherwise Windows breaks. TODO: Figure out why.
+                    bash <- bashPath
+                    echo <- cmdEcho
+                    let env = AddEnv "CONFIG_SHELL" bash
+                    cmd Shell echo env [Cwd dir] [path] buildOptions buildArgs
+
+                HsCpp    -> captureStdout
+                GenApply -> captureStdout
+
+                GenPrimopCode -> do
+                    stdin <- readFile' input
+                    Stdout stdout <- cmd (Stdin stdin) [path] buildArgs
+                    writeFileChanged output stdout
+
+                Make dir -> do
+                    echo <- cmdEcho
+                    cmd Shell echo path ["-C", dir] buildArgs
+
+                _  -> do
+                    echo <- cmdEcho
+                    cmd echo [path] buildArgs
+
+-- | Suppress build output depending on the Shake's verbosity setting.
+cmdEcho :: Action CmdOption
+cmdEcho = do
+    verbosity <- getVerbosity
+    return $ EchoStdout (verbosity >= Loud)
 
 -- TODO: Some builders are required only on certain platforms. For example,
 -- Objdump is only required on OpenBSD and AIX, as mentioned in #211. Add
@@ -156,15 +220,40 @@ systemBuilderPath builder = case builder of
             return "" -- TODO: Use a safe interface.
         else fixAbsolutePathOnWindows =<< lookupInPath path
 
--- | Determine the location of a 'Builder'.
-builderPath :: Builder -> Action FilePath
-builderPath builder = case builderProvenance builder of
-    Nothing      -> systemBuilderPath builder
-    Just context -> programPath context
-
 -- | Was the path to a given system 'Builder' specified in configuration files?
 isSpecified :: Builder -> Action Bool
 isSpecified = fmap (not . null) . systemBuilderPath
 
-getBuilderPath :: Builder -> Expr c Builder FilePath
-getBuilderPath = expr . builderPath
+-- This count includes arg "q" and arg file parameters in arBuilderArgs.
+-- Update this value appropriately when changing arBuilderArgs.
+arFlagsCount :: Int
+arFlagsCount = 2
+
+-- | Invoke 'Ar' builder given a path to it and a list of arguments. Take care
+-- not to exceed the limit on command line length, which differs across
+-- supported operating systems (see 'cmdLineLengthLimit'). 'Ar' needs to be
+-- handled in a special way because we sometimes need to archive __a lot__ of
+-- files (in Cabal package, for example, command line length can reach 2MB!).
+-- To work around the limit on the command line length we pass the list of files
+-- to be archived via a temporary file, or alternatively, we split argument list
+-- into chunks and call 'Ar' multiple times (when passing arguments via a
+-- temporary file is not supported).
+arCmd :: FilePath -> [String] -> Action ()
+arCmd path argList = do
+    arSupportsAtFile <- flag ArSupportsAtFile
+    let flagArgs = take arFlagsCount argList
+        fileArgs = drop arFlagsCount argList
+    if arSupportsAtFile
+    then useAtFile path flagArgs fileArgs
+    else useSuccessiveInvocations path flagArgs fileArgs
+
+useAtFile :: FilePath -> [String] -> [String] -> Action ()
+useAtFile path flagArgs fileArgs = withTempFile $ \tmp -> do
+    writeFile' tmp $ unwords fileArgs
+    cmd [path] flagArgs ('@' : tmp)
+
+useSuccessiveInvocations :: FilePath -> [String] -> [String] -> Action ()
+useSuccessiveInvocations path flagArgs fileArgs = do
+    maxChunk <- cmdLineLengthLimit
+    forM_ (chunksOfSize maxChunk fileArgs) $ \argsChunk ->
+        unit . cmd [path] $ flagArgs ++ argsChunk
diff --git a/src/Hadrian/Builder.hs b/src/Hadrian/Builder.hs
new file mode 100644 (file)
index 0000000..f1b27b0
--- /dev/null
@@ -0,0 +1,118 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     : Hadrian.Builder
+-- Copyright  : (c) Andrey Mokhov 2014-2017
+-- License    : MIT (see the file LICENSE)
+-- Maintainer : andrey.mokhov@gmail.com
+-- Stability  : experimental
+--
+-- A typical build system invokes several build tools, or /builders/, such as
+-- compilers, linkers, etc., some of which may be built by the build system
+-- itself. This module defines the 'Builder' type class and a few associated
+-- functions that can be used to invoke builders.
+-----------------------------------------------------------------------------
+module Hadrian.Builder (
+    Builder (..), BuildInfo (..), runBuilder, runBuilderWithCmdOptions,
+    build, buildWithResources, buildWithCmdOptions, getBuilderPath
+    ) where
+
+import Data.List
+import Development.Shake
+
+import Hadrian.Expression hiding (inputs, outputs)
+import Hadrian.Oracles.ArgsHash
+import Hadrian.Target
+import Hadrian.Utilities
+
+-- | This data structure captures all information relevant to invoking a builder.
+data BuildInfo = BuildInfo {
+    -- | Command line arguments.
+    buildArgs :: [String],
+    -- | Input files.
+    buildInputs :: [FilePath],
+    -- | Output files.
+    buildOutputs :: [FilePath],
+    -- | Options to be passed to Shake's 'cmd' function.
+    buildOptions :: [CmdOption],
+    -- | Resources to be aquired.
+    buildResources :: [(Resource, Int)] }
+
+class ShakeValue b => Builder b where
+    -- | The path to a builder.
+    builderPath :: b -> Action FilePath
+
+    -- | Make sure a builder exists and rebuild it if out of date.
+    needBuilder :: b -> Action ()
+    needBuilder builder = do
+        path <- builderPath builder
+        need [path]
+
+    -- | Run a builder with a given 'BuildInfo'. Also see 'runBuilder'.
+    runBuilderWith :: b -> BuildInfo -> Action ()
+    runBuilderWith builder buildInfo = do
+        let args = buildArgs buildInfo
+        needBuilder builder
+        path <- builderPath builder
+        let msg = if null args then "" else " (" ++ intercalate ", " args ++ ")"
+        putBuild $ "| Run " ++ show builder ++ msg
+        quietly $ cmd (buildOptions buildInfo) [path] args
+
+-- | Run a builder with a specified list of command line arguments, reading a
+-- list of input files and writing a list of output files. A lightweight version
+-- of 'runBuilderWith'.
+runBuilder :: Builder b => b -> [String] -> [FilePath] -> [FilePath] -> Action ()
+runBuilder = runBuilderWithCmdOptions []
+
+-- | Like 'runBuilder' but passes given options to Shake's 'cmd'.
+runBuilderWithCmdOptions :: Builder b => [CmdOption] -> b -> [String] -> [FilePath] -> [FilePath] -> Action ()
+runBuilderWithCmdOptions opts builder args inputs outputs =
+    runBuilderWith builder $ BuildInfo { buildArgs      = args
+                                       , buildInputs    = inputs
+                                       , buildOutputs   = outputs
+                                       , buildOptions   = opts
+                                       , buildResources = [] }
+
+-- | Build a 'Target' using the list of command line arguments computed from a
+-- given 'Args' expression. Force a rebuild if the argument list has changed
+-- since the last build.
+build :: (Builder b, ShakeValue c) => Target c b -> Args c b -> Action ()
+build = buildWith [] []
+
+-- | Like 'build' but acquires necessary resources.
+buildWithResources :: (Builder b, ShakeValue c) => [(Resource, Int)] -> Target c b -> Args c b -> Action ()
+buildWithResources rs = buildWith rs []
+
+-- | Like 'build' but passes given options to Shake's 'cmd'.
+buildWithCmdOptions :: (Builder b, ShakeValue c) => [CmdOption] -> Target c b -> Args c b -> Action ()
+buildWithCmdOptions = buildWith []
+
+buildWith :: (Builder b, ShakeValue c) => [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action ()
+buildWith rs opts target args = do
+    needBuilder (builder target)
+    argList <- interpret target args
+    trackArgsHash target -- Rerun the rule if the hash of argList has changed.
+    putInfo target
+    verbose <- interpret target verboseCommand
+    let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
+    quietlyUnlessVerbose $ do
+        runBuilderWith (builder target) $ BuildInfo
+            { buildArgs      = argList
+            , buildInputs    = inputs target
+            , buildOutputs   = outputs target
+            , buildOptions   = opts
+            , buildResources = rs }
+
+-- | Print out information about the command being executed.
+putInfo :: Show b => Target c b -> Action ()
+putInfo t = putProgressInfo =<< renderAction
+    ("Run " ++ show (builder t)) -- TODO: Bring back contextInfo.
+    (digest $ inputs  t)
+    (digest $ outputs t)
+  where
+    digest [] = "none"
+    digest [x] = x
+    digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"
+
+-- | Get the path to the current builder.
+getBuilderPath :: Builder b => b -> Expr c b FilePath
+getBuilderPath = expr . builderPath
index b0b7ad6..e5c01f8 100644 (file)
@@ -7,7 +7,7 @@ module Hadrian.Expression (
     expr, exprIO, arg, remove,
 
     -- ** Predicates
-    (?), input, inputs, output, outputs,
+    (?), input, inputs, output, outputs, VerboseCommand (..), verboseCommand,
 
     -- ** Evaluation
     interpret, interpretInContext,
@@ -21,6 +21,7 @@ import Control.Monad.Trans
 import Control.Monad.Trans.Reader
 import Data.Semigroup
 import Development.Shake
+import Development.Shake.Classes
 
 import qualified Hadrian.Target as Target
 import Hadrian.Target (Target, target)
@@ -144,3 +145,9 @@ output f = any (f ?==) <$> getOutputs
 -- | Does any of the output files match any of the given patterns?
 outputs :: [FilePattern] -> Predicate c b
 outputs = anyM output
+
+newtype VerboseCommand c b = VerboseCommand { predicate :: Predicate c b }
+    deriving Typeable
+
+verboseCommand :: (ShakeValue c, ShakeValue b) => Predicate c b
+verboseCommand = predicate =<< expr (userSetting . VerboseCommand $ return False)
index 416399b..9534645 100644 (file)
@@ -1,7 +1,7 @@
 {-# LANGUAGE TypeFamilies #-}
 module Hadrian.Utilities (
     -- * List manipulation
-    fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll,
+    fromSingleton, replaceEq, minusOrd, intersectOrd, lookupAll, chunksOfSize,
 
     -- * String manipulation
     quote, yesNo,
@@ -99,6 +99,13 @@ lookupAll (x:xs) (y:ys) = case compare x (fst y) of
     EQ -> Just (snd y) : lookupAll xs (y:ys)
     GT -> lookupAll (x:xs) ys
 
+-- | @chunksOfSize size strings@ splits a given list of strings into chunks not
+-- exceeding the given @size@. If that is impossible, it uses singleton chunks.
+chunksOfSize :: Int -> [String] -> [[String]]
+chunksOfSize n = repeatedly f
+  where
+    f xs = splitAt (max 1 $ length $ takeWhile (<= n) $ scanl1 (+) $ map length xs) xs
+
 -- | Add single quotes around a String.
 quote :: String -> String
 quote s = "'" ++ s ++ "'"
index 83ef3db..2a9f740 100644 (file)
@@ -1,6 +1,7 @@
 module Main (main) where
 
 import Development.Shake
+import Hadrian.Expression
 import Hadrian.Utilities
 
 import qualified Base
@@ -21,7 +22,8 @@ main = do
     argsMap <- CommandLine.cmdLineArgsMap
     let extra = insertExtra UserSettings.buildProgressColour
               $ insertExtra UserSettings.successColour
-              $ insertExtra UserSettings.userBuildRoot argsMap
+              $ insertExtra UserSettings.userBuildRoot
+              $ insertExtra (VerboseCommand UserSettings.verboseCommand) argsMap
 
         BuildRoot buildRoot = UserSettings.userBuildRoot
 
index d58aac6..5e29116 100644 (file)
@@ -3,6 +3,7 @@ module Rules.Configure (configureRules) where
 import qualified System.Info as System
 
 import Base
+import Builder
 import CommandLine
 import Context
 import GHC
index a1ad50d..31ede92 100644 (file)
@@ -285,7 +285,7 @@ installLibsTo libs dir = do
            ".a" -> do
                let out = dir -/- takeFileName lib
                installData [out] dir
-               runBuilder Ranlib [out]
+               runBuilder Ranlib [out] [out] [out]
            _ -> installData [lib] dir
 
 -- ref: includes/ghc.mk
index 6455277..bc8b01f 100644 (file)
@@ -2,7 +2,6 @@ module Rules.Perl (perlScriptRules) where
 
 import Base
 import Builder
-import Utilities
 
 -- TODO: Do we need this build rule?
 -- | Build Perl scripts, such as @ghc-split@, from their literate Perl sources.
@@ -11,4 +10,4 @@ perlScriptRules = do
     "//*.prl" %> \out -> do
         let src = out -<.> "lprl"
         need [src]
-        runBuilder Unlit [src, out]
+        runBuilder Unlit [src, out] [src] [out]
index f1f78bf..94c1ecc 100644 (file)
@@ -8,7 +8,6 @@ import GHC
 import Oracles.ModuleFiles
 import Oracles.Setting
 import Settings
-import Settings.Builders.Ar
 import Target
 
 instance Arbitrary Way where
index 259eb42..502ed2e 100644 (file)
@@ -6,7 +6,6 @@ import Base
 import Builder
 import Oracles.Setting
 import Rules.Clean
-import Utilities
 
 sourceDistRules :: Rules ()
 sourceDistRules = do
@@ -20,8 +19,9 @@ sourceDistRules = do
             dropTarXz = dropExtension . dropExtension
             treePath  = "sdistprep/ghc" -/- dropTarXz tarName
         prepareTree treePath
-        runBuilderWith [Cwd "sdistprep/ghc"] Tar
-            ["cJf", ".." -/- tarName, dropTarXz tarName]
+        runBuilderWithCmdOptions [Cwd "sdistprep/ghc"] Tar
+            ["cJf", ".." -/- tarName,  dropTarXz tarName]
+            ["cJf", ".." -/- tarName] [dropTarXz tarName]
     "GIT_COMMIT_ID" %> \fname ->
         writeFileChanged fname =<< setting ProjectGitCommitId
     "VERSION" %> \fname ->
index e597538..e8f533d 100644 (file)
@@ -1,4 +1,4 @@
-module Settings.Builders.Ar (arBuilderArgs, arCmd, chunksOfSize) where
+module Settings.Builders.Ar (arBuilderArgs) where
 
 import Settings.Builders.Common
 
@@ -6,43 +6,3 @@ arBuilderArgs :: Args
 arBuilderArgs = builder Ar ? mconcat [ arg "q"
                                      , arg =<< getOutput
                                      , getInputs ]
-
--- This count includes arg "q" and arg file parameters in arBuilderArgs.
--- Update this value appropriately when changing arBuilderArgs.
-arFlagsCount :: Int
-arFlagsCount = 2
-
--- | Invoke 'Ar' builder given a path to it and a list of arguments. Take care
--- not to exceed the limit on command line length, which differs across
--- supported operating systems (see 'cmdLineLengthLimit'). 'Ar' needs to be
--- handled in a special way because we sometimes need to archive __a lot__ of
--- files (in Cabal package, for example, command line length can reach 2MB!).
--- To work around the limit on the command line length we pass the list of files
--- to be archived via a temporary file, or alternatively, we split argument list
--- into chunks and call 'Ar' multiple times (when passing arguments via a
--- temporary file is not supported).
-arCmd :: FilePath -> [String] -> Action ()
-arCmd path argList = do
-    arSupportsAtFile <- flag ArSupportsAtFile
-    let flagArgs = take arFlagsCount argList
-        fileArgs = drop arFlagsCount argList
-    if arSupportsAtFile
-    then useAtFile path flagArgs fileArgs
-    else useSuccessiveInvocations path flagArgs fileArgs
-
-useAtFile :: FilePath -> [String] -> [String] -> Action ()
-useAtFile path flagArgs fileArgs = withTempFile $ \tmp -> do
-    writeFile' tmp $ unwords fileArgs
-    cmd [path] flagArgs ('@' : tmp)
-
-useSuccessiveInvocations :: FilePath -> [String] -> [String] -> Action ()
-useSuccessiveInvocations path flagArgs fileArgs = do
-    maxChunk <- cmdLineLengthLimit
-    forM_ (chunksOfSize maxChunk fileArgs) $ \argsChunk ->
-        unit . cmd [path] $ flagArgs ++ argsChunk
-
--- | @chunksOfSize size strings@ splits a given list of strings into chunks not
--- exceeding the given @size@. If that is impossible, it uses singleton chunks.
-chunksOfSize :: Int -> [String] -> [[String]]
-chunksOfSize n = repeatedly f
-    where f xs = splitAt (max 1 $ length $ takeWhile (<= n) $ scanl1 (+) $ map length xs) xs
index 981e704..3e03ed6 100644 (file)
@@ -3,7 +3,7 @@
 -- If you don't copy the file your changes will be tracked by git and you can
 -- accidentally commit them.
 module UserSettings (
-    userBuildRoot, userFlavours, userPackages, verboseCommands,
+    userBuildRoot, userFlavours, userPackages, verboseCommand,
     buildProgressColour, successColour, stage1Only, crossCompiling
     ) where
 
@@ -31,9 +31,9 @@ userPackages = []
 
 -- | Set to 'True' to print full command lines during the build process. Note:
 -- this is a 'Predicate', hence you can enable verbose output only for certain
--- targets, e.g.: @verboseCommands = package ghcPrim@.
-verboseCommands :: Predicate
-verboseCommands = do
+-- targets, e.g.: @verboseCommand = package ghcPrim@.
+verboseCommand :: Predicate
+verboseCommand = do
     verbosity <- expr getVerbosity
     return $ verbosity >= Loud
 
index de48b3e..9ffdfce 100644 (file)
 module Utilities (
-    build, buildWithCmdOptions, buildWithResources, applyPatch, runBuilder,
-    runBuilderWith, builderEnvironment, needLibrary,
-    installDirectory, installData, installScript, installProgram, linkSymbolic,
-    contextDependencies, stage1Dependencies, libraryTargets, topsortPackages
+    build, buildWithResources, buildWithCmdOptions, runBuilder, runBuilderWith,
+    builderEnvironment, needLibrary, applyPatch, installDirectory, installData,
+    installScript, installProgram, linkSymbolic, contextDependencies,
+    stage1Dependencies, libraryTargets, topsortPackages
     ) where
 
 import qualified System.Directory.Extra as IO
 
+import qualified Hadrian.Builder as H
 import Hadrian.Haskell.Cabal
-import Hadrian.Oracles.ArgsHash
 import Hadrian.Oracles.Path
 import Hadrian.Utilities
 
-import CommandLine
 import Context
-import Expression hiding (builder, inputs, outputs, way, stage, package)
+import Expression hiding (stage)
 import Oracles.Setting
 import Oracles.PackageData
 import Settings
-import Settings.Builders.Ar
 import Target
 import UserSettings
 
--- | Build a 'Target' with the right 'Builder' and command line arguments.
--- Force a rebuild if the argument list has changed since the last build.
 build :: Target -> Action ()
-build = customBuild [] []
+build target = H.build target getArgs
 
--- | Build a 'Target' with the right 'Builder' and command line arguments,
--- acquiring necessary resources. Force a rebuild if the argument list has
--- changed since the last build.
 buildWithResources :: [(Resource, Int)] -> Target -> Action ()
-buildWithResources rs = customBuild rs []
+buildWithResources rs target = H.buildWithResources rs target getArgs
 
--- | Build a 'Target' with the right 'Builder' and command line arguments,
--- using given options when executing the build command. Force a rebuild if
--- the argument list has changed since the last build.
 buildWithCmdOptions :: [CmdOption] -> Target -> Action ()
-buildWithCmdOptions = customBuild []
-
-customBuild :: [(Resource, Int)] -> [CmdOption] -> Target -> Action ()
-customBuild rs opts target = do
-    let targetBuilder = builder target
-    needBuilder targetBuilder
-    path    <- builderPath targetBuilder
-    argList <- interpret target getArgs
-    verbose <- interpret target verboseCommands
-    let quietlyUnlessVerbose = if verbose then withVerbosity Loud else quietly
-    trackArgsHash target -- Rerun the rule if the hash of argList has changed.
-    withResources rs $ do
-        putInfo target
-        quietlyUnlessVerbose $ case targetBuilder of
-            Ar _ -> do
-                output <- interpret target getOutput
-                if "//*.a" ?== output
-                then arCmd path argList
-                else do
-                    input <- interpret target getInput
-                    top   <- topDirectory
-                    echo  <- cmdEcho
-                    cmd echo [Cwd output] [path] "x" (top -/- input)
-
-            Configure dir -> do
-                -- Inject /bin/bash into `libtool`, instead of /bin/sh, otherwise Windows breaks.
-                -- TODO: Figure out why.
-                bash <- bashPath
-                echo <- cmdEcho
-                let env = AddEnv "CONFIG_SHELL" bash
-                cmd Shell echo env [Cwd dir] [path] opts argList
-
-            HsCpp    -> captureStdout target path argList
-            GenApply -> captureStdout target path argList
-
-            GenPrimopCode -> do
-                src  <- interpret target getInput
-                file <- interpret target getOutput
-                input <- readFile' src
-                Stdout output <- cmd (Stdin input) [path] argList
-                writeFileChanged file output
-
-            Make dir -> do
-                echo <- cmdEcho
-                cmd Shell echo path ["-C", dir] argList
-
-            _  -> do
-                echo <- cmdEcho
-                cmd echo [path] argList
-
--- | Suppress build output depending on the @--progress-info@ flag.
-cmdEcho :: Action CmdOption
-cmdEcho = do
-    progressInfo <- cmdProgressInfo
-    return $ EchoStdout (progressInfo `elem` [Normal, Unicorn])
-
--- | Run a builder, capture the standard output, and write it to a given file.
-captureStdout :: Target -> FilePath -> [String] -> Action ()
-captureStdout target path argList = do
-    file <- interpret target getOutput
-    Stdout output <- cmd [path] argList
-    writeFileChanged file output
+buildWithCmdOptions opts target = H.buildWithCmdOptions opts target getArgs
 
 -- | Apply a patch by executing the 'Patch' builder in a given directory.
 applyPatch :: FilePath -> FilePath -> Action ()
@@ -159,18 +88,6 @@ builderEnvironment variable builder = do
     path <- builderPath builder
     return $ AddEnv variable path
 
-runBuilder :: Builder -> [String] -> Action ()
-runBuilder = runBuilderWith []
-
--- | Run a builder with given list of arguments using custom 'cmd' options.
-runBuilderWith :: [CmdOption] -> Builder -> [String] -> Action ()
-runBuilderWith options builder args = do
-    needBuilder builder
-    path <- builderPath builder
-    let note = if null args then "" else " (" ++ intercalate ", " args ++ ")"
-    putBuild $ "| Run " ++ show builder ++ note
-    quietly $ cmd options [path] args
-
 -- | Given a 'Context' this 'Action' looks up its package dependencies and wraps
 -- the results in appropriate contexts. The only subtlety here is that we never
 -- depend on packages built in 'Stage2' or later, therefore the stage of the
@@ -225,19 +142,3 @@ topsortPackages pkgs = do
       let annotated = map (annotateInDeg es) es
           inDegZero = map snd $ filter ((== 0). fst) annotated
       in  inDegZero ++ topSort (es \\ inDegZero)
-
--- | Print out information about the command being executed.
-putInfo :: Target -> Action ()
-putInfo t = putProgressInfo =<< renderAction
-    ("Run " ++ show (builder t) ++ contextInfo)
-    (digest $ inputs  t)
-    (digest $ outputs t)
-  where
-    contextInfo = concat $ [ " (" ]
-        ++ [ "stage = "     ++ show (stage $ context t) ]
-        ++ [ ", package = " ++ pkgName (package $ context t) ]
-        ++ [ ", way = "     ++ show (way $ context t) | (way $ context t) /= vanilla ]
-        ++ [ ")" ]
-    digest [] = "none"
-    digest [x] = x
-    digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"