Refactor dependency oracles

hadrian.cabal

@@ -33,7 +33,6 @@ executable hadrian
                        , Oracles.ModuleFiles
                        , Oracles.PackageData
                        , Oracles.PackageDb
-                       , Oracles.PackageDeps
                        , Oracles.WindowsPath
                        , Package
                        , Predicate

src/Oracles/Config.hs

@@ -7,7 +7,7 @@ import Development.Shake.Config
 import Base
 
 newtype ConfigKey = ConfigKey String
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 askConfig :: String -> Action String
 askConfig key = askConfigWithDefault key . error

src/Oracles/Config/Flag.hs

 module Oracles.Config.Flag (
-    Flag (..), flag, getFlag,
-    crossCompiling, platformSupportsSharedLibs, ghcWithSMP,
-    ghcWithNativeCodeGen, supportsSplitObjects
+    Flag (..), flag, getFlag, crossCompiling, platformSupportsSharedLibs,
+    ghcWithSMP, ghcWithNativeCodeGen, supportsSplitObjects
     ) where
 
 import Control.Monad.Trans.Reader

src/Oracles/Config/Setting.hs

 module Oracles.Config.Setting (
-    Setting (..), SettingList (..),
-    setting, settingList, getSetting, getSettingList,
-    anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
+    Setting (..), SettingList (..), setting, settingList, getSetting,
+    getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
     ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,
     ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost
     ) where
@@ -12,13 +11,12 @@ import Base
 import Oracles.Config
 import Stage
 
--- TODO: reduce the variety of similar flags (e.g. CPP and non-CPP versions).
--- Each Setting comes from the system.config file, e.g. 'target-os = mingw32'.
--- setting TargetOs looks up the config file and returns "mingw32".
---
--- SettingList is used for multiple string values separated by spaces, such
--- as 'gmp-include-dirs = a b'.
--- settingList GmpIncludeDirs therefore returns a list of strings ["a", "b"].
+-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
+-- | Each 'Setting' comes from @system.config@ file, e.g. 'target-os = mingw32'.
+-- @setting TargetOs@ looks up the config file and returns "mingw32".
+-- 'SettingList' is used for multiple string values separated by spaces, such
+-- as @gmp-include-dirs = a b@.
+-- @settingList GmpIncludeDirs@ therefore returns a list of strings ["a", "b"].
 data Setting = BuildArch
              | BuildOs
              | BuildPlatform
@@ -150,7 +148,7 @@ ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc6
 useLibFFIForAdjustors :: Action Bool
 useLibFFIForAdjustors = notM $ anyTargetArch ["i386", "x86_64"]
 
--- Canonicalised GHC version number, used for integer version comparisons. We
+-- | Canonicalised GHC version number, used for integer version comparisons. We
 -- expand GhcMinorVersion to two digits by adding a leading zero if necessary.
 ghcCanonVersion :: Action String
 ghcCanonVersion = do
@@ -159,7 +157,7 @@ ghcCanonVersion = do
     let leadingZero = [ '0' | length ghcMinorVersion == 1 ]
     return $ ghcMajorVersion ++ leadingZero ++ ghcMinorVersion
 
--- Command lines have limited size on Windows. Since Windows 7 the limit is
+-- | Command lines have limited size on Windows. Since Windows 7 the limit is
 -- 32768 characters (theoretically). In practice we use 31000 to leave some
 -- breathing space for the builder's path & name, auxiliary flags, and other
 -- overheads. Use this function to set limits for other OSs if necessary.
@@ -168,11 +166,10 @@ cmdLineLengthLimit = do
     windows <- windowsHost
     osx     <- osxHost
     return $ case (windows, osx) of
-        -- windows
+        -- Windows:
         (True, False) -> 31000
-        -- osx 262144 is ARG_MAX
-        -- yet when using `xargs` on osx this is reduced by over 20 000.
-        -- 200 000 seems like a sensible limit.
+        -- On Mac OSX ARG_MAX is 262144, yet when using @xargs@ on OSX this is
+        -- reduced by over 20 000. Hence, 200 000 seems like a sensible limit.
         (False, True) -> 200000
         -- On all other systems, we try this:
