aboutsummaryrefslogtreecommitdiff
path: root/src/HaddockUtil.hs
diff options
context:
space:
mode:
authordavve <davve@dtek.chalmers.se>2007-02-03 21:23:56 +0000
committerdavve <davve@dtek.chalmers.se>2007-02-03 21:23:56 +0000
commit4dd150fe66a1c6d56569793af6d1d4c1a58daf68 (patch)
treeb22491aec88cae32e20e69a73fa8f93485a032a0 /src/HaddockUtil.hs
parent288ed096e584def7a2a30767e4b6d76177f2f75c (diff)
Let restrictCons handle infix constructors
Diffstat (limited to 'src/HaddockUtil.hs')
-rw-r--r--src/HaddockUtil.hs33
1 files changed, 18 insertions, 15 deletions
diff --git a/src/HaddockUtil.hs b/src/HaddockUtil.hs
index 7cdca748..b80e8a1b 100644
--- a/src/HaddockUtil.hs
+++ b/src/HaddockUtil.hs
@@ -81,21 +81,24 @@ restrictTo names (L loc decl) = L loc $ case decl of
_ -> decl
restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name]
-restrictCons names decls = [ L p (fromJust (keep d)) | L p d <- decls, isJust (keep d) ]
- where keep d | unLoc (con_name d) `elem` names =
- case con_details d of
- PrefixCon _ -> Just d
- RecCon fields
- | all field_avail fields -> Just d
- | otherwise -> Just (d { con_details = PrefixCon (field_types fields) })
- -- if we have *all* the field names available, then
- -- keep the record declaration. Otherwise degrade to
- -- a constructor declaration. This isn't quite right, but
- -- it's the best we can do.
- where
- field_avail (HsRecField n _ _) = (unLoc n) `elem` names
- field_types flds = [ ty | HsRecField n ty _ <- flds]
- keep d | otherwise = Nothing
+restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]
+ where
+ keep d | unLoc (con_name d) `elem` names =
+ case con_details d of
+ PrefixCon _ -> Just d
+ RecCon fields
+ | all field_avail fields -> Just d
+ | otherwise -> Just (d { con_details = PrefixCon (field_types fields) })
+ -- if we have *all* the field names available, then
+ -- keep the record declaration. Otherwise degrade to
+ -- a constructor declaration. This isn't quite right, but
+ -- it's the best we can do.
+ InfixCon _ _ -> Just d
+ where
+ field_avail (HsRecField n _ _) = (unLoc n) `elem` names
+ field_types flds = [ ty | HsRecField n ty _ <- flds]
+
+ keep d | otherwise = Nothing
restrictDecls :: [Name] -> [LSig Name] -> [LSig Name]
restrictDecls names decls = filter keep decls