From bc5756d062bbc5cad5d4fa60798435ed020c518e Mon Sep 17 00:00:00 2001
From: nand <git@nand.wakku.to>
Date: Tue, 11 Feb 2014 11:52:48 +0100
Subject: Improve display of poly-kinded type operators

This now displays them as (==) k a b c ... to mirror GHC's behavior,
instead of the old (k == a) b c ... which was just wrong.

Signed-off-by: Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
---
 CHANGES                            |   2 +
 html-test/ref/TypeFamilies.html    | 292 ++++++++++++++++++++++++++++---------
 html-test/src/TypeFamilies.hs      |  14 +-
 src/Haddock/Backends/LaTeX.hs      |  22 +--
 src/Haddock/Backends/Xhtml.hs      |   2 +-
 src/Haddock/Backends/Xhtml/Decl.hs |  30 ++--
 src/Haddock/Convert.hs             |  10 +-
 src/Haddock/Interface/Rename.hs    |   5 +-
 src/Haddock/Types.hs               |   6 +-
 9 files changed, 280 insertions(+), 103 deletions(-)

diff --git a/CHANGES b/CHANGES
index 63c3e687..f548d03a 100644
--- a/CHANGES
+++ b/CHANGES
@@ -29,6 +29,8 @@ Changes in version 2.14.0
 
  * Print type/data family instances
 
