From 7b3f6f3a5230dab898a8a824f03636e27b84bfb1 Mon Sep 17 00:00:00 2001 From: Alexander Biehl Date: Tue, 13 Mar 2018 08:45:06 +0100 Subject: extractDecl: Extract constructor patterns from data family instances (#776) * extractDecl: Allow extraction of data family instance constructors * extractDecl: extract data family instance constructors --- haddock-api/src/Haddock/Interface/Create.hs | 39 +++++++++++++++++++---------- 1 file changed, 26 insertions(+), 13 deletions(-) (limited to 'haddock-api/src') 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" -- cgit v1.2.3