aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs29
1 files changed, 17 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 4a13f386..27456998 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -739,10 +739,7 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
Nothing -> do
liftErrMsg $ tell
["Warning: Couldn't find .haddock for export " ++ pretty dflags t]
- let subs_ = [ (n, noDocForDecl)
- | n <- availNamesWithSelectors avail
- , n /= availName avail
- ]
+ let subs_ = availNoDocs avail
availExportDecl avail decl (noDocForDecl, subs_)
Just iface ->
availExportDecl avail decl (lookupDocs avail warnings (instDocMap iface) (instArgMap iface))
@@ -808,19 +805,19 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
-- from the type.
mb_r <- hiDecl dflags n
case mb_r of
- Nothing -> return ([], (noDocForDecl, []))
+ Nothing -> return ([], (noDocForDecl, availNoDocs avail))
-- TODO: If we try harder, we might be able to find
-- a Haddock! Look in the Haddocks for each thing in
-- requirementContext (pkgState)
- Just decl -> return ([decl], (noDocForDecl, []))
+ Just decl -> return ([decl], (noDocForDecl, availNoDocs avail))
| otherwise ->
- return ([], (noDocForDecl, []))
+ return ([], (noDocForDecl, availNoDocs avail))
| Just iface <- M.lookup (semToIdMod (moduleUnitId thisMod) m) modMap
, Just ds <- M.lookup n (ifaceDeclMap iface) =
return (ds, lookupDocs avail warnings
(ifaceDocMap iface)
(ifaceArgMap iface))
- | otherwise = return ([], (noDocForDecl, []))
+ | otherwise = return ([], (noDocForDecl, availNoDocs avail))
where
n = availName avail
m = nameModule n
@@ -841,8 +838,8 @@ availExportItem is_sig modMap thisMod semMod warnings exportedNames
_ -> pure []
pure (concat patsyns)
where
- mightBeBundledPatSyn n = isDataConName n && n /= availName avail
- constructor_names = filter mightBeBundledPatSyn (availNames avail)
+ constructor_names =
+ filter isDataConName (availSubordinates avail)
-- this heavily depends on the invariants stated in Avail
availExportsDecl :: AvailInfo -> Bool
@@ -851,6 +848,14 @@ availExportsDecl (AvailTC ty_name names _)
| otherwise = False
availExportsDecl _ = True
+availSubordinates :: AvailInfo -> [Name]
+availSubordinates avail =
+ filter (/= availName avail) (availNamesWithSelectors avail)
+
+availNoDocs :: AvailInfo -> [(Name, DocForDecl Name)]
+availNoDocs avail =
+ zip (availSubordinates avail) (repeat noDocForDecl)
+
-- | Given a 'Module' from a 'Name', convert it into a 'Module' that
-- we can actually find in the 'IfaceMap'.
semToIdMod :: UnitId -> Module -> Module
@@ -901,8 +906,8 @@ lookupDocs avail warnings docMap argMap =
let lookupArgDoc x = M.findWithDefault M.empty x argMap in
let doc = (lookupDoc n, lookupArgDoc n) in
let subDocs = [ (s, (lookupDoc s, lookupArgDoc s))
- | s <- availNamesWithSelectors avail
- , s /= n ] in
+ | s <- availSubordinates avail
+ ] in
(doc, subDocs)
where
lookupDoc name = Documentation (M.lookup name docMap) (M.lookup name warnings)