aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Utils.hs
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2012-03-26 09:14:23 +0100
committerSimon Peyton Jones <simonpj@microsoft.com>2012-03-26 09:14:23 +0100
commit1e6e6c01babee971420e1876cdffdfb0bf673c1e (patch)
tree892a4b3be7d2bd68ddb3bc50543a1e2834590092 /src/Haddock/Utils.hs
parent730d3e622268f59fd78d29026d164486c4e68fcb (diff)
Follow refactoring of TyClDecl/HsTyDefn
Diffstat (limited to 'src/Haddock/Utils.hs')
-rw-r--r--src/Haddock/Utils.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/src/Haddock/Utils.hs b/src/Haddock/Utils.hs
index de97ef85..3814b97e 100644
--- a/src/Haddock/Utils.hs
+++ b/src/Haddock/Utils.hs
@@ -125,18 +125,24 @@ toInstalledDescription = hmi_description . instInfo
restrictTo :: [Name] -> LHsDecl Name -> LHsDecl Name
restrictTo names (L loc decl) = L loc $ case decl of
- TyClD d | isDataDecl d && tcdND d == DataType ->
- TyClD (d { tcdCons = restrictCons names (tcdCons d) })
- TyClD d | isDataDecl d && tcdND d == NewType ->
- case restrictCons names (tcdCons d) of
- [] -> TyClD (d { tcdND = DataType, tcdCons = [] })
- [con] -> TyClD (d { tcdCons = [con] })
- _ -> error "Should not happen"
+ TyClD d | isDataDecl d ->
+ TyClD (d { tcdTyDefn = restrictTyDefn names (tcdTyDefn d) })
TyClD d | isClassDecl d ->
TyClD (d { tcdSigs = restrictDecls names (tcdSigs d),
tcdATs = restrictATs names (tcdATs d) })
_ -> decl
+restrictTyDefn :: [Name] -> HsTyDefn Name -> HsTyDefn Name
+restrictTyDefn _ defn@(TySynonym {})
+ = defn
+restrictTyDefn names defn@(TyData { td_ND = new_or_data, td_cons = cons })
+ | DataType <- new_or_data
+ = defn { td_cons = restrictCons names cons }
+ | otherwise -- Newtype
+ = case restrictCons names cons of
+ [] -> defn { td_ND = DataType, td_cons = [] }
+ [con] -> defn { td_cons = [con] }
+ _ -> error "Should not happen"
restrictCons :: [Name] -> [LConDecl Name] -> [LConDecl Name]
restrictCons names decls = [ L p d | L p (Just d) <- map (fmap keep) decls ]