+ * Fix display of poly-kinded type operators
+
 Changes in version 2.13.2
 
  * Handle HsExplicitListTy in renamer (#213)
diff --git a/html-test/ref/TypeFamilies.html b/html-test/ref/TypeFamilies.html
index bfafc3d0..65845102 100644
--- a/html-test/ref/TypeFamilies.html
+++ b/html-test/ref/TypeFamilies.html
@@ -90,7 +90,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 	    >type family</span
 	    > <a href="#t:Foo"
 	    >Foo</a
-	    > a</li
+	    > a :: k</li
 	  ><li class="src short"
 	  ><span class="keyword"
 	    >data family</span
@@ -125,6 +125,18 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 	    > <a href="#t:Bar"
 	    >Bar</a
 	    > b</li
+	  ><li class="src short"
+	  ><span class="keyword"
+	    >type family</span
+	    > a <a href="#t:-60--62-"
+	    >&lt;&gt;</a
+	    > b :: k</li
+	  ><li class="src short"
+	  ><span class="keyword"
+	    >class</span
+	    > a <a href="#t:-62--60-"
+	    >&gt;&lt;</a
+	    > b</li
 	  ></ul
 	></div
       ><div id="interface"
@@ -186,7 +198,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		><td class="src"
 		  ><a href="TypeFamilies.html#t:Assoc"
 		    >Assoc</a
-		    > <a href="TypeFamilies.html#t:X"
+		    > * <a href="TypeFamilies.html#t:X"
 		    >X</a
 		    ></td
 		  ><td class="doc"
@@ -198,7 +210,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		><td class="src"
 		  ><a href="TypeFamilies.html#t:Test"
 		    >Test</a
-		    > <a href="TypeFamilies.html#t:X"
+		    > * <a href="TypeFamilies.html#t:X"
 		    >X</a
 		    ></td
 		  ><td class="doc"
@@ -208,30 +220,14 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		  ></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:-62--60-"
+		    >(&gt;&lt;)</a
 		    > <a href="TypeFamilies.html#t:X"
 		    >X</a
+		    > <a href="TypeFamilies.html#v:XX"
+		    >XX</a
+		    > <a href="TypeFamilies.html#v:XXX"
+		    >XXX</a
 		    ></td
 		  ><td class="doc empty"
 		  >&nbsp;</td
@@ -277,12 +273,42 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		    ></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"
 		    >type</span
 		    > <a href="TypeFamilies.html#t:Foo"
 		    >Foo</a
-		    > <a href="TypeFamilies.html#t:X"
+		    > * <a href="TypeFamilies.html#t:X"
 		    >X</a
 		    > = <a href="TypeFamilies.html#t:Y"
 		    >Y</a
@@ -292,6 +318,38 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		    >Doc for: type instance Foo X = Y</p
 		    ></td
 		  ></tr
+		><tr
+		><td class="src"
+		  ><span class="keyword"
+		    >type</span
+		    > <a href="TypeFamilies.html#t:-60--62-"
+		    >(&lt;&gt;)</a
+		    > * <a href="TypeFamilies.html#t:X"
+		    >X</a
+		    > a = <a href="TypeFamilies.html#t:X"
+		    >X</a
+		    ></td
+		  ><td class="doc empty"
+		  >&nbsp;</td
+		  ></tr
+		><tr
+		><td class="src"
+		  ><span class="keyword"
+		    >type</span
+		    > <a href="TypeFamilies.html#t:-60--62-"
+		    >(&lt;&gt;)</a
+		    > <a href="TypeFamilies.html#t:X"
+		    >X</a
+		    > <a href="TypeFamilies.html#v:XXX"
+		    >XXX</a
+		    > <a href="TypeFamilies.html#v:XX"
+		    >XX</a
+		    > = <a href="TypeFamilies.html#v:X"
+		    >X</a
+		    ></td
+		  ><td class="doc empty"
+		  >&nbsp;</td
+		  ></tr
 		></table
 	      ></div
 	    ></div
@@ -316,7 +374,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		><td class="src"
 		  ><a href="TypeFamilies.html#t:Assoc"
 		    >Assoc</a
-		    > <a href="TypeFamilies.html#t:Y"
+		    > * <a href="TypeFamilies.html#t:Y"
 		    >Y</a
 		    ></td
 		  ><td class="doc"
@@ -328,7 +386,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		><td class="src"
 		  ><a href="TypeFamilies.html#t:Test"
 		    >Test</a
-		    > <a href="TypeFamilies.html#t:Y"
+		    > * <a href="TypeFamilies.html#t:Y"
 		    >Y</a
 		    ></td
 		  ><td class="doc"
@@ -337,36 +395,6 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		    ></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
@@ -397,12 +425,42 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		    ></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"
 		    >type</span
 		    > <a href="TypeFamilies.html#t:Foo"
 		    >Foo</a
-		    > <a href="TypeFamilies.html#t:Y"
+		    > * <a href="TypeFamilies.html#t:Y"
 		    >Y</a
 		    > = <a href="TypeFamilies.html#t:X"
 		    >X</a
@@ -412,6 +470,18 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		    >Doc for: type instance Foo Y = X</p
 		    ></td
 		  ></tr
+		><tr
+		><td class="src"
+		  ><span class="keyword"
+		    >type</span
+		    > <a href="TypeFamilies.html#t:-60--62-"
+		    >(&lt;&gt;)</a
+		    > * <a href="TypeFamilies.html#t:Y"
+		    >Y</a
+		    > a = a</td
+		  ><td class="doc empty"
+		  >&nbsp;</td
+		  ></tr
 		></table
 	      ></div
 	    ></div
@@ -436,7 +506,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		><td class="src"
 		  ><a href="TypeFamilies.html#t:Test"
 		    >Test</a
-		    > <a href="TypeFamilies.html#t:Y"
+		    > * <a href="TypeFamilies.html#t:Y"
 		    >Y</a
 		    ></td
 		  ><td class="doc"
@@ -448,7 +518,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		><td class="src"
 		  ><a href="TypeFamilies.html#t:Test"
 		    >Test</a
-		    > <a href="TypeFamilies.html#t:X"
+		    > * <a href="TypeFamilies.html#t:X"
 		    >X</a
 		    ></td
 		  ><td class="doc"
@@ -466,7 +536,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 	    >type family</span
 	    > <a name="t:Foo" class="def"
 	    >Foo</a
-	    > a</p
+	    > a :: k</p
 	  ><div class="doc"
 	  ><p
 	    >Doc for: type family Foo a</p
@@ -482,7 +552,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		    >type</span
 		    > <a href="TypeFamilies.html#t:Foo"
 		    >Foo</a
-		    > <a href="TypeFamilies.html#t:Y"
+		    > * <a href="TypeFamilies.html#t:Y"
 		    >Y</a
 		    > = <a href="TypeFamilies.html#t:X"
 		    >X</a
@@ -498,7 +568,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		    >type</span
 		    > <a href="TypeFamilies.html#t:Foo"
 		    >Foo</a
-		    > <a href="TypeFamilies.html#t:X"
+		    > * <a href="TypeFamilies.html#t:X"
 		    >X</a
 		    > = <a href="TypeFamilies.html#t:Y"
 		    >Y</a
@@ -646,7 +716,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		><td class="src"
 		  ><a href="TypeFamilies.html#t:Assoc"
 		    >Assoc</a
-		    > <a href="TypeFamilies.html#t:Y"
+		    > * <a href="TypeFamilies.html#t:Y"
 		    >Y</a
 		    ></td
 		  ><td class="doc"
@@ -658,7 +728,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 		><td class="src"
 		  ><a href="TypeFamilies.html#t:Assoc"
 		    >Assoc</a
-		    > <a href="TypeFamilies.html#t:X"
+		    > * <a href="TypeFamilies.html#t:X"
 		    >X</a
 		    ></td
 		  ><td class="doc"
@@ -710,6 +780,96 @@ window.onload = function () {pageLoad();setSynopsis("mini_TypeFamilies.html");};
 	      ></table
 	    ></div
 	  ></div
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >type family</span
+	    > a <a name="t:-60--62-" class="def"
+	    >&lt;&gt;</a
+	    > b :: k</p
+	  ><div class="subs instances"
+	  ><p id="control.i:-60--62-" class="caption collapser" onclick="toggleSection('i:-60--62-')"
+	    >Instances</p
+	    ><div id="section.i:-60--62-" class="show"
+	    ><table
+	      ><tr
+		><td class="src"
+		  ><span class="keyword"
+		    >type</span
+		    > <a href="TypeFamilies.html#t:-60--62-"
+		    >(&lt;&gt;)</a
+		    > * <a href="TypeFamilies.html#t:Y"
+		    >Y</a
+		    > a = a</td
+		  ><td class="doc empty"
+		  >&nbsp;</td
+		  ></tr
+		><tr
+		><td class="src"
+		  ><span class="keyword"
+		    >type</span
+		    > <a href="TypeFamilies.html#t:-60--62-"
+		    >(&lt;&gt;)</a
+		    > * <a href="TypeFamilies.html#t:X"
+		    >X</a
+		    > a = <a href="TypeFamilies.html#t:X"
+		    >X</a
+		    ></td
+		  ><td class="doc empty"
+		  >&nbsp;</td
+		  ></tr
+		><tr
+		><td class="src"
+		  ><span class="keyword"
+		    >type</span
+		    > <a href="TypeFamilies.html#t:-60--62-"
+		    >(&lt;&gt;)</a
+		    > <a href="TypeFamilies.html#t:X"
+		    >X</a
+		    > <a href="TypeFamilies.html#v:XXX"
+		    >XXX</a
+		    > <a href="TypeFamilies.html#v:XX"
+		    >XX</a
+		    > = <a href="TypeFamilies.html#v:X"
+		    >X</a
+		    ></td
+		  ><td class="doc empty"
+		  >&nbsp;</td
+		  ></tr
+		></table
+	      ></div
+	    ></div
+	  ></div
+	><div class="top"
+	><p class="src"
+	  ><span class="keyword"
+	    >class</span
+	    > a <a name="t:-62--60-" class="def"
+	    >&gt;&lt;</a
+	    > b</p
+	  ><div class="subs instances"
+	  ><p id="control.i:-62--60-" class="caption collapser" onclick="toggleSection('i:-62--60-')"
+	    >Instances</p
+	    ><div id="section.i:-62--60-" class="show"
+	    ><table
+	      ><tr
+		><td class="src"
+		  ><a href="TypeFamilies.html#t:-62--60-"
+		    >(&gt;&lt;)</a
+		    > <a href="TypeFamilies.html#t:X"
+		    >X</a
+		    > <a href="TypeFamilies.html#v:XX"
+		    >XX</a
+		    > <a href="TypeFamilies.html#v:XXX"
+		    >XXX</a
+		    ></td
+		  ><td class="doc empty"
+		  >&nbsp;</td
+		  ></tr
+		></table
+	      ></div
+	    ></div
+	  ></div
 	></div
       ></div
     ><div id="footer"
diff --git a/html-test/src/TypeFamilies.hs b/html-test/src/TypeFamilies.hs
index 725e76a7..e7cc0458 100644
--- a/html-test/src/TypeFamilies.hs
+++ b/html-test/src/TypeFamilies.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances, PolyKinds, TypeOperators, DataKinds, MultiParamTypeClasses #-}
 
 -- | Doc for: module TypeFamilies
 module TypeFamilies where
@@ -21,7 +21,7 @@ instance Test X
 instance Test Y
 
 -- | Doc for: type family Foo a
-type family Foo a
+type family Foo a :: k
 
 -- | Doc for: type instance Foo X = Y
 type instance Foo X = Y
@@ -66,3 +66,13 @@ instance Assoc Y where
 type family Bar b where
   Bar X = X
   Bar y = Y
+
+type family (<>) (a :: k) (b :: k) :: k
+
+type instance X <> a = X
+type instance Y <> a = a
+
+type instance XXX <> XX = 'X
+
+class (><) (a :: k) (b :: k)
+instance XX >< XXX
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 2185340b..24e8b7c8 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -560,10 +560,10 @@ ppInstDecl unicode instHead = keyword "instance" <+> ppInstHead unicode instHead
 
 
 ppInstHead :: Bool -> InstHead DocName -> LaTeX
-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) =
+ppInstHead unicode (n, ks, ts, ClassInst ctx) = ppContextNoLocs ctx unicode <+> ppAppNameTypes n ks ts unicode
+ppInstHead unicode (n, ks, ts, TypeInst rhs) = keyword "type"
+  <+> ppAppNameTypes n ks ts unicode <+> equals <+> ppType unicode rhs
+ppInstHead _unicode (_n, _ks, _ts, DataInst _dd) =
   error "data instances not supported by --latex yet"
 
 lookupAnySubdoc :: (Eq name1) =>
