Fix bug introduced in my recent refactoring.

5 files changed, 174 insertions, 18 deletions

diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 580aaa83..0a0c0e2d 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -433,13 +433,12 @@ mkExportItems
 
     declWith :: Name -> ErrMsgGhc [ ExportItem Name ]
     declWith t =
-      let (doc, subs) = exportDecl t docMap argMap subMap in
       case findDecl t of
-        [L _ (ValD _)] -> do
+        ([L _ (ValD _)], (doc, _)) -> do
           -- Top-level binding without type signature
           export <- hiValExportItem t doc
           return [export]
-        ds | decl : _ <- filter (not . isValD . unLoc) ds ->
+        (ds, docs_) | decl : _ <- filter (not . isValD . unLoc) ds ->
           let declNames = getMainDeclBinder (unL decl)
           in case () of
             _
@@ -461,7 +460,7 @@ mkExportItems
                    return []
 
               -- normal case
-              | otherwise -> return [ mkExportDecl t newDecl (doc, subs) ]
+              | otherwise -> return [ mkExportDecl t newDecl docs_ ]
                   where
                     -- Since a single signature might refer to many names, we
                     -- need to filter the ones that are actually exported. This
@@ -475,7 +474,7 @@ mkExportItems
                       _                  -> decl
 
         -- Declaration from another package
-        [] -> do
+        ([], _) -> do
           mayDecl <- hiDecl t
           case mayDecl of
             Nothing -> return [ ExportNoDecl t [] ]
@@ -489,7 +488,7 @@ mkExportItems
                    let subs_ = [ (n, noDocForDecl) | (n, _, _) <- subordinates (unLoc decl) ]
                    return [ mkExportDecl t decl (noDocForDecl, subs_) ]
                 Just iface -> do
