From d5abee553d073391ce34e2e12627d6e98630a447 Mon Sep 17 00:00:00 2001
From: Matthew Pickering <matthewtpickering@gmail.com>
Date: Tue, 20 Sep 2022 11:12:55 +0100
Subject: hadrian: Add extra_dependencies edges for all different ways
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The hack to add extra dependencies needed by DeriveLift extension missed
the cases for profiles and dynamic ways. For the profiled way this leads
to errors like:

```
GHC error in desugarer lookup in Data.IntSet.Internal:
  Failed to load interface for ‘Language.Haskell.TH.Lib.Internal’
  Perhaps you haven't installed the profiling libraries for package ‘template-haskell’?
  Use -v (or `:set -v` in ghci) to see a list of the files searched for.
ghc: panic! (the 'impossible' happened)
  GHC version 9.5.20220916:
        initDs
```

Therefore the fix is to add these extra edges in.

Fixes #22197
---
 hadrian/src/Rules/Dependencies.hs | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/hadrian/src/Rules/Dependencies.hs b/hadrian/src/Rules/Dependencies.hs
index dda176a64f..453c45acad 100644
--- a/hadrian/src/Rules/Dependencies.hs
+++ b/hadrian/src/Rules/Dependencies.hs
@@ -14,6 +14,7 @@ import Target
 import Utilities
 import Packages
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 import qualified Text.Parsec as Parsec
 
@@ -22,7 +23,7 @@ import qualified Text.Parsec as Parsec
 -- 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
+  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
@@ -32,9 +33,12 @@ extra_dependencies =
 
   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
+    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 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
 
 formatExtra :: (FilePath, FilePath) -> String
-- 
cgit v1.2.1