aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorCale Gibbard <cgibbard@gmail.com>2020-07-30 14:00:19 -0400
committerRichard Eisenberg <rae@richarde.dev>2020-11-25 23:18:35 -0500
commitacf235d607879eb9542127eb0ddb42a250b5b850 (patch)
treeab41b4f5840cd6a7631e4f2b2c94da010e88e614 /haddock-api/src/Haddock/Backends
parent8d260690b53f2fb6b54ba78bd13d1400d9ebd395 (diff)
Add type arguments to PrefixCon
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs6
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs6
3 files changed, 8 insertions, 8 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index 44841bc5..1f55db10 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -244,9 +244,9 @@ ppCtor dflags dat subdocs con@ConDeclH98 { con_args = con_args' }
-- AZ:TODO get rid of the concatMap
= concatMap (lookupCon dflags subdocs) [con_name con] ++ f con_args'
where
- f (PrefixCon args) = [typeSig name $ (map hsScaledThing args) ++ [resType]]
- f (InfixCon a1 a2) = f $ PrefixCon [a1,a2]
- f (RecCon (L _ recs)) = f (PrefixCon $ map (hsLinear . cd_fld_type . unLoc) recs) ++ concat
+ f (PrefixCon _ args) = [typeSig name $ (map hsScaledThing args) ++ [resType]]
+ f (InfixCon a1 a2) = f $ PrefixCon [] [a1,a2]
+ f (RecCon (L _ recs)) = f (PrefixCon [] $ map (hsLinear . cd_fld_type . unLoc) recs) ++ concat
[(concatMap (lookupCon dflags subdocs . noLoc . extFieldOcc . unLoc) (cd_fld_names r)) ++
[out dflags (map (extFieldOcc . unLoc) $ cd_fld_names r) `typeSig` [resType, cd_fld_type r]]
| r <- map unLoc recs]
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index 3a774ace..f9480a47 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -784,7 +784,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
header_ = ppConstrHdr forall_ tyVars context unicode
in case det of
-- Prefix constructor, e.g. 'Just a'
- PrefixCon args
+ PrefixCon _ args
| hasArgDocs -> header_ <+> ppOcc
| otherwise -> hsep [ header_
, ppOcc
@@ -823,7 +823,7 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
-- H98 record declarations
RecCon (L _ fields) -> doRecordFields fields
-- H98 prefix data constructors
- PrefixCon args | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args)
+ PrefixCon _ args | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args)
-- H98 infix data constructor
InfixCon arg1 arg2 | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing [arg1,arg2])
_ -> empty
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 8b9739f1..e9806471 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -845,7 +845,7 @@ ppShortConstrParts summary dataInst con unicode qual
in case det of
-- Prefix constructor, e.g. 'Just a'
- PrefixCon args ->
+ PrefixCon _ args ->
( header_ +++
hsep (ppOcc : map ((ppLParendType unicode qual HideEmptyContexts) . hsScaledThing) args)
, noHtml
@@ -918,7 +918,7 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
header_ = ppConstrHdr forall_ tyVars context unicode qual
in case det of
-- Prefix constructor, e.g. 'Just a'
- PrefixCon args
+ PrefixCon _ args
| hasArgDocs -> header_ +++ ppOcc <+> fixity
| otherwise -> hsep [ header_ +++ ppOcc
, hsep (map ((ppLParendType unicode qual HideEmptyContexts) . hsScaledThing) args)
@@ -959,7 +959,7 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
-- H98 record declarations
RecCon (L _ fields) -> [ doRecordFields fields ]
-- H98 prefix data constructors
- PrefixCon args | hasArgDocs -> [ doConstrArgsWithDocs args ]
+ PrefixCon _ args | hasArgDocs -> [ doConstrArgsWithDocs args ]
-- H98 infix data constructor
InfixCon arg1 arg2 | hasArgDocs -> [ doConstrArgsWithDocs [arg1,arg2] ]
_ -> []