Skip to content

Commit

Permalink
Small improvement in pretty-printing constructors.
Browse files Browse the repository at this point in the history
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
  • Loading branch information
Richard Eisenberg authored and bgamari committed Oct 3, 2015
1 parent 5c1fff2 commit cbd1ccb
Show file tree
Hide file tree
Showing 4 changed files with 19 additions and 16 deletions.
26 changes: 10 additions & 16 deletions compiler/hsSyn/HsDecls.hs
Expand Up @@ -12,7 +12,6 @@
-- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Abstract syntax of global declarations.
--
Expand Down Expand Up @@ -971,15 +970,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
Expand All @@ -1002,18 +1002,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)

{-
************************************************************************
Expand Down
6 changes: 6 additions & 0 deletions testsuite/tests/th/T10810.hs
@@ -0,0 +1,6 @@
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -ddump-splices -dsuppress-uniques #-}

module T10810 where

$([d| data Foo = (:!) |])
2 changes: 2 additions & 0 deletions testsuite/tests/th/T10810.stderr
@@ -0,0 +1,2 @@
T10810.hs:6:3-24: Splicing declarations
[d| data Foo = (:!) |] ======> data Foo = (:!)
1 change: 1 addition & 0 deletions testsuite/tests/th/all.T
Expand Up @@ -361,3 +361,4 @@ test('TH_Lift', normal, compile, ['-v0'])
test('T10019', normal, ghci_script, ['T10019.script'])
test('T10279', normal, compile_fail, ['-v0'])
test('T10596', normal, compile, ['-v0'])
test('T10810', normal, compile, ['-v0'])

0 comments on commit cbd1ccb

Please sign in to comment.