aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
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
parent87a9f86d1ad7de67ff011311905ecf76578b26e9 (diff)
Adapt to HsConDecl{H98,GADT}Details split
Needed for GHC#18844.
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-rw-r--r--haddock-api/src/Haddock/Backends/Hoogle.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs30
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs30
3 files changed, 34 insertions, 30 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hoogle.hs b/haddock-api/src/Haddock/Backends/Hoogle.hs
index c9aad6ed..8939664d 100644
--- a/haddock-api/src/Haddock/Backends/Hoogle.hs
+++ b/haddock-api/src/Haddock/Backends/Hoogle.hs
@@ -236,9 +236,9 @@ lookupCon dflags subdocs (L _ name) = case lookup name subdocs of
_ -> []
ppCtor :: DynFlags -> TyClDecl GhcRn -> [(Name, DocForDecl Name)] -> ConDecl GhcRn -> [String]
-ppCtor dflags dat subdocs con@ConDeclH98 {}
+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 (getConArgs con)
+ = 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]
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
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 20e099ee..d80f8e95 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -937,20 +937,22 @@ ppSideBySideConstr subdocs fixities unicode pkg qual (L _ con)
, fixity
]
- 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 args ]
-
- -- An infix H98 data constructor
- (_, InfixCon arg1 arg2) | hasArgDocs -> [ doConstrArgsWithDocs [arg1,arg2] ]
-
- _ -> []
+ 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 args ]
+ _ -> []
+
+ 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 args ]
+ -- H98 infix data constructor
+ InfixCon arg1 arg2 | hasArgDocs -> [ doConstrArgsWithDocs [arg1,arg2] ]
+ _ -> []
doRecordFields fields = subFields pkg qual
(map (ppSideBySideField subdocs unicode qual) (map unLoc fields))