aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2018-01-26 13:40:55 -0500
committerBen Gamari <ben@smart-cactus.org>2018-01-26 13:40:55 -0500
commitdd80ae1773ea6aae48c3c5a899d510699783d6ee (patch)
tree3e584806f3107f849ba2dcce0e6a87d4dbfa6837
parent3291502a4a15f30eaafdb22da4292a17e08aa7bd (diff)
parentb6a719bb3dcc51da8c162e213a4fdc43a35cb992 (diff)
Merge remote-tracking branch 'harpocrates/fix/missing-orphan-instances' into ghc-head
-rw-r--r--haddock-api/src/Haddock/Interface.hs14
-rw-r--r--haddock-api/src/Haddock/Interface/AttachInstances.hs2
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