aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs41
-rw-r--r--html-test/ref/FunArgs.html120
-rw-r--r--html-test/src/FunArgs.hs23
3 files changed, 159 insertions, 25 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 8e42ff47..7b30b52f 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -138,27 +138,26 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
do_largs n leader (L _ t) = do_args n leader t
do_args :: Int -> Html -> HsType DocName -> [SubDecl]
- do_args n leader (HsForAllTy Explicit tvs lctxt ltype)
- = (leader <+>
- hsep (forallSymbol unicode : ppTyVars tvs ++ [dot]) <+>
- ppLContextNoArrow lctxt unicode qual,
- Nothing, [])
- : do_largs n (darrow unicode) ltype
- do_args n leader (HsForAllTy Implicit _ lctxt ltype)
- | not (null (unLoc lctxt))
- = (leader <+> ppLContextNoArrow lctxt unicode qual,
- Nothing, [])
- : do_largs n (darrow unicode) ltype
- -- if we're not showing any 'forall' or class constraints or
- -- anything, skip having an empty line for the context.
- | otherwise
- = do_largs n leader ltype
+ do_args n leader (HsForAllTy _ tvs lctxt ltype)
+ = case unLoc lctxt of
+ [] -> do_largs n leader' ltype
+ _ -> (leader' <+> ppLContextNoArrow lctxt unicode qual, Nothing, [])
+ : do_largs n (darrow unicode) ltype
+ where leader' = leader <+> ppForAll tvs unicode qual
do_args n leader (HsFunTy lt r)
= (leader <+> ppLFunLhType unicode qual lt, argDoc n, [])
: do_largs (n+1) (arrow unicode) r
do_args n leader t
= [(leader <+> ppType unicode qual t, argDoc n, [])]
+ppForAll :: LHsTyVarBndrs DocName -> Unicode -> Qualification -> Html
+ppForAll tvs unicode qual =
+ case [ppKTv n k | L _ (KindedTyVar n k) <- hsQTvBndrs 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
@@ -618,7 +617,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
-- (except each field gets its own line in docs, to match
-- non-GADT records)
RecCon fields -> (ppBinder summary occ <+> dcolon unicode <+>
- ppForAll forall_ ltvs lcontext unicode qual <+> char '{',
+ ppForAllCon forall_ ltvs lcontext unicode qual <+> char '{',
doRecordFields fields,
char '}' <+> arrow unicode <+> ppLType unicode qual resTy)
InfixCon arg1 arg2 -> (doGADTCon [arg1, arg2] resTy, noHtml, noHtml)
@@ -626,7 +625,7 @@ ppShortConstrParts summary dataInst con unicode qual = case con_res con of
where
doRecordFields fields = shortSubDecls dataInst (map (ppShortField summary unicode qual) fields)
doGADTCon args resTy = ppBinder summary occ <+> dcolon unicode <+> hsep [
- ppForAll forall_ ltvs lcontext unicode qual,
+ ppForAllCon forall_ ltvs lcontext unicode qual,
ppLType unicode qual (foldr mkFunTy resTy args) ]
header_ = ppConstrHdr forall_ tyVars context
@@ -687,7 +686,7 @@ ppSideBySideConstr subdocs fixities unicode qual (L _ con) = (decl, mbDoc, field
(map (ppSideBySideField subdocs unicode qual) fields)
doGADTCon :: [LHsType DocName] -> Located (HsType DocName) -> Html
doGADTCon args resTy = ppBinder False occ <+> dcolon unicode
- <+> hsep [ppForAll forall_ ltvs (con_cxt con) unicode qual,
+ <+> hsep [ppForAllCon forall_ ltvs (con_cxt con) unicode qual,
ppLType unicode qual (foldr mkFunTy resTy args) ]
<+> fixity
@@ -805,9 +804,9 @@ ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual
-- Drop top-level for-all type variables in user style
-- since they are implicit in Haskell
-ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName
+ppForAllCon :: HsExplicitFlag -> LHsTyVarBndrs DocName
-> Located (HsContext DocName) -> Unicode -> Qualification -> Html
-ppForAll expl tvs cxt unicode qual
+ppForAllCon expl tvs cxt unicode qual
| show_forall = forall_part <+> ppLContext cxt unicode qual
| otherwise = ppLContext cxt unicode qual
where
@@ -822,7 +821,7 @@ ppr_mono_lty ctxt_prec ty = ppr_mono_ty ctxt_prec (unLoc ty)
ppr_mono_ty :: Int -> HsType DocName -> Unicode -> Qualification -> Html
ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode qual
- = maybeParen ctxt_prec pREC_FUN $ ppForAll expl tvs ctxt unicode qual
+ = maybeParen ctxt_prec pREC_FUN $ ppForAllCon expl tvs ctxt unicode qual
<+> ppr_mono_lty pREC_TOP ty unicode qual
-- UnicodeSyntax alternatives
diff --git a/html-test/ref/FunArgs.html b/html-test/ref/FunArgs.html
index d3fea6b7..5c1fe892 100644
--- a/html-test/ref/FunArgs.html
+++ b/html-test/ref/FunArgs.html
@@ -55,9 +55,7 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");};
><table
><tr
><td class="src"
- >:: <span class="keyword"
- >forall</span
- > a . <a href=""
+ >:: <a href=""
>Ord</a
> a</td
><td class="doc empty"
@@ -154,6 +152,122 @@ window.onload = function () {pageLoad();setSynopsis("mini_FunArgs.html");};
></table
></div
></div
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:h" class="def"
+ >h</a
+ ></p
+ ><div class="subs arguments"
+ ><p class="caption"
+ >Arguments</p
+ ><table
+ ><tr
+ ><td class="src"
+ >:: a</td
+ ><td class="doc"
+ ><p
+ >First argument</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ >-&gt; b</td
+ ><td class="doc"
+ ><p
+ >Second argument</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ >-&gt; c</td
+ ><td class="doc"
+ ><p
+ >Third argument</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ >-&gt; d</td
+ ><td class="doc"
+ ><p
+ >Result</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:i" class="def"
+ >i</a
+ ></p
+ ><div class="subs arguments"
+ ><p class="caption"
+ >Arguments</p
+ ><table
+ ><tr
+ ><td class="src"
+ >:: <span class="keyword"
+ >forall</span
+ > (b :: <a href=""
+ >()</a
+ >). (d ~ <a href=""
+ >()</a
+ >)</td
+ ><td class="doc empty"
+ >&nbsp;</td
+ ></tr
+ ><tr
+ ><td class="src"
+ >=&gt; a b c d</td
+ ><td class="doc"
+ ><p
+ >abcd</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ >-&gt; ()</td
+ ><td class="doc"
+ ><p
+ >Result</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
+ ><div class="top"
+ ><p class="src"
+ ><a name="v:j" class="def"
+ >j</a
+ ></p
+ ><div class="subs arguments"
+ ><p class="caption"
+ >Arguments</p
+ ><table
+ ><tr
+ ><td class="src"
+ >:: <span class="keyword"
+ >forall</span
+ > (a :: <a href=""
+ >()</a
+ >). proxy a</td
+ ><td class="doc"
+ ><p
+ >First argument</p
+ ></td
+ ></tr
+ ><tr
+ ><td class="src"
+ >-&gt; b</td
+ ><td class="doc"
+ ><p
+ >Result</p
+ ></td
+ ></tr
+ ></table
+ ></div
+ ></div
></div
></div
><div id="footer"
diff --git a/html-test/src/FunArgs.hs b/html-test/src/FunArgs.hs
index cfde185d..24e1ccff 100644
--- a/html-test/src/FunArgs.hs
+++ b/html-test/src/FunArgs.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE RankNTypes, DataKinds, TypeFamilies #-}
module FunArgs where
f :: forall a. Ord a
@@ -15,3 +15,24 @@ g :: a -- ^ First argument
-> c -- ^ Third argument
-> d -- ^ Result
g = undefined
+
+
+h :: forall a b c
+ . a -- ^ First argument
+ -> b -- ^ Second argument
+ -> c -- ^ Third argument
+ -> forall d. d -- ^ Result
+h = undefined
+
+
+i :: forall a (b :: ()) d. (d ~ '())
+ => forall c
+ . a b c d -- ^ abcd
+ -> () -- ^ Result
+i = undefined
+
+
+j :: forall proxy (a :: ()) b
+ . proxy a -- ^ First argument
+ -> b -- ^ Result
+j = undefined
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 10:04:18 +0000