Fix #61

We were not getting docs for re-exported class methods. This was because we
were looking up the docs in a map made from the declarations in the current
module being rendered. Obviously, re-exported class methods come from another
module.

Class methods and ATs were the only thing we were looking up using the doc map,
everything else we found in the ExporItems. So now I've put subordinate docs
in the ExportItem's directly, to make things a bit more consistent.

To do this, I added subordinates to the the declarations in the declaration
map. This was easy since we were computing subordinates anyway, to store
stand-alone in the map. I added a new type synonym 'DeclInfo', which is what we
call what is now stored in the map. 

This little refactoring removes duplicate code to retrieve subordinates and
documentation from the HsGroup.

7 files changed, 89 insertions, 66 deletions

diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 684d4294..dfd72758 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -81,7 +81,7 @@ operator x = x
 -- How to print each export
 
 ppExport :: ExportItem Name -> [String]
-ppExport (ExportDecl decl dc _) = doc dc ++ f (unL decl)
+ppExport (ExportDecl decl dc _ _) = doc dc ++ f (unL decl)
     where
         f (TyClD d@TyData{}) = ppData d
         f (TyClD d@ClassDecl{}) = ppClass d
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 1f685c3d..579d7896 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -553,7 +553,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface
  
     exports = numberSectionHeadings (ifaceRnExportItems iface)
 
-    has_doc (ExportDecl _ doc _) = isJust doc
+    has_doc (ExportDecl _ doc _ _) = isJust doc
     has_doc (ExportNoDecl _ _ _) = False
     has_doc (ExportModule _) = False
     has_doc _ = True
@@ -630,8 +630,8 @@ numberSectionHeadings exports = go 1 exports
 processExport :: Bool -> LinksInfo -> DocMap -> (ExportItem DocName) -> HtmlTable
 processExport _ _ _ (ExportGroup lev id0 doc)
   = ppDocGroup lev (namedAnchor id0 << docToHtml doc)
-processExport summary links docMap (ExportDecl decl doc insts)
-  = ppDecl summary links decl doc insts docMap
+processExport summary links docMap (ExportDecl decl doc subdocs insts)
+  = ppDecl summary links decl doc insts docMap subdocs
 processExport summmary _ _ (ExportNoDecl _ y [])
   = declBox (ppDocName y)
 processExport summmary _ _ (ExportNoDecl _ y subs)
@@ -660,9 +660,10 @@ declWithDoc False links loc nm (Just doc) html_decl =
 		topDeclBox links loc nm html_decl </> docBox (docToHtml doc)
 
 
+-- TODO: use DeclInfo DocName or something
 ppDecl :: Bool -> LinksInfo -> LHsDecl DocName -> 
-          Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> HtmlTable
-ppDecl summ links (L loc decl) mbDoc instances docMap = case decl of
+          Maybe (HsDoc DocName) -> [InstHead DocName] -> DocMap -> [(DocName, HsDoc DocName)] -> HtmlTable
+ppDecl summ links (L loc decl) mbDoc instances docMap subdocs = case decl of
   TyClD d@(TyFamily {})          -> ppTyFam summ False links loc mbDoc d
   TyClD d@(TyData {})
     | Nothing <- tcdTyPats d     -> ppDataDecl summ links instances loc mbDoc d
@@ -670,7 +671,7 @@ ppDecl summ links (L loc decl) mbDoc instances docMap = case decl of
   TyClD d@(TySynonym {})
     | Nothing <- tcdTyPats d     -> ppTySyn summ links loc mbDoc d
     | Just _  <- tcdTyPats d     -> ppTyInst summ False links loc mbDoc d
-  TyClD d@(ClassDecl {})         -> ppClassDecl summ links instances loc mbDoc docMap d
+  TyClD d@(ClassDecl {})         -> ppClassDecl summ links instances loc mbDoc docMap subdocs d
   SigD (TypeSig (L _ n) (L _ t)) -> ppFunSig summ links loc mbDoc n t
   ForD d                         -> ppFor summ links loc mbDoc d
   InstD d                        -> Html.emptyTable
