hadrian: Add extra implicit dependencies from DeriveLift

ghc -M should know that modules which use DeriveLift (or
TemplateHaskellQuotes) need TH.Lib.Internal but until it does, we have
to add these extra edges manually or the modules will be compiled before
TH.Lib.Internal is compiled which leads to a desugarer error.

2 files changed, 30 insertions, 2 deletions

diff --git a/hadrian/src/Oracles/ModuleFiles.hs b/hadrian/src/Oracles/ModuleFiles.hs
index b53a5901e1..41a3141f65 100644
--- a/hadrian/src/Oracles/ModuleFiles.hs
+++ b/hadrian/src/Oracles/ModuleFiles.hs
@@ -2,7 +2,7 @@
 module Oracles.ModuleFiles (
     decodeModule, encodeModule, findGenerator, hsSources, hsObjects,
     determineBuilder,
-    moduleFilesOracle
+    moduleFilesOracle, moduleSource
     ) where
 
 import qualified Data.HashMap.Strict as Map
diff --git a/hadrian/src/Rules/Dependencies.hs b/hadrian/src/Rules/Dependencies.hs
index d49cf68e6e..dda176a64f 100644
--- a/hadrian/src/Rules/Dependencies.hs
+++ b/hadrian/src/Rules/Dependencies.hs
@@ -12,15 +12,42 @@ import Rules.Generate
 import Settings
 import Target
 import Utilities
+import Packages
+import qualified Data.Map as M
 
 import qualified Text.Parsec as Parsec
 
+-- 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.
+extra_dependencies :: M.Map Package (Stage -> Action [(FilePath, FilePath)])
+extra_dependencies =
+  M.fromList [(containers, fmap 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
+    ]))
+    ]
+
+  where
+    th_internal = (templateHaskell, "Language.Haskell.TH.Lib.Internal")
+    dep (p1, m1) (p2, m2) s = (,) <$> path s p1 m1 <*> path s p2 m2
+    path stage p m =
+      let context = Context stage p vanilla Inplace
+      in objectPath context . moduleSource $ m
+
+formatExtra :: (FilePath, FilePath) -> String
+formatExtra (fp1, fp2) = fp1 ++ ":" ++ fp2 ++ "\n"
+
 buildPackageDependencies :: [(Resource, Int)] -> Rules ()
 buildPackageDependencies rs = do
     root <- buildRootRules
     root -/- "**/.dependencies.mk" %> \mk -> do
         DepMkFile stage pkgpath <- getDepMkFile root mk
-        let context = Context stage (unsafeFindPackageByPath pkgpath) vanilla Inplace
+        let pkg = unsafeFindPackageByPath pkgpath
+            context = Context stage pkg vanilla Inplace
+        extra <- maybe (return []) ($ stage) $ M.lookup pkg extra_dependencies
         srcs <- hsSources context
         gens <- interpretInContext context generatedDependencies
         need (srcs ++ gens)
@@ -28,6 +55,7 @@ buildPackageDependencies rs = do
         then writeFileChanged mk ""
         else buildWithResources rs $ target context
             (Ghc FindHsDependencies $ Context.stage context) srcs [mk]
+        liftIO $ mapM_ (appendFile mk . formatExtra) extra
         removeFile $ mk <.> "bak"
 
     root -/- "**/.dependencies" %> \deps -> do