aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface/Create.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/Interface/Create.hs
parent87a9f86d1ad7de67ff011311905ecf76578b26e9 (diff)
Adapt to HsConDecl{H98,GADT}Details split
Needed for GHC#18844.
Diffstat (limited to 'haddock-api/src/Haddock/Interface/Create.hs')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs18
1 files changed, 11 insertions, 7 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 59809e89..ecaf1a5d 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -926,7 +926,7 @@ extractDecl declMap name decl
let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body = d }))
<- insts
-- , L _ ConDecl { con_details = RecCon rec } <- dd_cons (feqn_rhs d)
- , RecCon rec <- map (getConArgs . unLoc) (dd_cons (feqn_rhs d))
+ , Just rec <- map (getRecConArgs_maybe . unLoc) (dd_cons (feqn_rhs d))
, ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
, L _ n <- ns
, extFieldOcc n == name
@@ -949,10 +949,14 @@ extractPatternSyn nm t tvs cons =
extract :: ConDecl GhcRn -> Sig GhcRn
extract con =
let args =
- case getConArgs con of
- PrefixCon args' -> (map hsScaledThing args')
- RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields
- InfixCon arg1 arg2 -> map hsScaledThing [arg1, arg2]
+ case con of
+ ConDeclH98 { con_args = con_args' } -> case con_args' of
+ PrefixCon args' -> map hsScaledThing args'
+ RecCon (L _ fields) -> cd_fld_type . unLoc <$> fields
+ InfixCon arg1 arg2 -> map hsScaledThing [arg1, arg2]
+ ConDeclGADT { con_g_args = con_args' } -> case con_args' of
+ PrefixConGADT args' -> map hsScaledThing args'
+ RecConGADT (L _ fields) -> cd_fld_type . unLoc <$> fields
typ = longArrow args (data_ty con)
typ' =
case con of
@@ -977,8 +981,8 @@ extractRecSel :: Name -> Name -> [LHsTypeArg GhcRn] -> [LConDecl GhcRn]
extractRecSel _ _ _ [] = error "extractRecSel: selector not found"
extractRecSel nm t tvs (L _ con : rest) =
- case getConArgs con of
- RecCon (L _ fields) | ((l,L _ (ConDeclField _ _nn ty _)) : _) <- matching_fields fields ->
+ case getRecConArgs_maybe con of
+ Just (L _ fields) | ((l,L _ (ConDeclField _ _nn ty _)) : _) <- matching_fields fields ->
L l (TypeSig noExtField [noLoc nm] (mkEmptySigWcType (noLoc (HsFunTy noExtField (HsUnrestrictedArrow NormalSyntax) data_ty (getBangType ty)))))
_ -> extractRecSel nm t tvs rest
where