aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/LaTeX.hs
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-10-24 10:38:55 -0400
committerRyan Scott <ryan.gl.scott@gmail.com>2020-10-30 04:53:05 -0400
commit3cce1bdee8c61bb6daa089059e12435178f50770 (patch)
tree32cb09fe0afa9753bf82fd90bd7016336439fc7b /haddock-api/src/Haddock/Backends/LaTeX.hs
parent87a9f86d1ad7de67ff011311905ecf76578b26e9 (diff)
Adapt to HsConDecl{H98,GADT}Details split
Needed for GHC#18844.
Diffstat (limited to 'haddock-api/src/Haddock/Backends/LaTeX.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs30
1 files changed, 16 insertions, 14 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs
index a90d9a6e..d0528322 100644
--- a/haddock-api/src/Haddock/Backends/LaTeX.hs
+++ b/haddock-api/src/Haddock/Backends/LaTeX.hs
@@ -796,20 +796,22 @@ ppSideBySideConstr subdocs unicode leader (L _ con) =
, ppLType unicode (getGADTConType con)
]
- fieldPart = case (con, getConArgsI con) of
- -- Record style GADTs
- (ConDeclGADT{}, RecCon _) -> doConstrArgsWithDocs []
-
- -- Regular record declarations
- (_, RecCon (L _ fields)) -> doRecordFields fields
-
- -- Any GADT or a regular H98 prefix data constructor
- (_, PrefixCon args) | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args)
-
- -- An infix H98 data constructor
- (_, InfixCon arg1 arg2) | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing [arg1,arg2])
-
- _ -> empty
+ fieldPart = case con of
+ ConDeclGADT{con_g_args = con_args'} -> case con_args' of
+ -- GADT record declarations
+ RecConGADT _ -> doConstrArgsWithDocs []
+ -- GADT prefix data constructors
+ PrefixConGADT args | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args)
+ _ -> empty
+
+ ConDeclH98{con_args = con_args'} -> case con_args' of
+ -- H98 record declarations
+ RecCon (L _ fields) -> doRecordFields fields
+ -- H98 prefix data constructors
+ PrefixCon args | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing args)
+ -- H98 infix data constructor
+ InfixCon arg1 arg2 | hasArgDocs -> doConstrArgsWithDocs (map hsScaledThing [arg1,arg2])
+ _ -> empty
doRecordFields fields =
vcat [ empty <-> tt (text begin) <+> ppSideBySideField subdocs unicode field <+> nl