diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2012-03-26 09:14:23 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2012-03-26 09:14:23 +0100 |
commit | 1e6e6c01babee971420e1876cdffdfb0bf673c1e (patch) | |
tree | 892a4b3be7d2bd68ddb3bc50543a1e2834590092 /src/Haddock/Utils.hs | |
parent | 730d3e622268f59fd78d29026d164486c4e68fcb (diff) |
Follow refactoring of TyClDecl/HsTyDefn
Diffstat (limited to 'src/Haddock/Utils.hs')
-rw-r--r-- | src/Haddock/Utils.hs | 20 |
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 ] |