-        _             -> 4194304 -- Cabal needs a bit more than 2MB!
+        _             -> 4194304 -- Cabal library needs a bit more than 2MB!

src/Oracles/Dependencies.hs

 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Oracles.Dependencies (dependencies, dependenciesOracle) where
+module Oracles.Dependencies (
+    fileDependencies, contextDependencies, needContext, dependenciesOracles
+    ) where
 
-import Control.Monad.Trans.Maybe
 import qualified Data.HashMap.Strict as Map
 
 import Base
+import Context
+import Expression
+import Oracles.PackageData
+import Settings
+import Settings.Builders.GhcCabal
 
-newtype DependenciesKey = DependenciesKey (FilePath, FilePath)
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
-
--- dependencies path obj is an action that looks up dependencies of an object
--- file in a generated dependecy file 'path/.dependencies'.
--- If the dependencies cannot be determined, an appropriate error is raised.
--- Otherwise, a pair (source, depFiles) is returned, such that obj can be
--- produced by compiling 'source'; the latter can also depend on a number of
--- other dependencies listed in depFiles.
-dependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])
-dependencies path obj = do
-    let depFile = path -/- ".dependencies"
-    -- if no dependencies found then attempt to drop the way prefix (for *.c sources)
-    res <- runMaybeT $ msum
-           $ map (\obj' -> MaybeT $ askOracle $ DependenciesKey (depFile, obj'))
-                 [obj, obj -<.> "o"]
-    case res of
-        Nothing -> error $ "No dependencies found for " ++ obj
-        Just [] -> error $ "Empty dependency list for " ++ obj
-        Just (src:depFiles) -> return (src, depFiles)
-
--- Oracle for 'path/dist/.dependencies' files
-dependenciesOracle :: Rules ()
-dependenciesOracle = void $ do
+newtype ObjDepsKey = ObjDepsKey (FilePath, FilePath)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+
+-- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
+-- in a generated dependecy file @path/.dependencies@, where @path@ is the build
+-- path of the given @context@. The action returns a pair @(source, files)@,
+-- such that the @file@ can be produced by compiling @source@, which in turn
+-- also depends on a number of other @files@.
+fileDependencies :: Context -> FilePath -> Action (FilePath, [FilePath])
+fileDependencies context obj = do
+    let path = buildPath context -/- ".dependencies"
+    -- If no dependencies found, try to drop the way suffix (for *.c sources).
+    deps <- listToMaybe . catMaybes <$>
+            mapM (askOracle . ObjDepsKey . (,) path) [obj, obj -<.> "o"]
+    case deps of
+        Nothing -> error $ "No dependencies found for file " ++ obj
+        Just [] -> error $ "No source file found for file " ++ obj
+        Just (source : files) -> return (source, files)
+
+newtype PkgDepsKey = PkgDepsKey String
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
+
+-- | Given a 'Context' this 'Action' looks up its package dependencies in
+-- 'Settings.Paths.packageDependencies' using 'packageDependenciesOracle', and
+-- wraps found dependencies in appropriate contexts. The only subtlety here is
+-- that we never depend on packages built in 'Stage2' or later, therefore the
+-- stage of the resulting dependencies is bounded from above at 'Stage1'. To
+-- compute package dependencies we scan package cabal files, see "Rules.Cabal".
+contextDependencies :: Context -> Action [Context]
+contextDependencies context@Context {..} = do
+    maybeDeps <- askOracle . PkgDepsKey $ pkgNameString package
+    deps <- case maybeDeps of
+        Nothing -> error $ "Context dependencies not found for " ++ show context
+        Just ds -> return $ map PackageName ds
+    let pkgContext = \pkg -> Context (min stage Stage1) pkg way
+    pkgs <- interpretInContext (pkgContext package) getPackages
+    return . map pkgContext $ matchPackageNames (sort pkgs) deps
+
+-- | Given a sorted list of packages and a sorted list of package names, returns
+-- packages whose names appear in the list of names.
+matchPackageNames :: [Package] -> [PackageName] -> [Package]
+matchPackageNames = intersectOrd (\pkg name -> compare (pkgName pkg) name)
+
+-- | Coarse-grain 'need': make sure given contexts are fully built.
+needContext :: [Context] -> Action ()
+needContext cs = do
+    libs <- fmap concat . forM cs $ \context -> do
+        libFile  <- pkgLibraryFile     context
+        lib0File <- pkgLibraryFile0    context
+        lib0     <- buildDll0          context
+        ghciLib  <- pkgGhciLibraryFile context
+        ghciFlag <- interpretInContext context $ getPkgData BuildGhciLib
+        let ghci = ghciFlag == "YES" && stage context == Stage1
+        return $ [ libFile ] ++ [ lib0File | lib0 ] ++ [ ghciLib | ghci ]
+    confs <- mapM pkgConfFile cs
+    need $ libs ++ confs
+
+-- | Oracles for the package dependencies and 'path/dist/.dependencies' files.
+dependenciesOracles :: Rules ()
+dependenciesOracles = do
     deps <- newCache $ \file -> do
         putLoud $ "Reading dependencies from " ++ file ++ "..."
         contents <- map words <$> readFileLines file
         return . Map.fromList $ map (\(x:xs) -> (x, xs)) contents
