From e0718f203f2448ba2029e70d14aed075860b7fac Mon Sep 17 00:00:00 2001
From: nand <git@nand.wakku.to>
Date: Tue, 4 Feb 2014 22:13:27 +0100
Subject: Add support for type/data families

This adds support for type/data families with their respective
instances, as well as closed type families and associated type/data
families.

Signed-off-by: Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
---
 CHANGES                                  |   2 +
 doc/haddock.xml                          |  12 +-
 html-test/ref/TypeFamilies.html          | 674 +++++++++++++++++++++++++++----
 html-test/ref/TypeFamilies2.html         | 113 ++++++
 html-test/ref/ocean.css                  |  19 +
 html-test/src/TypeFamilies.hs            |  76 +++-
 html-test/src/TypeFamilies2.hs           |  12 +
 resources/html/Ocean.std-theme/ocean.css |  13 +
 src/Haddock/Backends/LaTeX.hs            |  16 +-
 src/Haddock/Backends/Xhtml.hs            |   1 +
 src/Haddock/Backends/Xhtml/Decl.hs       |  42 +-
 src/Haddock/Backends/Xhtml/Layout.hs     |   5 +
 src/Haddock/Convert.hs                   |  34 +-
 src/Haddock/GhcUtils.hs                  |  11 +
 src/Haddock/Interface/AttachInstances.hs |  57 +--
 src/Haddock/Interface/Create.hs          | 122 +++---
 src/Haddock/Interface/Rename.hs          |   9 +-
 src/Haddock/Types.hs                     |  22 +-
 18 files changed, 1003 insertions(+), 237 deletions(-)
 create mode 100644 html-test/ref/TypeFamilies2.html
 create mode 100644 html-test/src/TypeFamilies2.hs

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,85 +41,577 @@ 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"
       ><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="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
-- 
cgit v1.2.3