aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Haddock/Interface/AttachInstances.hs57
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