Merge remote-tracking branch 'harpocrates/fix/missing-orphan-instances' into ghc-head

2 files changed, 15 insertions, 1 deletions

diff --git a/haddock-api/src/Haddock/Interface.hs b/haddock-api/src/Haddock/Interface.hs
index 20689a8f..cbdf81cb 100644
--- a/haddock-api/src/Haddock/Interface.hs
+++ b/haddock-api/src/Haddock/Interface.hs
@@ -58,6 +58,8 @@ import GHC hiding (verbosity)
 import HscTypes
 import FastString (unpackFS)
 import MonadUtils (liftIO)
+import TcRnTypes (tcg_rdr_env)
+import RdrName (plusGlobalRdrEnv)
 
 #if defined(mingw32_HOST_OS)
 import System.IO
@@ -163,6 +165,18 @@ processModule :: Verbosity -> ModSummary -> [Flag] -> IfaceMap -> InstIfaceMap -
 processModule verbosity modsum flags modMap instIfaceMap = do
   out verbosity verbose $ "Checking module " ++ moduleString (ms_mod modsum) ++ "..."
   tm <- loadModule =<< typecheckModule =<< parseModule modsum
+
+  -- We need to modify the interactive context's environment so that when
+  -- Haddock later looks for instances, it also looks in the modules it
+  -- encountered while typechecking.
+  --
+  -- See https://github.com/haskell/haddock/issues/469.
+  hsc_env@HscEnv{ hsc_IC = old_IC } <- getSession
+  let new_rdr_env = tcg_rdr_env . fst . GHC.tm_internals_ $ tm
+  setSession hsc_env{ hsc_IC = old_IC {
+    ic_rn_gbl_env = ic_rn_gbl_env old_IC `plusGlobalRdrEnv` new_rdr_env
+  } }
+
   if not $ isBootSummary modsum then do
     out verbosity verbose "Creating interface..."
     (interface, msg) <- runWriterGhc $ createInterface tm flags modMap instIfaceMap
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index 2231ce7e..4fd9d264 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -54,7 +54,7 @@ type ExportInfo = (ExportedNames, Modules)
 -- Also attaches fixities
 attachInstances :: ExportInfo -> [Interface] -> InstIfaceMap -> Ghc [Interface]
 attachInstances expInfo ifaces instIfaceMap = do
-  (_msgs, mb_index) <- getNameToInstancesIndex
+  (_msgs, mb_index) <- getNameToInstancesIndex (map ifaceMod ifaces)
   mapM (attach $ fromMaybe emptyNameEnv mb_index) ifaces
   where
     -- TODO: take an IfaceMap as input