From a36ab92b289b4d6b707696eef49145bc7ced4957 Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Sun, 25 Nov 2018 10:32:22 -0800 Subject: 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 --- haddock-api/src/Haddock/Backends/LaTeX.hs | 49 ++++++++++++++++++------------- 1 file changed, 28 insertions(+), 21 deletions(-) (limited to 'haddock-api/src/Haddock/Backends/LaTeX.hs') 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 -- cgit v1.2.3 From 53997f3db71d113bdad59548e3f16adfe90c112b Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Wed, 23 Jan 2019 11:46:46 -0800 Subject: Keep forall on H98 existential data constructors (#1003) The information about whether or not there is a source-level `forall` is already available on a `ConDecl` (as `con_forall`), so we should use it instead of always assuming `False`! Fixes #1002. --- haddock-api/src/Haddock/Backends/LaTeX.hs | 2 +- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 4 ++-- html-test/ref/PatternSyns.html | 8 ++++++-- html-test/ref/Test.html | 24 ++++++++++++++++++------ 4 files changed, 27 insertions(+), 11 deletions(-) (limited to 'haddock-api/src/Haddock/Backends/LaTeX.hs') diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 40ea916f..a84e7e45 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -758,9 +758,9 @@ ppSideBySideConstr subdocs unicode leader (L _ con) = decl = case con of ConDeclH98{ con_args = det , con_ex_tvs = tyVars + , con_forall = L _ forall_ , con_mb_cxt = cxt } -> let context = unLoc (fromMaybe (noLoc []) cxt) - forall_ = False header_ = ppConstrHdr forall_ tyVars context unicode in case det of -- Prefix constructor, e.g. 'Just a' diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 775e0c41..bc6e2c2b 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -800,9 +800,9 @@ ppShortConstrParts summary dataInst con unicode qual = case con of ConDeclH98{ con_args = det , con_ex_tvs = tyVars + , con_forall = L _ forall_ , con_mb_cxt = cxt } -> let context = unLoc (fromMaybe (noLoc []) cxt) - forall_ = False header_ = ppConstrHdr forall_ tyVars context unicode qual in case det of @@ -873,9 +873,9 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con) decl = case con of ConDeclH98{ con_args = det , con_ex_tvs = tyVars + , con_forall = L _ forall_ , con_mb_cxt = 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' diff --git a/html-test/ref/PatternSyns.html b/html-test/ref/PatternSyns.html index bae4b0bd..7e10b755 100644 --- a/html-test/ref/PatternSyns.html +++ b/html-test/ref/PatternSyns.html @@ -104,7 +104,9 @@ >data BlubType = = forall x.Show x => BlubCtor
forall x.Show x => BlubCtorEx a