diff --git a/hadrian/src/Rules/Dependencies.hs b/hadrian/src/Rules/Dependencies.hs index 099d82b0931c5f372d5ffaa8ace90d1f22189f63..b77a19b31ec8437384fd0c83cbc0251d766218ed 100644 --- a/hadrian/src/Rules/Dependencies.hs +++ b/hadrian/src/Rules/Dependencies.hs @@ -20,41 +20,26 @@ import qualified Data.Set as S import qualified Text.Parsec as Parsec - -data PkgMod = PkgMod { pkg :: Package, _mod :: String } - -extraDepsList :: [(PkgMod, PkgMod)] -extraDepsList = - [ (containers, "Data.IntSet.Internal") --> th_internal - , (containers, "Data.Set.Internal") --> th_internal - , (containers, "Data.Sequence.Internal") --> th_internal - , (containers, "Data.Graph") --> th_internal - ] - where - (p1,m1) --> (p2,m2) = (PkgMod p1 m1, PkgMod p2 m2) - th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") - -- These modules use DeriveLift which needs Language.Haskell.TH.Lib.Internal but -- the dependency is implicit. ghc -M should emit this additional dependency but -- until it does we need to add this dependency ourselves. -extraDependenciesFor :: Stage -> Package -> Action [(FilePath, FilePath)] -extraDependenciesFor stage srcPkg - | Just deps <- M.lookup srcPkg byPackage = concat <$> traverse dep deps - | otherwise = return [] - where - byPackage :: M.Map Package [(PkgMod, PkgMod)] - byPackage = M.fromListWith (++) [ (pkg x, [(x,y)]) | (x,y) <- extraDepsList ] +extra_dependencies :: M.Map Package (Stage -> Action [(FilePath, FilePath)]) +extra_dependencies = + M.fromList [(containers, fmap (fmap concat . sequence) (sequence + [dep (containers, "Data.IntSet.Internal") th_internal + ,dep (containers, "Data.Set.Internal") th_internal + ,dep (containers, "Data.Sequence.Internal") th_internal + ,dep (containers, "Data.Graph") th_internal + ])) + ] - -- @dep ((p1, m1), (p2, m2))@ is an extra dependency from - -- module m1 of package p1 to module m2 of package p2. - dep :: (PkgMod, PkgMod) -> Action [(FilePath, FilePath)] - dep (PkgMod p1 m1, PkgMod p2 m2) = do - let context = Context stage p1 (error "extra_dependencies: way not set") (error "extra_dependencies: inplace not set") + where + th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal") + dep (p1, m1) (p2, m2) s = do + let context = Context s p1 (error "extra_dependencies: way not set") (error "extra_dependencies: iplace not set") ways <- interpretInContext context getLibraryWays - mapM (\way -> (,) <$> path way p1 m1 <*> path way p2 m2) (S.toList ways) - - path :: Way -> Package -> String -> Action FilePath - path way p m = + mapM (\way -> (,) <$> path s way p1 m1 <*> path s way p2 m2) (S.toList ways) + path stage way p m = let context = Context stage p way Inplace in objectPath context . moduleSource $ m @@ -68,7 +53,7 @@ buildPackageDependencies rs = do DepMkFile stage pkgpath <- getDepMkFile root mk let pkg = unsafeFindPackageByPath pkgpath context = Context stage pkg vanilla Inplace - extra <- extraDependenciesFor stage pkg + extra <- maybe (return []) ($ stage) $ M.lookup pkg extra_dependencies srcs <- hsSources context gens <- interpretInContext context generatedDependencies need (srcs ++ gens)