From 37a1603cd81a117d107a8468f342a0f56af6f64e Mon Sep 17 00:00:00 2001
From: Jan Stolarek <jan.stolarek@p.lodz.pl>
Date: Fri, 19 Dec 2014 08:16:30 +0100
Subject: Follow changes from #6018

---
 haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 42 +++++++++++++++++++++++---
 1 file changed, 37 insertions(+), 5 deletions(-)

(limited to 'haddock-api/src/Haddock/Backends/Xhtml/Decl.hs')

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 69393a37..bc16bdcd 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -257,12 +257,32 @@ ppFamilyKind _ _ Nothing = noHtml
 ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocName
               -> Unicode -> Qualification -> Html
 ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
-                                               , fdKindSig = mkind })
+                                             , fdResultSig = L _ result
+                                             , fdInjectivityAnn = injectivity })
               unicode qual =
-    ppFamilyInfo associated info <+>
-    ppFamDeclBinderWithVars summary d <+>
-    ppFamilyKind unicode qual mkind
-
+  (case info of
+     OpenTypeFamily
+       | associated -> keyword "type"
+       | otherwise  -> keyword "type family"
+     DataFamily
+       | associated -> keyword "data"
+       | otherwise  -> keyword "data family"
+     ClosedTypeFamily _
+                    -> keyword "type family"
+  ) <+>
+
+  ppFamDeclBinderWithVars summary d <+>
+
+  (case result of
+    NoSig               -> noHtml
+    KindSig kind        -> dcolon unicode  <+> ppLKind unicode qual kind
+    TyVarSig (L _ bndr) -> equals <+> ppHsTyVarBndr unicode qual bndr
+  ) <+>
+
+  (case injectivity of
+     Nothing                   -> noHtml
+     Just (L _ injectivityAnn) -> ppInjectivityAnn unicode qual injectivityAnn
+  )
 
 ppPseudoFamilyHeader :: Unicode -> Qualification -> PseudoFamilyDecl DocName
                      -> Html
@@ -271,6 +291,11 @@ ppPseudoFamilyHeader unicode qual (PseudoFamilyDecl { .. }) =
     ppAppNameTypes (unLoc pfdLName) [] (map unLoc pfdTyVars) unicode qual <+>
     ppFamilyKind unicode qual pfdKindSig
 
+ppInjectivityAnn :: Bool -> Qualification -> InjectivityAnn DocName -> Html
+ppInjectivityAnn unicode qual (InjectivityAnn lhs rhs) =
+    char '|' <+> ppLDocName qual Raw lhs <+> arrow unicode <+>
+    hsep (map (ppLDocName qual Raw) rhs)
+
 
 ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] ->
            [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
@@ -913,6 +938,13 @@ ppCtxType    unicode qual ty = ppr_mono_ty pREC_CTX ty unicode qual
 ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual
 ppFunLhType  unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual
 
+ppHsTyVarBndr :: Unicode -> Qualification -> HsTyVarBndr DocName -> Html
+ppHsTyVarBndr _       qual (UserTyVar   name     ) =
+    ppDocName qual Raw False name
+ppHsTyVarBndr unicode qual (KindedTyVar name kind) =
+    parens (ppDocName qual Raw False (unLoc name) <+> dcolon unicode <+>
+            ppLKind unicode qual kind)
+
 ppLKind :: Unicode -> Qualification -> LHsKind DocName -> Html
 ppLKind unicode qual y = ppKind unicode qual (unLoc y)
 
-- 
cgit v1.2.3