Commit 4f2fbbbe authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add dependencies to Target.

parent 28a80787
......@@ -9,7 +9,8 @@ module Expression (
apply, append, appendM, remove,
appendSub, appendSubD, filterSub, removeSub,
interpret, interpretExpr,
getStage, getPackage, getBuilder, getFiles, getFile, getWay,
getStage, getPackage, getBuilder, getFiles, getFile,
getDependencies, getDependency, getWay,
stage, package, builder, stagedBuilder, file, way
) where
......@@ -173,6 +174,18 @@ getFile = do
[file] -> return file
_ -> error $ "Exactly one file expected in target " ++ show target
getDependencies :: Expr [FilePath]
getDependencies = asks Target.dependencies
getDependency :: Expr FilePath
getDependency = do
target <- ask
deps <- getDependencies
case deps of
[dep] -> return dep
_ -> error $ "Exactly one dependency expected in target "
++ show target
getWay :: Expr Way
getWay = asks Target.way
......
......@@ -16,6 +16,7 @@ import Development.Shake
-- the build system).
build :: FullTarget -> Action ()
build target = do
need $ Target.dependencies target
argList <- interpret target args
-- The line below forces the rule to be rerun if the args hash has changed
argsHash <- askArgsHash target
......
......@@ -15,9 +15,11 @@ import Development.Shake
-- Build package-data.mk by using GhcCabal to process pkgCabal file
buildPackageData :: StagePackageTarget -> Rules ()
buildPackageData target =
let stage = Target.stage target
pkg = Target.package target
path = targetPath stage pkg
let stage = Target.stage target
pkg = Target.package target
path = targetPath stage pkg
cabal = pkgPath pkg -/- pkgCabal pkg
configure = pkgPath pkg -/- "configure"
in
(path -/-) <$>
[ "package-data.mk"
......@@ -28,13 +30,12 @@ buildPackageData target =
-- TODO: Is this needed? Also check out Paths_cpsa.hs.
-- , "build" -/- "autogen" -/- ("Paths_" ++ name) <.> "hs"
] &%> \files -> do
let configure = pkgPath pkg -/- "configure"
-- GhcCabal will run the configure script, so we depend on it
need [pkgPath pkg -/- pkgCabal pkg]
-- GhcCabal may run the configure script, so we depend on it
-- We still don't know who built the configure script from configure.ac
whenM (doesFileExist $ configure <.> "ac") $ need [configure]
build $ fullTarget target files GhcCabal
buildWhen registerPackage $ fullTarget target files (GhcPkg stage)
build $ fullTarget target [cabal] GhcCabal files
buildWhen registerPackage $
fullTarget target [cabal] (GhcPkg stage) files
postProcessPackageData $ path -/- "package-data.mk"
-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
......
......@@ -6,6 +6,7 @@ import Package
import Expression
import qualified Target
import Oracles.PackageData
import Settings.Util
import Settings.TargetDirectory
import Rules.Actions
import Development.Shake
......@@ -17,13 +18,16 @@ buildPackageDependencies target =
path = targetPath stage pkg
buildPath = path -/- "build"
in do
(buildPath -/- "haskell.deps") %> \file ->
build $ fullTarget target [file] (GhcM stage)
(buildPath -/- "haskell.deps") %> \file -> do
srcs <- interpretExpr target getHsSources
build $ fullTarget target srcs (GhcM stage) [file]
(buildPath -/- "c.deps") %> \file -> do
srcs <- pkgDataList $ CSrcs path
deps <- fmap concat $ forM srcs $ \src -> do
build $ fullTarget target [pkgPath pkg -/- src] (GccM stage)
liftIO $ readFile (buildPath -/- takeFileName src <.> "deps")
writeFileChanged file deps
liftIO $ removeFiles path ["*.c.deps"]
deps <- forM srcs $ \src -> do
let srcFile = pkgPath pkg -/- src
depFile = buildPath -/- takeFileName src <.> "deps"
build $ fullTarget target [srcFile] (GccM stage) [depFile]
liftIO . readFile $ depFile
writeFileChanged file (concat deps)
liftIO $ removeFiles buildPath ["*.c.deps"]
......@@ -11,6 +11,7 @@ gccMArgs :: Args
gccMArgs = stagedBuilder GccM ? do
path <- getTargetPath
file <- getFile
src <- getDependency
ccArgs <- getPkgDataList CcArgs
mconcat
[ arg "-E"
......@@ -18,10 +19,10 @@ gccMArgs = stagedBuilder GccM ? do
, append ccArgs -- TODO: remove? any other flags?
, includeGccArgs
, arg "-MF"
, arg $ path -/- "build" -/- takeFileName file <.> "deps"
, arg file
, arg "-x"
, arg "c"
, arg file ]
, arg src ]
includeGccArgs :: Args
includeGccArgs = do
......
......@@ -88,6 +88,7 @@ bootPackageDbArgs = do
-- This is a positional argument, hence:
-- * if it is empty, we need to emit one empty string argument;
-- * otherwise, we must collapse it into one space-separated string.
-- TODO: should be non-empty for compiler
dllArgs :: Args
dllArgs = arg ""
......
......@@ -10,7 +10,6 @@ import Oracles.Flag
import Oracles.PackageData
import Settings.Util
import Settings.Ways
import Development.Shake
ghcMArgs :: Args
ghcMArgs = stagedBuilder GhcM ? do
......@@ -69,21 +68,3 @@ includeGhcArgs = do
, append . map (\dir -> "-I" ++ pkgPath -/- dir) $ incDirs
, arg "-optP-include" -- TODO: Shall we also add -cpp?
, arg $ "-optP" ++ autogenPath -/- "cabal_macros.h" ]
getHsSources :: Expr [FilePath]
getHsSources = do
path <- getTargetPath
pkgPath <- getPackagePath
srcDirs <- getPkgDataList SrcDirs
let paths = (path -/- "build/autogen") : map (pkgPath -/-) srcDirs
getSourceFiles paths [".hs", ".lhs"]
-- Find all source files in specified paths and with given extensions
getSourceFiles :: [FilePath] -> [String] -> Expr [FilePath]
getSourceFiles paths exts = do
modules <- getPkgDataList Modules
let modPaths = map (replaceEq '.' '/') modules
candidates = [ p -/- m ++ e | p <- paths, m <- modPaths, e <- exts ]
files <- lift $ filterM (doesDirectoryExist . takeDirectory) candidates
result <- lift $ getDirectoryFiles "" files
return $ map unifyPath result
......@@ -5,6 +5,7 @@ module Settings.Util (
getFlag, getSetting, getSettingList,
getPkgData, getPkgDataList,
getPackagePath, getTargetPath, getTargetDirectory,
getHsSources, getSourceFiles,
appendCcArgs,
needBuilder
-- argBuilderPath, argStagedBuilderPath,
......@@ -15,6 +16,7 @@ module Settings.Util (
-- argPackageConstraints,
) where
import Util
import Builder
import Package
import Expression
......@@ -68,6 +70,25 @@ getTargetPath = liftM2 targetPath getStage getPackage
getTargetDirectory :: Expr FilePath
getTargetDirectory = liftM2 targetDirectory getStage getPackage
-- Find all Haskell source files for the current target
getHsSources :: Expr [FilePath]
getHsSources = do
path <- getTargetPath
pkgPath <- getPackagePath
srcDirs <- getPkgDataList SrcDirs
let paths = (path -/- "build/autogen") : map (pkgPath -/-) srcDirs
getSourceFiles paths [".hs", ".lhs"]
-- Find all source files in specified paths and with given extensions
getSourceFiles :: [FilePath] -> [String] -> Expr [FilePath]
getSourceFiles paths exts = do
modules <- getPkgDataList Modules
let modPaths = map (replaceEq '.' '/') modules
candidates = [ p -/- m ++ e | p <- paths, m <- modPaths, e <- exts ]
files <- lift $ filterM (doesDirectoryExist . takeDirectory) candidates
result <- lift $ getDirectoryFiles "" files
return $ map unifyPath result
-- Pass arguments to Gcc and corresponding lists of sub-arguments of GhcCabal
appendCcArgs :: [String] -> Args
appendCcArgs xs = do
......
{-# LANGUAGE DeriveGeneric, TypeSynonymInstances #-}
module Target (
Target (..), StageTarget (..), StagePackageTarget (..), FullTarget (..),
stageTarget, stagePackageTarget, fullTarget, fullTarwithWay
stageTarget, stagePackageTarget, fullTarget, fullTargetWithWay
) where
import Way
......@@ -11,18 +11,22 @@ import Builder
import GHC.Generics
import Development.Shake.Classes
-- Target captures parameters relevant to the current build target: Stage and
-- Package being built, Builder that is to be invoked, file(s) that are to
-- be built and the Way they are to be built.
-- Target captures all parameters relevant to the current build target:
-- * Stage and Package being built,
-- * dependencies (e.g., source files) that need to be tracked,
-- * Builder to be invoked,
-- * Way to be built (set to vanilla for most targets),
-- * file(s) to be produced.
data Target = Target
{
stage :: Stage,
package :: Package,
files :: [FilePath],
builder :: Builder,
way :: Way
stage :: Stage,
package :: Package,
dependencies :: [FilePath],
builder :: Builder,
way :: Way,
files :: [FilePath]
}
deriving (Eq, Generic)
deriving (Show, Eq, Generic)
-- StageTarget is a partially constructed Target. Only stage is guaranteed to
-- be assigned.
......@@ -31,11 +35,12 @@ type StageTarget = Target
stageTarget :: Stage -> StageTarget
stageTarget s = Target
{
stage = s,
package = error "stageTarget: Package not set",
files = error "stageTarget: Files not set",
builder = error "stageTarget: Builder not set",
way = vanilla
stage = s,
package = error "stageTarget: package not set",
dependencies = error "stageTarget: dependencies not set",
builder = error "stageTarget: builder not set",
way = vanilla,
files = error "stageTarget: files not set"
}
-- StagePackageTarget is a partially constructed Target. Only stage and package
......@@ -45,42 +50,37 @@ type StagePackageTarget = Target
stagePackageTarget :: Stage -> Package -> StagePackageTarget
stagePackageTarget s p = Target
{
stage = s,
package = p,
files = error "stagePackageTarget: Files not set",
builder = error "stagePackageTarget: Builder not set",
way = vanilla
stage = s,
package = p,
dependencies = error "stagePackageTarget: dependencies not set",
builder = error "stagePackageTarget: builder not set",
way = vanilla,
files = error "stagePackageTarget: files not set"
}
-- FullTarget is a Target whose fields are all assigned
type FullTarget = Target
-- Most targets are built only one way, vanilla, hence we set it by default.
fullTarget :: StagePackageTarget -> [FilePath] -> Builder -> FullTarget
fullTarget target fs b = target
fullTarget :: StagePackageTarget -> [FilePath] -> Builder -> [FilePath] -> FullTarget
fullTarget target deps b fs = target
{
files = fs,
builder = b,
way = vanilla
dependencies = deps,
builder = b,
way = vanilla,
files = fs
}
-- Use this function to be explicit about the build way.
fullTarwithWay :: StagePackageTarget -> [FilePath] -> Builder -> Way -> FullTarget
fullTarwithWay target fs b w = target
fullTargetWithWay :: StagePackageTarget -> [FilePath] -> Builder -> Way -> [FilePath] -> FullTarget
fullTargetWithWay target deps b w fs = target
{
files = fs,
builder = b,
way = w
dependencies = deps,
builder = b,
way = w,
files = fs
}
-- Shows a (full) target as "package:file@stage (builder, way)"
instance Show FullTarget where
show target = show (package target)
++ ":" ++ show (files target)
++ "@" ++ show (stage target)
++ " (" ++ show (builder target)
++ ", " ++ show (way target) ++ ")"
-- Instances for storing in the Shake database
instance Binary FullTarget
instance NFData FullTarget
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment