aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Hengel <sol@typeful.net>2012-01-12 17:44:45 +0100
committerDavid Waern <david.waern@gmail.com>2012-02-04 00:51:04 +0100
commitd9c0ac268c5f08c35a3c8a8fc792a07757182cda (patch)
treea302ad4c8551b2759f0c99eabd3cbc61668074ca
parent583e46cc674d8a75bbc12f09dae88ba7ed2b3287 (diff)
Expand type signatures for modules without explicit export list
-rw-r--r--src/Haddock/Interface/Create.hs15
-rw-r--r--tests/html-tests/tests/BugDeprecated.hs18
-rw-r--r--tests/html-tests/tests/BugDeprecated.html.ref192
-rw-r--r--tests/html-tests/tests/mini_BugDeprecated.html.ref61
4 files changed, 285 insertions, 1 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index eb0d5f0d..2d903133 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -641,8 +641,21 @@ moduleExports thisMod expMod dflags gre _exports decls ifaceMap instIfaceMap map
fullModuleContents :: DynFlags -> GlobalRdrEnv -> Maps -> [LHsDecl Name] -> ErrMsgGhc [ExportItem Name]
fullModuleContents dflags gre (docMap, argMap, subMap, declMap) decls =
- liftM catMaybes $ mapM mkExportItem decls
+ liftM catMaybes $ mapM mkExportItem (expandSig decls)
where
+ -- A type signature can have multiple names, like:
+ -- foo, bar :: Types..
+ --
+ -- We go through the list of declarations and expand type signatures, so
+ -- that every type signature has exactly one name!
+ expandSig :: [LHsDecl name] -> [LHsDecl name]
+ expandSig = foldr f []
+ where
+ f :: LHsDecl name -> [LHsDecl name] -> [LHsDecl name]
+ f (L l (SigD (TypeSig names t))) xs = foldr (\n acc -> L l (SigD (TypeSig [n] t)) : acc) xs names
+ f (L l (SigD (GenericSig names t))) xs = foldr (\n acc -> L l (SigD (GenericSig [n] t)) : acc) xs names
+ f x xs = x : xs
+
mkExportItem (L _ (DocD (DocGroup lev docStr))) = do
mbDoc <- liftErrMsg $ lexParseRnHaddockComment dflags DocSectionComment gre docStr
return $ fmap (ExportGroup lev "") mbDoc
diff --git a/tests/html-tests/tests/BugDeprecated.hs b/tests/html-tests/tests/BugDeprecated.hs
new file mode 100644
index 00000000..0f7ac2eb
--- /dev/null
+++ b/tests/html-tests/tests/BugDeprecated.hs
@@ -0,0 +1,18 @@
+module BugDeprecated where
+
+foo, bar, baz :: Int
+foo = 23
+bar = 23
+baz = 23
+{-# DEPRECATED foo "for foo" #-}
+{-# DEPRECATED bar "for bar" #-}
+{-# DEPRECATED baz "for baz" #-}
+
+-- | some documentation for one, two and three
+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/BugDeprecated.html.ref b/tests/html-tests/tests/BugDeprecated.html.ref
new file mode 100644
index 00000000..394ce279
--- /dev/null
+++ b/tests/html-tests/tests/BugDeprecated.html.ref
@@ -0,0 +1,192 @@
+<!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
+ >BugDeprecated</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_BugDeprecated.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"
+ >&nbsp;</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"
+ >BugDeprecated</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"
+ ><a href=""
+ >foo</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=""
+ >bar</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=""
+ >three</a
+ > :: <a href=""
+ >Int</a
+ ></li
+ ><li class="src short"
+ ><a href=""
+ >two</a
+ > :: <a href=""
+ >Int</a
+ ></li
+ ></ul
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:foo" class="def"
+ >foo</a
+ > :: <a href=""
+ >Int</a
+ ></p
+ ><div class="doc"
+ ><div class="warning"
+ ><p
+ >Deprecated: for foo</p
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:baz" class="def"
+ >baz</a
+ > :: <a href=""
+ >Int</a
+ ></p
+ ><div class="doc"
+ ><div class="warning"
+ ><p
+ >Deprecated: for baz</p
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:bar" class="def"
+ >bar</a
+ > :: <a href=""
+ >Int</a
+ ></p
+ ><div class="doc"
+ ><div class="warning"
+ ><p
+ >Deprecated: for bar</p
+ ></div
+ ></div
+ ></div
+ ><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
+ ><p
+ >some documentation for one, two and three
+</p
+ ></div
+ ></div
+ ><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
+ ><p
+ >some documentation for one, two and three
+</p
+ ></div
+ ></div
+ ><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
+ ><p
+ >some documentation for one, two and three
+</p
+ ></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_BugDeprecated.html.ref b/tests/html-tests/tests/mini_BugDeprecated.html.ref
new file mode 100644
index 00000000..f0410137
--- /dev/null
+++ b/tests/html-tests/tests/mini_BugDeprecated.html.ref
@@ -0,0 +1,61 @@
+<!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
+ >BugDeprecated</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"
+ >BugDeprecated</p
+ ></div
+ ><div id="interface"
+ ><div class="top"
+ ><p class="src"
+ ><a href="" target="main"
+ >foo</a
+ ></p
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a href="" target="main"
+ >baz</a
+ ></p
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a href="" target="main"
+ >bar</a
+ ></p
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a href="" target="main"
+ >one</a
+ ></p
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a href="" target="main"
+ >three</a
+ ></p
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a href="" target="main"
+ >two</a
+ ></p
+ ></div
+ ></div
+ ></body
+ ></html
+>