aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/haddock.xml23
-rw-r--r--html-test/ref/Bug195.html179
-rw-r--r--html-test/src/Bug195.hs11
-rw-r--r--src/Haddock/Interface/Create.hs3
4 files changed, 215 insertions, 1 deletions
diff --git a/doc/haddock.xml b/doc/haddock.xml
index bec8067f..5bc27aca 100644
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -1218,6 +1218,29 @@ data R a b =
Haddock - for example doc comments can appear before or after
the comma in separated lists such as the list of record fields
above.</para>
+
+ <para>In case that more than one constructor exports a field
+ with the same name, the documentation attached to the first
+ occurence of the field will be used, even if a comment is not
+ present.
+ </para>
+
+<programlisting>
+data T a = A { someField :: a -- ^ Doc for someField of A
+ }
+ | B { someField :: a -- ^ Doc for someField of B
+ }
+</programlisting>
+
+ <para>In the above example, all occurences of
+ <literal>someField</literal> in the documentation are going to
+ be documented with <literal>Doc for someField of A</literal>.
+ Note that Haddock versions 2.14.0 and before would join up
+ documentation of each field and render the result. The reason
+ for this seemingly weird behaviour is the fact that
+ <literal>someField</literal> is actually the same (partial)
+ function.</para>
+
</section>
<section>
diff --git a/html-test/ref/Bug195.html b/html-test/ref/Bug195.html
new file mode 100644
index 00000000..9ab7c3b0
--- /dev/null
+++ b/html-test/ref/Bug195.html
@@ -0,0 +1,179 @@
+<!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
+ >Bug195</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_Bug195.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 empty"
+ >&nbsp;</p
+ ></div
+ ><div id="content"
+ ><div id="module-header"
+ ><table class="info"
+ ><tr
+ ><th
+ >Safe Haskell</th
+ ><td
+ >Safe-Inferred</td
+ ></tr
+ ></table
+ ><p class="caption"
+ >Bug195</p
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >data</span
+ > <a name="t:T" class="def"
+ >T</a
+ ></p
+ ><div class="subs constructors"
+ ><p class="caption"
+ >Constructors</p
+ ><table
+ ><tr
+ ><td class="src"
+ ><a name="v:A" class="def"
+ >A</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><div class="subs fields"
+ ><p class="caption"
+ >Fields</p
+ ><dl
+ ><dt class="src"
+ ><a name="v:someField" class="def"
+ >someField</a
+ > :: ()</dt
+ ><dd class="doc"
+ ><p
+ >Doc for someField of A</p
+ ></dd
+ ><dt class="src"
+ ><a name="v:someOtherField" class="def"
+ >someOtherField</a
+ > :: ()</dt
+ ><dd class="doc"
+ ><p
+ >Doc for someOtherField of A</p
+ ></dd
+ ></dl
+ ><div class="clear"
+ ></div
+ ></div
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a name="v:B" class="def"
+ >B</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><div class="subs fields"
+ ><p class="caption"
+ >Fields</p
+ ><dl
+ ><dt class="src"
+ ><a name="v:someField" class="def"
+ >someField</a
+ > :: ()</dt
+ ><dd class="doc"
+ ><p
+ >Doc for someField of A</p
+ ></dd
+ ><dt class="src"
+ ><a name="v:someOtherField" class="def"
+ >someOtherField</a
+ > :: ()</dt
+ ><dd class="doc"
+ ><p
+ >Doc for someOtherField of A</p
+ ></dd
+ ></dl
+ ><div class="clear"
+ ></div
+ ></div
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a name="v:C" class="def"
+ >C</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td colspan="2"
+ ><div class="subs fields"
+ ><p class="caption"
+ >Fields</p
+ ><dl
+ ><dt class="src"
+ ><a name="v:someField" class="def"
+ >someField</a
+ > :: ()</dt
+ ><dd class="doc"
+ ><p
+ >Doc for someField of A</p
+ ></dd
+ ><dt class="src"
+ ><a name="v:someOtherField" class="def"
+ >someOtherField</a
+ > :: ()</dt
+ ><dd class="doc"
+ ><p
+ >Doc for someOtherField of A</p
+ ></dd
+ ></dl
+ ><div class="clear"
+ ></div
+ ></div
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ></div
+ ></div
+ ><div id="footer"
+ ><p
+ >Produced by <a href=""
+ >Haddock</a
+ > version 2.14.0</p
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/src/Bug195.hs b/html-test/src/Bug195.hs
new file mode 100644
index 00000000..14440e8d
--- /dev/null
+++ b/html-test/src/Bug195.hs
@@ -0,0 +1,11 @@
+module Bug195 where
+
+data T = A { someField :: () -- ^ Doc for someField of A
+ , someOtherField :: () -- ^ Doc for someOtherField of A
+ }
+ | B { someField :: () -- ^ Doc for someField of B
+ , someOtherField :: () -- ^ Doc for someOtherField of B
+ }
+ | C { someField :: () -- ^ Doc for someField of C
+ , someOtherField :: () -- ^ Doc for someOtherField of C
+ }
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index cf5a3451..f3658a12 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -31,6 +31,7 @@ import Data.Ord
import Control.Applicative
import Control.DeepSeq
import Control.Monad
+import Data.Function (on)
import qualified Data.Foldable as F
import qualified Data.Traversable as T
@@ -255,7 +256,7 @@ mkMaps :: DynFlags
-> ErrMsgM Maps
mkMaps dflags gre instances decls = do
(a, b, c, d) <- unzip4 <$> mapM mappings decls
- return (f a, f b, f c, f d, instanceMap)
+ return (f $ map (nubBy ((==) `on` fst)) a , f b, f c, f d, instanceMap)
where
f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
f = M.fromListWith (<>) . concat