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-"
+ ><></a
+ > b :: k</li
+ ><li class="src short"
+ ><span class="keyword"
+ >class</span
+ > a <a href="#t:-62--60-"
+ >><</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"
- > </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-"
+ >(><)</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"
> </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"
+ > </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"
+ > </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-"
+ >(<>)</a
+ > * <a href="TypeFamilies.html#t:X"
+ >X</a
+ > a = <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc empty"
+ > </td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:-60--62-"
+ >(<>)</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"
+ > </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"
- > </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"
- > </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"
+ > </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"
+ > </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-"
+ >(<>)</a
+ > * <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ > a = a</td
+ ><td class="doc empty"
+ > </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"
+ ><></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-"
+ >(<>)</a
+ > * <a href="TypeFamilies.html#t:Y"
+ >Y</a
+ > a = a</td
+ ><td class="doc empty"
+ > </td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:-60--62-"
+ >(<>)</a
+ > * <a href="TypeFamilies.html#t:X"
+ >X</a
+ > a = <a href="TypeFamilies.html#t:X"
+ >X</a
+ ></td
+ ><td class="doc empty"
+ > </td
+ ></tr
+ ><tr
+ ><td class="src"
+ ><span class="keyword"
+ >type</span
+ > <a href="TypeFamilies.html#t:-60--62-"
+ >(<>)</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"
+ > </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"
+ >><</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-"
+ >(><)</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"
+ > </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