Bug fix

We tried to filter out subordinates that were already exported through their parent.

This didn't work properly since we were in some cases looking at the
grand-parent and not the parent.  We now properly compute all the parent-child
relations of a declaration, and use this information to get the parent of a
subordinate.

We also didn't consider record fields with multiple parents. This is now
handled correctly.

We don't currently support separately exported associated types. But when we
do, they should be handled correctly by this process too.

Also slightly improved the warning message that we give when filtering out
subordinates.

2 files changed, 75 insertions, 8 deletions

diff --git a/src/Haddock/GHC/Utils.hs b/src/Haddock/GHC/Utils.hs
index 40e13004..c0e73425 100644
--- a/src/Haddock/GHC/Utils.hs
+++ b/src/Haddock/GHC/Utils.hs
@@ -5,6 +5,7 @@
 --
 
 
+{-# LANGUAGE FlexibleInstances #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 {-# OPTIONS_HADDOCK hide #-}
 
@@ -15,6 +16,7 @@ module Haddock.GHC.Utils where
 import Data.Char
 import Data.Version
 import qualified Data.Map as Map
+import Control.Arrow
 
 import HsSyn
 import SrcLoc
@@ -113,3 +115,66 @@ pretty x = showSDoc (ppr x)
 
 trace_ppr :: Outputable a => a -> b -> b
 trace_ppr x y = trace (pretty x) y
+
+
+-------------------------------------------------------------------------------
+-- NamedThing instances
+-------------------------------------------------------------------------------
+
+
+instance NamedThing (TyClDecl Name) where
+  getName = tcdName
+
+
+instance NamedThing (ConDecl Name) where
+  getName = unL . con_name
+
+
+-------------------------------------------------------------------------------
+-- Subordinates
+-------------------------------------------------------------------------------
+
+
+class Parent a where
+  children :: a -> [Name]
+
+
+instance Parent (ConDecl Name) where
+  children con =
+    case con_details con of
+      RecCon fields -> map (unL . cd_fld_name) fields
+      _             -> []
+
+
+instance Parent (TyClDecl Name) where
+  children d
+    | isDataDecl  d = map (unL . con_name . unL) . tcdCons $ d
+    | isClassDecl d =
+        map (tcdName . unL) (tcdATs d) ++
+        [ unL n | L _ (TypeSig n _) <- tcdSigs d ]
+    | otherwise = []
+
+
+-- | A parent and its children
+family :: (NamedThing a, Parent a) => a -> (Name, [Name])
+family = getName &&& children
+
+
+-- | A mapping from the parent (main-binder) to its children and from each
+-- child to its grand-children, recursively.
+families :: TyClDecl Name -> [(Name, [Name])]
+families d
+  | isDataDecl  d = family d : map (family . unL) (tcdCons d)
+  | isClassDecl d = family d : concatMap (families . unL) (tcdATs d)
+  | otherwise     = []
+
+
+-- | A mapping from child to parent
+parentMap :: TyClDecl Name -> [(Name, Name)]
+parentMap d = [ (c, p) | (p, cs) <- families d, c <- cs ]
+
+
+-- | The parents of a subordinate in a declaration
+parents :: Name -> HsDecl Name -> [Name]
+parents n (TyClD d) = [ p | (c, p) <- parentMap d, c == n ]
+parents _ _ = []
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index e6c216e5..140d5358 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -389,13 +389,14 @@ mkExportItems modMap this_mod exported_names decls declMap
               -- name out in mkVisibleNames...
               | t `elem` declATs (unL decl)        -> return []
 
-              -- We should not show a subordinate at the top level if its
-              -- parent is also exported. See note [1].
-              | declName /= t, isExported declName ->
+              -- We should not show a subordinate by itself if any of its
+              -- parents is also exported. See note [1].
+              | t /= declName,
+                Just p <- find isExported (parents t $ unL decl) ->
                 do tell [ 
                      "Warning: " ++ moduleString this_mod ++ ": " ++
                      pretty (nameOccName t) ++ " is listed separately in " ++
-                     "the export list of " ++ pretty this_mod ++ ", but " ++
+                     "the export list, but " ++
                      "will be documented under its parent. " ++
                      "Consider exporting it through the parent "++
                      "export item only, for code clarity." ]
@@ -459,13 +460,14 @@ mkExportItems modMap this_mod exported_names decls declMap
 
 -- Note [1]:
 ------------
--- We should not show a subordinate at the top level if its parent is also
--- exported. We should show it under the parent to indicate its special
--- status as a class method or record field. Showing it again makes no sense.
+-- It is unnecessary to document a subordinate by itself at the top level if
+-- any of its parents is also documented. Furthermore, if the subordinate is a
+-- record field or a class method, documenting it under its parent
+-- indicates its special status.
 --
 -- A user might expect that it should show up separately, so we issue a
 -- warning. It's a fine opportunity to also tell the user she might want to
--- export the subordinate through the same export item for clarity.
+-- export the subordinate through the parent export item for clarity.
 --
 -- The code removes top-level subordinates also when the parent is exported
 -- through a 'module' export. I think that is fine.