@@ -872,13 +873,11 @@ ppTyInstHeader summary associated decl =
 --------------------------------------------------------------------------------
     
 
-ppAssocType :: Bool -> LinksInfo -> DocMap -> LTyClDecl DocName -> HtmlTable
-ppAssocType summ links docMap (L loc decl) = 
+ppAssocType :: Bool -> LinksInfo -> Maybe (HsDoc DocName) -> LTyClDecl DocName -> HtmlTable
+ppAssocType summ links doc (L loc decl) = 
   case decl of
     TyFamily  {} -> ppTyFam summ True links loc doc decl
     TySynonym {} -> ppTySyn summ links loc doc decl
-  where
-    doc = Map.lookup (docNameOrig $ tcdName decl) docMap
 
 
 --------------------------------------------------------------------------------
@@ -970,8 +969,8 @@ ppFds fds =
 	fundep (vars1,vars2) = hsep (map ppDocName vars1) <+> toHtml "->" <+>
 			       hsep (map ppDocName vars2)
 
-ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> DocMap -> HtmlTable
-ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc docMap = 
+ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan -> [(DocName, HsDoc DocName)] -> HtmlTable
+ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc subdocs = 
   if null sigs && null ats
     then (if summary then declBox else topDeclBox links loc nm) hdr
     else (if summary then declBox else topDeclBox links loc nm) (hdr <+> keyword "where")
@@ -980,12 +979,12 @@ ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc
 				bodyBox <<
 					aboves
 					(
-						map (ppAssocType summary links docMap) ats ++
+						[ ppAssocType summary links doc at | at <- ats
+                                                , let doc = lookup (tcdName $ unL at) subdocs ]  ++
 
-						[ ppFunSig summary links loc mbDoc n typ
+						[ ppFunSig summary links loc doc n typ
 						| L _ (TypeSig (L _ n) (L _ typ)) <- sigs
-						, let mbDoc = Map.lookup (docNameOrig n) docMap ] 
-
+						, let doc = lookup n subdocs ] 
 					)
 				)
   where
@@ -995,11 +994,11 @@ ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc
 
 
 ppClassDecl :: Bool -> LinksInfo -> [InstHead DocName] -> SrcSpan ->
-               Maybe (HsDoc DocName) -> DocMap -> TyClDecl DocName -> 
+               Maybe (HsDoc DocName) -> DocMap -> [(DocName, HsDoc DocName)] -> TyClDecl DocName -> 
                HtmlTable
-ppClassDecl summary links instances loc mbDoc docMap
+ppClassDecl summary links instances loc mbDoc docMap subdocs
 	decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _)
-  | summary = ppShortClassDecl summary links decl loc docMap
+  | summary = ppShortClassDecl summary links decl loc subdocs
   | otherwise = classheader </> bodyBox << (classdoc </> body </> instancesBit)
   where 
     classheader
@@ -1024,9 +1023,10 @@ ppClassDecl summary links instances loc mbDoc docMap
     methodTable =
       abovesSep s8 [ ppFunSig summary links loc doc n typ
                    | L _ (TypeSig (L _ n) (L _ typ)) <- lsigs
-                   , let doc = Map.lookup (docNameOrig n) docMap ]
+                   , let doc = lookup n subdocs ]
 
-    atTable = abovesSep s8 $ map (ppAssocType summary links docMap) ats
+    atTable = abovesSep s8 $ [ ppAssocType summary links doc at | at <- ats
+                             , let doc = lookup (tcdName $ unL at) subdocs ]
 
     instId = collapseId (docNameOrig nm)
     instancesBit
diff --git a/src/Haddock/DocName.hs b/src/Haddock/DocName.hs
index dfb21c0f..959d028b 100644
--- a/src/Haddock/DocName.hs
+++ b/src/Haddock/DocName.hs
@@ -16,6 +16,7 @@ import Binary
 
 
 data DocName = Documented Name Module | Undocumented Name
+  deriving Eq
 
 
 docNameOcc :: DocName -> OccName
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 636a5149..1454bdfc 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -43,9 +43,9 @@ attachInstances modules filterNames = map attach modules
       where
         newItems = map attachExport (ifaceExportItems mod)
 
