diff options
Diffstat (limited to 'libraries/template-haskell/Language/Haskell/TH/Ppr.hs')
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Ppr.hs | 24 |
1 files changed, 20 insertions, 4 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs index 98ddd1c2ca..461f213813 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Ppr.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Ppr.hs @@ -153,7 +153,11 @@ pprExp i (LamE ps e) = parensIf (i > noPrec) $ char '\\' <> hsep (map (pprPat ap <+> text "->" <+> ppr e pprExp i (LamCaseE ms) = parensIf (i > noPrec) $ text "\\case" $$ nest nestDepth (ppr ms) -pprExp _ (TupE es) = parens (commaSepWith (pprMaybeExp noPrec) es) +pprExp i (TupE es) + | [Just e] <- es + = pprExp i (ConE (tupleDataName 1) `AppE` e) + | otherwise + = parens (commaSepWith (pprMaybeExp noPrec) es) pprExp _ (UnboxedTupE es) = hashParens (commaSepWith (pprMaybeExp noPrec) es) pprExp _ (UnboxedSumE e alt arity) = unboxedSumBars (ppr e) alt arity -- Nesting in Cond is to avoid potential problems in do statements @@ -291,7 +295,11 @@ instance Ppr Pat where pprPat :: Precedence -> Pat -> Doc pprPat i (LitP l) = pprLit i l pprPat _ (VarP v) = pprName' Applied v -pprPat _ (TupP ps) = parens (commaSep ps) +pprPat i (TupP ps) + | [_] <- ps + = pprPat i (ConP (tupleDataName 1) ps) + | otherwise + = parens (commaSep ps) pprPat _ (UnboxedTupP ps) = hashParens (commaSep ps) pprPat _ (UnboxedSumP p alt arity) = unboxedSumBars (ppr p) alt arity pprPat i (ConP s ps) = parensIf (i >= appPrec) $ pprName' Applied s @@ -742,6 +750,7 @@ pprParendType (VarT v) = pprName' Applied v -- `Applied` is used here instead of `ppr` because of infix names (#13887) pprParendType (ConT c) = pprName' Applied c pprParendType (TupleT 0) = text "()" +pprParendType (TupleT 1) = pprParendType (ConT (tupleTypeName 1)) pprParendType (TupleT n) = parens (hcat (replicate (n-1) comma)) pprParendType (UnboxedTupleT n) = hashParens $ hcat $ replicate (n-1) comma pprParendType (UnboxedSumT arity) = hashParens $ hcat $ replicate (arity-1) bar @@ -750,6 +759,7 @@ pprParendType ListT = text "[]" pprParendType (LitT l) = pprTyLit l pprParendType (PromotedT c) = text "'" <> pprName' Applied c pprParendType (PromotedTupleT 0) = text "'()" +pprParendType (PromotedTupleT 1) = pprParendType (PromotedT (tupleDataName 1)) pprParendType (PromotedTupleT n) = quoteParens (hcat (replicate (n-1) comma)) pprParendType PromotedNilT = text "'[]" pprParendType PromotedConsT = text "'(:)" @@ -801,9 +811,15 @@ pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+> text "~", ppr arg2] pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg) pprTyApp (TupleT n, args) - | length args == n = parens (commaSep args) + | length args == n + = if n == 1 + then pprTyApp (ConT (tupleTypeName 1), args) + else parens (commaSep args) pprTyApp (PromotedTupleT n, args) - | length args == n = quoteParens (commaSep args) + | length args == n + = if n == 1 + then pprTyApp (PromotedT (tupleDataName 1), args) + else quoteParens (commaSep args) pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args) pprFunArgType :: Type -> Doc -- Should really use a precedence argument |