Skip to content
Snippets Groups Projects
Commit e5bd27b5 authored by Mateusz Kowalczyk's avatar Mateusz Kowalczyk
Browse files

Change rendering of duplicate record field docs

See Haddock Trac #195. We now change this behaviour to only rendering
the documentation attached to the first instance of a duplicate field.

Perhaps we could improve this by rendering the first instance that has
documentation attached to it but for now, we'll stick with this.
parent daa0ae5b
No related branches found
No related tags found
5 merge requests!38Make --no-tmp-comp-dir the default,!37Adapt to latest xhtml version, various optimizations,!31Support HsToken in DataDecl and ClassDecl,!12Drop orphan instance when defined upstream.,!10Haddock interfaces produced from `.hi` files
...@@ -1218,6 +1218,29 @@ data R a b = ...@@ -1218,6 +1218,29 @@ data R a b =
Haddock - for example doc comments can appear before or after Haddock - for example doc comments can appear before or after
the comma in separated lists such as the list of record fields the comma in separated lists such as the list of record fields
above.</para> 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>
<section> <section>
......
<!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
>
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
}
...@@ -31,6 +31,7 @@ import Data.Ord ...@@ -31,6 +31,7 @@ import Data.Ord
import Control.Applicative import Control.Applicative
import Control.DeepSeq import Control.DeepSeq
import Control.Monad import Control.Monad
import Data.Function (on)
import qualified Data.Foldable as F import qualified Data.Foldable as F
import qualified Data.Traversable as T import qualified Data.Traversable as T
...@@ -255,7 +256,7 @@ mkMaps :: DynFlags ...@@ -255,7 +256,7 @@ mkMaps :: DynFlags
-> ErrMsgM Maps -> ErrMsgM Maps
mkMaps dflags gre instances decls = do mkMaps dflags gre instances decls = do
(a, b, c, d) <- unzip4 <$> mapM mappings decls (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 where
f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
f = M.fromListWith (<>) . concat f = M.fromListWith (<>) . concat
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment