diff options
author | Richard Eisenberg <eir@cis.upenn.edu> | 2015-09-20 16:03:07 -0400 |
---|---|---|
committer | Richard Eisenberg <eir@cis.upenn.edu> | 2015-09-20 21:39:16 -0400 |
commit | 6a2092050c14570b9131fb5189c96dc562713b4c (patch) | |
tree | 936e0ef0e569085fa67af6d0ec7c711ef052d241 | |
parent | 93fafe057da20c40ff0a0f383e3341cac6aaee23 (diff) | |
download | haskell-6a2092050c14570b9131fb5189c96dc562713b4c.tar.gz |
Small improvement in pretty-printing constructors.
This fixes #10810 by cleaning up pretty-printing of constructor
declarations. This change also removes a (in my opinion) deeply
bogus orphan instance OutputableBndr [Located name], making
HsDecls now a non-orphan module. Yay all around.
Test case: th/T10810
-rw-r--r-- | compiler/hsSyn/HsDecls.hs | 26 | ||||
-rw-r--r-- | testsuite/tests/th/T10810.hs | 6 | ||||
-rw-r--r-- | testsuite/tests/th/T10810.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/th/all.T | 1 |
4 files changed, 19 insertions, 16 deletions
diff --git a/compiler/hsSyn/HsDecls.hs b/compiler/hsSyn/HsDecls.hs index 047ad14ae0..ecc36937da 100644 --- a/compiler/hsSyn/HsDecls.hs +++ b/compiler/hsSyn/HsDecls.hs @@ -12,7 +12,6 @@ -- in module PlaceHolder {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleInstances #-} -{-# OPTIONS_GHC -fno-warn-orphans #-} -- | Abstract syntax of global declarations. -- @@ -1114,15 +1113,16 @@ instance (OutputableBndr name) => Outputable (ConDecl name) where ppr = pprConDecl pprConDecl :: OutputableBndr name => ConDecl name -> SDoc -pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs +pprConDecl (ConDecl { con_names = [L _ con] -- NB: non-GADT means 1 con + , con_explicit = expl, con_qvars = tvs , con_cxt = cxt, con_details = details , con_res = ResTyH98, con_doc = doc }) = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details details] where - ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc cons, ppr t2] - ppr_details (PrefixCon tys) = hsep (pprPrefixOcc cons + ppr_details (InfixCon t1 t2) = hsep [ppr t1, pprInfixOcc con, ppr t2] + ppr_details (PrefixCon tys) = hsep (pprPrefixOcc con : map (pprParendHsType . unLoc) tys) - ppr_details (RecCon fields) = ppr_con_names cons + ppr_details (RecCon fields) = pprPrefixOcc con <+> pprConDeclFields (unLoc fields) pprConDecl (ConDecl { con_names = cons, con_explicit = expl, con_qvars = tvs @@ -1146,18 +1146,12 @@ pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT { -- so if we ever trip over one (albeit I can't see how that -- can happen) print it like a prefix one -ppr_con_names :: (OutputableBndr name) => [Located name] -> SDoc -ppr_con_names [x] = ppr x -ppr_con_names xs = interpp'SP xs - -instance (Outputable name) => OutputableBndr [Located name] where - pprBndr _bs xs = cat $ punctuate comma (map ppr xs) +-- this fallthrough would happen with a non-GADT-syntax ConDecl with more +-- than one constructor, which should indeed be impossible +pprConDecl (ConDecl { con_names = cons }) = pprPanic "pprConDecl" (ppr cons) - pprPrefixOcc [x] = ppr x - pprPrefixOcc xs = cat $ punctuate comma (map ppr xs) - - pprInfixOcc [x] = ppr x - pprInfixOcc xs = cat $ punctuate comma (map ppr xs) +ppr_con_names :: (OutputableBndr name) => [Located name] -> SDoc +ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc) {- ************************************************************************ diff --git a/testsuite/tests/th/T10810.hs b/testsuite/tests/th/T10810.hs new file mode 100644 index 0000000000..328c3e99fc --- /dev/null +++ b/testsuite/tests/th/T10810.hs @@ -0,0 +1,6 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-} + +module T10810 where + +$([d| data Foo = (:!) |]) diff --git a/testsuite/tests/th/T10810.stderr b/testsuite/tests/th/T10810.stderr new file mode 100644 index 0000000000..c960fe1941 --- /dev/null +++ b/testsuite/tests/th/T10810.stderr @@ -0,0 +1,2 @@ +T10810.hs:6:3-24: Splicing declarations + [d| data Foo = (:!) |] ======> data Foo = (:!) diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 85dae8b05a..bad0a0e161 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -354,3 +354,4 @@ test('T10704', test('T6018th', normal, compile_fail, ['-v0']) test('TH_namePackage', normal, compile_and_run, ['-v0']) test('T10811', normal, compile, ['-v0']) +test('T10810', normal, compile, ['-v0']) |