aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Haddock/Interface/Create.hs34
-rw-r--r--tests/html-tests/tests/A.hs9
-rw-r--r--tests/html-tests/tests/A.html.ref88
-rw-r--r--tests/html-tests/tests/B.hs4
-rw-r--r--tests/html-tests/tests/B.html.ref57
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"
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 11:35:01 +0000