-                   return [ mkExportDecl t decl (exportDecl t (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
+                   return [ mkExportDecl t decl (lookupDocs t (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
 
         _ -> return []
 
@@ -506,13 +505,15 @@ mkExportItems
     isExported = (`elem` exportedNames)
 
 
-    findDecl :: Name -> [LHsDecl Name]
-    findDecl name
-      | mdl == thisMod = maybe [] id (M.lookup name declMap)
-      | Just iface <- M.lookup mdl modMap = maybe [] id (M.lookup name (ifaceDeclMap iface))
-      | otherwise = []
+    findDecl :: Name -> ([LHsDecl Name], (DocForDecl Name, [(Name, DocForDecl Name)]))
+    findDecl n
+      | m == thisMod, Just ds <- M.lookup n declMap =
+          (ds, lookupDocs n docMap argMap subMap)
+      | Just iface <- M.lookup m modMap, Just ds <- M.lookup n (ifaceDeclMap iface) =
+          (ds, lookupDocs n (ifaceDocMap iface) (ifaceArgMap iface) (ifaceSubMap iface))
+      | otherwise = ([], (noDocForDecl, []))
       where
-        mdl = nameModule name
+        m = nameModule n
 
 
 hiDecl :: Name -> ErrMsgGhc (Maybe (LHsDecl Name))
@@ -533,8 +534,9 @@ hiValExportItem name doc = do
     Just decl -> return (ExportDecl decl doc [] [])
 
 
-exportDecl :: Name -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
-exportDecl name docMap argMap subMap =
+-- | Lookup docs for a declaration from maps.
+lookupDocs :: Name -> DocMap Name -> ArgMap Name -> SubMap -> (DocForDecl Name, [(Name, DocForDecl Name)])
+lookupDocs name docMap argMap subMap =
   let lookupArgMap x = maybe M.empty id (M.lookup x argMap) in
   let doc = (M.lookup name docMap, lookupArgMap name) in
   let subs = [ (sub, (M.lookup sub docMap, lookupArgMap sub)) | sub <- maybe [] id (M.lookup name subMap) ] in
@@ -616,12 +618,12 @@ fullModuleContents dflags gre (docMap, argMap, subMap, declMap) decls =
     mkExportItem (L _ (ValD d))
       | name:_ <- collectHsBindBinders d, Just [L _ (ValD _)] <- M.lookup name declMap =
           -- Top-level binding without type signature.
-          let (doc, _) = exportDecl name docMap argMap subMap in
+          let (doc, _) = lookupDocs name docMap argMap subMap in
           fmap Just (hiValExportItem name doc)
       | otherwise = return Nothing
     mkExportItem decl
       | name:_ <- getMainDeclBinder (unLoc decl) =
-        let (doc, subs) = exportDecl name docMap argMap subMap in
+        let (doc, subs) = lookupDocs name docMap argMap subMap in
         return $ Just (ExportDecl decl doc subs [])
       | otherwise = return Nothing
 
diff --git a/tests/html-tests/tests/A.hs b/tests/html-tests/tests/A.hs
index ac8fad49..606b0865 100644
--- a/tests/html-tests/tests/A.hs
+++ b/tests/html-tests/tests/A.hs
@@ -1,8 +1,17 @@
 module A where
+
 data A = A
 
 other :: Int
 other = 2
 
+-- | Doc for test2
 test2 :: Bool
 test2 = False
+
+-- | Should show up on the page for both modules A and B
+data X = X -- ^ Doc for consructor
+
+-- | Should show up on the page for both modules A and B
+reExport :: Int
+reExport = 1
diff --git a/tests/html-tests/tests/A.html.ref b/tests/html-tests/tests/A.html.ref
index 38a39479..143f8a73 100644
--- a/tests/html-tests/tests/A.html.ref
+++ b/tests/html-tests/tests/A.html.ref
@@ -41,6 +41,46 @@ window.onload = function () {pageLoad();setSynopsis("mini_A.html");};
 	><p class="caption"
 	>A</p
 	></div
+      ><div id="synopsis"
+      ><p id="control.syn" class="caption expander" onclick="toggleSection('syn')"
+	>Synopsis</p
+	><ul id="section.syn" class="hide" onclick="toggleSection('syn')"
+	><li class="src short"
+	  ><span class="keyword"
+	    >data</span
+	    >  <a href=""
+	    >A</a
+	    >  = <a href=""
+	    >A</a
+	    ></li
+	  ><li class="src short"
+	  ><a href=""
+	    >other</a
+	    > :: <a href=""
+	    >Int</a
+	    ></li
+	  ><li class="src short"
+	  ><a href=""
+	    >test2</a
+	    > :: <a href=""
+	    >Bool</a
+	    ></li
+	  ><li class="src short"
+	  ><span class="keyword"
+	    >data</span
+	    >  <a href=""
+	    >X</a
+	    >  = <a href=""
+	    >X</a
+	    ></li
+	  ><li class="src short"
+	  ><a href=""
+	    >reExport</a
+	    > :: <a href=""
+	    >Int</a
+	    ></li
+	  ></ul
+	></div
       ><div id="interface"
       ><h1
 	>Documentation</h1
@@ -81,6 +121,54 @@ window.onload = function () {pageLoad();setSynopsis("mini_A.html");};
 	    > :: <a href=""
 	    >Bool</a
 	    ></p
+	  ><div class="doc"
+	  ><p
+	    >Doc for test2
+</p
+	    ></div
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >data</span
+	    >  <a name="t:X" class="def"
+	    >X</a
+	    >  </p
+	  ><div class="doc"
+	  ><p
+	    >Should show up on the page for both modules A and B
+</p
+	    ></div
+	  ><div class="subs constructors"
+	  ><p class="caption"
+	    >Constructors</p
+	    ><table
+	    ><tr
+	      ><td class="src"
+		><a name="v:X" class="def"
+		  >X</a
+		  ></td
+		><td class="doc"
+		><p
+		  >Doc for consructor
+</p
+		  ></td
+		></tr
+	      ></table
+	    ></div
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a name="v:reExport" class="def"
+	    >reExport</a
+	    > :: <a href=""
+	    >Int</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >Should show up on the page for both modules A and B
+</p
+	    ></div
 	  ></div
 	></div
       ></div
diff --git a/tests/html-tests/tests/B.hs b/tests/html-tests/tests/B.hs
index 28cda4a0..5fd69acd 100644
--- a/tests/html-tests/tests/B.hs
+++ b/tests/html-tests/tests/B.hs
@@ -1,5 +1,5 @@
-module B ( module A, test ) where
-import A ( A(..), test2 )
+module B ( module A, test, reExport, X(..) ) where
+import A ( A(..), test2, reExport, X(..) )
 
 -- | This link shouldn't work: 'other'.
 --   These links should work: 'A.other', 'Data.List.sortBy', 'test2', 'A.test2', 'Data.Maybe.fromMaybe'.
diff --git a/tests/html-tests/tests/B.html.ref b/tests/html-tests/tests/B.html.ref
index 039d860f..374e34e3 100644
--- a/tests/html-tests/tests/B.html.ref
+++ b/tests/html-tests/tests/B.html.ref
@@ -55,6 +55,20 @@ window.onload = function () {pageLoad();setSynopsis("mini_B.html");};
 	    > :: <a href=""
 	    >Int</a
 	    ></li
+	  ><li class="src short"
+	  ><a href=""
+	    >reExport</a
+	    > :: <a href=""
+	    >Int</a
+	    ></li
+	  ><li class="src short"
+	  ><span class="keyword"
+	    >data</span
+	    >  <a href=""
+	    >X</a
+	    >  = <a href=""
+	    >X</a
+	    ></li
 	  ></ul
 	></div
       ><div id="interface"
@@ -105,6 +119,49 @@ window.onload = function () {pageLoad();setSynopsis("mini_B.html");};
 </p
 	    ></div
 	  ></div
+	><div class="top"
+	><p class="src"
+	  ><a name="v:reExport" class="def"
+	    >reExport</a
+	    > :: <a href=""
+	    >Int</a
+	    ></p
+	  ><div class="doc"
+	  ><p
+	    >Should show up on the page for both modules A and B
+</p
+	    ></div
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >data</span
+	    >  <a name="t:X" class="def"
+	    >X</a
+	    >  </p
+	  ><div class="doc"
+	  ><p
+	    >Should show up on the page for both modules A and B
+</p
+	    ></div
+	  ><div class="subs constructors"
+	  ><p class="caption"
+	    >Constructors</p
+	    ><table
+	    ><tr
+	      ><td class="src"
+		><a name="v:X" class="def"
+		  >X</a
+		  ></td
+		><td class="doc"
+		><p
+		  >Doc for consructor
+</p
+		  ></td
+		></tr
+	      ></table
+	    ></div
+	  ></div
 	></div
       ></div
     ><div id="footer"