aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml
diff options
context:
space:
mode:
authorJan Stolarek <jan.stolarek@p.lodz.pl>2014-12-19 08:16:30 +0100
committerMatthew Pickering <matthewtpickering@gmail.com>2015-12-14 15:17:00 +0000
commit37a1603cd81a117d107a8468f342a0f56af6f64e (patch)
tree5eb686f8bf11e080fb8cbcb9e7c26badee7b5f93 /haddock-api/src/Haddock/Backends/Xhtml
parentdf0988170814b5e5e0e9015eb28c249b08a2d6de (diff)
Follow changes from #6018
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs42
1 files changed, 37 insertions, 5 deletions
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)