-    addOracle $ \(DependenciesKey (file, obj)) -> Map.lookup obj <$> deps file
+    void $ addOracle $ \(ObjDepsKey (file, obj)) -> Map.lookup obj <$> deps file
+
+    pkgDeps <- newCache $ \_ -> do
+        putLoud $ "Reading package dependencies..."
+        contents <- readFileLines packageDependencies
+        return $ Map.fromList [ (p, ps) | s <- contents, let p:ps = words s ]
+    void $ addOracle $ \(PkgDepsKey pkg) -> Map.lookup pkg <$> pkgDeps ()

src/Oracles/LookupInPath.hs

@@ -6,7 +6,7 @@ import System.Directory
 import Base
 
 newtype LookupInPath = LookupInPath String
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 -- | Lookup an executable in @PATH@.
 lookupInPath :: FilePath -> Action FilePath

src/Oracles/PackageData.hs

@@ -34,7 +34,7 @@ data PackageDataList = CcArgs             FilePath
                      | TransitiveDepNames FilePath
 
 newtype PackageDataKey = PackageDataKey (FilePath, String)
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
 askPackageData :: FilePath -> String -> Action String
 askPackageData path key = do

src/Oracles/PackageDeps.hs

-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-module Oracles.PackageDeps (packageDeps, packageDepsOracle) where
-
-import qualified Data.HashMap.Strict as Map
-
-import Base
-import Package
-import Settings.Paths
-
-newtype PackageDepsKey = PackageDepsKey String
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
-
--- @packageDeps name@ is an action that given a 'Package' looks up its
--- dependencies in 'Base.packageDependencies' file. The dependencies need to be
--- computed by scanning package cabal files (see Rules.Cabal).
-packageDeps :: Package -> Action [PackageName]
-packageDeps pkg = do
-    res <- askOracle . PackageDepsKey $ pkgNameString pkg
-    return . map PackageName $ fromMaybe [] res
-
--- Oracle for the package dependencies file
-packageDepsOracle :: Rules ()
-packageDepsOracle = do
-    deps <- newCache $ \_ -> do
-        putLoud $ "Reading package dependencies..."
-        contents <- readFileLines packageDependencies
-        return . Map.fromList $
-            [ (p, ps) | line <- contents, let p:ps = words line ]
-    _ <- addOracle $ \(PackageDepsKey pkg) -> Map.lookup pkg <$> deps ()
-    return ()

src/Oracles/WindowsPath.hs

@@ -9,12 +9,11 @@ import Base
 import Oracles.Config.Setting
 
 newtype WindowsPath = WindowsPath FilePath
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+    deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
 
+-- | Path to the GHC source tree.
 topDirectory :: Action FilePath
-topDirectory = do
-    ghcSourcePath <- setting GhcSourcePath
-    fixAbsolutePathOnWindows ghcSourcePath
+topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
 
 -- | Fix an absolute path on Windows:
 -- * "/c/" => "C:/"

