Implement compilePackage build rule.

src/Package/Compile.hs

-{-# LANGUAGE NoImplicitPrelude #-}
-module Package.Compile (buildPackageCompile) where
-
-import Package.Base
-
-argListDir :: FilePath
-argListDir = "shake/arg/buildPackageCompile"
-
-suffixArgs :: Way -> Args
-suffixArgs way =
-    return ["-hisuf", hisuf way, "-osuf", osuf way, "-hcsuf", hcsuf way]
-
-ghcArgs :: Package -> TodoItem -> Way -> [FilePath] -> FilePath -> Args
-ghcArgs (Package _ path _ _) (stage, dist, _) way srcs result =
-    let pathDist = path </> dist
-        buildDir = unifyPath $ pathDist </> "build"
-    in args [ suffixArgs way
-            , wayHcArgs way
-            , args SrcHcArgs
-            , packageArgs stage pathDist
-            , includeGhcArgs path dist
-            , concatArgs ["-optP"] $ CppArgs pathDist
-            , args $ HsArgs pathDist
-            -- TODO: now we have both -O and -O2
-            -- <> arg ["-O2"]
-            , productArgs ["-odir", "-hidir", "-stubdir"] [buildDir]
-            , when (splitObjects stage) $ arg "-split-objs"
-            , args ("-c":srcs)
-            , args ["-o", result] ]
-
-gccArgs :: Package -> TodoItem -> [FilePath] -> FilePath -> Args
-gccArgs (Package _ path _ _) (_, dist, settings) srcs result =
-    let pathDist = path </> dist
-    in args [ args $ CcArgs pathDist
-            , commonCcArgs
-            , customCcArgs settings
-            , commonCcWarninigArgs
-            , includeGccArgs path dist
-            , args ("-c":srcs)
-            , args ["-o", result] ]
-
-compileC :: Package -> TodoItem -> [FilePath] -> FilePath -> Action ()
-compileC pkg todo @ (stage, _, _) deps obj = do
-    need deps
-    let srcs = filter ("//*.c" ?==) deps
-    run (Gcc stage) $ gccArgs pkg todo srcs obj
-
-compileHaskell :: Package -> TodoItem -> FilePath -> Way -> Action ()
-compileHaskell pkg @ (Package _ path _ _) todo @ (stage, dist, _) obj way = do
-    let buildDir = unifyPath $ path </> dist </> "build"
-    -- TODO: keep only vanilla dependencies in 'haskell.deps'
-    deps <- args $ DependencyList (buildDir </> "haskell.deps") obj
-    let srcs = filter ("//*hs" ?==) deps
-    need deps
-    run (Ghc stage) $ ghcArgs pkg todo way srcs obj
-
-buildRule :: Package -> TodoItem -> Rules ()
-buildRule pkg @ (Package name path _ _) todo @ (stage, dist, _) =
-    let buildDir = unifyPath $ path </> dist </> "build"
-        cDepFile = buildDir </> "c.deps"
-    in
-    forM_ allWays $ \way -> do -- TODO: optimise (too many ways in allWays)
-        let oPattern  = "*." ++ osuf way
-        let hiPattern = "*." ++ hisuf way
-
-        (buildDir <//> hiPattern) %> \hi -> do
-            let obj = hi -<.> osuf way
-            -- TODO: Understand why 'need [obj]' doesn't work, leading to
-            -- recursive rules error. Below is a workaround.
-            -- putColoured Yellow $ "Hi " ++ hi
-            compileHaskell pkg todo obj way
-
-        (buildDir <//> oPattern) %> \obj -> do
-            let vanillaObjName = takeFileName obj -<.> "o"
-            cDeps <- args $ DependencyList cDepFile vanillaObjName
-            if null cDeps
-            then compileHaskell pkg todo obj way
-            else compileC pkg todo cDeps obj
-            -- Finally, record the argument list
-            need [argListPath argListDir pkg stage]
-
-argListRule :: Package -> TodoItem -> Rules ()
-argListRule pkg todo @ (stage, _, settings) =
-    (argListPath argListDir pkg stage) %> \out -> do
-        need $ ["shake/src/Package/Compile.hs"] ++ sourceDependecies
-        ways' <- ways settings
-        ghcList <- forM ways' $ \way ->
-            argListWithComment
-                ("way '" ++ tag way ++ "'")
-                (Ghc stage)
-                (ghcArgs pkg todo way ["input.hs"] $ "output" <.> osuf way)
-        gccList <- forM ways' $ \way ->
-            argListWithComment
-                ("way '" ++ tag way ++ "'")
-                (Gcc stage)
-                (gccArgs pkg todo ["input.c"] $ "output" <.> osuf way)
-
-        writeFileChanged out $ unlines ghcList ++ "\n" ++ unlines gccList
-
-buildPackageCompile :: Package -> TodoItem -> Rules ()
-buildPackageCompile = argListRule <> buildRule

src/Rules/Compile.hs

+module Rules.Compile (compilePackage) where
+
+import Way
+import Base
+import Util
+import Builder
+import Expression
+import qualified Target
+import Oracles.DependencyList
+import Settings.Ways
+import Settings.TargetDirectory
+import Rules.Actions
+import Rules.Resources
+
+compilePackage :: Resources -> StagePackageTarget -> Rules ()
+compilePackage _ target = do
+    let stage     = Target.stage target
+        pkg       = Target.package target
+        path      = targetPath stage pkg
+        buildPath = path -/- "build"
+        cDepsFile = buildPath -/- "c.deps"
+        hDepsFile = buildPath -/- "haskell.deps"
+
+    forM_ knownWays $ \way -> do
+        (buildPath <//> "*." ++ hisuf way) %> \hi -> do
+            let obj = hi -<.> osuf way
+            need [obj]
+
+        (buildPath <//> "*." ++ osuf way) %> \obj -> do
+            let vanillaObjName = takeFileName obj -<.> "o"
+            cDeps <- dependencyList cDepsFile vanillaObjName
+            hDeps <- dependencyList hDepsFile obj
+            let hSrcDeps = filter ("//*hs" ?==) hDeps
+
+            when (null cDeps && null hDeps) $
+                putError_ $ "Cannot determine sources for '" ++ obj ++ "'."
+
+            if null cDeps
+            then build $ fullTargetWithWay target hSrcDeps (Ghc stage) way [obj]
+            else build $ fullTarget        target cDeps    (Gcc stage)     [obj]

src/Rules/Package.hs

@@ -3,8 +3,9 @@ module Rules.Package (buildPackage) where
 import Base
 import Expression
 import Rules.Data
+import Rules.Compile
 import Rules.Resources
 import Rules.Dependencies
 
 buildPackage :: Resources -> StagePackageTarget -> Rules ()
-buildPackage = buildPackageData <> buildPackageDependencies
+buildPackage = buildPackageData <> buildPackageDependencies <> compilePackage

src/Settings/Gcc.hs

+module Settings.Gcc (gccArgs, includeGccArgs) where
+
+import Base
+import Util
+import Builder
+import Expression
+import Oracles.PackageData
+import Settings.Util
+
+gccArgs :: Args
+gccArgs = stagedBuilder Gcc ? do
+    path   <- getTargetPath
+    file   <- getFile
+    deps   <- getDependencies
+    ccArgs <- getPkgDataList CcArgs
+    mconcat [ append ccArgs
+            , includeGccArgs
+            , arg "-c"
+            , append $ filter ("//*.c" ?==) deps
+            , arg "-o"
+            , arg file ]
+
+includeGccArgs :: Args
+includeGccArgs = do
+    path    <- getTargetPath
+    pkgPath <- getPackagePath
+    pkg     <- getPackage
+    iDirs   <- getPkgDataList IncludeDirs
+    dDirs   <- getPkgDataList DepIncludeDirs
+    mconcat
+        [ arg $ "-I" ++ path -/- "build/autogen"
+        , append . map (\dir -> "-I" ++ pkgPath -/- dir) $ iDirs ++ dDirs ]

src/Settings/GccM.hs

 module Settings.GccM (gccMArgs) where
 
-import Util
 import Builder
 import Expression
 import Oracles.PackageData
+import Settings.Gcc
 import Settings.Util
 
 -- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
@@ -23,14 +23,3 @@ gccMArgs = stagedBuilder GccM ? do
         , arg "-x"
         , arg "c"
         , arg src ]
-
-includeGccArgs :: Args
-includeGccArgs = do
-    path    <- getTargetPath
-    pkgPath <- getPackagePath
-    pkg     <- getPackage
-    iDirs   <- getPkgDataList IncludeDirs
-    dDirs   <- getPkgDataList DepIncludeDirs
-    mconcat
-        [ arg $ "-I" ++ path -/- "build/autogen"
-        , append . map (\dir -> "-I" ++ pkgPath -/- dir) $ iDirs ++ dDirs ]

src/Settings/Ghc.hs

+module Settings.Ghc (ghcArgs, packageGhcArgs, includeGhcArgs) where
+
+import Way
+import Util
+import Stage
+import Builder
+import Switches
+import Expression
+import Oracles.Flag
+import Oracles.PackageData
+import Settings.Util
+
+ghcArgs :: Args
+ghcArgs = stagedBuilder Ghc ? do
+    way     <- getWay
+    hsArgs  <- getPkgDataList HsArgs
+    cppArgs <- getPkgDataList CppArgs
+    srcs    <- getDependencies
+    file    <- getFile
+    path    <- getTargetPath
+    let buildPath = path -/- "build"
+    mconcat
+        [ arg "-hisuf", arg $ hisuf way
+        , arg "-osuf" , arg $  osuf way
+        , arg "-hcsuf", arg $ hcsuf way
+        , wayHcArgs
+        , packageGhcArgs
+        , includeGhcArgs
+        , append hsArgs
+        , append . map ("-optP" ++) $ cppArgs
+        , arg "-odir"   , arg buildPath
+        , arg "-stubdir", arg buildPath
+        , arg "-hidir"  , arg buildPath
+        , splitObjects  ? arg "-split-objs"
+        , arg "-no-user-package-db" -- TODO: is this needed?
+        , arg "-rtsopts"            -- TODO: is this needed?
+        , arg "-c", append srcs
+        , arg "-o", arg file ]
+
+-- TODO: do '-ticky' in all debug ways?
+wayHcArgs :: Args
+wayHcArgs = do
+    way <- getWay
+    mconcat [ if (Dynamic `wayUnit` way)
+              then append ["-fPIC", "-dynamic"]
+              else arg "-static"
+            , (Threaded  `wayUnit` way) ? arg "-optc-DTHREADED_RTS"
+            , (Debug     `wayUnit` way) ? arg "-optc-DDEBUG"
+            , (Profiling `wayUnit` way) ? arg "-prof"
+            , (Logging   `wayUnit` way) ? arg "-eventlog"
+            , (Parallel  `wayUnit` way) ? arg "-parallel"
+            , (GranSim   `wayUnit` way) ? arg "-gransim"
+            , (way == debug || way == debugDynamic) ?
+              append ["-ticky", "-DTICKY_TICKY"] ]
+
+packageGhcArgs :: Args
+packageGhcArgs = do
+    stage              <- getStage
+    supportsPackageKey <- getFlag SupportsPackageKey
+    pkgKey             <- getPkgData PackageKey
+    pkgDepKeys         <- getPkgDataList DepKeys
+    pkgDeps            <- getPkgDataList Deps
+    mconcat
+        [ arg "-hide-all-packages"
+        , arg "-no-user-package-db"
+        , arg "-include-pkg-deps"
+        , stage0 ? arg "-package-db libraries/bootstrapping.conf"
+        , if supportsPackageKey || stage /= Stage0
+          then mconcat [ arg $ "-this-package-key " ++ pkgKey
+                       , append . map ("-package-key " ++) $ pkgDepKeys ]
+          else mconcat [ arg $ "-package-name" ++ pkgKey
+                       , append . map ("-package " ++) $ pkgDeps ]]
+
+includeGhcArgs :: Args
+includeGhcArgs = do
+    path    <- getTargetPath
+    pkgPath <- getPackagePath
+    srcDirs <- getPkgDataList SrcDirs
+    incDirs <- getPkgDataList IncludeDirs
+    cppArgs <- getPkgDataList CppArgs
+    let buildPath   = path -/- "build"
+        autogenPath = buildPath -/- "autogen"
+    mconcat
+        [ arg "-i"
+        , append . map (\dir -> "-i" ++ pkgPath -/- dir) $ srcDirs
+        , arg $ "-i" ++ buildPath
+        , arg $ "-i" ++ autogenPath
+        , arg $ "-I" ++ buildPath
+        , arg $ "-I" ++ autogenPath
+        , append . map (\dir -> "-I" ++ pkgPath -/- dir) $ incDirs
+        , arg "-optP-include", arg $ "-optP" ++ autogenPath -/- "cabal_macros.h"
+        , append . map ("-optP" ++) $ cppArgs ]

src/Settings/GhcM.hs

@@ -2,12 +2,10 @@ module Settings.GhcM (ghcMArgs) where
 
 import Way
 import Util
-import Stage
 import Builder
-import Switches
 import Expression
-import Oracles.Flag
 import Oracles.PackageData
+import Settings.Ghc
 import Settings.Util
 import Settings.Ways
 
@@ -23,52 +21,13 @@ ghcMArgs = stagedBuilder GhcM ? do
         [ arg "-M"
         , packageGhcArgs
         , includeGhcArgs
+        , append hsArgs
         , append . map ("-optP" ++) $ cppArgs
         , arg "-odir"        , arg buildPath
         , arg "-stubdir"     , arg buildPath
         , arg "-hidir"       , arg buildPath
         , arg "-dep-makefile", arg $ buildPath -/- "haskell.deps"
         , append . concatMap (\way -> ["-dep-suffix", wayPrefix way]) $ ways
-        , append hsArgs
         , arg "-no-user-package-db" -- TODO: is this needed?
         , arg "-rtsopts"            -- TODO: is this needed?
         , append hsSrcs ]
-
-
-packageGhcArgs :: Args
-packageGhcArgs = do
-    stage              <- getStage
-    supportsPackageKey <- getFlag SupportsPackageKey
-    pkgKey             <- getPkgData PackageKey
-    pkgDepKeys         <- getPkgDataList DepKeys
-    pkgDeps            <- getPkgDataList Deps
-    mconcat
-        [ arg "-hide-all-packages"
-        , arg "-no-user-package-db"
-        , arg "-include-pkg-deps"
-        , stage0 ? arg "-package-db libraries/bootstrapping.conf"
-        , if supportsPackageKey || stage /= Stage0
-          then mconcat [ arg $ "-this-package-key " ++ pkgKey
-                       , append . map ("-package-key " ++) $ pkgDepKeys ]
-          else mconcat [ arg $ "-package-name" ++ pkgKey
-                       , append . map ("-package " ++) $ pkgDeps ]]
-
-includeGhcArgs :: Args
-includeGhcArgs = do
-    path    <- getTargetPath
-    pkgPath <- getPackagePath
-    srcDirs <- getPkgDataList SrcDirs
-    incDirs <- getPkgDataList IncludeDirs
-    cppArgs <- getPkgDataList CppArgs
-    let buildPath   = path -/- "build"
-        autogenPath = buildPath -/- "autogen"
-    mconcat
-        [ arg "-i"
-        , append . map (\dir -> "-i" ++ pkgPath -/- dir) $ srcDirs
-        , arg $ "-i" ++ buildPath
-        , arg $ "-i" ++ autogenPath
-        , arg $ "-I" ++ buildPath
-        , arg $ "-I" ++ autogenPath
-        , append . map (\dir -> "-I" ++ pkgPath -/- dir) $ incDirs
-        , arg "-optP-include", arg $ "-optP" ++ autogenPath -/- "cabal_macros.h"
-        , append . map ("-optP" ++) $ cppArgs ]

src/Settings/Util.hs

@@ -146,18 +146,3 @@ needBuilder ghc @ (Ghc stage) = do
 needBuilder builder = do
     path <- builderPath builder
     need [path]
-
--- TODO: do '-ticky' in all debug ways?
--- wayHcArgs :: Way -> Args
--- wayHcArgs (Way _ units) = args
---     [ if (Dynamic    `elem` units)
---       then args ["-fPIC", "-dynamic"]
---       else arg "-static"
---     , when (Threaded   `elem` units) $ arg "-optc-DTHREADED_RTS"
---     , when (Debug      `elem` units) $ arg "-optc-DDEBUG"
---     , when (Profiling  `elem` units) $ arg "-prof"
---     , when (Logging    `elem` units) $ arg "-eventlog"
---     , when (Parallel   `elem` units) $ arg "-parallel"
---     , when (GranSim    `elem` units) $ arg "-gransim"
---     , when (units == [Debug] || units == [Debug, Dynamic]) $
---       args ["-ticky", "-DTICKY_TICKY"] ]