@@ -749,27 +749,27 @@ ppDataHeader _ _ = error "ppDataHeader: illegal argument"
 --------------------------------------------------------------------------------
 
 
--- | Print an application of a DocName and a list of HsTypes
-ppAppNameTypes :: DocName -> [HsType DocName] -> Bool -> LaTeX
-ppAppNameTypes n ts unicode = ppTypeApp n ts ppDocName (ppParendType unicode)
+-- | Print an application of a DocName and two lists of HsTypes (kinds, types)
+ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -> Bool -> LaTeX
+ppAppNameTypes n ks ts unicode = ppTypeApp n ks ts ppDocName (ppParendType unicode)
 
 
 -- | Print an application of a DocName and a list of Names
 ppAppDocNameNames :: Bool -> DocName -> [Name] -> LaTeX
 ppAppDocNameNames _summ n ns =
-  ppTypeApp n ns (ppBinder . nameOccName . getName) ppSymName
+  ppTypeApp n [] ns (ppBinder . nameOccName . getName) ppSymName
 
 
 -- | General printing of type applications
-ppTypeApp :: DocName -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX
-ppTypeApp n (t1:t2:rest) ppDN ppT
+ppTypeApp :: DocName -> [a] -> [a] -> (DocName -> LaTeX) -> (a -> LaTeX) -> LaTeX
+ppTypeApp n [] (t1:t2:rest) ppDN ppT
   | operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)
   | operator                    = opApp
   where
     operator = isNameSym . getName $ n
     opApp = ppT t1 <+> ppDN n <+> ppT t2
 