src/Package.hs

 {-# LANGUAGE DeriveGeneric, GeneralizedNewtypeDeriving #-}
-
 module Package (
     Package (..), PackageName (..), PackageType (..),
     -- * Queries
-    pkgNameString,
-    pkgCabalFile,
-    matchPackageNames,
+    pkgNameString, pkgCabalFile,
     -- * Helpers for constructing and using 'Package's
     setPath, topLevel, library, utility, setType, isLibrary, isProgram
     ) where
@@ -15,25 +12,24 @@ import GHC.Generics (Generic)
 
 import Base
 
--- | The name of a Cabal package
+-- | The name of a Cabal package.
 newtype PackageName = PackageName { fromPackageName :: String }
-    deriving (Eq, Ord, IsString, Generic, Binary, Hashable, Typeable, NFData)
+    deriving (Binary, Eq, Generic, Hashable, IsString, NFData, Ord, Typeable)
 
--- TODO: Make PackageType more precise, #12
+-- TODO: Make PackageType more precise, #12.
 -- TODO: Turn Program to Program FilePath thereby getting rid of programPath
--- | We regard packages as either being libraries or programs. This is
--- bit of a convenient lie as Cabal packages can be both, but it works
--- for now.
-data PackageType = Program | Library deriving Generic
+-- | We regard packages as either being libraries or programs. This is bit of a
+-- convenient lie as Cabal packages can be both, but it works for now.
+data PackageType = Library | Program deriving Generic
 
 data Package = Package
-    { pkgName :: PackageName -- ^ Examples: "ghc", "Cabal"
-    , pkgPath :: FilePath    -- ^ pkgPath is the path to the source code relative to the root.
-                             -- e.g. "compiler", "libraries/Cabal/Cabal"
-    , pkgType :: PackageType
+    { pkgName :: PackageName -- ^ Examples: "ghc", "Cabal".
+    , pkgPath :: FilePath    -- ^ pkgPath is the path to the source code relative
+                             -- to the root, e.g. "compiler", "libraries/Cabal/Cabal".
+    , pkgType :: PackageType -- ^ A library or a program.
     } deriving Generic
 
--- | Prettyprint Package name.
+-- | Prettyprint 'Package' name.
 pkgNameString :: Package -> String
 pkgNameString = fromPackageName . pkgName
 
@@ -81,12 +77,7 @@ instance Eq Package where
 instance Ord Package where
     compare = compare `on` pkgName
 
--- | Given a sorted list of packages and a sorted list of package names, returns
--- packages whose names appear in the list of names.
-matchPackageNames :: [Package] -> [PackageName] -> [Package]
-matchPackageNames = intersectOrd (\pkg name -> compare (pkgName pkg) name)
-
--- Instances for storing in the Shake database
+-- | Instances for storing in the Shake database.
 instance Binary Package
 instance Hashable Package where
     hashWithSalt salt = hashWithSalt salt . show

src/Rules/Cabal.hs

@@ -13,7 +13,7 @@ import Settings
 
 cabalRules :: Rules ()
 cabalRules = do
-    -- Cache boot package constraints (to be used in cabalArgs)
+    -- Cache boot package constraints (to be used in cabalArgs).
     bootPackageConstraints %> \out -> do
         bootPkgs <- interpretInContext (stageContext Stage0) getPackages
         let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
@@ -26,11 +26,10 @@ cabalRules = do
             return $ name ++ " == " ++ version
         writeFileChanged out . unlines $ constraints
 
-    -- Cache package dependencies
+    -- Cache package dependencies.
     packageDependencies %> \out -> do
-        let pkgs = knownPackages \\ [hp2ps, libffi, touchy, unlit]
-        pkgDeps <- forM (sort pkgs) $ \pkg ->
-            if pkg == rts
+        pkgDeps <- forM (sort knownPackages) $ \pkg ->
+            if pkg `elem` [hp2ps, libffi, rts, touchy, unlit]
             then return $ pkgNameString pkg
             else do
                 need [pkgCabalFile pkg]

src/Rules/Compile.hs

@@ -16,19 +16,26 @@ compilePackage rs context@Context {..} = do
 
     path <//> "*" <.> hibootsuf way %> \hiboot -> need [ hiboot -<.> obootsuf way ]
 
-    -- TODO: add dependencies for #include of .h and .hs-incl files (gcc -MM?)
+    -- TODO: Add dependencies for #include of .h and .hs-incl files (gcc -MM?).
     path <//> "*" <.> osuf way %> \obj -> do
-        (src, deps) <- dependencies path obj
+        (src, deps) <- fileDependencies context obj
         if ("//*.c" ?== src)
         then do
             need $ src : deps
             build $ Target context (Cc Compile stage) [src] [obj]
         else do
             need $ src : deps
+            needCompileDependencies context
             buildWithResources rs $ Target context (Ghc Compile stage) [src] [obj]
 
-    -- TODO: get rid of these special cases
+    -- TODO: Get rid of these special cases.
     path <//> "*" <.> obootsuf way %> \obj -> do
-        (src, deps) <- dependencies path obj
+        (src, deps) <- fileDependencies context obj
         need $ src : deps
+        needCompileDependencies context
         buildWithResources rs $ Target context (Ghc Compile stage) [src] [obj]
+
+needCompileDependencies :: Context -> Action ()
+needCompileDependencies context@Context {..} = do
+    when (isLibrary package) $ need =<< return <$> pkgConfFile context
+    needContext =<< contextDependencies context

src/Rules/Data.hs

@@ -5,7 +5,7 @@ import Context
 import Expression
 import GHC
 import Oracles.Config.Setting
-import Oracles.PackageDeps
+import Oracles.Dependencies
 import Rules.Actions
 import Rules.Generate
 import Rules.Libffi
@@ -13,7 +13,7 @@ import Settings
 import Settings.Builders.Common
 import Target
 
--- Build package-data.mk by using GhcCabal to process pkgCabal file
+-- | Build @package-data.mk@ by using ghc-cabal utility to process .cabal files.
 buildPackageData :: Context -> Rules ()
 buildPackageData context@Context {..} = do
     let cabalFile = pkgCabalFile package
@@ -23,25 +23,19 @@ buildPackageData context@Context {..} = do
         inTreeMk  = oldPath -/- takeFileName dataFile -- TODO: remove, #113
 
     inTreeMk %> \mk -> do
-        -- The first thing we do with any package is make sure all generated
-        -- dependencies are in place before proceeding.
+        -- Make sure all generated dependencies are in place before proceeding.
         orderOnly $ generatedDependencies stage package
 
-        -- GhcCabal may run the configure script, so we depend on it
+        -- 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
-        let depStage   = min stage Stage1 -- dependencies come from Stage0/1
-            depContext = vanillaContext depStage
-        deps <- packageDeps package
-        pkgs <- interpretInContext (depContext package) getPackages
-        let depPkgs = matchPackageNames (sort pkgs) deps
-        need =<< traverse (pkgConfFile . depContext) depPkgs
+        -- Before we configure a package its dependencies need to be registered.
+        need =<< mapM pkgConfFile =<< contextDependencies context
 
         need [cabalFile]
         build $ Target context GhcCabal [cabalFile] [mk]
 
-    -- TODO: get rid of this, see #113
+    -- TODO: Get rid of this, see #113.
     dataFile %> \mk -> do
         copyFile inTreeMk mk
         autogenFiles <- getDirectoryFiles (oldPath -/- "build") ["autogen/*"]
@@ -53,7 +47,7 @@ buildPackageData context@Context {..} = do
         copyFile (oldPath -/- haddockPrologue) (buildPath context -/- haddockPrologue)
         postProcessPackageData context mk
 
-    -- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps
+    -- TODO: PROGNAME was $(CrossCompilePrefix)hp2ps.
     priority 2.0 $ do
         when (package == hp2ps) $ dataFile %> \mk -> do
             orderOnly $ generatedDependencies stage package
@@ -111,9 +105,8 @@ buildPackageData context@Context {..} = do
                 windows <- windowsHost
                 let prefix = fixKey (buildPath context) ++ "_"
                     dirs   = [ ".", "hooks", "sm", "eventlog" ]
-                          ++ [ "posix" | not windows ]
-                          ++ [ "win32" |     windows ]
-                -- TODO: adding cmm/S sources to C_SRCS is a hack; rethink after #18
+                          ++ [ if windows then "win32" else "posix" ]
+                -- TODO: Adding cmm/S sources to C_SRCS is a hack -- refactor.
                 cSrcs   <- map unifyPath <$>
                            getDirectoryFiles (pkgPath package) (map (-/- "*.c") dirs)
                 cmmSrcs <- getDirectoryFiles (pkgPath package) ["*.cmm"]
@@ -153,6 +146,6 @@ postProcessPackageData context@Context {..} file = fixFile file fixPackageData
         fixedPrefix = takeDirectory file ++ drop len prefix
         len         = length (pkgPath package -/- contextDirectory context)
 
--- TODO: remove, see #113
+-- TODO: Remove, see #113.
 fixKey :: String -> String
 fixKey = replaceSeparators '_'

src/Rules/Generators/GhcBootPlatformH.hs

 module Rules.Generators.GhcBootPlatformH (generateGhcBootPlatformH) where
 
-import Base
 import Expression
 import Oracles.Config.Setting
 import Rules.Generators.Common

src/Rules/Generators/GhcPlatformH.hs

 module Rules.Generators.GhcPlatformH (generateGhcPlatformH) where
 
-import Base
 import Expression
 import Oracles.Config.Flag
 import Oracles.Config.Setting

src/Rules/Generators/VersionHs.hs

 module Rules.Generators.VersionHs (generateVersionHs) where
 
-import Base
 import Expression
 import Oracles.Config.Setting
 import Rules.Generators.Common

src/Rules/Oracles.hs

@@ -5,7 +5,6 @@ import qualified Oracles.Config
 import qualified Oracles.Dependencies
 import qualified Oracles.LookupInPath
 import qualified Oracles.PackageData
-import qualified Oracles.PackageDeps
 import qualified Oracles.WindowsPath
 import qualified Oracles.ArgsHash
 import qualified Oracles.ModuleFiles
@@ -15,10 +14,9 @@ oracleRules :: Rules ()
 oracleRules = do
     Oracles.ArgsHash.argsHashOracle
     Oracles.Config.configOracle
-    Oracles.Dependencies.dependenciesOracle
+    Oracles.Dependencies.dependenciesOracles
     Oracles.LookupInPath.lookupInPathOracle
     Oracles.ModuleFiles.moduleFilesOracle
     Oracles.PackageData.packageDataOracle
     Oracles.PackageDb.packageDbOracle
-    Oracles.PackageDeps.packageDepsOracle
     Oracles.WindowsPath.windowsPathOracle

src/Rules/Program.hs

@@ -7,24 +7,24 @@ import Context
 import Expression
 import GHC
 import Oracles.Config.Setting
+import Oracles.Dependencies
 import Oracles.PackageData
 import Rules.Actions
 import Rules.Library
 import Rules.Wrappers.Ghc
 import Rules.Wrappers.GhcPkg
 import Settings
-import Settings.Builders.GhcCabal
 import Target
 
--- TODO: move to buildRootPath, see #113
--- Directory for wrapped binaries
+-- TODO: Move to buildRootPath, see #113.
+-- | Directory for wrapped binaries.
 programInplaceLibPath :: FilePath
 programInplaceLibPath = "inplace/lib/bin"
 
--- Wrapper is parameterised by the path to the wrapped binary
+-- | Wrapper is parameterised by the path to the wrapped binary.
 type Wrapper = FilePath -> Expr String
 
--- List of wrappers we build
+-- | List of wrappers we build.
 wrappers :: [(Context, Wrapper)]
 wrappers = [ (vanillaContext Stage0 ghc   , ghcWrapper   )
            , (vanillaContext Stage1 ghc   , ghcWrapper   )
@@ -54,7 +54,7 @@ buildProgram rs context@Context {..} = do
 
     matchWrapped ?> \bin -> buildBinary rs context bin
 
--- Replace programInplacePath with programInplaceLibPath in a given path
+-- | Replace 'programInplacePath' with 'programInplaceLibPath' in a given path.
 computeWrappedPath :: FilePath -> Maybe FilePath
 computeWrappedPath =
     fmap (programInplaceLibPath ++) . stripPrefix programInplacePath
@@ -70,35 +70,21 @@ buildWrapper context@Context {..} wrapper wrapperPath binPath = do
 -- TODO: Get rid of the Paths_hsc2hs.o hack.
 -- TODO: Do we need to consider other ways when building programs?
 buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
-buildBinary rs context@(Context stage package _) bin = do
-    let path = buildPath context
-    cSrcs <- cSources context -- TODO: remove code duplication (Library.hs)
-    hSrcs <- hSources context
-    let cObjs = [ path -/- src -<.> osuf vanilla | src <- cSrcs   ]
-        hObjs = [ path -/- src  <.> osuf vanilla | src <- hSrcs   ]
-             ++ [ path -/- "Paths_hsc2hs.o"      | package == hsc2hs  ]
-             ++ [ path -/- "Paths_haddock.o"     | package == haddock ]
-        objs  = cObjs ++ hObjs
-    ways     <- interpretInContext context getLibraryWays
-    depNames <- interpretInContext context $ getPkgDataList TransitiveDepNames
-    let libStage   = min stage Stage1 -- libraries are built only in Stage0/1
-        libContext = vanillaContext libStage package
-    pkgs <- interpretInContext libContext getPackages
-    let deps = matchPackageNames (sort pkgs) (map PackageName $ sort depNames)
-    libs <- fmap concat . forM deps $ \dep -> do
-        let depContext = vanillaContext libStage dep
-        ghciFlag <- interpretInContext depContext $ getPkgData BuildGhciLib
-        libFiles <- fmap concat . forM ways $ \way -> do
-            libFile  <- pkgLibraryFile  $ Context libStage dep way
-            lib0File <- pkgLibraryFile0 $ Context libStage dep way
-            dll0     <- needDll0 libStage dep
-            return $ libFile : [ lib0File | dll0 ]
-        ghciLib <- pkgGhciLibraryFile $ vanillaContext libStage dep
-        return $ libFiles ++ [ ghciLib | ghciFlag == "YES" && stage == Stage1 ]
-    let binDeps = if package == ghcCabal && stage == Stage0
-                  then [ pkgPath package -/- src <.> "hs" | src <- hSrcs ]
-                  else objs
-    need $ binDeps ++ libs
+buildBinary rs context@Context {..} bin = do
+    hSrcs   <- hSources context
+    binDeps <- if stage == Stage0 && package == ghcCabal
+        then return [ pkgPath package -/- src <.> "hs" | src <- hSrcs ]
+        else do
+            ways <- interpretInContext context getLibraryWays
+            deps <- contextDependencies context
+            needContext [ dep { way = w } | dep <- deps, w <- ways ]
+            cSrcs <- cSources context -- TODO: Drop code duplication (Library.hs).
+            let path = buildPath context
+            return $ [ path -/- src -<.> osuf vanilla | src <- cSrcs       ]
+                  ++ [ path -/- src  <.> osuf vanilla | src <- hSrcs       ]
+                  ++ [ path -/- "Paths_hsc2hs.o"      | package == hsc2hs  ]
+                  ++ [ path -/- "Paths_haddock.o"     | package == haddock ]
+    need binDeps
     buildWithResources rs $ Target context (Ghc Link stage) binDeps [bin]
     synopsis <- interpretInContext context $ getPkgData Synopsis
     putSuccess $ renderProgram

src/Rules/Register.hs

@@ -21,7 +21,7 @@ registerPackage rs context@Context {..} = do
         -- This produces inplace-pkg-config. TODO: Add explicit tracking.
         need [pkgDataFile context]
 
-        -- Post-process inplace-pkg-config. TODO: remove, see #113, #148
+        -- Post-process inplace-pkg-config. TODO: remove, see #113, #148.