From 43532d74c2c4374260b8176b88026de571d5a344 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Thu, 18 Feb 2016 00:00:07 +0100 Subject: Xhtml.Decl: Various cleanups --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index cb6b8cf2..5fca8f7d 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -171,6 +171,7 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge rightEdge = thespan ! [theclass "rightedge"] << noHtml +-- | Pretty-print type variables. ppTyVars :: [LHsTyVarBndr DocName] -> [Html] ppTyVars tvs = map (ppTyName . getName . hsLTyVarName) tvs @@ -208,7 +209,7 @@ ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars ppTySyn _ _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn" -ppTypeSig :: Bool -> [OccName] -> Html -> Bool -> Html +ppTypeSig :: Bool -> [OccName] -> Html -> Unicode -> Html ppTypeSig summary nms pp_ty unicode = concatHtml htmlNames <+> dcolon unicode <+> pp_ty where @@ -248,8 +249,8 @@ ppFamilyInfo _ (ClosedTypeFamily _) = keyword "type family" ppTyFamHeader :: Bool -> Bool -> FamilyDecl DocName -> Unicode -> Qualification -> Html ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info - , fdResultSig = L _ result - , fdInjectivityAnn = injectivity }) + , fdResultSig = L _ result + , fdInjectivityAnn = injectivity }) unicode qual = (case info of OpenTypeFamily @@ -360,14 +361,14 @@ ppDataBinderWithVars summ decl = -------------------------------------------------------------------------------- --- | Print an application of a DocName and two lists of HsTypes (kinds, types) +-- | Print an application of a 'DocName' and two lists of 'HsTypes' (kinds, types) ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -> Unicode -> Qualification -> Html ppAppNameTypes n ks ts unicode qual = ppTypeApp n ks ts (\p -> ppDocName qual p True) (ppParendType unicode qual) --- | Print an application of a DocName and a list of Names +-- | 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 -- cgit v1.2.3 From fdd07f36c26b7f8452c3e15aca312b32821f1ea5 Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Thu, 18 Feb 2016 00:00:24 +0100 Subject: Xhtml.Decl: Show kind signatures for type family variables Addresses GHC #11588. --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 5fca8f7d..59b444a0 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -263,7 +263,7 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info -> keyword "type family" ) <+> - ppFamDeclBinderWithVars summary d <+> + ppFamDeclBinderWithVars summary unicode qual d <+> ppResultSig result unicode qual <+> (case injectivity of @@ -347,9 +347,9 @@ ppAssocType summ links doc (L loc decl) fixities splice unicode qual = -------------------------------------------------------------------------------- -- | Print a type family and its variables -ppFamDeclBinderWithVars :: Bool -> FamilyDecl DocName -> Html -ppFamDeclBinderWithVars summ (FamilyDecl { fdLName = lname, fdTyVars = tvs }) = - ppAppDocNameNames summ (unLoc lname) (tyvarNames tvs) +ppFamDeclBinderWithVars :: Bool -> Unicode -> Qualification -> FamilyDecl DocName -> Html +ppFamDeclBinderWithVars summ unicode qual (FamilyDecl { fdLName = lname, fdTyVars = tvs }) = + ppAppDocNameTyVarBndrs summ unicode qual (unLoc lname) (map unLoc $ hsq_explicit tvs) -- | Print a newtype / data binder and its variables ppDataBinderWithVars :: Bool -> TyClDecl DocName -> Html @@ -360,6 +360,13 @@ ppDataBinderWithVars summ decl = -- * Type applications -------------------------------------------------------------------------------- +ppAppDocNameTyVarBndrs :: Bool -> Unicode -> Qualification -> DocName -> [HsTyVarBndr DocName] -> Html +ppAppDocNameTyVarBndrs summ unicode qual n vs = + ppTypeApp n [] vs ppDN (ppHsTyVarBndr unicode qual) + where + ppDN notation = ppBinderFixity notation summ . nameOccName . getName + ppBinderFixity Infix = ppBinderInfix + ppBinderFixity _ = ppBinder -- | Print an application of a 'DocName' and two lists of 'HsTypes' (kinds, types) ppAppNameTypes :: DocName -> [HsType DocName] -> [HsType DocName] -- cgit v1.2.3 From 7ac0237e68045b8735a0c0452656390fc0a2cdcb Mon Sep 17 00:00:00 2001 From: Ben Gamari Date: Thu, 18 Feb 2016 00:01:25 +0100 Subject: Xhtml.Decl: Show 'where ...' after closed type family Seems like we should ideally show the actual equations as well but that seems like it would be a fair amount of work --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 59b444a0..2f802aef 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -269,6 +269,11 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info (case injectivity of Nothing -> noHtml Just (L _ injectivityAnn) -> ppInjectivityAnn unicode qual injectivityAnn + ) <+> + + (case info of + ClosedTypeFamily _ -> keyword "where ..." + _ -> mempty ) ppResultSig :: FamilyResultSig DocName -> Unicode -> Qualification -> Html -- cgit v1.2.3