Fix a bug in attachInstances

We didn't look for instance docs in all the interfaces of the package. This had
the effect of instance docs not always showing up under a declaration. I took
the opportunity to clean up the code in H.I.AttachInstances a bit as well. More
cleanup is needed, however.

1 files changed, 39 insertions, 18 deletions

diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 09d38b4f..fd1e86d9 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -38,33 +38,54 @@ import FastString
 attachInstances :: [Interface] -> InstIfaceMap -> Ghc [Interface]
 attachInstances ifaces instIfaceMap = mapM attach ifaces
   where
+    -- TODO: take an IfaceMap as input
+    ifaceMap = Map.fromList [ (ifaceMod i, i) | i <- ifaces ]
+
     attach iface = do
-      newItems <- mapM attachExport $ ifaceExportItems iface
+      newItems <- mapM (attachToExportItem iface ifaceMap instIfaceMap)
+                       (ifaceExportItems iface)
       return $ iface { ifaceExportItems = newItems }
-      where
-        attachExport export@ExportDecl{expItemDecl = L _ (TyClD d)} = do
-           mb_info <- getAllInfo (unLoc (tcdLName d))
-           return $ export { expItemInstances = case mb_info of
-             Just (_, _, instances) ->
-               let insts = map (first synifyInstHead) $ sortImage (first instHead)
-                             [ (instanceHead i, getName i) | i <- instances ]
-               in [ (inst, lookupInstDoc name iface instIfaceMap)
-                  | (inst, name) <- insts ]
-             Nothing -> []
+
+
+attachToExportItem :: Interface -> IfaceMap -> InstIfaceMap -> ExportItem Name -> Ghc (ExportItem Name)
+attachToExportItem iface ifaceMap instIfaceMap export =
+  case export of
+    ExportDecl { expItemDecl = L _ (TyClD d) } -> do
+      mb_info <- getAllInfo (unLoc (tcdLName d))
+      let export' =
+            export {
+              expItemInstances =
+                case mb_info of
+                  Just (_, _, instances) ->
+                    let insts = map (first synifyInstHead) $ sortImage (first instHead)
+                                [ (instanceHead i, getName i) | i <- instances ]
+                    in [ (inst, lookupInstDoc name iface ifaceMap instIfaceMap)
+                       | (inst, name) <- insts ]
+                  Nothing -> []
             }
-        attachExport export = return export
+      return export'
+    _ -> return export
 
 
-lookupInstDoc :: Name -> Interface -> InstIfaceMap -> Maybe (Doc Name)
+lookupInstDoc :: Name -> Interface -> IfaceMap -> InstIfaceMap -> Maybe (Doc Name)
 -- TODO: capture this pattern in a function (when we have streamlined the
 -- handling of instances)
-lookupInstDoc name iface ifaceMap =
+lookupInstDoc name iface ifaceMap instIfaceMap =
   case Map.lookup name (ifaceInstanceDocMap iface) of
     Just doc -> Just doc
-    Nothing -> do -- in Maybe
-      instIface <- Map.lookup modName ifaceMap
-      (Just doc, _) <- Map.lookup name (instDocMap instIface)
-      return doc
+    Nothing ->
+      case Map.lookup modName ifaceMap of
+        Just iface2 ->
+          case Map.lookup name (ifaceInstanceDocMap iface2) of
+            Just doc -> Just doc
+            Nothing -> Nothing
+        Nothing ->
+          case Map.lookup modName instIfaceMap of
+            Just instIface ->
+              case Map.lookup name (instDocMap instIface) of
+                Just (doc, _) -> doc
+                Nothing -> Nothing
+            Nothing -> Nothing
   where
     modName = nameModule name