From 1789c77a6ed1580dc10a4391dc8c398e902f03b1 Mon Sep 17 00:00:00 2001
From: alexbiehl <alex.biehl@gmail.com>
Date: Thu, 2 Nov 2017 12:16:22 +0100
Subject: 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.
---
 haddock-api/src/Haddock/Interface/Create.hs | 29 +++++++++++++++++------------
 1 file 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)
-- 
cgit v1.2.3