From bd134c7b2a6880bf3858fd8c27fa16ab946d7718 Mon Sep 17 00:00:00 2001
From: Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>
Date: Mon, 31 Mar 2014 05:34:36 +0100
Subject: Print kind signatures on GADTs

---
 src/Haddock/Backends/Xhtml/Decl.hs | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

(limited to 'src/Haddock')

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 2dc1e0e7..8884f69f 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -39,7 +39,6 @@ import GHC.Exts
 import Name
 import BooleanFormula
 
-
 ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
        -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]
        -> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html
@@ -312,7 +311,6 @@ ppDataBinderWithVars :: Bool -> TyClDecl DocName -> Html
 ppDataBinderWithVars summ decl =
   ppAppDocNameNames summ (tcdName decl) (tyvarNames $ tcdTyVars decl)
 
-
 --------------------------------------------------------------------------------
 -- * Type applications
 --------------------------------------------------------------------------------
@@ -726,17 +724,23 @@ ppShortField summary unicode qual (ConDeclField (L _ name) ltype _)
 -- | Print the LHS of a data\/newtype declaration.
 -- Currently doesn't handle 'data instance' decls or kind signatures
 ppDataHeader :: Bool -> TyClDecl DocName -> Unicode -> Qualification -> Html
-ppDataHeader summary decl@(DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd
-                                                               , dd_ctxt = ctxt } })
+ppDataHeader summary decl@(DataDecl { tcdDataDefn =
+                                         HsDataDefn { dd_ND = nd
+                                                    , dd_ctxt = ctxt
+                                                    , dd_kindSig = ks } })
              unicode qual
   = -- newtype or data
-    (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" }) <+>
+    (case nd of { NewType -> keyword "newtype"; DataType -> keyword "data" })
+    <+>
     -- context
     ppLContext ctxt unicode qual <+>
     -- T a b c ..., or a :+: b
     ppDataBinderWithVars summary decl
-ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument"
+    <+> case ks of
+      Nothing -> mempty
+      Just (L _ x) -> dcolon unicode <+> ppKind unicode qual x
 
+ppDataHeader _ _ _ _ = error "ppDataHeader: illegal argument"
 
 --------------------------------------------------------------------------------
 -- * Types and contexts
-- 
cgit v1.2.3