aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/AttachInstances.hs13
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs2
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs26
3 files changed, 31 insertions, 10 deletions
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs
index faf043aa..20971071 100644
--- a/haddock-api/src/Haddock/Interface/AttachInstances.hs
+++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs
@@ -60,7 +60,18 @@ attachInstances expInfo ifaces instIfaceMap = mapM attach ifaces
attach iface = do
newItems <- mapM (attachToExportItem expInfo iface ifaceMap instIfaceMap)
(ifaceExportItems iface)
- return $ iface { ifaceExportItems = newItems }
+ let orphanInstances = attachOrphanInstances expInfo iface ifaceMap instIfaceMap (ifaceInstances iface)
+ return $ iface { ifaceExportItems = newItems
+ , ifaceOrphanInstances = orphanInstances
+ }
+
+attachOrphanInstances :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap -> [ClsInst] -> [DocInstance Name]
+attachOrphanInstances expInfo iface ifaceMap instIfaceMap cls_instances =
+ [ (synifyInstHead i, instLookup instDocMap n iface ifaceMap instIfaceMap, (L (getSrcSpan n) n))
+ | let is = [ (instanceSig i, getName i) | i <- cls_instances, isOrphan (is_orphan i) ]
+ , (i@(_,_,cls,tys), n) <- sortBy (comparing $ first instHead) is
+ , not $ isInstanceHidden expInfo cls tys
+ ]
attachToExportItem :: ExportInfo -> Interface -> IfaceMap -> InstIfaceMap
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index c41946f5..6466acfb 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -150,6 +150,8 @@ createInterface tm flags modMap instIfaceMap = do
, ifaceModuleAliases = aliases
, ifaceInstances = instances
, ifaceFamInstances = fam_instances
+ , ifaceOrphanInstances = [] -- Filled in `attachInstances`
+ , ifaceRnOrphanInstances = [] -- Filled in `renameInterface`
, ifaceHaddockCoverage = coverage
, ifaceWarningMap = warningMap
, ifaceTokenizedSrc = tokenizedSrc
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 2478ce23..a6223445 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -47,13 +47,17 @@ renameInterface dflags renamingEnv warnings iface =
(rnArgMap, missingNames3) = runRnFM localEnv (mapM (mapM renameDoc) (ifaceArgMap iface))
- (finalModuleDoc, missingNames4)
+ (renamedOrphanInstances, missingNames4)
+ = runRnFM localEnv (mapM renameDocInstance (ifaceOrphanInstances iface))
+
+ (finalModuleDoc, missingNames5)
= runRnFM localEnv (renameDocumentation (ifaceDoc iface))
-- combine the missing names and filter out the built-ins, which would
- -- otherwise allways be missing.
+ -- otherwise always be missing.
missingNames = nub $ filter isExternalName -- XXX: isExternalName filters out too much
- (missingNames1 ++ missingNames2 ++ missingNames3 ++ missingNames4)
+ (missingNames1 ++ missingNames2 ++ missingNames3
+ ++ missingNames4 ++ missingNames5)
-- filter out certain built in type constructors using their string
-- representation. TODO: use the Name constants from the GHC API.
@@ -72,7 +76,8 @@ renameInterface dflags renamingEnv warnings iface =
return $ iface { ifaceRnDoc = finalModuleDoc,
ifaceRnDocMap = rnDocMap,
ifaceRnArgMap = rnArgMap,
- ifaceRnExportItems = renamedExportItems }
+ ifaceRnExportItems = renamedExportItems,
+ ifaceRnOrphanInstances = renamedOrphanInstances}
--------------------------------------------------------------------------------
@@ -561,6 +566,13 @@ renameWc rn_thing (HsWC { hswc_body = thing })
; return (HsWC { hswc_body = thing'
, hswc_wcs = PlaceHolder, hswc_ctx = Nothing }) }
+renameDocInstance :: DocInstance Name -> RnM (DocInstance DocName)
+renameDocInstance (inst, idoc, L l n) = do
+ inst' <- renameInstHead inst
+ n' <- rename n
+ idoc' <- mapM renameDoc idoc
+ return (inst', idoc',L l n')
+
renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
renameExportItem item = case item of
ExportModule mdl -> return (ExportModule mdl)
@@ -571,11 +583,7 @@ renameExportItem item = case item of
decl' <- renameLDecl decl
doc' <- renameDocForDecl doc
subs' <- mapM renameSub subs
- instances' <- forM instances $ \(inst, idoc, L l n) -> do
- inst' <- renameInstHead inst
- n' <- rename n
- idoc' <- mapM renameDoc idoc
- return (inst', idoc',L l n')
+ instances' <- forM instances renameDocInstance
fixities' <- forM fixities $ \(name, fixity) -> do
name' <- lookupRn name
return (name', fixity)