-ppTypeApp n ts ppDN ppT = ppDN n <+> hsep (map ppT ts)
+ppTypeApp n ks ts ppDN ppT = ppDN n <+> hsep (map ppT $ ks ++ ts)
 
 
 -------------------------------------------------------------------------------
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 53b106a2..77ff35b2 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -605,7 +605,7 @@ ppTyClBinderWithVarsMini :: Module -> TyClDecl DocName -> Html
 ppTyClBinderWithVarsMini mdl decl =
   let n = tcdName decl
       ns = tyvarNames $ tcdTyVars decl -- it's safe to use tcdTyVars, see code above
-  in ppTypeApp n ns (\is_infix -> ppNameMini is_infix mdl . nameOccName . getName) ppTyName
+  in ppTypeApp n [] ns (\is_infix -> ppNameMini is_infix mdl . nameOccName . getName) ppTyName
 
 
 ppModuleContents :: Qualification -> [ExportItem DocName] -> Html
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 9180c3c3..85eee248 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -235,7 +235,7 @@ ppTyFam summary associated links instances loc doc decl unicode qual
     -- 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
+      = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual
           <+> equals <+> ppType unicode qual (unLoc rhs)
         , Nothing, [] )
 
@@ -270,31 +270,31 @@ ppDataBinderWithVars summ decl =
 --------------------------------------------------------------------------------
 
 
--- | Print an application of a DocName and a list of HsTypes
-ppAppNameTypes :: DocName -> [HsType DocName] -> Bool -> Qualification -> Html
-ppAppNameTypes n ts unicode qual =
-    ppTypeApp n ts (ppDocName qual . Just) (ppParendType unicode qual)
+-- | Print an application of a DocName and two lists of HsTypes (kinds, types)
+ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -> Bool -> Qualification -> Html
+ppAppNameTypes n ks ts unicode qual =
+    ppTypeApp n ks ts (ppDocName qual . Just) (ppParendType unicode qual)
 
 
 -- | Print an application of a DocName and a list of Names
 ppAppDocNameNames :: Bool -> DocName -> [Name] -> Html
 ppAppDocNameNames summ n ns =
-    ppTypeApp n ns ppDN ppTyName
+    ppTypeApp n [] ns ppDN ppTyName
   where
     ppDN is_infix = ppBinderFixity is_infix summ . nameOccName . getName
     ppBinderFixity True = ppBinderInfix
     ppBinderFixity False = ppBinder
 
 -- | General printing of type applications
