diff options
-rw-r--r-- | src/Haddock/Interface/Create.hs | 19 | ||||
-rw-r--r-- | tests/html-tests/tests/BugExportHeadings.hs | 29 | ||||
-rw-r--r-- | tests/html-tests/tests/BugExportHeadings.html.ref | 217 | ||||
-rw-r--r-- | tests/html-tests/tests/mini_BugExportHeadings.html.ref | 79 |
4 files changed, 330 insertions, 14 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 76b59a80..eb0d5f0d 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -436,18 +436,10 @@ mkExportItems (maps@(docMap, argMap, subMap, declMap)) optExports _ instIfaceMap dflags = case optExports of Nothing -> fullModuleContents dflags gre maps decls - Just exports -> liftM (nubBy commaDeclared . concat) $ mapM lookupExport exports + Just exports -> liftM concat $ mapM lookupExport exports where decls = filter (not . isInstD . unLoc) decls0 - -- A type signature can have multiple names, like: - -- foo, bar :: Types.. - -- When going throug the exported names we have to take care to detect such - -- situations and remove the duplicates. - commaDeclared (ExportDecl (L _ sig1) _ _ _) (ExportDecl (L _ sig2) _ _ _) = - getMainDeclBinder sig1 == getMainDeclBinder sig2 - commaDeclared _ _ = False - lookupExport (IEVar x) = declWith x lookupExport (IEThingAbs t) = declWith t @@ -505,13 +497,12 @@ mkExportItems -- normal case | 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 - -- requires modifying the type signatures to "hide" the - -- names that are not exported. + -- A single signature might refer to many names, but we + -- create an export item for a single name only. So we + -- modify the signature to contain only that single name. newDecl = case decl of (L loc (SigD sig)) -> - L loc . SigD . fromJust $ filterSigNames isExported sig + L loc . SigD . fromJust $ filterSigNames (== t) sig -- fromJust is safe since we already checked in guards -- that 't' is a name declared in this declaration. _ -> decl diff --git a/tests/html-tests/tests/BugExportHeadings.hs b/tests/html-tests/tests/BugExportHeadings.hs new file mode 100644 index 00000000..a5493a08 --- /dev/null +++ b/tests/html-tests/tests/BugExportHeadings.hs @@ -0,0 +1,29 @@ +-- test for #192 +module BugExportHeadings ( +-- * Foo + foo +-- * Bar +, bar +-- * Baz +, baz + +-- * One +, one +-- * Two +, two +-- * Three +, three +) where + +foo, bar, baz :: Int +foo = 23 +bar = 23 +baz = 23 + +one, two, three :: Int +one = 23 +two = 23 +three = 23 +{-# DEPRECATED one "for one" #-} +{-# DEPRECATED two "for two" #-} +{-# DEPRECATED three "for three" #-} diff --git a/tests/html-tests/tests/BugExportHeadings.html.ref b/tests/html-tests/tests/BugExportHeadings.html.ref new file mode 100644 index 00000000..37056334 --- /dev/null +++ b/tests/html-tests/tests/BugExportHeadings.html.ref @@ -0,0 +1,217 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >BugExportHeadings</title + ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script type="text/javascript" + >//<![CDATA[ +window.onload = function () {pageLoad();setSynopsis("mini_BugExportHeadings.html");}; +//]]> +</script + ></head + ><body + ><div id="package-header" + ><ul class="links" id="page-menu" + ><li + ><a href="" + >Contents</a + ></li + ><li + ><a href="" + >Index</a + ></li + ></ul + ><p class="caption" class="empty" + > </p + ></div + ><div id="content" + ><div id="module-header" + ><table class="info" + ><tr + ><th + >Safe Haskell</th + ><td + >None</td + ></tr + ></table + ><p class="caption" + >BugExportHeadings</p + ></div + ><div id="table-of-contents" + ><p class="caption" + >Contents</p + ><ul + ><li + ><a href="" + >Foo +</a + ></li + ><li + ><a href="" + >Bar +</a + ></li + ><li + ><a href="" + >Baz +</a + ></li + ><li + ><a href="" + >One +</a + ></li + ><li + ><a href="" + >Two +</a + ></li + ><li + ><a href="" + >Three +</a + ></li + ></ul + ></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" + ><a href="" + >foo</a + > :: <a href="" + >Int</a + ></li + ><li class="src short" + ><a href="" + >bar</a + > :: <a href="" + >Int</a + ></li + ><li class="src short" + ><a href="" + >baz</a + > :: <a href="" + >Int</a + ></li + ><li class="src short" + ><a href="" + >one</a + > :: <a href="" + >Int</a + ></li + ><li class="src short" + ><a href="" + >two</a + > :: <a href="" + >Int</a + ></li + ><li class="src short" + ><a href="" + >three</a + > :: <a href="" + >Int</a + ></li + ></ul + ></div + ><div id="interface" + ><h1 id="g:1" + >Foo +</h1 + ><div class="top" + ><p class="src" + ><a name="v:foo" class="def" + >foo</a + > :: <a href="" + >Int</a + ></p + ></div + ><h1 id="g:2" + >Bar +</h1 + ><div class="top" + ><p class="src" + ><a name="v:bar" class="def" + >bar</a + > :: <a href="" + >Int</a + ></p + ></div + ><h1 id="g:3" + >Baz +</h1 + ><div class="top" + ><p class="src" + ><a name="v:baz" class="def" + >baz</a + > :: <a href="" + >Int</a + ></p + ></div + ><h1 id="g:4" + >One +</h1 + ><div class="top" + ><p class="src" + ><a name="v:one" class="def" + >one</a + > :: <a href="" + >Int</a + ></p + ><div class="doc" + ><div class="warning" + ><p + >Deprecated: for one</p + ></div + ></div + ></div + ><h1 id="g:5" + >Two +</h1 + ><div class="top" + ><p class="src" + ><a name="v:two" class="def" + >two</a + > :: <a href="" + >Int</a + ></p + ><div class="doc" + ><div class="warning" + ><p + >Deprecated: for two</p + ></div + ></div + ></div + ><h1 id="g:6" + >Three +</h1 + ><div class="top" + ><p class="src" + ><a name="v:three" class="def" + >three</a + > :: <a href="" + >Int</a + ></p + ><div class="doc" + ><div class="warning" + ><p + >Deprecated: for three</p + ></div + ></div + ></div + ></div + ></div + ><div id="footer" + ><p + >Produced by <a href="" + >Haddock</a + > version 2.10.0</p + ></div + ></body + ></html +> diff --git a/tests/html-tests/tests/mini_BugExportHeadings.html.ref b/tests/html-tests/tests/mini_BugExportHeadings.html.ref new file mode 100644 index 00000000..b481720d --- /dev/null +++ b/tests/html-tests/tests/mini_BugExportHeadings.html.ref @@ -0,0 +1,79 @@ +<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd"> +<html xmlns="http://www.w3.org/1999/xhtml" +><head + ><meta http-equiv="Content-Type" content="text/html; charset=UTF-8" + /><title + >BugExportHeadings</title + ><link href="ocean.css" rel="stylesheet" type="text/css" title="Ocean" + /><script src="haddock-util.js" type="text/javascript" + ></script + ><script type="text/javascript" + >//<![CDATA[ +window.onload = function () {pageLoad();}; +//]]> +</script + ></head + ><body id="mini" + ><div id="module-header" + ><p class="caption" + >BugExportHeadings</p + ></div + ><div id="interface" + ><h1 + >Foo +</h1 + ><div class="top" + ><p class="src" + ><a href="" target="main" + >foo</a + ></p + ></div + ><h1 + >Bar +</h1 + ><div class="top" + ><p class="src" + ><a href="" target="main" + >bar</a + ></p + ></div + ><h1 + >Baz +</h1 + ><div class="top" + ><p class="src" + ><a href="" target="main" + >baz</a + ></p + ></div + ><h1 + >One +</h1 + ><div class="top" + ><p class="src" + ><a href="" target="main" + >one</a + ></p + ></div + ><h1 + >Two +</h1 + ><div class="top" + ><p class="src" + ><a href="" target="main" + >two</a + ></p + ></div + ><h1 + >Three +</h1 + ><div class="top" + ><p class="src" + ><a href="" target="main" + >three</a + ></p + ></div + ></div + ></body + ></html +> |