Commit e8b62f7e authored by Andrey Mokhov's avatar Andrey Mokhov

Factor out Context from Target.

See #207.
parent 2c219087
......@@ -20,6 +20,7 @@ executable ghc-shake
other-modules: Base
, Builder
, CmdLineFlag
, Context
, Environment
, Expression
, GHC
......
{-# LANGUAGE DeriveGeneric #-}
module Context (Context (..), vanillaContext, stageContext) where
import GHC.Generics (Generic)
import Base
import Package
import Stage
import Way
-- | Build context for a currently built 'Target'. We generate potentially
-- different build rules for each 'Context'.
data Context = Context
{ stage :: Stage -- ^ Currently build Stage
, package :: Package -- ^ Currently build Package
, way :: Way -- ^ Currently build Way (usually 'vanilla')
} deriving (Show, Eq, Generic)
-- | Most targets are built only one way, hence the notion of 'vanillaContext'.
vanillaContext :: Stage -> Package -> Context
vanillaContext s p = Context s p vanilla
stageContext :: Stage -> Context
stageContext s = vanillaContext s $ error "stageContext: package not set"
instance Binary Context
instance NFData Context
instance Hashable Context
......@@ -6,13 +6,13 @@ module Expression (
apply, append, arg, remove, removePair,
appendSub, appendSubD, filterSub, removeSub,
-- ** Evaluation
interpret, interpretPartial, interpretWithStage, interpretDiff,
interpret, interpretInContext, interpretDiff,
-- ** Predicates
Predicate, (?), applyPredicate,
-- ** Common expressions
Args, Ways, Packages,
-- ** Targets
Target, PartialTarget (..), unsafeFromPartial, fullTarget, fullTargetWithWay,
-- ** Context and Target
Context, vanillaContext, stageContext, Target, dummyTarget,
-- * Convenient accessors
getStage, getPackage, getBuilder, getOutputs, getInputs, getWay,
......@@ -30,6 +30,7 @@ import Control.Monad.Trans.Reader
import Data.Monoid
import Base
import Context
import Package
import Builder
import Stage
......@@ -146,16 +147,13 @@ filterSub prefix p = apply $ map filterSubstr
removeSub :: String -> [String] -> Args
removeSub prefix xs = filterSub prefix (`notElem` xs)
-- | Interpret a given expression in a given environment.
-- | Interpret a given expression according to the given 'Target'.
interpret :: Target -> Expr a -> Action a
interpret = flip runReaderT
interpretPartial :: PartialTarget -> Expr a -> Action a
interpretPartial = interpret . unsafeFromPartial
interpretWithStage :: Stage -> Expr a -> Action a
interpretWithStage s = interpretPartial $
PartialTarget s (error "interpretWithStage: package not set")
-- | Interpret a given expression by looking only at the given 'Context'.
interpretInContext :: Context -> Expr a -> Action a
interpretInContext = interpret . dummyTarget
-- | Extract an expression from a difference expression.
fromDiffExpr :: Monoid a => DiffExpr a -> Expr a
......@@ -167,11 +165,11 @@ interpretDiff target = interpret target . fromDiffExpr
-- | Convenient getters for target parameters.
getStage :: Expr Stage
getStage = asks stage
getStage = stage <$> asks context
-- | Get the 'Package' of the current 'Target'.
getPackage :: Expr Package
getPackage = asks package
getPackage = package <$> asks context
-- | Get the 'Builder' for the current 'Target'.
getBuilder :: Expr Builder
......@@ -179,7 +177,7 @@ getBuilder = asks builder
-- | Get the 'Way' of the current 'Target'.
getWay :: Expr Way
getWay = asks way
getWay = way <$> asks context
-- | Get the input files of the current 'Target'.
getInputs :: Expr [FilePath]
......
......@@ -3,6 +3,7 @@ module Oracles.PackageDb (packageDbOracle) where
import qualified System.Directory as IO
import Base
import Context hiding (stage)
import Builder
import GHC
import Rules.Actions
......@@ -16,8 +17,7 @@ packageDbOracle = do
let dir = packageDbDirectory stage
file = dir -/- "package.cache"
unlessM (liftIO $ IO.doesFileExist file) $ do
let target = PartialTarget stage ghcPkg
removeDirectoryIfExists dir
build $ fullTarget target (GhcPkg stage) [] [dir]
build $ Target (vanillaContext stage ghcPkg) (GhcPkg stage) [] [dir]
putSuccess $ "| Successfully initialised " ++ dir
return ()
......@@ -3,7 +3,7 @@ module Rules (topLevelTargets, packageRules) where
import Base
import Data.Foldable
import Expression
import GHC
import GHC hiding (haddock)
import qualified Rules.Generate
import Rules.Package
import Rules.Resources
......@@ -27,14 +27,14 @@ topLevelTargets = do
for_ allStages $ \stage ->
for_ (knownPackages \\ [rts, libffi]) $ \pkg -> action $ do
let target = PartialTarget stage pkg
activePackages <- interpretPartial target getPackages
let context = vanillaContext stage pkg
activePackages <- interpretInContext context getPackages
when (pkg `elem` activePackages) $
if isLibrary pkg
then do -- build a library
ways <- interpretPartial target getLibraryWays
ways <- interpretInContext context getLibraryWays
libs <- traverse (pkgLibraryFile stage pkg) ways
haddock <- interpretPartial target buildHaddock
haddock <- interpretInContext context buildHaddock
need $ libs ++ [ pkgHaddockFile pkg | haddock && stage == Stage1 ]
else do -- otherwise build a program
need [ fromJust $ programPath stage pkg ] -- TODO: drop fromJust
......@@ -44,4 +44,4 @@ packageRules = do
resources <- resourceRules
for_ allStages $ \stage ->
for_ knownPackages $ \pkg ->
buildPackage resources $ PartialTarget stage pkg
buildPackage resources $ vanillaContext stage pkg
......@@ -11,20 +11,20 @@ import qualified Control.Exception.Base as IO
import Base
import CmdLineFlag
import Context
import Expression
import Oracles.ArgsHash
import Oracles.WindowsPath
import Settings
import Settings.Args
import Settings.Builders.Ar
import qualified Target
import Target
-- Build a given target using an appropriate builder and acquiring necessary
-- resources. Force a rebuilt if the argument list has changed since the last
-- built (that is, track changes in the build system).
buildWithResources :: [(Resource, Int)] -> Target -> Action ()
buildWithResources rs target = do
let builder = Target.builder target
buildWithResources rs target @ Target {..} = do
needBuilder laxDependencies builder
path <- builderPath builder
argList <- interpret target getArgs
......@@ -160,15 +160,15 @@ makeExecutable file = do
quietly $ cmd "chmod +x " [file]
-- Print out key information about the command being executed
putInfo :: Target.Target -> Action ()
putInfo Target.Target {..} = putProgressInfo $ renderAction
("Run " ++ show builder ++ " (" ++ stageInfo
++ "package = " ++ pkgNameString package ++ wayInfo ++ ")")
(digest inputs)
(digest outputs)
putInfo :: Target -> Action ()
putInfo Target {..} = putProgressInfo $ renderAction
("Run " ++ show builder ++ contextInfo) (digest inputs) (digest outputs)
where
stageInfo = if isStaged builder then "" else "stage = " ++ show stage ++ ", "
wayInfo = if way == vanilla then "" else ", way = " ++ show way
contextInfo = concat $ [ " (" ]
++ [ "stage = " ++ show (stage context) ]
++ [ ", package = " ++ pkgNameString (package context) ]
++ [ ", way = " ++ show (way context) | way context /= vanilla ]
++ [ ")" ]
digest [] = "none"
digest [x] = x
digest (x:xs) = x ++ " (and " ++ show (length xs) ++ " more)"
......
......@@ -14,7 +14,7 @@ cabalRules :: Rules ()
cabalRules = do
-- Cache boot package constraints (to be used in cabalArgs)
bootPackageConstraints %> \out -> do
bootPkgs <- interpretWithStage Stage0 getPackages
bootPkgs <- interpretInContext (stageContext Stage0) getPackages
let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
constraints <- forM (sort pkgs) $ \pkg -> do
need [pkgCabalFile pkg]
......@@ -27,7 +27,7 @@ cabalRules = do
-- Cache package dependencies
packageDependencies %> \out -> do
pkgs <- interpretWithStage Stage1 getPackages
pkgs <- interpretInContext (stageContext Stage1) getPackages
pkgDeps <- forM (sort pkgs) $ \pkg ->
if pkg == rts
then return $ pkgNameString pkg
......
{-# LANGUAGE RecordWildCards #-}
module Rules.Compile (compilePackage) where
import Base
import Context
import Expression
import Oracles.Dependencies
import Rules.Actions
import Rules.Resources
import Settings
import Target hiding (context)
compilePackage :: Resources -> PartialTarget -> Rules ()
compilePackage rs target @ (PartialTarget stage pkg) = do
let buildPath = targetPath stage pkg -/- "build"
-- TODO: Use way from Context, #207
compilePackage :: Resources -> Context -> Rules ()
compilePackage rs context @ (Context {..}) = do
let buildPath = targetPath stage package -/- "build"
matchBuildResult buildPath "hi" ?> \hi ->
if compileInterfaceFilesSeparately && not ("//HpcParser.*" ?== hi)
then do
let way = detectWay hi
(src, deps) <- dependencies buildPath $ hi -<.> osuf way
let w = detectWay hi
(src, deps) <- dependencies buildPath $ hi -<.> osuf w
need $ src : deps
buildWithResources [(resPackageDb rs, 1)] $
fullTargetWithWay target (Ghc stage) way [src] [hi]
Target (context { way = w }) (Ghc stage) [src] [hi]
else need [ hi -<.> osuf (detectWay hi) ]
matchBuildResult buildPath "hi-boot" ?> \hiboot ->
if compileInterfaceFilesSeparately
then do
let way = detectWay hiboot
(src, deps) <- dependencies buildPath $ hiboot -<.> obootsuf way
let w = detectWay hiboot
(src, deps) <- dependencies buildPath $ hiboot -<.> obootsuf w
need $ src : deps
buildWithResources [(resPackageDb rs, 1)] $
fullTargetWithWay target (Ghc stage) way [src] [hiboot]
Target (context { way = w }) (Ghc stage) [src] [hiboot]
else need [ hiboot -<.> obootsuf (detectWay hiboot) ]
-- TODO: add dependencies for #include of .h and .hs-incl files (gcc -MM?)
......@@ -37,21 +41,21 @@ compilePackage rs target @ (PartialTarget stage pkg) = do
if ("//*.c" ?== src)
then do
need $ src : deps
build $ fullTarget target (Gcc stage) [src] [obj]
build $ Target context (Gcc stage) [src] [obj]
else do
let way = detectWay obj
let w = detectWay obj
if compileInterfaceFilesSeparately && "//*.hs" ?== src && not ("//HpcParser.*" ?== src)
then need $ (obj -<.> hisuf (detectWay obj)) : src : deps
else need $ src : deps
buildWithResources [(resPackageDb rs, 1)] $
fullTargetWithWay target (Ghc stage) way [src] [obj]
Target (context { way = w }) (Ghc stage) [src] [obj]
-- TODO: get rid of these special cases
matchBuildResult buildPath "o-boot" ?> \obj -> do
(src, deps) <- dependencies buildPath obj
let way = detectWay obj
let w = detectWay obj
if compileInterfaceFilesSeparately
then need $ (obj -<.> hibootsuf (detectWay obj)) : src : deps
else need $ src : deps
buildWithResources [(resPackageDb rs, 1)] $
fullTargetWithWay target (Ghc stage) way [src] [obj]
Target (context { way = w }) (Ghc stage) [src] [obj]
{-# LANGUAGE RecordWildCards #-}
module Rules.Data (buildPackageData) where
import qualified System.Directory as IO
import Base
import Context
import Expression
import GHC
import Oracles.Config.Setting
......@@ -13,26 +15,27 @@ import Rules.Libffi
import Rules.Resources
import Settings
import Settings.Builders.Common
import Target
-- Build package-data.mk by using GhcCabal to process pkgCabal file
buildPackageData :: Resources -> PartialTarget -> Rules ()
buildPackageData _ target @ (PartialTarget stage pkg) = do
let cabalFile = pkgCabalFile pkg
configure = pkgPath pkg -/- "configure"
dataFile = pkgDataFile stage pkg
oldPath = pkgPath pkg -/- targetDirectory stage pkg -- TODO: remove, #113
buildPackageData :: Resources -> Context -> Rules ()
buildPackageData _ context @ (Context {..}) = do
let cabalFile = pkgCabalFile package
configure = pkgPath package -/- "configure"
dataFile = pkgDataFile stage package
oldPath = pkgPath package -/- targetDirectory stage package -- TODO: remove, #113
[dataFile, oldPath -/- "package-data.mk"] &%> \_ -> do
-- The first thing we do with any package is make sure all generated
-- dependencies are in place before proceeding.
orderOnly $ generatedDependencies stage pkg
orderOnly $ generatedDependencies stage package
-- GhcCabal may run the configure script, so we depend on it
whenM (doesFileExist $ configure <.> "ac") $ need [configure]
-- Before we configure a package its dependencies need to be registered
deps <- packageDeps pkg
pkgs <- interpretPartial target getPackages
deps <- packageDeps package
pkgs <- interpretInContext context getPackages
let depPkgs = matchPackageNames (sort pkgs) deps
need =<< traverse (pkgConfFile stage) depPkgs
......@@ -40,24 +43,24 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
let inTreeMk = oldPath -/- takeFileName dataFile
need [cabalFile]
build $ fullTarget target GhcCabal [cabalFile] [inTreeMk]
build $ Target context GhcCabal [cabalFile] [inTreeMk]
-- TODO: get rid of this, see #113
liftIO $ IO.copyFile inTreeMk dataFile
autogenFiles <- getDirectoryFiles oldPath ["build/autogen/*"]
createDirectory $ targetPath stage pkg -/- "build/autogen"
createDirectory $ targetPath stage package -/- "build/autogen"
forM_ autogenFiles $ \file -> do
copyFile (oldPath -/- file) (targetPath stage pkg -/- file)
copyFile (oldPath -/- file) (targetPath stage package -/- file)
let haddockPrologue = "haddock-prologue.txt"
copyFile (oldPath -/- haddockPrologue) (targetPath stage pkg -/- haddockPrologue)
copyFile (oldPath -/- haddockPrologue) (targetPath stage package -/- haddockPrologue)
postProcessPackageData stage pkg dataFile
postProcessPackageData stage package dataFile
-- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps
priority 2.0 $ do
when (pkg == hp2ps) $ dataFile %> \mk -> do
includes <- interpretPartial target $ fromDiffExpr includesArgs
let prefix = fixKey (targetPath stage pkg) ++ "_"
when (package == hp2ps) $ dataFile %> \mk -> do
includes <- interpretInContext context $ fromDiffExpr includesArgs
let prefix = fixKey (targetPath stage package) ++ "_"
cSrcs = [ "AreaBelow.c", "Curves.c", "Error.c", "Main.c"
, "Reorder.c", "TopTwenty.c", "AuxFile.c"
, "Deviation.c", "HpFile.c", "Marks.c", "Scale.c"
......@@ -71,8 +74,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
writeFileChanged mk contents
putSuccess $ "| Successfully generated '" ++ mk ++ "'."
when (pkg == unlit) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage pkg) ++ "_"
when (package == unlit) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage package) ++ "_"
contents = unlines $ map (prefix++)
[ "PROGNAME = unlit"
, "C_SRCS = unlit.c"
......@@ -80,8 +83,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
writeFileChanged mk contents
putSuccess $ "| Successfully generated '" ++ mk ++ "'."
when (pkg == touchy) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage pkg) ++ "_"
when (package == touchy) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage package) ++ "_"
contents = unlines $ map (prefix++)
[ "PROGNAME = touchy"
, "C_SRCS = touchy.c" ]
......@@ -91,8 +94,8 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
-- Bootstrapping `ghcCabal`: although `ghcCabal` is a proper cabal
-- package, we cannot generate the corresponding `package-data.mk` file
-- by running by running `ghcCabal`, because it has not yet been built.
when (pkg == ghcCabal && stage == Stage0) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage pkg) ++ "_"
when (package == ghcCabal && stage == Stage0) $ dataFile %> \mk -> do
let prefix = fixKey (targetPath stage package) ++ "_"
contents = unlines $ map (prefix++)
[ "PROGNAME = ghc-cabal"
, "MODULES = Main"
......@@ -101,24 +104,24 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
writeFileChanged mk contents
putSuccess $ "| Successfully generated '" ++ mk ++ "'."
when (pkg == rts && stage == Stage1) $ do
when (package == rts && stage == Stage1) $ do
dataFile %> \mk -> do
orderOnly $ generatedDependencies stage pkg
orderOnly $ generatedDependencies stage package
windows <- windowsHost
let prefix = fixKey (targetPath stage pkg) ++ "_"
let prefix = fixKey (targetPath stage package) ++ "_"
dirs = [ ".", "hooks", "sm", "eventlog" ]
++ [ "posix" | not windows ]
++ [ "win32" | windows ]
-- TODO: rts/dist/build/sm/Evac_thr.c, rts/dist/build/sm/Scav_thr.c
-- TODO: adding cmm/S sources to C_SRCS is a hack; rethink after #18
cSrcs <- getDirectoryFiles (pkgPath pkg) (map (-/- "*.c") dirs)
cmmSrcs <- getDirectoryFiles (pkgPath pkg) ["*.cmm"]
cSrcs <- getDirectoryFiles (pkgPath package) (map (-/- "*.c") dirs)
cmmSrcs <- getDirectoryFiles (pkgPath package) ["*.cmm"]
buildAdjustor <- anyTargetArch ["i386", "powerpc", "powerpc64"]
buildStgCRunAsm <- anyTargetArch ["powerpc64le"]
let sSrcs = [ "AdjustorAsm.S" | buildAdjustor ]
++ [ "StgCRunAsm.S" | buildStgCRunAsm ]
extraSrcs = [ rtsBuildPath -/- "AutoApply.cmm" ]
includes <- interpretPartial target $ fromDiffExpr includesArgs
includes <- interpretInContext context $ fromDiffExpr includesArgs
let contents = unlines $ map (prefix++)
[ "C_SRCS = "
++ unwords (cSrcs ++ cmmSrcs ++ sSrcs ++ extraSrcs)
......@@ -137,16 +140,16 @@ buildPackageData _ target @ (PartialTarget stage pkg) = do
-- is replaced by libraries_deepseq_dist-install_VERSION = 1.4.0.0
-- Reason: Shake's built-in makefile parser doesn't recognise slashes
postProcessPackageData :: Stage -> Package -> FilePath -> Action ()
postProcessPackageData stage pkg file = fixFile file fixPackageData
postProcessPackageData stage package file = fixFile file fixPackageData
where
fixPackageData = unlines . map processLine . filter (not . null) . filter ('$' `notElem`) . lines
processLine line = fixKey fixedPrefix ++ suffix
where
(prefix, suffix) = break (== '=') line
-- Change pkg/path/targetDir to takeDirectory file
-- Change package/path/targetDir to takeDirectory file
-- This is a temporary hack until we get rid of ghc-cabal
fixedPrefix = takeDirectory file ++ drop len prefix
len = length (pkgPath pkg -/- targetDirectory stage pkg)
len = length (pkgPath package -/- targetDirectory stage package)
-- TODO: remove, see #113
fixKey :: String -> String
......
{-# LANGUAGE RecordWildCards #-}
module Rules.Dependencies (buildPackageDependencies) where
import Development.Shake.Util (parseMakefile)
import Base
import Context
import Expression
import Oracles.PackageData
import Rules.Actions
import Rules.Resources
import Settings
import Development.Shake.Util (parseMakefile)
import Target
-- TODO: simplify handling of AutoApply.cmm
buildPackageDependencies :: Resources -> PartialTarget -> Rules ()
buildPackageDependencies rs target @ (PartialTarget stage pkg) =
let path = targetPath stage pkg
buildPackageDependencies :: Resources -> Context -> Rules ()
buildPackageDependencies rs context @ (Context {..}) =
let path = targetPath stage package
buildPath = path -/- "build"
dropBuild = (pkgPath pkg ++) . drop (length buildPath)
dropBuild = (pkgPath package ++) . drop (length buildPath)
hDepFile = buildPath -/- ".hs-dependencies"
in do
fmap (buildPath++)
......@@ -22,15 +26,15 @@ buildPackageDependencies rs target @ (PartialTarget stage pkg) =
then dropExtension out
else dropBuild . dropExtension $ out
need [srcFile]
build $ fullTarget target (GccM stage) [srcFile] [out]
build $ Target context (GccM stage) [srcFile] [out]
hDepFile %> \out -> do
srcs <- interpretPartial target getPackageSources
srcs <- interpretInContext context getPackageSources
need srcs
if srcs == []
then writeFileChanged out ""
else buildWithResources [(resPackageDb rs, 1)] $
fullTarget target (GhcM stage) srcs [out]
Target context (GhcM stage) srcs [out]
removeFileIfExists $ out <.> "bak"
-- TODO: don't accumulate *.deps into .dependencies
......
{-# LANGUAGE RecordWildCards #-}
module Rules.Documentation (buildPackageDocumentation) where
import Base
import Context
import Expression
import GHC
import Oracles.PackageData
import Rules.Actions
import Rules.Resources
import Settings
import Target
haddockHtmlLib :: FilePath
haddockHtmlLib = "inplace/lib/html/haddock-util.js"
......@@ -14,14 +17,14 @@ haddockHtmlLib = "inplace/lib/html/haddock-util.js"
-- Note: this build rule creates plenty of files, not just the .haddock one.
-- All of them go into the 'doc' subdirectory. Pedantically tracking all built
-- files in the Shake databases seems fragile and unnecesarry.
buildPackageDocumentation :: Resources -> PartialTarget -> Rules ()
buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
let cabalFile = pkgCabalFile pkg
haddockFile = pkgHaddockFile pkg
buildPackageDocumentation :: Resources -> Context -> Rules ()
buildPackageDocumentation _ context @ (Context {..}) =
let cabalFile = pkgCabalFile package
haddockFile = pkgHaddockFile package
in when (stage == Stage1) $ do
haddockFile %> \file -> do
srcs <- interpretPartial target getPackageSources
deps <- map PackageName <$> interpretPartial target (getPkgDataList DepNames)
srcs <- interpretInContext context getPackageSources
deps <- map PackageName <$> interpretInContext context (getPkgDataList DepNames)
let haddocks = [ pkgHaddockFile depPkg
| Just depPkg <- map findKnownPackage deps
, depPkg /= rts ]
......@@ -30,15 +33,15 @@ buildPackageDocumentation _ target @ (PartialTarget stage pkg) =
-- HsColour sources
-- TODO: what is the output of GhcCabalHsColour?
whenM (specified HsColour) $ do
pkgConf <- pkgConfFile stage pkg
pkgConf <- pkgConfFile stage package
need [ cabalFile, pkgConf ] -- TODO: check if need pkgConf
build $ fullTarget target GhcCabalHsColour [cabalFile] []
build $ Target context GhcCabalHsColour [cabalFile] []
-- Build Haddock documentation
let haddockWay = if dynamicGhcPrograms then dynamic else vanilla
build $ fullTargetWithWay target Haddock haddockWay srcs [file]
build $ Target (context {way = haddockWay}) Haddock srcs [file]
when (pkg == haddock) $ haddockHtmlLib %> \_ -> do
when (package == haddock) $ haddockHtmlLib %> \_ -> do
let dir = takeDirectory haddockHtmlLib
liftIO $ removeFiles dir ["//*"]
copyDirectory "utils/haddock/haddock-api/resources/html" dir
......
......@@ -6,6 +6,7 @@ module Rules.Generate (
import qualified System.Directory as IO
import Base
import Context hiding (stage)
import Expression
import GHC
import Rules.Generators.ConfigHs
......@@ -21,6 +22,7 @@ import Rules.Gmp
import Rules.Libffi
import Rules.Resources (Resources)
import Settings
import Target hiding (builder, context)
installTargets :: [FilePath]
installTargets = [ "inplace/lib/ghc-usage.txt"
......@@ -106,18 +108,18 @@ determineBuilder file = fmap fst $ find (\(_, e) -> e == ext) knownGenerators
where
ext = takeExtension file
generate :: FilePath -> PartialTarget -> Expr String -> Action ()
generate file target expr = do
contents <- interpretPartial target expr
generate :: FilePath -> Context -> Expr String -> Action ()
generate file context expr = do
contents <- interpretInContext context expr
writeFileChanged file contents
putSuccess $ "| Successfully generated '" ++ file ++ "'."
generatePackageCode :: Resources -> PartialTarget -> Rules ()
generatePackageCode _ target @ (PartialTarget stage pkg) =
generatePackageCode :: Resources -> Context -> Rules ()
generatePackageCode _ context @ (Context stage pkg _) =
let buildPath = targetPath stage pkg -/- "build"
dropBuild = drop (length buildPath + 1)
generated f = (buildPath ++ "//*.hs") ?== f && not ("//autogen/*" ?== f)
file <~ gen = generate file target gen
file <~ gen = generate file context gen
in do
generated ?> \file -> do