aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--CHANGES2
-rw-r--r--doc/haddock.xml12
-rw-r--r--html-test/ref/TypeFamilies.html674
-rw-r--r--html-test/ref/TypeFamilies2.html113
-rw-r--r--html-test/ref/ocean.css19
-rw-r--r--html-test/src/TypeFamilies.hs76
-rw-r--r--html-test/src/TypeFamilies2.hs12
-rw-r--r--resources/html/Ocean.std-theme/ocean.css13
-rw-r--r--src/Haddock/Backends/LaTeX.hs16
-rw-r--r--src/Haddock/Backends/Xhtml.hs1
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs42
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs5
-rw-r--r--src/Haddock/Convert.hs34
-rw-r--r--src/Haddock/GhcUtils.hs11
-rw-r--r--src/Haddock/Interface/AttachInstances.hs57
-rw-r--r--src/Haddock/Interface/Create.hs122
-rw-r--r--src/Haddock/Interface/Rename.hs9
-rw-r--r--src/Haddock/Types.hs22
18 files changed, 1003 insertions, 237 deletions
diff --git a/CHANGES b/CHANGES
index 8793c588..63c3e687 100644
--- a/CHANGES
+++ b/CHANGES
@@ -27,6 +27,8 @@ Changes in version 2.14.0
* Properly render License field (#271)
+ * Print type/data family instances
+
Changes in version 2.13.2
* Handle HsExplicitListTy in renamer (#213)
diff --git a/doc/haddock.xml b/doc/haddock.xml
index 7c1ca91c..8eb9ede7 100644
--- a/doc/haddock.xml
+++ b/doc/haddock.xml
@@ -1093,11 +1093,19 @@ square x = x * x
<para>A <literal>newtype</literal> declaration,</para>
</listitem>
<listitem>
- <para>A <literal>type</literal> declaration, or</para>
+ <para>A <literal>type</literal> declaration</para>
</listitem>
<listitem>
- <para>A <literal>class</literal> declaration.</para>
+ <para>A <literal>class</literal> declaration,</para>
</listitem>
+ <listitem>
+ <para>A <literal>data family</literal> or
+ <literal>type family</literal> declaration, or</para>
+ </listitem>
+ <listitem>
+ <para>A <literal>data instance</literal> or
+ <literal>type instance</literal> declaration.</para>
+ </listitem>
</itemizedlist>
<para>If the annotation is followed by a different kind of
diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html
index 27a4564c..bfafc3d0 100644
--- a/html-test/ref/TypeFamilies.html
+++ b/html-test/ref/TypeFamilies.html
@@ -17,11 +17,11 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><div id="package-header"
><ul class="links" id="page-menu"
><li
- ><a href=""
+ ><a href="index.html"
>Contents</a
></li
><li
- ><a href=""
+ ><a href="doc-index.html"
>Index</a
></li
></ul
@@ -41,56 +41,90 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><p class="caption"
>TypeFamilies</p
></div
+ ><div id="description"
+ ><p class="caption"
+ >Description</p
+ ><div class="doc"
+ ><p
+ >Doc for: module TypeFamilies</p
+ ></div
+ ></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="#t:X"
+ >X</a
+ ><ul class="subs"
+ ><li
+ >= <a href="#v:X"
+ >X</a
+ ></li
+ ><li
+ >| <a href="#v:XX"
+ >XX</a
+ ></li
+ ><li
+ >| <a href="#v:XXX"
+ >XXX</a
+ ></li
+ ></ul
+ ></li
+ ><li class="src short"
+ ><span class="keyword"
+ >data</span
+ > <a href="#t:Y"
+ >Y</a
+ ></li
+ ><li class="src short"
+ ><span class="keyword"
+ >class</span
+ > <a href="#t:Test"
+ >Test</a
+ > a</li
+ ><li class="src short"
+ ><span class="keyword"
>type family</span
- > <a href=""
- >G</a
+ > <a href="#t:Foo"
+ >Foo</a
+ > a</li
+ ><li class="src short"
+ ><span class="keyword"
+ >data family</span
+ > <a href="#t:Bat"
+ >Bat</a
> a :: *</li
><li class="src short"
><span class="keyword"
>class</span
- > <a href=""
- >A</a
+ > <a href="#t:Assoc"
+ >Assoc</a
> a <span class="keyword"
>where</span
><ul class="subs"
><li
><span class="keyword"
>data</span
- > <a href=""
- >B</a
- > a :: * -&gt; *</li
+ > <a href="#t:AssocD"
+ >AssocD</a
+ > a :: *</li
><li
- ><a href=""
- >f</a
- > :: <a href=""
- >B</a
- > a <a href=""
- >Int</a
- ></li
+ ><span class="keyword"
+ >type</span
+ > <a href="#t:AssocT"
+ >AssocT</a
+ > a :: *</li
></ul
></li
><li class="src short"
><span class="keyword"
>type family</span
- > <a href=""
- >F</a
- > a</li
- ><li class="src short"
- ><a href=""
- >g</a
- > :: <a href=""
- >B</a
- > <a href=""
- >Int</a
- > <a href=""
- >Integer</a
- ></li
+ > <a href="#t:Bar"
+ >Bar</a
+ > b</li
></ul
></div
><div id="interface"
@@ -99,27 +133,485 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><div class="top"
><p class="src"
><span class="keyword"
+ >data</span
+ > <a name="t:X" class="def"
+ >X</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Doc for: data X</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: X</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a name="v:XX" class="def"
+ >XX</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: XX</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a name="v:XXX" class="def"
+ >XXX</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: XXX</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ><div class="subs instances"
+ ><p id="control.i:X" class="caption collapser" onclick="toggleSection('i:X')"
+ >Instances</p
+ ><div id="section.i:X" class="show"
+ ><table
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Assoc"
+ >Assoc</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: instance Assoc X</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Test"
+ >Test</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: instance Test X</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="TypeFamilies.html#t:AssocD"
+ >AssocD</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ > = <a name="v:AssocX" class="def"
+ >AssocX</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:AssocT"
+ >AssocT</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ > = <a href="TypeFamilies.html#t:Foo"
+ >Foo</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="TypeFamilies.html#t:Bat"
+ >Bat</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ > <ul class="subs"
+ ><li
+ >= <a name="v:BatX" class="def"
+ >BatX</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></li
+ ><li
+ >| <a name="v:BatXX" class="def"
+ >BatXX</a
+ > { <ul class="subs"
+ ><li
+ ><a name="v:aaa" class="def"
+ >aaa</a
+ > :: <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></li
+ ><li
+ ><a name="v:bbb" class="def"
+ >bbb</a
+ > :: <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></li
+ ></ul
+ > }</li
+ ></ul
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: data instance Bat X</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:Foo"
+ >Foo</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ > = <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: type instance Foo X = Y</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >data</span
+ > <a name="t:Y" class="def"
+ >Y</a
+ ></p
+ ><div class="doc"
+ ><p
+ >Doc for: data Y</p
+ ></div
+ ><div class="subs instances"
+ ><p id="control.i:Y" class="caption collapser" onclick="toggleSection('i:Y')"
+ >Instances</p
+ ><div id="section.i:Y" class="show"
+ ><table
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Assoc"
+ >Assoc</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: instance Assoc Y</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Test"
+ >Test</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: instance Test Y</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="TypeFamilies.html#t:AssocD"
+ >AssocD</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ > = <a name="v:AssocY" class="def"
+ >AssocY</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:AssocT"
+ >AssocT</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ > = <a href="TypeFamilies.html#t:Bat"
+ >Bat</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="TypeFamilies.html#t:Bat"
+ >Bat</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ > <ul class="subs"
+ ><li
+ >= <a name="v:BatY" class="def"
+ >BatY</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></li
+ ><li
+ >| <a href="TypeFamilies.html#t:X"
+ >X</a
+ > <a name="v::-43-" class="def"
+ >:+</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></li
+ ></ul
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: data instance Bat Y</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:Foo"
+ >Foo</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ > = <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: type instance Foo Y = X</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >class</span
+ > <a name="t:Test" class="def"
+ >Test</a
+ > a</p
+ ><div class="doc"
+ ><p
+ >Doc for: class Test a</p
+ ></div
+ ><div class="subs instances"
+ ><p id="control.i:Test" class="caption collapser" onclick="toggleSection('i:Test')"
+ >Instances</p
+ ><div id="section.i:Test" class="show"
+ ><table
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Test"
+ >Test</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: instance Test Y</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Test"
+ >Test</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: instance Test X</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
>type family</span
- > <a name="t:G" class="def"
- >G</a
+ > <a name="t:Foo" class="def"
+ >Foo</a
+ > a</p
+ ><div class="doc"
+ ><p
+ >Doc for: type family Foo a</p
+ ></div
+ ><div class="subs instances"
+ ><p id="control.i:Foo" class="caption collapser" onclick="toggleSection('i:Foo')"
+ >Instances</p
+ ><div id="section.i:Foo" class="show"
+ ><table
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:Foo"
+ >Foo</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ > = <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: type instance Foo Y = X</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:Foo"
+ >Foo</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ > = <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: type instance Foo X = Y</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >data family</span
+ > <a name="t:Bat" class="def"
+ >Bat</a
> a :: *</p
><div class="doc"
><p
- >Type family G</p
+ >Doc for: data family Bat a</p
+ ></div
+ ><div class="subs instances"
+ ><p id="control.i:Bat" class="caption collapser" onclick="toggleSection('i:Bat')"
+ >Instances</p
+ ><div id="section.i:Bat" class="show"
+ ><table
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="TypeFamilies.html#t:Bat"
+ >Bat</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ > <ul class="subs"
+ ><li
+ >= <a name="v:BatY" class="def"
+ >BatY</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></li
+ ><li
+ >| <a href="TypeFamilies.html#t:X"
+ >X</a
+ > <a name="v::-43-" class="def"
+ >:+</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></li
+ ></ul
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: data instance Bat Y</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >data</span
+ > <a href="TypeFamilies.html#t:Bat"
+ >Bat</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ > <ul class="subs"
+ ><li
+ >= <a name="v:BatX" class="def"
+ >BatX</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></li
+ ><li
+ >| <a name="v:BatXX" class="def"
+ >BatXX</a
+ > { <ul class="subs"
+ ><li
+ ><a name="v:aaa" class="def"
+ >aaa</a
+ > :: <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></li
+ ><li
+ ><a name="v:bbb" class="def"
+ >bbb</a
+ > :: <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></li
+ ></ul
+ > }</li
+ ></ul
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: data instance Bat X</p
+ ></td
+ ></tr
+ ></table
+ ></div
></div
></div
><div class="top"
><p class="src"
><span class="keyword"
>class</span
- > <a name="t:A" class="def"
- >A</a
- > a <span class="keyword"
- >where</span
- ></p
+ > <a name="t:Assoc" class="def"
+ >Assoc</a
+ > a</p
><div class="doc"
><p
- >A class with an associated type</p
+ >Doc for: class Assoc a</p
></div
><div class="subs associated-types"
><p class="caption"
@@ -127,44 +619,52 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><p class="src"
><span class="keyword"
>data</span
- > <a name="t:B" class="def"
- >B</a
- > a :: * -&gt; *</p
+ > <a name="t:AssocD" class="def"
+ >AssocD</a
+ > a :: *</p
><div class="doc"
><p
- >An associated type</p
+ >Doc for: data AssocD a</p
></div
- ></div
- ><div class="subs methods"
- ><p class="caption"
- >Methods</p
><p class="src"
- ><a name="v:f" class="def"
- >f</a
- > :: <a href=""
- >B</a
- > a <a href=""
- >Int</a
- ></p
+ ><span class="keyword"
+ >type</span
+ > <a name="t:AssocT" class="def"
+ >AssocT</a
+ > a :: *</p
><div class="doc"
><p
- >A method</p
+ >Doc for: type AssocT a</p
></div
></div
><div class="subs instances"
- ><p id="control.i:A" class="caption collapser" onclick="toggleSection('i:A')"
+ ><p id="control.i:Assoc" class="caption collapser" onclick="toggleSection('i:Assoc')"
>Instances</p
- ><div id="section.i:A" class="show"
+ ><div id="section.i:Assoc" class="show"
><table
><tr
><td class="src"
- ><a href=""
- >A</a
- > <a href=""
- >Int</a
+ ><a href="TypeFamilies.html#t:Assoc"
+ >Assoc</a
+ > <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: instance Assoc Y</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Assoc"
+ >Assoc</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc"
+ ><p
+ >Doc for: instance Assoc X</p
></td
- ><td class="doc empty"
- >&nbsp;</td
></tr
></table
></div
@@ -174,31 +674,47 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
><p class="src"
><span class="keyword"
>type family</span
- > <a name="t:F" class="def"
- >F</a
- > a</p
+ > <a name="t:Bar" class="def"
+ >Bar</a
+ > b</p
><div class="doc"
><p
- >Doc for family</p
+ >Doc for: type family Bar b</p
+ ></div
+ ><div class="subs equations"
+ ><p class="caption"
+ >Equations</p
+ ><table
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Bar"
+ >Bar</a
+ > <a href="TypeFamilies.html#t:X"
+ >X</a
+ > = <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><a href="TypeFamilies.html#t:Bar"
+ >Bar</a
+ > y = <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ ></td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ></table
></div
- ></div
- ><div class="top"
- ><p class="src"
- ><a name="v:g" class="def"
- >g</a
- > :: <a href=""
- >B</a
- > <a href=""
- >Int</a
- > <a href=""
- >Integer</a
- ></p
></div
></div
></div
><div id="footer"
><p
- >Produced by <a href=""
+ >Produced by <a href="http://www.haskell.org/haddock/"
>Haddock</a
> version 2.14.0</p
></div
diff --git a/html-test/ref/TypeFamilies2.html b/html-test/ref/TypeFamilies2.html
new file mode 100644
index 00000000..eaa0772f
--- /dev/null
+++ b/html-test/ref/TypeFamilies2.html
@@ -0,0 +1,113 @@
+<!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
+ >TypeFamilies2</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_TypeFamilies2.html");};
+//]]>
+</script
+ ></head
+ ><body
+ ><div id="package-header"
+ ><ul class="links" id="page-menu"
+ ><li
+ ><a href="index.html"
+ >Contents</a
+ ></li
+ ><li
+ ><a href="doc-index.html"
+ >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"
+ >TypeFamilies2</p
+ ></div
+ ><div id="interface"
+ ><h1
+ >Documentation</h1
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >data</span
+ > <a name="t:X" class="def"
+ >X</a
+ ></p
+ ><div class="subs instances"
+ ><p id="control.i:X" class="caption collapser" onclick="toggleSection('i:X')"
+ >Instances</p
+ ><div id="section.i:X" class="show"
+ ><table
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies2.html#t:Foo"
+ >Foo</a
+ > <a href="TypeFamilies2.html#t:X"
+ >X</a
+ > = Y</td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><span class="keyword"
+ >type family</span
+ > <a name="t:Foo" class="def"
+ >Foo</a
+ > a</p
+ ><div class="subs instances"
+ ><p id="control.i:Foo" class="caption collapser" onclick="toggleSection('i:Foo')"
+ >Instances</p
+ ><div id="section.i:Foo" class="show"
+ ><table
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies2.html#t:Foo"
+ >Foo</a
+ > <a href="TypeFamilies2.html#t:X"
+ >X</a
+ > = Y</td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ></div
+ ></div
+ ></div
+ ><div id="footer"
+ ><p
+ >Produced by <a href="http://www.haskell.org/haddock/"
+ >Haddock</a
+ > version 2.14.0</p
+ ></div
+ ></body
+ ></html
+>
diff --git a/html-test/ref/ocean.css b/html-test/ref/ocean.css
index 42238709..05597d79 100644
--- a/html-test/ref/ocean.css
+++ b/html-test/ref/ocean.css
@@ -420,6 +420,19 @@ div#style-menu-holder {
margin: 0;
}
+.subs ul {
+ height: 100%;
+ padding: 0.5em;
+ margin: 0;
+}
+
+.subs ul,
+.subs ul li.src {
+ list-style: none;
+ margin-left: 1em;
+}
+
+
.top p.src {
border-top: 1px solid #ccc;
}
@@ -457,6 +470,12 @@ div#style-menu-holder {
/* @group Auxillary Pages */
+
+.extension-list {
+ list-style-type: none;
+ margin-left: 0;
+}
+
#mini {
margin: 0 auto;
padding: 0 1em 1em;
diff --git a/html-test/src/TypeFamilies.hs b/html-test/src/TypeFamilies.hs
index 561f95fd..725e76a7 100644
--- a/html-test/src/TypeFamilies.hs
+++ b/html-test/src/TypeFamilies.hs
@@ -1,28 +1,68 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
+-- | Doc for: module TypeFamilies
module TypeFamilies where
--- | Type family G
-type family G a :: *
+-- | Doc for: data X
+data X
+ = X -- ^ Doc for: X
+ | XX -- ^ Doc for: XX
+ | XXX -- ^ Doc for: XXX
--- | A class with an associated type
-class A a where
- -- | An associated type
- data B a :: * -> *
- -- | A method
- f :: B a Int
+-- | Doc for: data Y
+data Y
--- | Doc for family
-type family F a
+-- | Doc for: class Test a
+class Test a
+-- | Doc for: instance Test X
+instance Test X
+-- | Doc for: instance Test Y
+instance Test Y
--- | Doc for G Int
-type instance G Int = Bool
-type instance G Float = Int
+-- | Doc for: type family Foo a
+type family Foo a
+-- | Doc for: type instance Foo X = Y
+type instance Foo X = Y
+-- | Doc for: type instance Foo Y = X
+type instance Foo Y = X
-instance A Int where
- data B Int x = Con x
- f = Con 3
+-- | Doc for: data family Bat a
+data family Bat a :: *
-g = Con 5
+-- | Doc for: data instance Bat X
+data instance Bat X
+ = BatX X -- ^ Doc for: BatX X
+ | BatXX { aaa :: X , bbb :: Y } -- ^ Doc for: BatXX { ... }
+
+-- | Doc for: data instance Bat Y
+data instance Bat Y
+ = BatY Y -- ^ Doc for: BatY Y
+ | X :+ X -- X :+ X
+
+-- | Doc for: class Assoc a
+class Assoc a where
+ -- | Doc for: data AssocD a
+ data AssocD a :: *
+ -- | Doc for: type AssocT a
+ type AssocT a :: *
+
+-- | Doc for: instance Assoc X
+instance Assoc X where
+ -- | Doc for: data AssocD X = AssocX
+ data AssocD X = AssocX -- ^ Doc for: AssocX
+ -- | Doc for: type AssocT X = Foo X
+ type AssocT X = Foo X
+
+-- | Doc for: instance Assoc Y
+instance Assoc Y where
+ -- | Doc for: data AssocD Y = AssocY
+ data AssocD Y = AssocY -- ^ Doc for: AssocY
+ -- | Doc for: type AssocT Y = Bat Y
+ type AssocT Y = Bat Y
+
+-- | Doc for: type family Bar b
+type family Bar b where
+ Bar X = X
+ Bar y = Y
diff --git a/html-test/src/TypeFamilies2.hs b/html-test/src/TypeFamilies2.hs
new file mode 100644
index 00000000..718e11dc
--- /dev/null
+++ b/html-test/src/TypeFamilies2.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TypeFamilies #-}
+-- This tests what happens if we have unexported types
+-- in type instances. The expected behaviour is
+-- that we get the instance, Y is not linked and
+-- Haddock shows a linking warning.
+module TypeFamilies2 (X, Foo) where
+
+data X
+data Y
+
+type family Foo a
+type instance Foo X = Y
diff --git a/resources/html/Ocean.std-theme/ocean.css b/resources/html/Ocean.std-theme/ocean.css
index b9ad560e..3d81c3ca 100644
--- a/resources/html/Ocean.std-theme/ocean.css
+++ b/resources/html/Ocean.std-theme/ocean.css
@@ -420,6 +420,19 @@ div#style-menu-holder {
margin: 0;
}
+.subs ul {
+ height: 100%;
+ padding: 0.5em;
+ margin: 0;
+}
+
+.subs ul,
+.subs ul li.src {
+ list-style: none;
+ margin-left: 1em;
+}
+
+
.top p.src {
border-top: 1px solid #ccc;
}
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 94adc558..2185340b 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -284,7 +284,7 @@ ppDecl :: LHsDecl DocName
ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs = case decl of
TyClD d@(FamDecl {}) -> ppTyFam False loc doc d unicode
TyClD d@(DataDecl {})
- -> ppDataDecl instances subdocs loc doc d unicode
+ -> ppDataDecl instances subdocs loc (Just doc) d unicode
TyClD d@(SynDecl {}) -> ppTySyn loc (doc, fnArgsDoc) d unicode
-- Family instances happen via FamInst now
-- TyClD d@(TySynonym {})
@@ -560,9 +560,11 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
ppInstHead :: Bool -> InstHead DocName -> LaTeX
-ppInstHead unicode ([], n, ts) = ppAppNameTypes n ts unicode
-ppInstHead unicode (ctxt, n, ts) = ppContextNoLocs ctxt unicode <+> ppAppNameTypes n ts unicode
-
+ppInstHead unicode (n, ts, ClassInst ctx) = ppContextNoLocs ctx unicode <+> ppAppNameTypes n ts unicode
+ppInstHead unicode (n, ts, TypeInst rhs) = keyword "type"
+ <+> ppAppNameTypes n ts unicode <+> equals <+> ppType unicode rhs
+ppInstHead _unicode (_n, _ts, DataInst _dd) =
+ error "data instances not supported by --latex yet"
lookupAnySubdoc :: (Eq name1) =>
name1 -> [(name1, DocForDecl name2)] -> DocForDecl name2
@@ -577,8 +579,8 @@ lookupAnySubdoc n subdocs = case lookup n subdocs of
ppDataDecl :: [DocInstance DocName] ->
- [(DocName, DocForDecl DocName)] ->
- SrcSpan -> Documentation DocName -> TyClDecl DocName -> Bool ->
+ [(DocName, DocForDecl DocName)] -> SrcSpan ->
+ Maybe (Documentation DocName) -> TyClDecl DocName -> Bool ->
LaTeX
ppDataDecl instances subdocs _loc doc dataDecl unicode
@@ -590,7 +592,7 @@ ppDataDecl instances subdocs _loc doc dataDecl unicode
cons = dd_cons (tcdDataDefn dataDecl)
resTy = (con_res . unLoc . head) cons
- body = catMaybes [constrBit, documentationToLaTeX doc]
+ body = catMaybes [constrBit, doc >>= documentationToLaTeX]
(whereBit, leaders)
| null cons = (empty,[])
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 3168c7b0..53b106a2 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -648,6 +648,7 @@ numberSectionHeadings = go 1
processExport :: Bool -> LinksInfo -> Bool -> Qualification
-> ExportItem DocName -> Maybe Html
+processExport _ _ _ _ (ExportDecl (L _ (InstD _)) _ _ _) = Nothing -- Hide empty instances
processExport summary _ _ qual (ExportGroup lev id0 doc)
= nothingIf summary $ groupHeading lev id0 << docToHtml qual doc
processExport summary links unicode qual (ExportDecl decl doc subdocs insts)
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index acde5a0f..9180c3c3 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -41,7 +41,7 @@ ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] ->
Bool -> Qualification -> Html
ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode qual = case decl of
- TyClD (FamDecl d) -> ppTyFam summ False links loc mbDoc d unicode qual
+ TyClD (FamDecl d) -> ppTyFam summ False links instances loc mbDoc d unicode qual
TyClD d@(DataDecl {}) -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual
TyClD d@(SynDecl {}) -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual
TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances loc mbDoc subdocs d unicode qual
@@ -212,9 +212,9 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
Nothing -> noHtml
)
-ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Documentation DocName ->
+ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan -> Documentation DocName ->
FamilyDecl DocName -> Bool -> Qualification -> Html
-ppTyFam summary associated links loc doc decl unicode qual
+ppTyFam summary associated links instances loc doc decl unicode qual
| summary = ppTyFamHeader True associated decl unicode qual
| otherwise = header_ +++ docSection qual doc +++ instancesBit
@@ -225,16 +225,19 @@ ppTyFam summary associated links loc doc decl unicode qual
header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode qual)
instancesBit
- | FamilyDecl { fdInfo = ClosedTypeFamily _eqns } <- decl
+ | FamilyDecl { fdInfo = ClosedTypeFamily eqns } <- decl
, not summary
- = noHtml -- TODO: print eqns
+ = subEquations qual $ map (ppTyFamEqn . unLoc) eqns
| otherwise
= ppInstances instances docname unicode qual
- -- TODO: get the instances
- instances = []
-
+ -- Individual equation of a closed type family
+ ppTyFamEqn TyFamInstEqn { tfie_tycon = n, tfie_rhs = rhs
+ , tfie_pats = HsWB { hswb_cts = ts }}
+ = ( ppAppNameTypes (unLoc n) (map unLoc ts) unicode qual
+ <+> equals <+> ppType unicode qual (unLoc rhs)
+ , Nothing, [] )
--------------------------------------------------------------------------------
-- * Associated Types
@@ -244,7 +247,7 @@ ppTyFam summary associated links loc doc decl unicode qual
ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName -> Bool
-> Qualification -> Html
ppAssocType summ links doc (L loc decl) unicode qual =
- ppTyFam summ True links loc (fst doc) decl unicode qual
+ ppTyFam summ True links [] loc (fst doc) decl unicode qual
--------------------------------------------------------------------------------
@@ -423,10 +426,14 @@ ppInstances instances baseName unicode qual
instName = getOccString $ getName baseName
instDecl :: DocInstance DocName -> SubDecl
instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
- instHead ([], n, ts) = ppAppNameTypes n ts unicode qual
- instHead (ctxt, n, ts) = ppContextNoLocs ctxt unicode qual
+ instHead (n, ts, ClassInst cs) = ppContextNoLocs cs unicode qual
<+> ppAppNameTypes n ts unicode qual
-
+ instHead (n, ts, TypeInst rhs) = keyword "type"
+ <+> ppAppNameTypes n ts unicode qual
+ <+> equals <+> ppType unicode qual rhs
+ instHead (n, ts, DataInst dd) = keyword "data"
+ <+> ppAppNameTypes n ts unicode qual
+ <+> ppShortDataDecl False True dd unicode qual
lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
@@ -438,9 +445,8 @@ lookupAnySubdoc n = fromMaybe noDocForDecl . lookup n
-- TODO: print contexts
-ppShortDataDecl :: Bool -> LinksInfo -> SrcSpan -> TyClDecl DocName -> Bool
- -> Qualification -> Html
-ppShortDataDecl summary _links _loc dataDecl unicode qual
+ppShortDataDecl :: Bool -> Bool -> TyClDecl DocName -> Bool -> Qualification -> Html
+ppShortDataDecl summary dataInst dataDecl unicode qual
| [] <- cons = dataHeader
@@ -455,7 +461,9 @@ ppShortDataDecl summary _links _loc dataDecl unicode qual
+++ shortSubDecls (map doGADTConstr cons)
where
- dataHeader = ppDataHeader summary dataDecl unicode qual
+ dataHeader
+ | dataInst = noHtml
+ | otherwise = ppDataHeader summary dataDecl unicode qual
doConstr c con = toHtml [c] <+> ppShortConstr summary (unLoc con) unicode qual
doGADTConstr con = ppShortConstr summary (unLoc con) unicode qual
@@ -469,7 +477,7 @@ ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] ->
Qualification -> Html
ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual
- | summary = ppShortDataDecl summary links loc dataDecl unicode qual
+ | summary = ppShortDataDecl summary False dataDecl unicode qual
| otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit
where
diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs
index 4584fd82..dbc043be 100644
--- a/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/src/Haddock/Backends/Xhtml/Layout.hs
@@ -29,6 +29,7 @@ module Haddock.Backends.Xhtml.Layout (
subArguments,
subAssociatedTypes,
subConstructors,
+ subEquations,
subFields,
subInstances,
subMethods,
@@ -165,6 +166,10 @@ subFields :: Qualification -> [SubDecl] -> Html
subFields qual = divSubDecls "fields" "Fields" . subDlist qual
+subEquations :: Qualification -> [SubDecl] -> Html
+subEquations qual = divSubDecls "equations" "Equations" . subTable qual
+
+
subInstances :: Qualification -> String -> [SubDecl] -> Html
subInstances qual nm = maybe noHtml wrap . instTable
where
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 66497783..d9bb0fcf 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -30,6 +30,7 @@ import CoAxiom
import ConLike
import DataCon
import PatSyn
+import FamInstEnv
import BasicTypes ( TupleSort(..) )
import TysPrim ( alphaTyVars )
import TysWiredIn ( listTyConName, eqTyCon )
@@ -38,6 +39,7 @@ import Bag ( emptyBag )
import Unique ( getUnique )
import SrcLoc ( Located, noLoc, unLoc )
import Data.List( partition )
+import Haddock.Types
-- the main function here! yay!
@@ -62,7 +64,7 @@ tyThingToLHsDecl t = noLoc $ case t of
extractFamilyDecl _ =
error "tyThingToLHsDecl: impossible associated tycon"
- atTyClDecls = [synifyTyCon at_tc | (at_tc, _) <- classATItems cl]
+ atTyClDecls = [synifyTyCon Nothing at_tc | (at_tc, _) <- classATItems cl]
atFamDecls = map extractFamilyDecl atTyClDecls in
TyClD $ ClassDecl
{ tcdCtxt = synifyCtx (classSCTheta cl)
@@ -80,7 +82,7 @@ tyThingToLHsDecl t = noLoc $ case t of
, tcdDocs = [] --we don't have any docs at this point
, tcdFVs = placeHolderNames }
| otherwise
- -> TyClD (synifyTyCon tc)
+ -> TyClD (synifyTyCon Nothing tc)
-- type-constructors (e.g. Maybe) are complicated, put the definition
-- later in the file (also it's used for class associated-types too.)
@@ -119,13 +121,13 @@ synifyAxiom ax@(CoAxiom { co_ax_tc = tc })
| Just ax' <- isClosedSynFamilyTyCon_maybe tc
, getUnique ax' == getUnique ax -- without the getUniques, type error
- = TyClD (synifyTyCon tc)
+ = TyClD (synifyTyCon (Just ax) tc)
| otherwise
= error "synifyAxiom: closed/open family confusion"
-synifyTyCon :: TyCon -> TyClDecl Name
-synifyTyCon tc
+synifyTyCon :: Maybe (CoAxiom br) -> TyCon -> TyClDecl Name
+synifyTyCon coax tc
| isFunTyCon tc || isPrimTyCon tc
= DataDecl { tcdLName = synifyName tc
, tcdTyVars = -- tyConTyVars doesn't work on fun/prim, but we can make them up:
@@ -181,7 +183,10 @@ synifyTyCon tc
let
alg_nd = if isNewTyCon tc then NewType else DataType
alg_ctx = synifyCtx (tyConStupidTheta tc)
- name = synifyName tc
+ name = case coax of
+ Just a -> synifyName a -- Data families are named according to their
+ -- CoAxioms, not their TyCons
+ _ -> synifyName tc
tyvars = synifyTyVars (tyConTyVars tc)
kindSig = Just (tyConKind tc)
-- The data constructors.
@@ -365,10 +370,19 @@ synifyTyLit (StrTyLit s) = HsStrTy s
synifyKindSig :: Kind -> LHsKind Name
synifyKindSig k = synifyType WithinType k
-synifyInstHead :: ([TyVar], [PredType], Class, [Type]) ->
- ([HsType Name], Name, [HsType Name])
+synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name
synifyInstHead (_, preds, cls, ts) =
- ( map (unLoc . synifyType WithinType) preds
- , getName cls
+ ( getName cls
, map (unLoc . synifyType WithinType) ts
+ , ClassInst $ map (unLoc . synifyType WithinType) preds
+ )
+
+-- Convert a family instance, this could be a type family or data family
+synifyFamInst :: FamInst -> InstHead Name
+synifyFamInst fi =
+ ( fi_fam fi
+ , map (unLoc . synifyType WithinType) $ fi_tys fi
+ , case fi_flavor fi of
+ SynFamilyInst -> TypeInst . unLoc . synifyType WithinType $ fi_rhs fi
+ DataFamilyInst c -> DataInst $ synifyTyCon (Just $ famInstAxiom fi) c
)
diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs
index a8a4f1c9..bf6436d1 100644
--- a/src/Haddock/GhcUtils.hs
+++ b/src/Haddock/GhcUtils.hs
@@ -91,6 +91,17 @@ getMainDeclBinder (ForD (ForeignImport name _ _ _)) = [unLoc name]
getMainDeclBinder (ForD (ForeignExport _ _ _ _)) = []
getMainDeclBinder _ = []
+-- Extract the source location where an instance is defined. This is used
+-- to correlate InstDecls with their Instance/CoAxiom Names, via the
+-- instanceMap.
+getInstLoc :: InstDecl name -> SrcSpan
+getInstLoc (ClsInstD (ClsInstDecl { cid_poly_ty = L l _ })) = l
+getInstLoc (DataFamInstD (DataFamInstDecl { dfid_tycon = L l _ })) = l
+getInstLoc (TyFamInstD (TyFamInstDecl
+ -- Since CoAxioms' Names refer to the whole line for type family instances
+ -- in particular, we need to dig a bit deeper to pull out the entire
+ -- equation. This does not happen for data family instances, for some reason.
+ { tfid_eqn = L _ (TyFamInstEqn { tfie_rhs = L l _ })})) = l
-- Useful when there is a signature with multiple names, e.g.
-- foo, bar :: Types..
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index 03d463cb..a56759a5 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -23,6 +23,7 @@ import qualified Data.Map as Map
import qualified Data.Set as Set
import Class
+import FamInstEnv
import FastString
import GHC
import GhcMonad (withSession)
@@ -64,16 +65,17 @@ attachToExportItem expInfo iface ifaceMap instIfaceMap export =
export {
expItemInstances =
case mb_info of
- Just (_, _, cls_instances, _fam_instances) ->
-{-
- let insts = map (first synifyInstHead) $ sortImage (first instHead)
- [ (instanceSig i, getName i) | i <- instances ]
--}
- let insts = map (first synifyInstHead) $ sortImage (first instHead) $
- filter (\((_,_,cls,tys),_) -> not $ isInstanceHidden expInfo cls tys)
- [ (instanceHead' i, getName i) | i <- cls_instances ]
- in [ (inst, lookupInstDoc name iface ifaceMap instIfaceMap)
- | (inst, name) <- insts ]
+ Just (_, _, cls_instances, fam_instances) ->
+ let fam_insts = [ (synifyFamInst i, n)
+ | i <- sortImage instFam fam_instances
+ , let n = lookupInstDoc (getName i) iface ifaceMap instIfaceMap
+ ]
+ cls_insts = [ (synifyInstHead i, lookupInstDoc n iface ifaceMap instIfaceMap)
+ | let is = [ (instanceHead' i, getName i) | i <- cls_instances ]
+ , (i@(_,_,cls,tys), n) <- sortImage (first instHead) is
+ , not $ isInstanceHidden expInfo cls tys
+ ]
+ in cls_insts ++ fam_insts
Nothing -> []
}
return export'
@@ -139,22 +141,27 @@ data SimpleType = SimpleType Name [SimpleType]
instHead :: ([TyVar], [PredType], Class, [Type]) -> ([Int], Name, [SimpleType])
instHead (_, _, cls, args)
= (map argCount args, className cls, map simplify args)
- where
- argCount (AppTy t _) = argCount t + 1
- argCount (TyConApp _ ts) = length ts
- argCount (FunTy _ _ ) = 2
- argCount (ForAllTy _ t) = argCount t
- argCount _ = 0
-
- simplify (ForAllTy _ t) = simplify t
- simplify (FunTy t1 t2) =
- SimpleType funTyConName [simplify t1, simplify t2]
- simplify (AppTy t1 t2) = SimpleType s (ts ++ [simplify t2])
- where (SimpleType s ts) = simplify t1
- simplify (TyVarTy v) = SimpleType (tyVarName v) []
- simplify (TyConApp tc ts) = SimpleType (tyConName tc) (map simplify ts)
- simplify (LitTy l) = SimpleTyLit l
+argCount :: Type -> Int
+argCount (AppTy t _) = argCount t + 1
+argCount (TyConApp _ ts) = length ts
+argCount (FunTy _ _ ) = 2
+argCount (ForAllTy _ t) = argCount t
+argCount _ = 0
+
+simplify :: Type -> SimpleType
+simplify (ForAllTy _ t) = simplify t
+simplify (FunTy t1 t2) = SimpleType funTyConName [simplify t1, simplify t2]
+simplify (AppTy t1 t2) = SimpleType s (ts ++ [simplify t2])
+ where (SimpleType s ts) = simplify t1
+simplify (TyVarTy v) = SimpleType (tyVarName v) []
+simplify (TyConApp tc ts) = SimpleType (tyConName tc) (map simplify ts)
+simplify (LitTy l) = SimpleTyLit l
+
+-- Used for sorting
+instFam :: FamInst -> ([Int], Name, [SimpleType], Int, SimpleType)
+instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t }
+ = (map argCount ts, n, map simplify ts, argCount t, simplify t)
-- sortImage f = sortBy (\x y -> compare (f x) (f y))
sortImage :: Ord b => (a -> b) -> [a] -> [a]
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index 6e85ad16..cf5a3451 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -58,9 +58,10 @@ createInterface tm flags modMap instIfaceMap = do
mdl = ms_mod ms
dflags = ms_hspp_opts ms
!instances = modInfoInstances mi
+ !fam_instances = md_fam_insts md
!exportedNames = modInfoExports mi
- (TcGblEnv {tcg_rdr_env = gre, tcg_warns = warnings}, _) = tm_internals_ tm
+ (TcGblEnv {tcg_rdr_env = gre, tcg_warns = warnings}, md) = tm_internals_ tm
-- The renamed source should always be available to us, but it's best
-- to be on the safe side.
@@ -80,9 +81,10 @@ createInterface tm flags modMap instIfaceMap = do
let declsWithDocs = topDecls group_
(decls, _) = unzip declsWithDocs
- localInsts = filter (nameIsLocalOrFrom mdl . getName) instances
+ localInsts = filter (nameIsLocalOrFrom mdl) $ map getName instances
+ ++ map getName fam_instances
- maps@(!docMap, !argMap, !subMap, !declMap) <-
+ maps@(!docMap, !argMap, !subMap, !declMap, _) <-
liftErrMsg $ mkMaps dflags gre localInsts declsWithDocs
let exports0 = fmap (reverse . map unLoc) mayExports
@@ -90,16 +92,14 @@ createInterface tm flags modMap instIfaceMap = do
| OptIgnoreExports `elem` opts = Nothing
| otherwise = exports0
- liftErrMsg $ warnAboutFilteredDecls dflags mdl decls
-
warningMap <- liftErrMsg $ mkWarningMap dflags warnings gre exportedNames
let allWarnings = M.unions (warningMap : map ifaceWarningMap (M.elems modMap))
exportItems <- mkExportItems modMap mdl allWarnings gre exportedNames decls maps exports
- instances instIfaceMap dflags
+ instIfaceMap dflags
- let !visibleNames = mkVisibleNames exportItems opts
+ let !visibleNames = mkVisibleNames maps exportItems opts
-- Measure haddock documentation coverage.
let prunedExportItems0 = pruneExportItems exportItems
@@ -138,6 +138,7 @@ createInterface tm flags modMap instIfaceMap = do
, ifaceSubMap = subMap
, ifaceModuleAliases = aliases
, ifaceInstances = instances
+ , ifaceFamInstances = fam_instances
, ifaceHaddockCoverage = coverage
, ifaceWarningMap = warningMap
}
@@ -242,33 +243,33 @@ parseOption other = tell ["Unrecognised option: " ++ other] >> return Nothing
--------------------------------------------------------------------------------
-type Maps = (DocMap Name, ArgMap Name, SubMap, DeclMap)
+type Maps = (DocMap Name, ArgMap Name, SubMap, DeclMap, InstMap)
-- | Create 'Maps' by looping through the declarations. For each declaration,
-- find its names, its subordinates, and its doc strings. Process doc strings
-- into 'Doc's.
mkMaps :: DynFlags
-> GlobalRdrEnv
- -> [ClsInst]
+ -> [Name]
-> [(LHsDecl Name, [HsDocString])]
-> 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)
+ return (f a, f b, f c, f d, instanceMap)
where
f :: (Ord a, Monoid b) => [[(a, b)]] -> Map a b
f = M.fromListWith (<>) . concat
mappings (ldecl, docStrs) = do
- let decl = unLoc ldecl
+ let L l decl = ldecl
let declDoc strs m = do
doc <- processDocStrings dflags gre strs
m' <- M.mapMaybe id <$> T.mapM (processDocStringParas dflags gre) m
return (doc, m')
(doc, args) <- declDoc docStrs (typeDocs decl)
- let subs = subordinates decl
+ let subs = subordinates instanceMap decl
(subDocs, subArgs) <- unzip <$> mapM (\(_, strs, m) -> declDoc strs m) subs
- let ns = names decl
+ let ns = names l decl
subNs = [ n | (n, _, _) <- subs ]
dm = [ (n, d) | (n, Just d) <- zip ns (repeat doc) ++ zip subNs subDocs ]
am = [ (n, args) | n <- ns ] ++ zip subNs subArgs
@@ -282,11 +283,14 @@ mkMaps dflags gre instances decls = do
return (dm, am, sm, cm)
instanceMap :: Map SrcSpan Name
- instanceMap = M.fromList [ (getSrcSpan n, n) | i <- instances, let n = getName i ]
+ instanceMap = M.fromList [ (getSrcSpan n, n) | n <- instances ]
- names :: HsDecl Name -> [Name]
- names (InstD (ClsInstD (ClsInstDecl { cid_poly_ty = L l _ }))) = maybeToList (M.lookup l instanceMap) -- See note [2].
- names decl = getMainDeclBinder decl
+ names :: SrcSpan -> HsDecl Name -> [Name]
+ names l (InstD d) = maybeToList (M.lookup loc instanceMap) -- See note [2].
+ where loc = case d of
+ TyFamInstD _ -> l -- The CoAx's loc is the whole line, but only for TFs
+ _ -> getInstLoc d
+ names _ decl = getMainDeclBinder decl
-- Note [2]:
------------
@@ -303,24 +307,29 @@ mkMaps dflags gre instances decls = do
-- | Get all subordinate declarations inside a declaration, and their docs.
-subordinates :: HsDecl Name -> [(Name, [HsDocString], Map Int HsDocString)]
-subordinates (TyClD decl)
- | isClassDecl decl = classSubs
- | isDataDecl decl = dataSubs
+subordinates :: InstMap -> HsDecl Name -> [(Name, [HsDocString], Map Int HsDocString)]
+subordinates instMap decl = case decl of
+ InstD (ClsInstD d) -> do
+ DataFamInstDecl { dfid_tycon = L l _
+ , dfid_defn = def } <- unLoc <$> cid_datafam_insts d
+ [ (n, [], M.empty) | Just n <- [M.lookup l instMap] ] ++ dataSubs def
+
+ InstD (DataFamInstD d) -> dataSubs (dfid_defn d)
+ TyClD d | isClassDecl d -> classSubs d
+ | isDataDecl d -> dataSubs (tcdDataDefn d)
+ _ -> []
where
- classSubs = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls decl
- , name <- getMainDeclBinder d, not (isValD d)
- ]
- dataSubs = constrs ++ fields
+ classSubs dd = [ (name, doc, typeDocs d) | (L _ d, doc) <- classDecls dd
+ , name <- getMainDeclBinder d, not (isValD d)
+ ]
+ dataSubs dd = constrs ++ fields
where
- cons = map unL $ (dd_cons (tcdDataDefn decl))
+ cons = map unL $ (dd_cons dd)
constrs = [ (unL $ con_name c, maybeToList $ fmap unL $ con_doc c, M.empty)
| c <- cons ]
fields = [ (unL n, maybeToList $ fmap unL doc, M.empty)
| RecCon flds <- map con_details cons
, ConDeclField n _ doc <- flds ]
-subordinates _ = []
-
-- | Extract function argument docs from inside types.
typeDocs :: HsDecl Name -> Map Int HsDocString
@@ -390,38 +399,6 @@ sortByLoc :: [Located a] -> [Located a]
sortByLoc = sortBy (comparing getLoc)
-warnAboutFilteredDecls :: DynFlags -> Module -> [LHsDecl Name] -> ErrMsgM ()
-warnAboutFilteredDecls dflags mdl decls = do
- let modStr = moduleString mdl
- let typeInstances =
- nub (concat [[ unLoc (tfie_tycon (unLoc eqn))
- | L _ (InstD (TyFamInstD (TyFamInstDecl { tfid_eqn = eqn }))) <- decls ],
- [ unLoc (dfid_tycon d)
- | L _ (InstD (DataFamInstD { dfid_inst = d })) <- decls ],
- [ unLoc tc
- | L _ (TyClD (FamDecl (FamilyDecl { fdInfo = ClosedTypeFamily _
- , fdLName = tc }))) <- decls ]])
-
- unless (null typeInstances) $
- tell [
- "Warning: " ++ modStr ++ ": Instances of type and data "
- ++ "families and equations of closed type families are not yet supported."
- ++ "Instances of the following families "
- ++ "will be filtered out:\n " ++ (intercalate ", "
- $ map (occNameString . nameOccName) typeInstances) ]
-
- let instances = nub [ pretty dflags i | L _ (InstD (ClsInstD (ClsInstDecl
- { cid_poly_ty = i
- , cid_tyfam_insts = ats
- , cid_datafam_insts = adts }))) <- decls
- , not (null ats) || not (null adts) ]
-
- unless (null instances) $
- tell [
- "Warning: " ++ modStr ++ ": We do not support associated types in instances yet. "
- ++ "These instances are affected:\n" ++ intercalate ", " instances ]
-
-
--------------------------------------------------------------------------------
-- Filtering of declarations
--
@@ -493,20 +470,16 @@ mkExportItems
-> [LHsDecl Name]
-> Maps
-> Maybe [IE Name]
- -> [ClsInst]
-> InstIfaceMap
-> DynFlags
-> ErrMsgGhc [ExportItem Name]
mkExportItems
- modMap thisMod warnings gre exportedNames decls0
- (maps@(docMap, argMap, subMap, declMap)) optExports _ instIfaceMap dflags =
+ modMap thisMod warnings gre exportedNames decls
+ (maps@(docMap, argMap, subMap, declMap, instMap)) optExports instIfaceMap dflags =
case optExports of
Nothing -> fullModuleContents dflags warnings gre maps decls
Just exports -> liftM concat $ mapM lookupExport exports
where
- decls = filter (not . isInstD . unLoc) decls0
-
-
lookupExport (IEVar x) = declWith x
lookupExport (IEThingAbs t) = declWith t
lookupExport (IEThingAll t) = declWith t
@@ -585,7 +558,7 @@ mkExportItems
Nothing -> do
liftErrMsg $ tell
["Warning: Couldn't find .haddock for export " ++ pretty dflags t]
- let subs_ = [ (n, noDocForDecl) | (n, _, _) <- subordinates (unLoc decl) ]
+ let subs_ = [ (n, noDocForDecl) | (n, _, _) <- subordinates instMap (unLoc decl) ]
return [ mkExportDecl t decl (noDocForDecl, subs_) ]
Just iface ->
return [ mkExportDecl t decl (lookupDocs t warnings (instDocMap iface) (instArgMap iface) (instSubMap iface)) ]
@@ -710,7 +683,7 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa
fullModuleContents :: DynFlags -> WarningMap -> GlobalRdrEnv -> Maps -> [LHsDecl Name] -> ErrMsgGhc [ExportItem Name]
-fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap) decls =
+fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap) decls =
liftM catMaybes $ mapM mkExportItem (expandSig decls)
where
-- A type signature can have multiple names, like:
@@ -739,6 +712,10 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap) decls =
let (doc, _) = lookupDocs name warnings docMap argMap subMap in
fmap Just (hiValExportItem dflags name doc)
| otherwise = return Nothing
+ mkExportItem decl@(L _ (InstD d))
+ | Just name <- M.lookup (getInstLoc d) instMap =
+ let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
+ return $ Just (ExportDecl decl doc subs [])
mkExportItem decl
| name:_ <- getMainDeclBinder (unLoc decl) =
let (doc, subs) = lookupDocs name warnings docMap argMap subMap in
@@ -809,14 +786,17 @@ pruneExportItems = filter hasDoc
hasDoc _ = True
-mkVisibleNames :: [ExportItem Name] -> [DocOption] -> [Name]
-mkVisibleNames exports opts
+mkVisibleNames :: Maps -> [ExportItem Name] -> [DocOption] -> [Name]
+mkVisibleNames (_, _, _, _, instMap) exports opts
| OptHide `elem` opts = []
| otherwise = let ns = concatMap exportName exports
in seqList ns `seq` ns
where
- exportName e@ExportDecl {} = getMainDeclBinder (unL $ expItemDecl e) ++ subs
+ exportName e@ExportDecl {} = name ++ subs
where subs = map fst (expItemSubDocs e)
+ name = case unLoc $ expItemDecl e of
+ InstD d -> maybeToList $ M.lookup (getInstLoc d) instMap
+ decl -> getMainDeclBinder decl
exportName ExportNoDecl {} = [] -- we don't count these as visible, since
-- we don't want links to go to them.
exportName _ = []
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index b4a7e19a..de23e9b5 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -258,11 +258,14 @@ renameLContext (L loc context) = do
renameInstHead :: InstHead Name -> RnM (InstHead DocName)
-renameInstHead (preds, className, types) = do
- preds' <- mapM renameType preds
+renameInstHead (className, types, rest) = do
className' <- rename className
types' <- mapM renameType types
- return (preds', className', types')
+ rest' <- case rest of
+ ClassInst cs -> ClassInst <$> mapM renameType cs
+ TypeInst ts -> TypeInst <$> renameType ts
+ DataInst dd -> DataInst <$> renameTyClD dd
+ return (className', types', rest')
renameLDecl :: LHsDecl Name -> RnM (LHsDecl DocName)
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 0a633ec0..0e7f83af 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -23,7 +23,7 @@ module Haddock.Types (
import Data.Foldable
import Data.Traversable
import Control.Exception
-import Control.Arrow
+import Control.Arrow hiding ((<+>))
import Control.DeepSeq
import Data.Typeable
import Data.Map (Map)
@@ -31,6 +31,7 @@ import qualified Data.Map as Map
import GHC hiding (NoLink)
import DynFlags (ExtensionFlag, Language)
import OccName
+import Outputable
import Control.Applicative (Applicative(..))
import Control.Monad (ap)
@@ -45,6 +46,7 @@ type DocMap a = Map Name (Doc a)
type ArgMap a = Map Name (Map Int (Doc a))
type SubMap = Map Name [Name]
type DeclMap = Map Name [LHsDecl Name]
+type InstMap = Map SrcSpan Name
type SrcMap = Map PackageId FilePath
type DocPaths = (FilePath, Maybe FilePath) -- paths to HTML and sources
@@ -112,6 +114,7 @@ data Interface = Interface
-- | Instances exported by the module.
, ifaceInstances :: ![ClsInst]
+ , ifaceFamInstances :: ![FamInst]
-- | The number of haddockable and haddocked items in the module, as a
-- tuple. Haddockable items are the exports and the module itself.
@@ -273,14 +276,23 @@ instance NamedThing DocName where
-- * Instances
-----------------------------------------------------------------------------
+-- | The three types of instances
+data InstType name
+ = ClassInst [HsType name] -- ^ Context
+ | TypeInst (HsType name) -- ^ Body (right-hand side)
+ | DataInst (TyClDecl name) -- ^ Data constructors
+
+instance OutputableBndr a => Outputable (InstType a) where
+ ppr (ClassInst a) = text "ClassInst" <+> ppr a
+ ppr (TypeInst a) = text "TypeInst" <+> ppr a
+ ppr (DataInst a) = text "DataInst" <+> ppr a
-- | An instance head that may have documentation.
type DocInstance name = (InstHead name, Maybe (Doc name))
-
--- | The head of an instance. Consists of a context, a class name and a list
--- of instance types.
-type InstHead name = ([HsType name], name, [HsType name])
+-- | The head of an instance. Consists of a class name, a list of parameters
+-- and an instance type
+type InstHead name = (name, [HsType name], InstType name)
-----------------------------------------------------------------------------
-- * Documentation comments
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 04:33:31 +0000