aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs12
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs30
-rw-r--r--haddock-api/src/Haddock/Convert.hs2
-rw-r--r--haddock-api/src/Haddock/GhcUtils.hs2
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs6
5 files changed, 25 insertions, 27 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 85716f33..3b0c38c4 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -251,7 +251,7 @@ declNames :: LHsDecl DocName -> [DocName]
declNames (L _ decl) = case decl of
TyClD d -> [tcdName d]
SigD (TypeSig lnames _ ) -> map unLoc lnames
- SigD (PatSynSig lname _) -> [unLoc lname]
+ SigD (PatSynSig lnames _) -> map unLoc lnames
ForD (ForeignImport (L _ n) _ _ _) -> [n]
ForD (ForeignExport (L _ n) _ _ _) -> [n]
_ -> error "declaration not supported by declNames"
@@ -296,8 +296,8 @@ ppDecl (L loc decl) (doc, fnArgsDoc) instances subdocs _fixities = case decl of
TyClD d@(ClassDecl {}) -> ppClassDecl instances loc doc subdocs d unicode
SigD (TypeSig lnames t) -> ppFunSig loc (doc, fnArgsDoc) (map unLoc lnames)
(hsSigWcType t) unicode
- SigD (PatSynSig lname ty) ->
- ppLPatSig loc (doc, fnArgsDoc) lname ty unicode
+ SigD (PatSynSig lnames ty) ->
+ ppLPatSig loc (doc, fnArgsDoc) (map unLoc lnames) ty unicode
ForD d -> ppFor loc (doc, fnArgsDoc) d unicode
InstD _ -> empty
DerivD _ -> empty
@@ -355,14 +355,14 @@ ppFunSig loc doc docnames (L _ typ) unicode =
where
names = map getName docnames
-ppLPatSig :: SrcSpan -> DocForDecl DocName -> Located DocName
+ppLPatSig :: SrcSpan -> DocForDecl DocName -> [DocName]
-> LHsSigType DocName
-> Bool -> LaTeX
-ppLPatSig _loc (doc, _argDocs) (L _ name) ty unicode
+ppLPatSig _loc (doc, _argDocs) docnames ty unicode
= declWithDoc pref1 (documentationToLaTeX doc)
where
pref1 = hsep [ keyword "pattern"
- , ppDocBinder name
+ , hsep $ punctuate comma $ map ppDocBinder docnames
, dcolon unicode
, ppLType unicode (hsSigType ty)
]
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index d32c6d1b..ed9fd964 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -44,18 +44,18 @@ ppDecl :: Bool -> LinksInfo -> LHsDecl DocName
-> DocForDecl DocName -> [DocInstance DocName] -> [(DocName, Fixity)]
-> [(DocName, DocForDecl DocName)] -> Splice -> Unicode -> Qualification -> Html
ppDecl summ links (L loc decl) (mbDoc, fnArgsDoc) instances fixities subdocs splice unicode qual = case decl of
- TyClD (FamDecl d) -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
- TyClD d@(DataDecl {}) -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual
- TyClD d@(SynDecl {}) -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
- TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
- SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
+ TyClD (FamDecl d) -> ppTyFam summ False links instances fixities loc mbDoc d splice unicode qual
+ TyClD d@(DataDecl {}) -> ppDataDecl summ links instances fixities subdocs loc mbDoc d splice unicode qual
+ TyClD d@(SynDecl {}) -> ppTySyn summ links fixities loc (mbDoc, fnArgsDoc) d splice unicode qual
+ TyClD d@(ClassDecl {}) -> ppClassDecl summ links instances fixities loc mbDoc subdocs d splice unicode qual
+ SigD (TypeSig lnames lty) -> ppLFunSig summ links loc (mbDoc, fnArgsDoc) lnames
(hsSigWcType lty) fixities splice unicode qual
- SigD (PatSynSig lname ty) -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lname
+ SigD (PatSynSig lnames ty) -> ppLPatSig summ links loc (mbDoc, fnArgsDoc) lnames
ty fixities splice unicode qual
- ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
- InstD _ -> noHtml
- DerivD _ -> noHtml
- _ -> error "declaration not supported by ppDecl"
+ ForD d -> ppFor summ links loc (mbDoc, fnArgsDoc) d fixities splice unicode qual
+ InstD _ -> noHtml
+ DerivD _ -> noHtml
+ _ -> error "declaration not supported by ppDecl"
ppLFunSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
@@ -75,22 +75,20 @@ ppFunSig summary links loc doc docnames typ fixities splice unicode qual =
pp_typ = ppLType unicode qual typ
ppLPatSig :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName ->
- Located DocName -> LHsSigType DocName ->
+ [Located DocName] -> LHsSigType DocName ->
[(DocName, Fixity)] ->
Splice -> Unicode -> Qualification -> Html
-ppLPatSig summary links loc (doc, _argDocs) (L _ name) typ fixities splice unicode qual
+ppLPatSig summary links loc (doc, _argDocs) docnames typ fixities splice unicode qual
| summary = pref1
- | otherwise = topDeclElem links loc splice [name] (pref1 <+> ppFixities fixities qual)
+ | otherwise = topDeclElem links loc splice (map unLoc docnames) (pref1 <+> ppFixities fixities qual)
+++ docSection Nothing qual doc
where
pref1 = hsep [ keyword "pattern"
- , ppBinder summary occname
+ , hsep $ punctuate comma $ map (ppBinder summary . getOccName) docnames
, dcolon unicode
, ppLType unicode qual (hsSigType typ)
]
- occname = nameOccName . getName $ name
-
ppSigLike :: Bool -> LinksInfo -> SrcSpan -> Html -> DocForDecl DocName ->
[DocName] -> [(DocName, Fixity)] -> (HsType DocName, Html) ->
Splice -> Unicode -> Qualification -> Html
diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs
index 5f3a1e9e..88cedc75 100644
--- a/haddock-api/src/Haddock/Convert.hs
+++ b/haddock-api/src/Haddock/Convert.hs
@@ -101,7 +101,7 @@ tyThingToLHsDecl t = case t of
(synifySigWcType ImplicitizeForAll (dataConUserType dc)))
AConLike (PatSynCon ps) ->
- allOK . SigD $ PatSynSig (synifyName ps) (synifyPatSynSigType ps)
+ allOK . SigD $ PatSynSig [synifyName ps] (synifyPatSynSigType ps)
where
withErrs e x = return (e, x)
allOK x = return (mempty, x)
diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs
index 3933f8e7..c8e5ea8b 100644
--- a/haddock-api/src/Haddock/GhcUtils.hs
+++ b/haddock-api/src/Haddock/GhcUtils.hs
@@ -104,7 +104,7 @@ sigName (L _ sig) = sigNameNoLoc sig
sigNameNoLoc :: Sig name -> [name]
sigNameNoLoc (TypeSig ns _) = map unLoc ns
sigNameNoLoc (ClassOpSig _ ns _) = map unLoc ns
-sigNameNoLoc (PatSynSig n _) = [unLoc n]
+sigNameNoLoc (PatSynSig ns _) = map unLoc ns
sigNameNoLoc (SpecSig n _ _) = [unLoc n]
sigNameNoLoc (InlineSig n _) = [unLoc n]
sigNameNoLoc (FixSig (FixitySig ns _)) = map unLoc ns
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index ab23ce3b..d786d0cc 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -470,10 +470,10 @@ renameSig sig = case sig of
lnames' <- mapM renameL lnames
ltype' <- renameLSigType sig_ty
return (ClassOpSig is_default lnames' ltype')
- PatSynSig lname sig_ty -> do
- lname' <- renameL lname
+ PatSynSig lnames sig_ty -> do
+ lnames' <- mapM renameL lnames
sig_ty' <- renameLSigType sig_ty
- return $ PatSynSig lname' sig_ty'
+ return $ PatSynSig lnames' sig_ty'
FixSig (FixitySig lnames fixity) -> do
lnames' <- mapM renameL lnames
return $ FixSig (FixitySig lnames' fixity)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 09:53:17 +0000