aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs49
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs61
2 files changed, 50 insertions, 60 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 613c6deb..40ea916f 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -458,7 +458,7 @@ ppTypeOrFunSig typ (doc, argDocs) (pref1, pref2, sep0) unicode
text "\\end{tabulary}\\par" $$
fromMaybe empty (documentationToLaTeX doc)
--- This splits up a type signature along `->` and adds docs (when they exist)
+-- | This splits up a type signature along @->@ and adds docs (when they exist)
-- to the arguments. The output is a list of (leader/seperator, argument and
-- its doc)
ppSubSigLike :: Bool -- ^ unicode
@@ -474,13 +474,10 @@ ppSubSigLike unicode typ argDocs subdocs leader = do_args 0 leader typ
arg_doc n = rDoc . fmap _doc $ Map.lookup n argDocs
do_args :: Int -> LaTeX -> HsType DocNameI -> [(LaTeX, LaTeX)]
- do_args _n leader (HsForAllTy _ tvs ltype)
- = [ ( decltt leader
- , decltt (hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]))
- <+> ppLType unicode ltype
- ) ]
+ do_args n leader (HsForAllTy _ tvs ltype)
+ = do_largs n (leader <+> decltt (ppForAllPart unicode tvs)) ltype
do_args n leader (HsQualTy _ lctxt ltype)
- = (decltt leader, ppLContextNoArrow lctxt unicode <+> nl)
+ = (decltt leader, decltt (ppLContextNoArrow lctxt unicode) <+> nl)
: do_largs n (darrow unicode) ltype
do_args n leader (HsFunTy _ (L _ (HsRecTy _ fields)) r)
@@ -512,8 +509,9 @@ ppTypeSig nms ty unicode =
<+> ppType unicode ty
-ppTyVars :: [LHsTyVarBndr DocNameI] -> [LaTeX]
-ppTyVars = map (ppSymName . getName . hsLTyVarName)
+-- | Pretty-print type variables.
+ppTyVars :: Bool -> [LHsTyVarBndr DocNameI] -> [LaTeX]
+ppTyVars unicode tvs = map (ppHsTyVarBndr unicode . unLoc) tvs
tyvarNames :: LHsQTyVars DocNameI -> [Name]
@@ -716,15 +714,21 @@ ppDataDecl pats instances subdocs doc dataDecl unicode =
-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: Bool -> [Name] -> HsContext DocNameI -> Bool -> LaTeX
-ppConstrHdr forall tvs ctxt unicode
- = (if null tvs then empty else ppForall)
- <+>
- (if null ctxt then empty else ppContextNoArrow ctxt unicode <+> darrow unicode <+> text " ")
+ppConstrHdr
+ :: Bool -- ^ print explicit foralls
+ -> [LHsTyVarBndr DocNameI] -- ^ type variables
+ -> HsContext DocNameI -- ^ context
+ -> Bool -- ^ unicode
+ -> LaTeX
+ppConstrHdr forall_ tvs ctxt unicode = ppForall <> ppCtxt
where
- ppForall = case forall of
- True -> forallSymbol unicode <+> hsep (map ppName tvs) <+> text ". "
- False -> empty
+ ppForall
+ | null tvs || not forall_ = empty
+ | otherwise = ppForAllPart unicode tvs
+
+ ppCtxt
+ | null ctxt = empty
+ | otherwise = ppContextNoArrow ctxt unicode <+> darrow unicode <> space
-- | Pretty-print a constructor
@@ -753,10 +757,9 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
-- First line of the constructor (no doc, no fields, single-line)
decl = case con of
ConDeclH98{ con_args = det
- , con_ex_tvs = vars
+ , con_ex_tvs = tyVars
, con_mb_cxt = cxt
- } -> let tyVars = map (getName . hsLTyVarName) vars
- context = unLoc (fromMaybe (noLoc []) cxt)
+ } -> let context = unLoc (fromMaybe (noLoc []) cxt)
forall_ = False
header_ = ppConstrHdr forall_ tyVars context unicode
in case det of
@@ -1010,13 +1013,17 @@ ppKind unicode ki = ppr_mono_ty (reparenTypePrec PREC_TOP ki) unicode
-- Drop top-level for-all type variables in user style
-- since they are implicit in Haskell
+ppForAllPart :: Bool -> [LHsTyVarBndr DocNameI] -> LaTeX
+ppForAllPart unicode tvs = hsep (forallSymbol unicode : ppTyVars unicode tvs) <> dot
+
+
ppr_mono_lty :: LHsType DocNameI -> Bool -> LaTeX
ppr_mono_lty ty unicode = ppr_mono_ty (unLoc ty) unicode
ppr_mono_ty :: HsType DocNameI -> Bool -> LaTeX
ppr_mono_ty (HsForAllTy _ tvs ty) unicode
- = sep [ hsep (forallSymbol unicode : ppTyVars tvs) <> dot
+ = sep [ ppForAllPart unicode tvs
, ppr_mono_lty ty unicode ]
ppr_mono_ty (HsQualTy _ ctxt ty) unicode
= sep [ ppLContext ctxt unicode
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 9df6acc0..775e0c41 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -130,8 +130,8 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
curname = getName <$> listToMaybe docnames
--- This splits up a type signature along `->` and adds docs (when they exist) to
--- the arguments.
+-- | This splits up a type signature along @->@ and adds docs (when they exist)
+-- to the arguments.
--
-- If one passes in a list of the available subdocs, any top-level `HsRecTy`
-- found will be expanded out into their fields.
@@ -149,9 +149,7 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ
do_args :: Int -> Html -> HsType DocNameI -> [SubDecl]
do_args n leader (HsForAllTy _ tvs ltype)
- = do_largs n leader' ltype
- where
- leader' = leader <+> ppForAll tvs unicode qual
+ = do_largs n (leader <+> ppForAllPart unicode qual tvs) ltype
do_args n leader (HsQualTy _ lctxt ltype)
| null (unLoc lctxt)
@@ -185,15 +183,6 @@ ppSubSigLike unicode qual typ argDocs subdocs sep emptyCtxts = do_args 0 sep typ
gadtOpen = toHtml "{"
-
-ppForAll :: [LHsTyVarBndr DocNameI] -> Unicode -> Qualification -> Html
-ppForAll tvs unicode qual =
- case [ppKTv n k | L _ (KindedTyVar _ (L _ n) k) <- tvs] of
- [] -> noHtml
- ts -> forallSymbol unicode <+> hsep ts +++ dot
- where ppKTv n k = parens $
- ppTyName (getName n) <+> dcolon unicode <+> ppLKind unicode qual k
-
ppFixities :: [(DocName, Fixity)] -> Qualification -> Html
ppFixities [] _ = noHtml
ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
@@ -258,10 +247,6 @@ ppTypeSig summary nms pp_ty unicode =
htmlNames = intersperse (stringToHtml ", ") $ map (ppBinder summary) nms
-ppTyName :: Name -> Html
-ppTyName = ppName Prefix
-
-
ppSimpleSig :: LinksInfo -> Splice -> Unicode -> Qualification -> HideEmptyContexts -> SrcSpan
-> [DocName] -> HsType DocNameI
-> Html
@@ -814,24 +799,23 @@ ppShortConstrParts :: Bool -> Bool -> ConDecl DocNameI -> Unicode -> Qualificati
ppShortConstrParts summary dataInst con unicode qual
= case con of
ConDeclH98{ con_args = det
- , con_ex_tvs = vars
+ , con_ex_tvs = tyVars
, con_mb_cxt = cxt
- } -> let tyVars = map (getName . hsLTyVarName) vars
- context = unLoc (fromMaybe (noLoc []) cxt)
+ } -> let context = unLoc (fromMaybe (noLoc []) cxt)
forall_ = False
header_ = ppConstrHdr forall_ tyVars context unicode qual
in case det of
-- Prefix constructor, e.g. 'Just a'
PrefixCon args ->
- ( header_ +++ hsep (ppOcc : map (ppLParendType unicode qual HideEmptyContexts) args)
+ ( header_ <+> hsep (ppOcc : map (ppLParendType unicode qual HideEmptyContexts) args)
, noHtml
, noHtml
)
-- Record constructor, e.g. 'Identity { runIdentity :: a }'
RecCon (L _ fields) ->
- ( header_ +++ ppOcc <+> char '{'
+ ( header_ <+> ppOcc <+> char '{'
, shortSubDecls dataInst [ ppShortField summary unicode qual field
| L _ field <- fields
]
@@ -840,7 +824,7 @@ ppShortConstrParts summary dataInst con unicode qual
-- Infix constructor, e.g. 'a :| [a]'
InfixCon arg1 arg2 ->
- ( header_ +++ hsep [ ppLParendType unicode qual HideEmptyContexts arg1
+ ( header_ <+> hsep [ ppLParendType unicode qual HideEmptyContexts arg1
, ppOccInfix
, ppLParendType unicode qual HideEmptyContexts arg2
]
@@ -888,28 +872,27 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
decl = case con of
ConDeclH98{ con_args = det
- , con_ex_tvs = vars
+ , con_ex_tvs = tyVars
, con_mb_cxt = cxt
- } -> let tyVars = map (getName . hsLTyVarName) vars
- context = unLoc (fromMaybe (noLoc []) cxt)
+ } -> let context = unLoc (fromMaybe (noLoc []) cxt)
forall_ = False
header_ = ppConstrHdr forall_ tyVars context unicode qual
in case det of
-- Prefix constructor, e.g. 'Just a'
PrefixCon args
- | hasArgDocs -> header_ +++ ppOcc <+> fixity
- | otherwise -> hsep [ header_ +++ ppOcc
+ | hasArgDocs -> header_ <+> ppOcc <+> fixity
+ | otherwise -> hsep [ header_ <+> ppOcc
, hsep (map (ppLParendType unicode qual HideEmptyContexts) args)
, fixity
]
-- Record constructor, e.g. 'Identity { runIdentity :: a }'
- RecCon _ -> header_ +++ ppOcc <+> fixity
+ RecCon _ -> header_ <+> ppOcc <+> fixity
-- Infix constructor, e.g. 'a :| [a]'
InfixCon arg1 arg2
- | hasArgDocs -> header_ +++ ppOcc <+> fixity
- | otherwise -> hsep [ header_ +++ ppLParendType unicode qual HideEmptyContexts arg1
+ | hasArgDocs -> header_ <+> ppOcc <+> fixity
+ | otherwise -> hsep [ header_ <+> ppLParendType unicode qual HideEmptyContexts arg1
, ppOccInfix
, ppLParendType unicode qual HideEmptyContexts arg2
, fixity
@@ -962,17 +945,17 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
-- ppConstrHdr is for (non-GADT) existentials constructors' syntax
-ppConstrHdr :: Bool -- ^ print explicit foralls
- -> [Name] -- ^ type variables
- -> HsContext DocNameI -- ^ context
- -> Unicode -> Qualification -> Html
+ppConstrHdr
+ :: Bool -- ^ print explicit foralls
+ -> [LHsTyVarBndr DocNameI] -- ^ type variables
+ -> HsContext DocNameI -- ^ context
+ -> Unicode -> Qualification
+ -> Html
ppConstrHdr forall_ tvs ctxt unicode qual = ppForall +++ ppCtxt
where
ppForall
| null tvs || not forall_ = noHtml
- | otherwise = forallSymbol unicode
- <+> hsep (map (ppName Prefix) tvs)
- <+> toHtml ". "
+ | otherwise = ppForAllPart unicode qual tvs
ppCtxt
| null ctxt = noHtml
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 01:07:47 +0000