aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2018-11-25 10:32:22 -0800
committerAlec Theriault <alec.theriault@gmail.com>2018-11-26 11:11:28 -0800
commita36ab92b289b4d6b707696eef49145bc7ced4957 (patch)
treea640a73c0f04132f60ac6ba39645521341866407 /haddock-api/src/Haddock/Backends/Xhtml
parent8c785e2c46d3e37d14ab7888d96005ea2c69f37f (diff)
More uniform handling of `forall`'s in HTML/LaTeX
* don't forget to print explicit `forall`'s when there are arg docs * when printing an explicit `forall`, print all tyvars Fixes #973
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs61
1 files changed, 22 insertions, 39 deletions
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