aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs39
1 files changed, 26 insertions, 13 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index cac1e8b0..deef7ad3 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -1054,19 +1054,32 @@ extractDecl declMap name decl
FamEqn { feqn_tycon = L _ n
, feqn_pats = tys
, feqn_rhs = defn }}))) ->
- SigD <$> extractRecSel name n tys (dd_cons defn)
- InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts }) ->
- 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 (getConDetails . unLoc) (dd_cons (feqn_rhs d))
- , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
- , L _ n <- ns
- , selectorFieldOcc n == name
- ]
- in case matches of
- [d0] -> extractDecl declMap name (noLoc . InstD $ DataFamInstD d0)
- _ -> error "internal: extractDecl (ClsInstD)"
+ if isDataConName name
+ then SigD <$> extractPatternSyn name n tys (dd_cons defn)
+ else SigD <$> extractRecSel name n tys (dd_cons defn)
+ InstD (ClsInstD ClsInstDecl { cid_datafam_insts = insts })
+ | isDataConName name ->
+ let matches = [ d' | L _ d'@(DataFamInstDecl (HsIB { hsib_body =
+ FamEqn { feqn_rhs = dd
+ }
+ })) <- insts
+ , name `elem` map unLoc (concatMap (getConNames . unLoc) (dd_cons dd))
+ ]
+ in case matches of
+ [d0] -> extractDecl declMap name (noLoc (InstD (DataFamInstD d0)))
+ _ -> error "internal: extractDecl (ClsInstD)"
+ | otherwise ->
+ 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 (getConDetails . unLoc) (dd_cons (feqn_rhs d))
+ , ConDeclField { cd_fld_names = ns } <- map unLoc (unLoc rec)
+ , L _ n <- ns
+ , selectorFieldOcc n == name
+ ]
+ in case matches of
+ [d0] -> extractDecl declMap name (noLoc . InstD $ DataFamInstD d0)
+ _ -> error "internal: extractDecl (ClsInstD)"
_ -> error "internal: extractDecl"