aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoralexbiehl <alex.biehl@gmail.com>2017-11-02 12:16:22 +0100
committeralexbiehl <alex.biehl@gmail.com>2017-11-02 12:16:22 +0100
commit1789c77a6ed1580dc10a4391dc8c398e902f03b1 (patch)
tree632f6bcae5fc6682870926dace7237aa1db0e2f9
parentaee89dcde08a80957b55e0872eff919a48cc13f9 (diff)
Always return documentation for exported subordinates
... event if they have no documentation (e.g. noDocForDecl) By using the information in the AvailInfo we don't need additional export checks.
-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)