-        attachExport (ExportDecl decl@(L _ (TyClD d)) doc _)
+        attachExport (ExportDecl decl@(L _ (TyClD d)) doc subs _)
           | isClassDecl d || isDataDecl d || isFamilyDecl d =
-             ExportDecl decl doc (case Map.lookup (tcdName d) instMap of
+             ExportDecl decl doc subs (case Map.lookup (tcdName d) instMap of
                                     Nothing -> []
                                     Just instheads -> instheads)
         attachExport export = export
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 5932bc64..9d0995e6 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -54,21 +54,21 @@ createInterface ghcMod flags modMap = do
       exports       = fmap (reverse . map unLoc) (ghcMbExports ghcMod)
       localNames    = ghcDefinedNames ghcMod
       subMap        = mkSubMap group
-      decls         = topDecls group
-      decls'        = filterOutInstances decls
-      declMap       = mkDeclMap decls'
+      decls0        = declInfos . topDecls $ group
+      decls         = filterOutInstances decls0
+      declMap       = mkDeclMap decls
 --      famMap        = mkFamMap decls'
       ignoreExps    = Flag_IgnoreAllExports `elem` flags
       exportedNames = ghcExportedNames ghcMod
       instances     = ghcInstances ghcMod
 
-  warnAboutFilteredDecls mod decls
+  warnAboutFilteredDecls mod decls0
 
   visibleNames <- mkVisibleNames mod modMap localNames 
                                  (ghcNamesInScope ghcMod) 
                                  subMap exports opts declMap 
 
-  exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls' declMap
+  exportItems <- mkExportItems modMap mod (ghcExportedNames ghcMod) decls declMap
                                subMap opts exports ignoreExps instances
 
   -- prune the export list to just those declarations that have
@@ -137,20 +137,22 @@ type DeclWithDoc = (Decl, Maybe Doc)
 -- type Family = (Maybe DeclWithDoc, [DeclWithDoc])
 
 
--- | Make a map from names to declarations with documentation. The map excludes
--- all kinds of instance declarations (including type family instances) and
--- documentation declarations.
--- Subordinate names are mapped to the parent declaration, but with the doc
--- for the subordinate declaration.
-mkDeclMap :: [(Decl, Maybe Doc)] -> Map Name DeclInfo
+-- Make a map from names to 'DeclInfo's. Exclude declarations that don't
+-- have names (instances and stand-alone documentation comments). Include
+-- subordinate names, but map them to their parent declarations. 
+mkDeclMap :: [DeclInfo] -> Map Name DeclInfo
 mkDeclMap decls = Map.fromList . concat $
   [ (declName d, (parent, doc, subs)) : subDecls
-  | (parent@(L loc d), doc) <- decls 
-  , let subs = subordinates d
+  | (parent@(L _ d), doc, subs) <- decls 
   , let subDecls = [ (n, (parent, doc', [])) | (n, doc') <- subs ]
   , not (isDocD d), not (isInstD d) ]
 
 
+declInfos :: [(Decl, Maybe Doc)] -> [DeclInfo]
+declInfos decls = [ (parent, doc, subordinates d)
+                  | (parent@(L _ d), doc) <- decls]
+
+
 -- | Group type family instances together. Include the family declaration
 -- if found.
 {-mkFamMap :: [DeclWithDoc] -> Map Name Family
@@ -170,15 +172,18 @@ subordinates _ = []
 
 classDataSubs :: TyClDecl Name -> [(Name, Maybe Doc)]
 classDataSubs decl
-  | isClassDecl decl = classMeths
-  | isDataDecl  decl = recordFields
+  | isClassDecl decl = classSubs
+  | isDataDecl  decl = dataSubs
   | otherwise        = []
   where
-    classMeths   = [ (declName d, doc) | (L _ d, doc) <- classDecls decl ]
-    recordFields = [ (unLoc lname, fmap unLoc doc) |
-                     ConDeclField lname _ doc <- fields ]
-    cons         = [ con | L _ con <- tcdCons decl ]
-    fields       = concat [ fields | RecCon fields <- map con_details cons]
+    classSubs = [ (declName d, doc) | (L _ d, doc) <- classDecls decl ]
+    dataSubs  = constrs ++ fields   
+      where
+        cons    = map unL $ tcdCons decl
+        constrs = [ (unL $ con_name c, fmap unL $ con_doc c) | c <- cons ]
+        fields  = [ (unL n, fmap unL doc)
+                  | RecCon flds <- map con_details cons
+                  , ConDeclField n _ doc <- flds ]
 
 
 -- All the sub declarations of a class (that we handle), ordered by
@@ -206,7 +211,7 @@ topDecls :: HsGroup Name -> [DeclWithDoc]
 topDecls = filterClasses . filterDecls . collectDocs . sortByLoc . declsFromGroup
 
 
-filterOutInstances = filter (\(L _ d, _) -> not (isInstD d))
+filterOutInstances = filter (\(L _ d, _, _) -> not (isInstD d))
 
 
 -- | Take all declarations in an 'HsGroup' and convert them into a list of
@@ -235,7 +240,7 @@ sortByLoc = sortBy (comparing getLoc)
 warnAboutFilteredDecls mod decls = do
   let modStr = moduleString mod
   let typeInstances =
-        nub [ tcdName d | (L _ (TyClD d), _) <- decls, isFamInstDecl d ]
+        nub [ tcdName d | (L _ (TyClD d), _, _) <- decls, isFamInstDecl d ]
 
   when (not $null typeInstances) $
     tell $ nub [
@@ -244,7 +249,7 @@ warnAboutFilteredDecls mod decls = do
       ++ "will be filtered out:\n  " ++ (concat $ intersperse ", "
       $ map (occNameString . nameOccName) typeInstances) ]
 
-  let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _) <- decls
+  let instances = nub [ pretty i | (L _ (InstD (InstDecl i _ _ ats)), _, _) <- decls
                                  , not (null ats) ]
 
   when (not $ null instances) $
@@ -365,7 +370,7 @@ mkExportItems
   :: ModuleMap
   -> Module			-- this module
   -> [Name]			-- exported names (orig)
-  -> [(Decl, Maybe Doc)]
+  -> [DeclInfo]
   -> Map Name DeclInfo             -- maps local names to declarations
   -> Map Name [Name]	-- sub-map for this module
   -> [DocOption]
@@ -380,7 +385,7 @@ mkExportItems modMap this_mod exported_names decls declMap sub_map
     = everything_local_exported
   | Just specs <- maybe_exps = liftM concat $ mapM lookupExport specs
   where
-    instances = [ d  | d@(L _ decl, _) <- decls, isInstD decl ]
+    instances = [ d | d@(L _ decl, _, _) <- decls, isInstD decl ]
 
     everything_local_exported =  -- everything exported
       return (fullContentsOfThisModule this_mod decls)
@@ -401,7 +406,7 @@ mkExportItems modMap this_mod exported_names decls declMap sub_map
     lookupExport (IEGroup lev doc)     = return [ ExportGroup lev "" doc ]
     lookupExport (IEDoc doc)           = return [ ExportDoc doc ] 
     lookupExport (IEDocNamed str) = do
-      r <- findNamedDoc str (map (unLoc . fst) decls)
+      r <- findNamedDoc str [ unL d | (d,_,_) <- decls ]
       case r of
         Nothing -> return []
         Just found -> return [ ExportDoc found ]
@@ -411,15 +416,19 @@ mkExportItems modMap this_mod exported_names decls declMap sub_map
       -- temp hack: we filter out separately declared ATs, since we haven't decided how
       -- to handle them yet. We should really give an warning message also, and filter the
       -- name out in mkVisibleNames...
-      | Just (decl, maybeDoc, _) <- findDecl t, t `notElem` declATs (unL decl) =
-          return [ ExportDecl (restrictTo subs (extractDecl t mdl decl)) maybeDoc [] ]
+      | Just x@(decl,_,_) <- findDecl t,
+        t `notElem` declATs (unL decl) = return [ mkExportDecl t x ]
       | otherwise = return []
-     where 
-       mdl = nameModule t
-       subs = filter (`elem` exported_names) all_subs
-       all_subs
-         | mdl == this_mod = Map.findWithDefault [] t sub_map
-         | otherwise       = allSubsOfName modMap t
+
+
+    mkExportDecl :: Name -> DeclInfo -> ExportItem Name
+    mkExportDecl n (decl, doc, subs) = decl'
+      where
+        decl' = ExportDecl (restrictTo subs' (extractDecl n mdl decl)) doc subdocs []
+        mdl = nameModule n
+        subs' = filter (`elem` exported_names) $ map fst subs
+        subdocs = [ (n, doc) | (n, Just doc) <- subs ]
+
 
     fullContentsOf m  
 	| m == this_mod = return (fullContentsOfThisModule this_mod decls)
@@ -441,11 +450,13 @@ mkExportItems modMap this_mod exported_names decls declMap sub_map
         m = nameModule n
 
 
-fullContentsOfThisModule :: Module -> [(Decl, Maybe Doc)] -> [ExportItem Name]
+fullContentsOfThisModule :: Module -> [DeclInfo] -> [ExportItem Name]
 fullContentsOfThisModule module_ decls = catMaybes (map mkExportItem decls)
   where
-    mkExportItem (L _ (DocD (DocGroup lev doc)), _) = Just $ ExportGroup lev "" doc
-    mkExportItem (decl, doc) = Just $ ExportDecl decl doc []
+    mkExportItem (L _ (DocD (DocGroup lev doc)), _, _) = Just $ ExportGroup lev "" doc
+    mkExportItem (decl, doc, subs) = Just $ ExportDecl decl doc subdocs []
+      where subdocs = [ (n, doc) | (n, Just doc) <- subs ]
+
 --    mkExportItem _ = Nothing -- TODO: see if this is really needed
 
 
@@ -513,7 +524,7 @@ extractRecSel nm mdl t tvs (L _ con : rest) =
 -- Pruning
 pruneExportItems :: [ExportItem Name] -> [ExportItem Name]
 pruneExportItems items = filter hasDoc items
-  where hasDoc (ExportDecl _ d _) = isJust d
+  where hasDoc (ExportDecl _ d _ _) = isJust d
 	hasDoc _ = True
 
 
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index 3efc2526..3675f0b4 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -369,9 +369,10 @@ renameTyClD d = case d of
 
       
 renameSig sig = case sig of 
-  TypeSig (L loc name) ltype -> do 
+  TypeSig lname ltype -> do 
+    lname' <- renameL lname
     ltype' <- renameLType ltype
-    return (TypeSig (L loc (keep name)) ltype')
+    return (TypeSig lname' ltype')
   -- we have filtered out all other kinds of signatures in Interface.Create
 
 
@@ -395,11 +396,12 @@ renameExportItem item = case item of
   ExportGroup lev id doc -> do
     doc' <- renameDoc doc
     return (ExportGroup lev id doc')
-  ExportDecl decl doc instances -> do
+  ExportDecl decl doc subs instances -> do
     decl' <- renameLDecl decl
     doc'  <- mapM renameDoc doc
+    subs' <- mapM renameSub subs
     instances' <- mapM renameInstHead instances
-    return (ExportDecl decl' doc' instances')
+    return (ExportDecl decl' doc' subs' instances')
   ExportNoDecl x y subs -> do
     y'    <- lookupRn id y
     subs' <- mapM (lookupRn id) subs
@@ -407,3 +409,9 @@ renameExportItem item = case item of
   ExportDoc doc -> do
     doc' <- renameDoc doc
     return (ExportDoc doc')
+
+
+renameSub (n,doc) = do
+  n' <- rename n
+  doc' <- renameDoc doc
+  return (n', doc')
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 671637c5..24f5fd25 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -47,6 +47,9 @@ data ExportItem name
       -- | Maybe a doc comment
       expItemMbDoc :: Maybe (HsDoc name),
 
+      -- | Documentation for subordinate declarations
+      expItemSubDocs :: [(name, HsDoc name)],
+
       -- | Instances relevant to this declaration
       expItemInstances :: [InstHead name]