[commit: haddock] ghc-head, wip/revert-ttg-2017-11-20, wip/ttg-2017-11-06, wip/ttg2-2017-11-10, wip/ttg3-2017-11-12, wip/ttg4-constraints-2017-11-13: Always return documentation for exported subordinates (1789c77)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branches: ghc-head,wip/revert-ttg-2017-11-20,wip/ttg-2017-11-06,wip/ttg2-2017-11-10,wip/ttg3-2017-11-12,wip/ttg4-constraints-2017-11-13
Link       : http://git.haskell.org/haddock.git/commitdiff/1789c77a6ed1580dc10a4391dc8c398e902f03b1

>---------------------------------------------------------------

commit 1789c77a6ed1580dc10a4391dc8c398e902f03b1
Author: alexbiehl <alex.biehl at gmail.com>
Date:   Thu Nov 2 12:16:22 2017 +0100

    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.


>---------------------------------------------------------------

1789c77a6ed1580dc10a4391dc8c398e902f03b1
 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 4a13f38..2745699 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)