-ppTypeApp :: DocName -> [a] -> (Bool -> DocName -> Html) -> (a -> Html) -> Html
-ppTypeApp n (t1:t2:rest) ppDN ppT
+ppTypeApp :: DocName -> [a] -> [a] -> (Bool -> DocName -> Html) -> (a -> Html) -> Html
+ppTypeApp n [] (t1:t2:rest) ppDN ppT
   | operator, not . null $ rest = parens opApp <+> hsep (map ppT rest)
   | operator                    = opApp
   where
     operator = isNameSym . getName $ n
     opApp = ppT t1 <+> ppDN True n <+> ppT t2
 
-ppTypeApp n ts ppDN ppT = ppDN False n <+> hsep (map ppT ts)
+ppTypeApp n ks ts ppDN ppT = ppDN False n <+> hsep (map ppT $ ks ++ ts)
 
 
 -------------------------------------------------------------------------------
@@ -426,13 +426,13 @@ ppInstances instances baseName unicode qual
     instName = getOccString $ getName baseName
     instDecl :: DocInstance DocName -> SubDecl
     instDecl (inst, maybeDoc) = (instHead inst, maybeDoc, [])
-    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
+    instHead (n, ks, ts, ClassInst cs) = ppContextNoLocs cs unicode qual
+        <+> ppAppNameTypes n ks ts unicode qual
+    instHead (n, ks, ts, TypeInst rhs) = keyword "type"
+        <+> ppAppNameTypes n ks ts unicode qual
         <+> equals <+> ppType unicode qual rhs
-    instHead (n, ts, DataInst dd) = keyword "data"
-        <+> ppAppNameTypes n ts unicode qual
+    instHead (n, ks, ts, DataInst dd) = keyword "data"
+        <+> ppAppNameTypes n ks ts unicode qual
         <+> ppShortDataDecl False True dd unicode qual
 
 lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index d9bb0fcf..3670473d 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -21,7 +21,7 @@ import HsSyn
 import TcType ( tcSplitSigmaTy )
 import TypeRep
 import Type(isStrLitTy)
-import Kind ( splitKindFunTys, synTyConResKind )
+import Kind ( splitKindFunTys, synTyConResKind, isKind )
 import Name
 import Var
 import Class
@@ -371,18 +371,22 @@ synifyKindSig :: Kind -> LHsKind Name
 synifyKindSig k = synifyType WithinType k
 
 synifyInstHead :: ([TyVar], [PredType], Class, [Type]) -> InstHead Name
-synifyInstHead (_, preds, cls, ts) =
+synifyInstHead (_, preds, cls, types) =
   ( getName cls
+  , map (unLoc . synifyType WithinType) ks
   , map (unLoc . synifyType WithinType) ts
   , ClassInst $ map (unLoc . synifyType WithinType) preds
   )
+  where (ks,ts) = break (not . isKind) types
 
 -- 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
+  , map (unLoc . synifyType WithinType) ks
+  , map (unLoc . synifyType WithinType) ts
   , case fi_flavor fi of
       SynFamilyInst -> TypeInst . unLoc . synifyType WithinType $ fi_rhs fi
       DataFamilyInst c -> DataInst $ synifyTyCon (Just $ famInstAxiom fi) c
   )
+  where (ks,ts) = break (not . isKind) $ fi_tys fi
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index de23e9b5..59b11854 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -258,14 +258,15 @@ renameLContext (L loc context) = do
 
 
 renameInstHead :: InstHead Name -> RnM (InstHead DocName)
-renameInstHead (className, types, rest) = do
+renameInstHead (className, k, types, rest) = do
   className' <- rename className
+  k' <- mapM renameType k
   types' <- mapM renameType 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')
+  return (className', k', types', rest')
 
 
 renameLDecl :: LHsDecl Name -> RnM (LHsDecl DocName)
diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs
index 0e7f83af..a3d731af 100644
--- a/src/Haddock/Types.hs
+++ b/src/Haddock/Types.hs
@@ -290,9 +290,9 @@ instance OutputableBndr a => Outputable (InstType a) where
 -- | An instance head that may have documentation.
 type DocInstance name = (InstHead name, Maybe (Doc 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)
+-- | The head of an instance. Consists of a class name, a list of kind
+-- parameters, a list of type parameters and an instance type
+type InstHead name = (name, [HsType name], [HsType name], InstType name)
 
 -----------------------------------------------------------------------------
 -- * Documentation comments
-- 
cgit v1.2.3