Add dependencies to Target.
authorAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 25 Jul 2015 16:08:35 +0000 (17:08 +0100)
committerAndrey Mokhov <andrey.mokhov@gmail.com>
Sat, 25 Jul 2015 16:08:35 +0000 (17:08 +0100)
src/Expression.hs
src/Rules/Actions.hs
src/Rules/Data.hs
src/Rules/Dependencies.hs
src/Settings/GccM.hs
src/Settings/GhcCabal.hs
src/Settings/GhcM.hs
src/Settings/Util.hs
src/Target.hs

index 29c9f00..419a988 100644 (file)
@@ -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
 
index a90a3bc..055931e 100644 (file)
@@ -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
index a50884b..b48ff48 100644 (file)
@@ -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:
index 6dfb56e..251a233 100644 (file)
@@ -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"]
index ced4a56..d33cb23 100644 (file)
@@ -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
index 0438a37..91ee6b8 100644 (file)
@@ -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 ""
 
index 1ae57e6..7349a86 100644 (file)
@@ -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
index 6d9c63e..1e7585e 100644 (file)
@@ -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
index 76705fe..c3b6b93 100644 (file)
@@ -1,7 +1,7 @@
 {-# 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