diff options
| author | Jan Stolarek <jan.stolarek@p.lodz.pl> | 2014-12-19 08:16:30 +0100 |
|---|---|---|
| committer | Matthew Pickering <matthewtpickering@gmail.com> | 2015-12-14 15:17:00 +0000 |
| commit | 37a1603cd81a117d107a8468f342a0f56af6f64e (patch) | |
| tree | 5eb686f8bf11e080fb8cbcb9e7c26badee7b5f93 /haddock-api/src/Haddock/Backends/Xhtml | |
| parent | df0988170814b5e5e0e9015eb28c249b08a2d6de (diff) | |
Follow changes from #6018
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 42 |
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) |