Factor out generic build infrastructure

See #347

hadrian.cabal

@@ -26,6 +26,8 @@ executable hadrian
                        , Expression
                        , Flavour
                        , GHC
+                       , Hadrian.Expression
+                       , Hadrian.Target
                        , Oracles.ArgsHash
                        , Oracles.Config
                        , Oracles.Config.Flag

src/Expression.hs

-{-# LANGUAGE DeriveFunctor, FlexibleInstances, LambdaCase #-}
 module Expression (
     -- * Expressions
-    Expr, expr, exprIO,
-    -- ** Operators
-    append, arg, remove,
+    Expr, Predicate, Args, Ways, Packages,
+
+    -- ** Construction and modification
+    expr, exprIO, append, arg, remove, (?),
+
     -- ** Evaluation
     interpret, interpretInContext,
-    -- ** Predicates
-    Predicate, (?), applyPredicate,
-    -- ** Common expressions
-    Args, Ways, Packages,
+
     -- ** Context and Target
-    Context, vanillaContext, stageContext, Target, dummyTarget,
+    Context, vanillaContext, stageContext, Target,
 
     -- * Convenient accessors
     getContext, getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
@@ -26,11 +24,11 @@ module Expression (
     module Way
     ) where
 
-import Control.Monad.Trans.Reader
-import Control.Monad.Trans
 import Data.Semigroup
 
-import Base
+import qualified Hadrian.Expression as H
+import Hadrian.Expression hiding (Expr, Predicate, Args)
+
 import Builder
 import Context
 import Package
@@ -44,38 +42,13 @@ import Oracles.Path
 
 -- | @Expr a@ is a computation that produces a value of type @Action a@ and can
 -- read parameters of the current build 'Target'.
-newtype Expr a = Expr (ReaderT Target Action a) deriving Functor
-
-expr :: Action a -> Expr a
-expr = Expr . lift
-
-exprIO :: IO a -> Expr a
-exprIO = Expr . liftIO
-
-instance Semigroup a => Semigroup (Expr a) where
-    Expr x <> Expr y = Expr $ (<>) <$> x <*> y
-
--- TODO: The 'Semigroup a' constraint will at some point become redundant.
-instance (Semigroup a, Monoid a) => Monoid (Expr a) where
-    mempty  = pure mempty
-    mappend = (<>)
-
-instance Applicative Expr where
-    pure  = Expr . pure
-    (<*>) = ap
-
-instance Monad Expr where
-    return       = pure
-    Expr e >>= f = Expr $ do
-        re <- e
-        let Expr rf = f re
-        rf
+type Expr a = H.Expr Context Builder a
 
 -- | The following expressions are used throughout the build system for
 -- specifying conditions ('Predicate'), lists of arguments ('Args'), 'Ways'
 -- and 'Packages'.
-type Predicate = Expr Bool
-type Args      = Expr [String]
+type Predicate = H.Predicate Context Builder
+type Args      = H.Args      Context Builder
 type Packages  = Expr [Package]
 type Ways      = Expr [Way]
 
@@ -85,88 +58,17 @@ type Ways      = Expr [Way]
 append :: a -> Expr a
 append = pure
 
--- | Remove given elements from a list expression.
-remove :: Eq a => [a] -> Expr [a] -> Expr [a]
-remove xs e = filter (`notElem` xs) <$> e
-
--- | Apply a predicate to an expression.
-applyPredicate :: (Monoid a, Semigroup a) => Predicate -> Expr a -> Expr a
-applyPredicate predicate expr = do
-    bool <- predicate
-    if bool then expr else mempty
-
--- | Add a single argument to 'Args'.
-arg :: String -> Args
-arg = append . return
-
--- | A convenient operator for predicate application.
-class PredicateLike a where
-    (?) :: (Monoid m, Semigroup m) => a -> Expr m -> Expr m
-
-infixr 3 ?
-
-instance PredicateLike Predicate where
-    (?) = applyPredicate
-
-instance PredicateLike Bool where
-    (?) = applyPredicate . Expr . return
-
-instance PredicateLike (Action Bool) where
-    (?) = applyPredicate . expr
-
--- | Interpret a given expression according to the given 'Target'.
-interpret :: Target -> Expr a -> Action a
-interpret target (Expr e) = runReaderT e target
-
--- | Interpret a given expression by looking only at the given 'Context'.
-interpretInContext :: Context -> Expr a -> Action a
-interpretInContext = interpret . dummyTarget
-
--- | Get the current build 'Context'.
-getContext :: Expr Context
-getContext = Expr $ asks context
-
 -- | Get the 'Stage' of the current 'Context'.
 getStage :: Expr Stage
-getStage = Expr $ stage <$> asks context
+getStage = stage <$> getContext
 
 -- | Get the 'Package' of the current 'Context'.
 getPackage :: Expr Package
-getPackage = Expr $ package <$> asks context
+getPackage = package <$> getContext
 
 -- | Get the 'Way' of the current 'Context'.
 getWay :: Expr Way
-getWay = Expr $ way <$> asks context
-
--- | Get the 'Builder' for the current 'Target'.
-getBuilder :: Expr Builder
-getBuilder = Expr $ asks builder
-
--- | Get the input files of the current 'Target'.
-getInputs :: Expr [FilePath]
-getInputs = Expr $ asks inputs
-
--- | Run 'getInputs' and check that the result contains one input file only.
-getInput :: Expr FilePath
-getInput = Expr $ do
-    target <- ask
-    getSingleton ("Exactly one input file expected in " ++ show target) <$> asks inputs
-
--- | Get the files produced by the current 'Target'.
-getOutputs :: Expr [FilePath]
-getOutputs = Expr $ asks outputs
-
--- | Run 'getOutputs' and check that the result contains one output file only.
-getOutput :: Expr FilePath
-getOutput = Expr $ do
-    target <- ask
-    getSingleton ("Exactly one output file expected in " ++ show target) <$> asks outputs
-
--- | Extract a value from a singleton list, or raise an error if the list does
--- not contain exactly one value.
-getSingleton :: String -> [a] -> a
-getSingleton _ [res] = res
-getSingleton msg _   = error msg
+getWay = way <$> getContext
 
 getSetting :: Setting -> Expr String
 getSetting = expr . setting

src/Hadrian/Expression.hs

+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+module Hadrian.Expression (
+    -- * Expressions
+    Expr, Predicate, Args,
+
+    -- ** Construction and modification
+    expr, exprIO, arg, remove, (?),
+
+    -- ** Evaluation
+    interpret, interpretInContext,
+
+    -- * Convenient accessors
+    getContext, getBuilder, getOutputs, getInputs, getInput, getOutput, getSingleton
+    ) where
+
+import Control.Monad.Trans
+import Control.Monad.Trans.Reader
+import Data.Semigroup
+import Development.Shake
+
+import Hadrian.Target
+
+-- | 'Expr' @c b a@ is a computation that produces a value of type 'Action' @a@
+-- and can read parameters of the current build 'Target' @c b@.
+newtype Expr c b a = Expr (ReaderT (Target c b) Action a)
+    deriving (Applicative, Functor, Monad)
+
+instance Semigroup a => Semigroup (Expr c b a) where
+    Expr x <> Expr y = Expr $ (<>) <$> x <*> y
+
+-- TODO: The 'Semigroup a' constraint will at some point become redundant.
+instance (Semigroup a, Monoid a) => Monoid (Expr c b a) where
+    mempty  = pure mempty
+    mappend = (<>)
+
+-- | Expressions that compute a Boolean value.
+type Predicate c b = Expr c b Bool
+
+-- | Expressions that compute lists of arguments to be passed to builders.
+type Args c b = Expr c b [String]
+
+-- | Lift actions independent from the current build 'Target' into the 'Expr'
+-- monad.
+expr :: Action a -> Expr c b a
+expr = Expr . lift
+
+-- | Lift IO computations independent from the current build 'Target' into the
+-- 'Expr' monad.
+exprIO :: IO a -> Expr c b a
+exprIO = Expr . liftIO
+
+-- | Remove given elements from a list expression.
+remove :: Eq a => [a] -> Expr c b [a] -> Expr c b [a]
+remove xs e = filter (`notElem` xs) <$> e
+
+-- | Add a single argument to 'Args'.
+arg :: String -> Args c b
+arg = pure . pure
+
+-- | Values that can be converted to a 'Predicate'.
+class ToPredicate p c b where
+    toPredicate :: p -> Predicate c b
+
+infixr 3 ?
+
+-- | Apply a predicate to an expression.
+(?) :: (Monoid a, Semigroup a, ToPredicate p c b) => p -> Expr c b a -> Expr c b a
+p ? e = do
+    bool <- toPredicate p
+    if bool then e else mempty
+
+instance ToPredicate (Predicate c b) c b where
+    toPredicate = id
+
+instance ToPredicate Bool c b where
+    toPredicate = pure
+
+instance ToPredicate (Action Bool) c b where
+    toPredicate = expr
+
+-- | Interpret a given expression according to the given 'Target'.
+interpret :: Target c b -> Expr c b a -> Action a
+interpret target (Expr e) = runReaderT e target
+
+-- | Interpret a given expression by looking only at the given 'Context'.
+interpretInContext :: c -> Expr c b a -> Action a
+interpretInContext c = interpret $ target c
+    (error "contextOnlyTarget: builder not set")
+    (error "contextOnlyTarget: inputs not set" )
+    (error "contextOnlyTarget: outputs not set")
+
+-- | Get the current build 'Context'.
+getContext :: Expr c b c
+getContext = Expr $ asks context
+
+-- | Get the 'Builder' for the current 'Target'.
+getBuilder :: Expr c b b
+getBuilder = Expr $ asks builder
+
+-- | Get the input files of the current 'Target'.
+getInputs :: Expr c b [FilePath]
+getInputs = Expr $ asks inputs
+
+-- | Run 'getInputs' and check that the result contains one input file only.
+getInput :: (Show b, Show c) => Expr c b FilePath
+getInput = Expr $ do
+    target <- ask
+    getSingleton ("Exactly one input file expected in " ++ show target) <$> asks inputs
+
+-- | Get the files produced by the current 'Target'.
+getOutputs :: Expr c b [FilePath]
+getOutputs = Expr $ asks outputs
+
+-- | Run 'getOutputs' and check that the result contains one output file only.
+getOutput :: (Show b, Show c) => Expr c b FilePath
+getOutput = Expr $ do
+    target <- ask
+    getSingleton ("Exactly one output file expected in " ++ show target) <$> asks outputs
+
+-- | Extract a value from a singleton list, or raise an error if the list does
+-- not contain exactly one value.
+getSingleton :: String -> [a] -> a
+getSingleton _ [res] = res
+getSingleton msg _   = error msg

src/Hadrian/Target.hs

+{-# LANGUAGE DeriveGeneric #-}
+module Hadrian.Target (Target, target, context, builder, inputs, outputs) where
+
+import GHC.Generics
+
+import Base
+
+-- | Each invocation of a builder is fully described by a 'Target', which
+-- comprises a build context (type variable @c@), a builder (type variable @b@),
+-- a list of input files and a list of output files. For example:
+--
+-- @
+-- preludeTarget = Target (GHC.Context) (GHC.Builder)
+--     { context = Context Stage1 base profiling
+--     , builder = Ghc Stage1
+--     , inputs = ["libraries/base/Prelude.hs"]
+--     , outputs = ["build/stage1/libraries/base/Prelude.p_o"] }
+-- @
+data Target c b = Target
+    { context :: c          -- ^ Current build context
+    , builder :: b          -- ^ Builder to be invoked
+    , inputs  :: [FilePath] -- ^ Input files for the builder
+    , outputs :: [FilePath] -- ^ Files to be produced
+    } deriving (Eq, Generic, Show)
+
+target :: c -> b -> [FilePath] -> [FilePath] -> Target c b
+target = Target
+
+instance (Binary   c, Binary   b) => Binary   (Target c b)
+instance (Hashable c, Hashable b) => Hashable (Target c b)
+instance (NFData   c, NFData   b) => NFData   (Target c b)

src/Oracles/ArgsHash.hs

@@ -21,10 +21,10 @@ newtype ArgsHashKey = ArgsHashKey Target
 -- argument list constructors are assumed not to examine target sources, but
 -- only append them to argument lists where appropriate.
 checkArgsHash :: Target -> Action ()
-checkArgsHash target = do
-    let hashed = [ show . hash $ inputs target ]
-    _ <- askOracle . ArgsHashKey $ target { inputs = hashed } :: Action Int
-    return ()
+checkArgsHash t = do
+    let hashedInputs = [ show $ hash (inputs t) ]
+        hashedTarget = target (context t) (builder t) hashedInputs (outputs t)
+    void (askOracle $ ArgsHashKey hashedTarget :: Action Int)
 
 -- | Oracle for storing per-target argument list hashes.
 argsHashOracle :: Rules ()

src/Rules/Compile.hs

@@ -19,13 +19,13 @@ compilePackage rs context@Context {..} = do
             let src = obj2src context obj
             need [src]
             needDependencies context src $ obj <.> "d"
-            build $ Target context (compiler stage) [src] [obj]
+            build $ target context (compiler stage) [src] [obj]
         compileHs = \[obj, _hi] -> do
             (src, deps) <- fileDependencies context obj
             need $ src : deps
             when (isLibrary package) $ need =<< return <$> pkgConfFile context
             needLibrary =<< contextDependencies context
-            buildWithResources rs $ Target context (Ghc CompileHs stage) [src] [obj]
+            buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj]
 
     priority 2.0 $ do
         nonHs "c"   %> compile (Ghc CompileCWithGhc) (obj2src "c"   isGeneratedCFile  )
@@ -43,7 +43,7 @@ needDependencies :: Context -> FilePath -> FilePath -> Action ()
 needDependencies context@Context {..} src depFile = discover
   where
     discover = do
-        build $ Target context (Cc FindCDependencies stage) [src] [depFile]
+        build $ target context (Cc FindCDependencies stage) [src] [depFile]
         deps <- parseFile depFile
         -- Generated dependencies, if not yet built, will not be found and hence
         -- will be referred to simply by their file names.

src/Rules/Configure.hs

@@ -29,7 +29,7 @@ configureRules = do
             let srcs    = map (<.> "in") outs
                 context = vanillaContext Stage0 compiler
             need srcs
-            build $ Target context (Configure ".") srcs outs
+            build $ target context (Configure ".") srcs outs
 
     ["configure", configH <.> "in"] &%> \_ -> do
         if cmdSkipConfigure

src/Rules/Data.hs

@@ -33,7 +33,7 @@ buildPackageData context@Context {..} = do
         need =<< mapM pkgConfFile =<< contextDependencies context
 
         need [cabalFile]
-        build $ Target context GhcCabal [cabalFile] [mk, setupConfig]
+        build $ target context GhcCabal [cabalFile] [mk, setupConfig]
         postProcessPackageData context mk
 
     pkgInplaceConfig context %> \conf -> do
@@ -41,7 +41,7 @@ buildPackageData context@Context {..} = do
         if package == rts
         then do
             need [rtsConfIn]
-            build $ Target context HsCpp [rtsConfIn] [conf]
+            build $ target context HsCpp [rtsConfIn] [conf]
             fixFile conf $ unlines
                          . map
                          ( replace "\"\"" ""

src/Rules/Dependencies.hs

@@ -21,7 +21,7 @@ buildPackageDependencies rs context@Context {..} =
         if srcs == []
         then writeFileChanged mk ""
         else buildWithResources rs $
-            Target context (Ghc FindHsDependencies stage) srcs [mk]
+            target context (Ghc FindHsDependencies stage) srcs [mk]
         removeFile $ mk <.> "bak"
         mkDeps <- readFile' mk
         writeFileChanged deps . unlines

src/Rules/Documentation.hs

@@ -33,7 +33,7 @@ buildPackageDocumentation context@Context {..} =
             -- Build Haddock documentation
             -- TODO: pass the correct way from Rules via Context
             let haddockWay = if dynamicGhcPrograms flavour then dynamic else vanilla
-            build $ Target (context {way = haddockWay}) Haddock srcs [file]
+            build $ target (context {way = haddockWay}) Haddock srcs [file]
 
         when (package == haddock) $ haddockHtmlLib %> \_ -> do
             let dir = takeDirectory haddockHtmlLib

src/Rules/Generate.hs

@@ -109,7 +109,7 @@ generatePackageCode context@(Context stage pkg _) =
             let unpack = fromMaybe . error $ "No generator for " ++ file ++ "."
             (src, builder) <- unpack <$> findGenerator context file
             need [src]
-            build $ Target context builder [src] [file]
+            build $ target context builder [src] [file]
             let boot = src -<.> "hs-boot"
             whenM (doesFileExist boot) . copyFile boot $ file -<.> "hs-boot"
 
@@ -121,7 +121,7 @@ generatePackageCode context@(Context stage pkg _) =
         when (pkg == compiler) $ do
             primopsTxt stage %> \file -> do
                 need $ [platformH stage, primopsSource] ++ includesDependencies
-                build $ Target context HsCpp [primopsSource] [file]
+                build $ target context HsCpp [primopsSource] [file]
 
             platformH stage %> go generateGhcBootPlatformH
 
@@ -131,10 +131,10 @@ generatePackageCode context@(Context stage pkg _) =
             , "GHC/PrimopWrappers.hs"
             , "*.hs-incl" ] |%> \file -> do
                 need [primopsTxt stage]
-                build $ Target context GenPrimopCode [primopsTxt stage] [file]
+                build $ target context GenPrimopCode [primopsTxt stage] [file]
 
         when (pkg == rts) $ path -/- "cmm/AutoApply.cmm" %> \file ->
-            build $ Target context GenApply [] [file]
+            build $ target context GenApply [] [file]
 
 copyRules :: Rules ()
 copyRules = do
@@ -161,7 +161,7 @@ generateRules = do
     -- TODO: simplify, get rid of fake rts context
     generatedPath ++ "//*" %> \file -> do
         withTempDir $ \dir -> build $
-            Target rtsContext DeriveConstants [] [file, dir]
+            target rtsContext DeriveConstants [] [file, dir]
   where
     file <~ gen = file %> \out -> generate out emptyTarget gen
 

src/Rules/Gmp.hs

@@ -43,13 +43,13 @@ gmpRules = do
             putBuild "| No GMP library/framework detected; in tree GMP will be built"
             need [gmpLibrary]
             createDirectory gmpObjects
-            build $ Target gmpContext (Ar Stage1) [gmpLibrary] [gmpObjects]
+            build $ target gmpContext (Ar Stage1) [gmpLibrary] [gmpObjects]
             copyFile (gmpBuildPath -/- "gmp.h") header
             copyFile (gmpBuildPath -/- "gmp.h") gmpLibraryInTreeH
 
     -- Build in-tree GMP library
     gmpLibrary %> \lib -> do
-        build $ Target gmpContext (Make gmpBuildPath) [gmpMakefile] [lib]
+        build $ target gmpContext (Make gmpBuildPath) [gmpMakefile] [lib]
         putSuccess "| Successfully built custom library 'gmp'"
 
     -- In-tree GMP header is built in the gmpLibraryH rule
@@ -64,7 +64,7 @@ gmpRules = do
         env <- configureEnvironment
         need [mk <.> "in"]
         buildWithCmdOptions env $
-            Target gmpContext (Configure gmpBuildPath) [mk <.> "in"] [mk]
+            target gmpContext (Configure gmpBuildPath) [mk <.> "in"] [mk]
 
     -- Extract in-tree GMP sources and apply patches
     gmpMakefile <.> "in" %> \_ -> do
@@ -79,7 +79,7 @@ gmpRules = do
         withTempDir $ \dir -> do
             let tmp = unifyPath dir
             need [tarball]
-            build $ Target gmpContext Tar [tarball] [tmp]
+            build $ target gmpContext Tar [tarball] [tmp]
 
             let patch     = gmpBase -/- "gmpsrc.patch"
                 patchName = takeFileName patch

src/Rules/Install.hs

@@ -135,7 +135,7 @@ installPackageConf :: Action ()
 installPackageConf = do
     let context = vanillaContext Stage0 rts
     liftIO $ IO.createDirectoryIfMissing True (takeDirectory pkgConfInstallPath)
-    build $ Target context HsCpp [ pkgPath rts -/- "package.conf.in" ]
+    build $ target context HsCpp [ pkgPath rts -/- "package.conf.in" ]
                                  [ pkgConfInstallPath <.> "raw" ]
     Stdout content <- cmd "grep" [ "-v", "^#pragma GCC"
                                  , pkgConfInstallPath <.> "raw" ]
@@ -206,7 +206,7 @@ installPackages = do
                     installDistDir (installDistDir -/- "build")
 
                 whenM (isSpecified HsColour) $
-                    build $ Target context GhcCabalHsColour [cabalFile] []
+                    build $ target context GhcCabalHsColour [cabalFile] []
 
                 pref <- setting InstallPrefix
                 unit $ cmd ghcCabalInplace [ "copy"
@@ -282,7 +282,7 @@ installLibsTo libs dir = do
                installData [out] dir
                let context = vanillaContext Stage0 $ topLevel (PackageName "")
                -- TODO: Get rid of meaningless context for certain builder like ranlib
-               build $ Target context Ranlib [out] [out]
+               build $ target context Ranlib [out] [out]
            _ -> installData [lib] dir
 
 -- ref: includes/ghc.mk

src/Rules/Libffi.hs

@@ -49,7 +49,7 @@ libffiRules = do
                 copyFile (ffiIncludeDir -/- file) (rtsBuildPath -/- file)
             putSuccess $ "| Successfully copied system FFI library header files"
         else do
-            build $ Target libffiContext (Make libffiBuildPath) [] []
+            build $ target libffiContext (Make libffiBuildPath) [] []
 
             hs <- getDirectoryFiles "" [libffiBuildPath -/- "inst/lib/*/include/*"]
             forM_ hs $ \header ->
@@ -72,7 +72,7 @@ libffiRules = do
         removeDirectory (buildRootPath -/- libname)
         -- TODO: Simplify.
         actionFinally (do
-            build $ Target libffiContext Tar [tarball] [buildRootPath]
+            build $ target libffiContext Tar [tarball] [buildRootPath]
             moveDirectory (buildRootPath -/- libname) libffiBuildPath) $
                 removeFiles buildRootPath [libname <//> "*"]
 
@@ -86,4 +86,4 @@ libffiRules = do
 
         env <- configureEnvironment
         buildWithCmdOptions env $
-            Target libffiContext (Configure libffiBuildPath) [mk <.> "in"] [mk]
+            target libffiContext (Configure libffiBuildPath) [mk <.> "in"] [mk]

src/Rules/Library.hs

@@ -50,7 +50,7 @@ buildDynamicLib context@Context{..} = do
         deps <- contextDependencies context
         need =<< mapM pkgLibraryFile deps
         objs <- libraryObjects context
-        build $ Target context (Ghc LinkHs stage) objs [so]
+        build $ target context (Ghc LinkHs stage) objs [so]
 
 buildPackageLibrary :: Context -> Rules ()
 buildPackageLibrary context@Context {..} = do
@@ -61,8 +61,8 @@ buildPackageLibrary context@Context {..} = do
         asuf <- libsuf way
         let isLib0 = ("//*-0" ++ asuf) ?== a
         removeFile a
-        if isLib0 then build $ Target context (Ar stage) []   [a] -- TODO: Scan for dlls
-                  else build $ Target context (Ar stage) objs [a]
+        if isLib0 then build $ target context (Ar stage) []   [a] -- TODO: Scan for dlls
+                  else build $ target context (Ar stage) objs [a]
 
         synopsis <- interpretInContext context $ getPkgData Synopsis
         unless isLib0 . putSuccess $ renderLibrary
@@ -75,7 +75,7 @@ buildPackageGhciLibrary context@Context {..} = priority 2 $ do
     matchVersionedFilePath libPrefix (waySuffix way <.> "o") ?> \obj -> do
         objs <- allObjects context
         need objs
-        build $ Target context Ld objs [obj]
+        build $ target context Ld objs [obj]
 
 allObjects :: Context -> Action [FilePath]
 allObjects context = (++) <$> nonHsObjects context <*> hsObjects context

src/Rules/Program.hs

@@ -104,7 +104,7 @@ buildBinary rs context@Context {..} bin = do
                   ++ [ path -/- "Paths_hsc2hs.o"  | package == hsc2hs  ]
                   ++ [ path -/- "Paths_haddock.o" | package == haddock ]
     need binDeps
-    buildWithResources rs $ Target context (Ghc LinkHs stage) binDeps [bin]
+    buildWithResources rs $ target context (Ghc LinkHs stage) binDeps [bin]
     synopsis <- interpretInContext context $ getPkgData Synopsis
     putSuccess $ renderProgram
         (quote (pkgNameString package) ++ " (" ++ show stage ++ ").")

src/Rules/Register.hs

@@ -19,11 +19,11 @@ registerPackage rs context@Context {..} = when (stage <= Stage1) $ do
     matchVersionedFilePath (dir -/- pkgNameString package) "conf" ?> \conf -> do
         need [confIn]
         buildWithResources rs $
-            Target context (GhcPkg Update stage) [confIn] [conf]
+            target context (GhcPkg Update stage) [confIn] [conf]
 
     when (package == ghc) $ packageDbStamp stage %> \stamp -> do
         removeDirectory dir
         buildWithResources rs $
-            Target (vanillaContext stage ghc) (GhcPkg Init stage) [] [dir]
+            target (vanillaContext stage ghc) (GhcPkg Init stage) [] [dir]
         writeFileLines stamp []
         putSuccess $ "| Successfully initialised " ++ dir

src/Rules/Test.hs

@@ -24,7 +24,7 @@ testRules = do
         need ["inplace/bin/hp2ps", "inplace/bin/hsc2hs"]