summaryrefslogtreecommitdiff
path: root/compiler/main/PprTyThing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/main/PprTyThing.hs')
-rw-r--r--compiler/main/PprTyThing.hs12
1 files changed, 8 insertions, 4 deletions
diff --git a/compiler/main/PprTyThing.hs b/compiler/main/PprTyThing.hs
index 1fd5d0cbcf..2fa4783063 100644
--- a/compiler/main/PprTyThing.hs
+++ b/compiler/main/PprTyThing.hs
@@ -228,7 +228,7 @@ pprAlgTyCon ss tyCon
datacons = tyConDataCons tyCon
gadt = any (not . isVanillaDataCon) datacons
- ok_con dc = showSub ss dc || any (showSub ss) (dataConFieldLabels dc)
+ ok_con dc = showSub ss dc || any (showSub ss . flSelector) (dataConFieldLabels dc)
show_con dc
| ok_con dc = Just (pprDataConDecl ss gadt dc)
| otherwise = Nothing
@@ -262,9 +262,10 @@ pprDataConDecl ss gadt_style dataCon
user_ify (HsUnpack {}) = HsUserBang (Just True) True
user_ify bang = bang
- maybe_show_label (lbl,bty)
- | showSub ss lbl = Just (ppr_bndr lbl <+> dcolon <+> pprBangTy bty)
- | otherwise = Nothing
+ maybe_show_label (fl, bty)
+ | showSub ss (flSelector fl)
+ = Just (ppr_bndr_occ (mkVarOccFS (flLabel fl)) <+> dcolon <+> pprBangTy bty)
+ | otherwise = Nothing
ppr_fields [ty1, ty2]
| dataConIsInfix dataCon && null labels
@@ -331,6 +332,9 @@ add_bars (c:cs) = sep ((equals <+> c) : map (char '|' <+>) cs)
ppr_bndr :: NamedThing a => a -> SDoc
ppr_bndr a = parenSymOcc (getOccName a) (ppr (getName a))
+ppr_bndr_occ :: OccName -> SDoc
+ppr_bndr_occ a = parenSymOcc a (ppr a)
+
showWithLoc :: SDoc -> SDoc -> SDoc
showWithLoc loc doc
= hang doc 2 (char '\t' <> comment <+> loc)