aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Hoogle.hs2
-rw-r--r--src/Haddock/Backends/LaTeX.hs11
-rw-r--r--src/Haddock/Backends/Xhtml.hs10
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs175
-rw-r--r--src/Haddock/Backends/Xhtml/Utils.hs17
5 files changed, 133 insertions, 82 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 1f098d6d..dbce787f 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -110,7 +110,7 @@ operator x = x
-- How to print each export
ppExport :: DynFlags -> ExportItem Name -> [String]
-ppExport dflags (ExportDecl decl dc subdocs _) = ppDocumentation dflags (fst dc) ++ f (unL decl)
+ppExport dflags (ExportDecl decl dc subdocs _ _) = ppDocumentation dflags (fst dc) ++ f (unL decl)
where
f (TyClD d@DataDecl{}) = ppData dflags d subdocs
f (TyClD d@SynDecl{}) = ppSynonym dflags d
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 24e8b7c8..e6108ab6 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -177,7 +177,7 @@ string_txt (LStr s1 _) s2 = unpackLitString s1 ++ s2
exportListItem :: ExportItem DocName -> LaTeX
-exportListItem (ExportDecl decl _doc subdocs _insts)
+exportListItem (ExportDecl decl _doc subdocs _insts _fixities)
= sep (punctuate comma . map ppDocBinder $ declNames decl) <>
case subdocs of
[] -> empty
@@ -212,7 +212,7 @@ processExports (e : es) =
isSimpleSig :: ExportItem DocName -> Maybe ([DocName], HsType DocName)
isSimpleSig (ExportDecl (L _ (SigD (TypeSig lnames (L _ t))))
- (Documentation Nothing Nothing, argDocs) _ _)
+ (Documentation Nothing Nothing, argDocs) _ _ _)
| Map.null argDocs = Just (map unLoc lnames, t)
isSimpleSig _ = Nothing
@@ -225,8 +225,8 @@ isExportModule _ = Nothing
processExport :: ExportItem DocName -> LaTeX
processExport (ExportGroup lev _id0 doc)
= ppDocGroup lev (docToLaTeX doc)
-processExport (ExportDecl decl doc subdocs insts)
- = ppDecl decl doc insts subdocs
+processExport (ExportDecl decl doc subdocs insts fixities)
+ = ppDecl decl doc insts subdocs fixities
processExport (ExportNoDecl y [])
= ppDocName y
processExport (ExportNoDecl y subs)
@@ -279,9 +279,10 @@ ppDecl :: LHsDecl DocName
-> DocForDecl DocName
-> [DocInstance DocName]
-> [(DocName, DocForDecl DocName)]
+ -> [(DocName, Fixity)]
-> LaTeX
-ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs = case decl of
+ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
TyClD d@(FamDecl {}) -> ppTyFam False loc doc d unicode
TyClD d@(DataDecl {})
-> ppDataDecl instances subdocs loc (Just doc) d unicode
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index bdd1afdc..4eda68f6 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -533,7 +533,7 @@ ifaceToHtml maybe_source_url maybe_wiki_url iface unicode qual
-- todo: if something has only sub-docs, or fn-args-docs, should
-- it be measured here and thus prevent omitting the synopsis?
- has_doc (ExportDecl _ (Documentation mDoc mWarning, _) _ _) = isJust mDoc || isJust mWarning
+ has_doc (ExportDecl _ (Documentation mDoc mWarning, _) _ _ _) = isJust mDoc || isJust mWarning
has_doc (ExportNoDecl _ _) = False
has_doc (ExportModule _) = False
has_doc _ = True
@@ -578,7 +578,7 @@ miniSynopsis mdl iface unicode qual =
processForMiniSynopsis :: Module -> Bool -> Qualification -> ExportItem DocName
-> [Html]
-processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts) =
+processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts _fixities) =
((divTopDecl <<).(declElem <<)) <$> case decl0 of
TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of
(FamDecl decl) -> [ppTyFamHeader True False decl unicode qual]
@@ -648,11 +648,11 @@ numberSectionHeadings = go 1
processExport :: Bool -> LinksInfo -> Bool -> Qualification
-> ExportItem DocName -> Maybe Html
-processExport _ _ _ _ (ExportDecl (L _ (InstD _)) _ _ _) = Nothing -- Hide empty instances
+processExport _ _ _ _ (ExportDecl (L _ (InstD _)) _ _ _ _) = Nothing -- Hide empty instances
processExport summary _ _ qual (ExportGroup lev id0 doc)
= nothingIf summary $ groupHeading lev id0 << docToHtml qual doc
-processExport summary links unicode qual (ExportDecl decl doc subdocs insts)
- = processDecl summary $ ppDecl summary links decl doc insts subdocs unicode qual
+processExport summary links unicode qual (ExportDecl decl doc subdocs insts fixities)
+ = processDecl summary $ ppDecl summary links decl doc insts fixities subdocs unicode qual
processExport summary _ _ qual (ExportNoDecl y [])
= processDeclOneLiner summary $ ppDocName qual Prefix True y
processExport summary _ _ qual (ExportNoDecl y subs)
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 9e72d4ad..20db5df1 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -37,50 +37,53 @@ import GHC
import Name
-ppDecl :: Bool -> LinksInfo -> LHsDecl DocName ->
- DocForDecl DocName -> [DocInstance DocName] -> [(DocName, DocForDecl DocName)] ->
- Bool -> Qualification -> Html
-ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances subdocs unicode qual = case decl of
- TyClD (FamDecl d) -> ppTyFam summ False links instances loc mbDoc d unicode qual
- TyClD d@(DataDecl {}) -> ppDataDecl summ links instances subdocs loc mbDoc d unicode qual
- TyClD d@(SynDecl {}) -> ppTySyn summ links loc (mbDoc, fnArgsDoc) d unicode qual
- TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances loc mbDoc subdocs d unicode qual
- SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty unicode qual
+ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
+ -> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]
+ -> [(DocName, DocForDecl DocName)] -> Bool -> Qualification -> Html
+ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs unicode qual = case decl of
+ TyClD (FamDecl d) -> ppTyFam summ False links instances fixities loc mbDoc d unicode qual
+ TyClD d@(DataDecl {}) -> ppDataDecl summ links instances fixities subdocs loc mbDoc d unicode qual
+ TyClD d@(SynDecl {}) -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d unicode qual
+ TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances fixities loc mbDoc subdocs d unicode qual
+ SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames lty fixities unicode qual
SigD (PatSynSig lname args ty prov req) ->
- ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname args ty prov req unicode qual
- ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d unicode qual
+ ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname args ty prov req fixities unicode qual
+ ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities unicode qual
InstD _ -> noHtml
_ -> error "declaration not supported by ppDecl"
ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
- [Located DocName] -> LHsType DocName -> Bool -> Qualification -> Html
-ppLFunSig summary links loc doc lnames lty unicode qual =
- ppFunSig summary links loc doc (map unLoc lnames) (unLoc lty) unicode qual
+ [Located DocName] -> LHsType DocName -> [(DocName, Fixity)] ->
+ Bool -> Qualification -> Html
+ppLFunSig summary links loc doc lnames lty fixities unicode qual =
+ ppFunSig summary links loc doc (map unLoc lnames) (unLoc lty) fixities unicode qual
ppFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
- [DocName] -> HsType DocName -> Bool -> Qualification -> Html
-ppFunSig summary links loc doc docnames typ unicode qual =
- ppSigLike summary links loc mempty doc docnames (typ, pp_typ) unicode qual
+ [DocName] -> HsType DocName -> [(DocName, Fixity)] ->
+ Bool -> Qualification -> Html
+ppFunSig summary links loc doc docnames typ fixities unicode qual =
+ ppSigLike summary links loc mempty doc docnames fixities (typ, pp_typ) unicode qual
where
pp_typ = ppType unicode qual typ
ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
Located DocName ->
HsPatSynDetails (LHsType DocName) -> LHsType DocName ->
- LHsContext DocName -> LHsContext DocName ->
+ LHsContext DocName -> LHsContext DocName -> [(DocName, Fixity)] ->
Bool -> Qualification -> Html
-ppLPatSig summary links loc doc lname args typ prov req unicode qual =
- ppPatSig summary links loc doc (unLoc lname) (fmap unLoc args) (unLoc typ) (unLoc prov) (unLoc req) unicode qual
+ppLPatSig summary links loc doc lname args typ prov req fixities unicode qual =
+ ppPatSig summary links loc doc (unLoc lname) (fmap unLoc args) (unLoc typ) (unLoc prov) (unLoc req) fixities unicode qual
ppPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
DocName ->
HsPatSynDetails (HsType DocName) -> HsType DocName ->
- HsContext DocName -> HsContext DocName ->
+ HsContext DocName -> HsContext DocName -> [(DocName, Fixity)] ->
Bool -> Qualification -> Html
-ppPatSig summary links loc (doc, _argDocs) docname args typ prov req unicode qual
+ppPatSig summary links loc (doc, _argDocs) docname args typ prov req fixities unicode qual
| summary = pref1
- | otherwise = topDeclElem links loc [docname] pref1 +++ docSection qual doc
+ | otherwise = topDeclElem links loc [docname] (ppFixities fixities qual <=> pref1)
+ +++ docSection qual doc
where
pref1 = hsep [ toHtml "pattern"
, pp_cxt prov
@@ -99,16 +102,20 @@ ppPatSig summary links loc (doc, _argDocs) docname args typ prov req unicode qua
occname = nameOccName . getName $ docname
ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
- [DocName] -> (HsType DocName, Html) -> Bool -> Qualification -> Html
-ppSigLike summary links loc leader doc docnames (typ, pp_typ) unicode qual =
+ [DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) ->
+ Bool -> Qualification -> Html
+ppSigLike summary links loc leader doc docnames fixities (typ, pp_typ) unicode qual =
ppTypeOrFunSig summary links loc docnames typ doc
- ( leader <+> ppTypeSig summary occnames pp_typ unicode
- , concatHtml . punctuate comma $ map (ppBinder False) occnames
+ ( addFixities $ leader <+> ppTypeSig summary occnames pp_typ unicode
+ , addFixities . concatHtml . punctuate comma $ map (ppBinder False) occnames
, dcolon unicode
)
unicode qual
where
occnames = map (nameOccName . getName) docnames
+ addFixities html
+ | summary = html
+ | otherwise = ppFixities fixities qual <=> html
ppTypeOrFunSig :: Bool -> LinksInfo -> SrcSpan -> [DocName] -> HsType DocName
@@ -144,6 +151,16 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
do_args n leader t
= [(leader <+> ppType unicode qual t, argDoc n, [])]
+ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
+ppFixities fs qual = vcat $ map ppFix fs
+ where
+ ppFix (n, Fixity p d) = toHtml (ppDir d) <+> toHtml (show p)
+ <+> ppDocName qual Infix False n
+
+ ppDir InfixR = "infixr"
+ ppDir InfixL = "infixl"
+ ppDir InfixN = "infix"
+
ppTyVars :: LHsTyVarBndrs DocName -> [Html]
ppTyVars tvs = map ppTyName (tyvarNames tvs)
@@ -154,25 +171,28 @@ tyvarNames = map getName . hsLTyVarNames
ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
- -> ForeignDecl DocName -> Bool -> Qualification -> Html
-ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) unicode qual
- = ppFunSig summary links loc doc [name] typ unicode qual
-ppFor _ _ _ _ _ _ _ = error "ppFor"
+ -> ForeignDecl DocName -> [(DocName, Fixity)] -> Bool -> Qualification -> Html
+ppFor summary links loc doc (ForeignImport (L _ name) (L _ typ) _ _) fixities unicode qual
+ = ppFunSig summary links loc doc [name] typ fixities unicode qual
+ppFor _ _ _ _ _ _ _ _ = error "ppFor"
-- we skip type patterns for now
-ppTySyn :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool
+ppTySyn :: Bool -> LinksInfo -> [(DocName, Fixity)] -> SrcSpan -> DocForDecl DocName -> TyClDecl DocName -> Bool
-> Qualification -> Html
-ppTySyn summary links loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
- , tcdRhs = ltype })
+ppTySyn summary links fixities loc doc (SynDecl { tcdLName = L _ name, tcdTyVars = ltyvars
+ , tcdRhs = ltype })
unicode qual
= ppTypeOrFunSig summary links loc [name] (unLoc ltype) doc
- (full, hdr, spaceHtml +++ equals) unicode qual
+ (fixs <=> full, fixs <=> hdr, spaceHtml +++ equals) unicode qual
where
hdr = hsep ([keyword "type", ppBinder summary occ] ++ ppTyVars ltyvars)
full = hdr <+> equals <+> ppLType unicode qual ltype
occ = nameOccName . getName $ name
-ppTySyn _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
+ fixs
+ | summary = noHtml
+ | otherwise = ppFixities fixities qual
+ppTySyn _ _ _ _ _ _ _ _ = error "declaration not supported by ppTySyn"
ppTypeSig :: Bool -> [OccName] -> Html -> Bool -> Html
@@ -212,9 +232,10 @@ ppTyFamHeader summary associated d@(FamilyDecl { fdInfo = info
Nothing -> noHtml
)
-ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan -> Documentation DocName ->
- FamilyDecl DocName -> Bool -> Qualification -> Html
-ppTyFam summary associated links instances loc doc decl unicode qual
+ppTyFam :: Bool -> Bool -> LinksInfo -> [DocInstance DocName] ->
+ [(DocName, Fixity)] -> SrcSpan -> Documentation DocName ->
+ FamilyDecl DocName -> Bool -> Qualification -> Html
+ppTyFam summary associated links instances fixities loc doc decl unicode qual
| summary = ppTyFamHeader True associated decl unicode qual
| otherwise = header_ +++ docSection qual doc +++ instancesBit
@@ -222,7 +243,8 @@ ppTyFam summary associated links instances loc doc decl unicode qual
where
docname = unLoc $ fdLName decl
- header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode qual)
+ header_ = topDeclElem links loc [docname] $
+ ppFixities fixities qual <=> ppTyFamHeader summary associated decl unicode qual
instancesBit
| FamilyDecl { fdInfo = ClosedTypeFamily eqns } <- decl
@@ -244,10 +266,10 @@ ppTyFam summary associated links instances loc doc decl unicode qual
--------------------------------------------------------------------------------
-ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName -> Bool
- -> Qualification -> Html
-ppAssocType summ links doc (L loc decl) unicode qual =
- ppTyFam summ True links [] loc (fst doc) decl unicode qual
+ppAssocType :: Bool -> LinksInfo -> DocForDecl DocName -> LFamilyDecl DocName
+ -> [(DocName, Fixity)] -> Bool -> Qualification -> Html
+ppAssocType summ links doc (L loc decl) fixities unicode qual =
+ ppTyFam summ True links [] fixities loc (fst doc) decl unicode qual
--------------------------------------------------------------------------------
@@ -363,12 +385,12 @@ ppShortClassDecl summary links (ClassDecl { tcdCtxt = lctxt, tcdLName = lname, t
else (if summary then id else topDeclElem links loc [nm]) (hdr <+> keyword "where")
+++ shortSubDecls
(
- [ ppAssocType summary links doc at unicode qual | at <- ats
+ [ ppAssocType summary links doc at [] unicode qual | at <- ats
, let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ] ++
-- ToDo: add associated type defaults
- [ ppFunSig summary links loc doc names typ unicode qual
+ [ ppFunSig summary links loc doc names typ [] unicode qual
| L _ (TypeSig lnames (L _ typ)) <- sigs
, let doc = lookupAnySubdoc (head names) subdocs
names = map unLoc lnames ]
@@ -383,10 +405,11 @@ ppShortClassDecl _ _ _ _ _ _ _ = error "declaration type not supported by ppShor
-ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan
- -> Documentation DocName -> [(DocName, DocForDecl DocName)]
- -> TyClDecl DocName -> Bool -> Qualification -> Html
-ppClassDecl summary links instances loc d subdocs
+ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)]
+ -> SrcSpan -> Documentation DocName
+ -> [(DocName, DocForDecl DocName)] -> TyClDecl DocName
+ -> Bool -> Qualification -> Html
+ppClassDecl summary links instances fixities loc d subdocs
decl@(ClassDecl { tcdCtxt = lctxt, tcdLName = lname, tcdTyVars = ltyvars
, tcdFDs = lfds, tcdSigs = lsigs, tcdATs = ats }) unicode qual
| summary = ppShortClassDecl summary links decl loc subdocs unicode qual
@@ -394,21 +417,29 @@ ppClassDecl summary links instances loc d subdocs
+++ atBit +++ methodBit +++ instancesBit
where
classheader
- | null lsigs = topDeclElem links loc [nm] (hdr unicode qual)
- | otherwise = topDeclElem links loc [nm] (hdr unicode qual <+> keyword "where")
+ | null lsigs = topDeclElem links loc [nm] (fixs <=> hdr unicode qual)
+ | otherwise = topDeclElem links loc [nm] (fixs <=> hdr unicode qual <+> keyword "where")
+
+ -- Only the fixity relevant to the class header
+ fixs = ppFixities [ f | f@(n,_) <- fixities, n == unLoc lname ] qual
nm = tcdName decl
hdr = ppClassHdr summary lctxt (unLoc lname) ltyvars lfds
-- ToDo: add assocatied typ defaults
- atBit = subAssociatedTypes [ ppAssocType summary links doc at unicode qual
+ atBit = subAssociatedTypes [ ppAssocType summary links doc at subfixs unicode qual
| at <- ats
- , let doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs ]
+ , let n = unL . fdLName $ unL at
+ doc = lookupAnySubdoc (unL $ fdLName $ unL at) subdocs
+ subfixs = [ f | f@(n',_) <- fixities, n == n' ] ]
- methodBit = subMethods [ ppFunSig summary links loc doc names typ unicode qual
+ methodBit = subMethods [ ppFunSig summary links loc doc names typ subfixs unicode qual
| L _ (TypeSig lnames (L _ typ)) <- lsigs
, let doc = lookupAnySubdoc (head names) subdocs
+ subfixs = [ f | n <- names
+ , f@(n',_) <- fixities
+ , n == n' ]
names = map unLoc lnames ]
-- FIXME: is taking just the first name ok? Is it possible that
-- there are different subdocs for different names in a single
@@ -416,7 +447,7 @@ ppClassDecl summary links instances loc d subdocs
instancesBit = ppInstances instances nm unicode qual
-ppClassDecl _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
+ppClassDecl _ _ _ _ _ _ _ _ _ _ = error "declaration type not supported by ppShortClassDecl"
ppInstances :: [DocInstance DocName] -> DocName -> Bool -> Qualification -> Html
@@ -471,11 +502,11 @@ ppShortDataDecl summary dataInst dataDecl unicode qual
resTy = (con_res . unLoc . head) cons
-ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] ->
+ppDataDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> [(DocName, Fixity)] ->
[(DocName, DocForDecl DocName)] ->
SrcSpan -> Documentation DocName -> TyClDecl DocName -> Bool ->
Qualification -> Html
-ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual
+ppDataDecl summary links instances fixities subdocs loc doc dataDecl unicode qual
| summary = ppShortDataDecl summary False dataDecl unicode qual
| otherwise = header_ +++ docSection qual doc +++ constrBit +++ instancesBit
@@ -485,8 +516,10 @@ ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual
cons = dd_cons (tcdDataDefn dataDecl)
resTy = (con_res . unLoc . head) cons
- header_ = topDeclElem links loc [docname] (ppDataHeader summary dataDecl unicode qual
- <+> whereBit)
+ header_ = topDeclElem links loc [docname] (fix
+ <=> ppDataHeader summary dataDecl unicode qual <+> whereBit)
+
+ fix = ppFixities (filter (\(n,_) -> n == docname) fixities) qual
whereBit
| null cons = noHtml
@@ -495,7 +528,10 @@ ppDataDecl summary links instances subdocs loc doc dataDecl unicode qual
_ -> noHtml
constrBit = subConstructors qual
- (map (ppSideBySideConstr subdocs unicode qual) cons)
+ [ ppSideBySideConstr subdocs subfixs unicode qual c
+ | c <- cons
+ , let subfixs = filter (\(n,_) -> n == unLoc (con_name (unLoc c))) fixities
+ ]
instancesBit = ppInstances instances docname unicode qual
@@ -568,20 +604,20 @@ ppConstrHdr forall_ tvs ctxt unicode qual
Implicit -> noHtml
-ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> Bool -> Qualification
- -> LConDecl DocName -> SubDecl
-ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart)
+ppSideBySideConstr :: [(DocName, DocForDecl DocName)] -> [(DocName, Fixity)]
+ -> Bool -> Qualification -> LConDecl DocName -> SubDecl
+ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, fieldPart)
where
decl = case con_res con of
ResTyH98 -> case con_details con of
PrefixCon args ->
- hsep ((header_ unicode qual +++ ppBinder False occ)
+ hsep ((header_ +++ ppBinder False occ)
: map (ppLParendType unicode qual) args)
- RecCon _ -> header_ unicode qual +++ ppBinder False occ
+ RecCon _ -> header_ +++ ppBinder False occ
InfixCon arg1 arg2 ->
- hsep [header_ unicode qual +++ ppLParendType unicode qual arg1,
+ hsep [header_ +++ ppLParendType unicode qual arg1,
ppBinderInfix False occ,
ppLParendType unicode qual arg2]
@@ -599,12 +635,13 @@ ppSideBySideConstr subdocs unicode qual (L _ con) = (decl, mbDoc, fieldPart)
doRecordFields fields = subFields qual
(map (ppSideBySideField subdocs unicode qual) fields)
doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
- doGADTCon args resTy =
+ doGADTCon args resTy = fixity <=>
ppBinder False occ <+> dcolon unicode
<+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual,
ppLType unicode qual (foldr mkFunTy resTy args) ]
- header_ = ppConstrHdr forall_ tyVars context
+ fixity = ppFixities fixities qual
+ header_ = fixity <=> ppConstrHdr forall_ tyVars context unicode qual
occ = nameOccName . getName . unLoc . con_name $ con
ltvs = con_qvars con
tyVars = tyvarNames (con_qvars con)
diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs
index 232e18cc..cbcbbd6d 100644
--- a/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/src/Haddock/Backends/Xhtml/Utils.hs
@@ -17,13 +17,13 @@ module Haddock.Backends.Xhtml.Utils (
spliceURL,
groupId,
- (<+>), char,
+ (<+>), (<=>), char,
keyword, punctuate,
braces, brackets, pabrackets, parens, parenList, ubxParenList,
arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote,
- hsep,
+ hsep, vcat,
collapseSection, collapseToggle, collapseControl,
) where
@@ -100,6 +100,11 @@ hsep :: [Html] -> Html
hsep [] = noHtml
hsep htmls = foldr1 (\a b -> a+++" "+++b) htmls
+-- | Concatenate a series of 'Html' values vertically, with linebreaks in between.
+vcat :: [Html] -> Html
+vcat [] = noHtml
+vcat htmls = foldr1 (\a b -> a+++br+++b) htmls
+
infixr 8 <+>
(<+>) :: Html -> Html -> Html
@@ -107,6 +112,14 @@ a <+> b = a +++ sep +++ b
where
sep = if isNoHtml a || isNoHtml b then noHtml else toHtml " "
+-- | Join two 'Html' values together with a linebreak in between.
+-- Has 'noHtml' as left identity.
+infixr 8 <=>
+(<=>) :: Html -> Html -> Html
+a <=> b = a +++ sep +++ b
+ where
+ sep = if isNoHtml a then noHtml else br
+
keyword :: String -> Html
keyword s = thespan ! [theclass "keyword"] << toHtml s
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 10:34:16 +0000