Commit 70dd0e4b authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Marge Bot

Parenthesize the * kind in TH.Ppr

parent 3354c68e
......@@ -791,12 +791,17 @@ instance Ppr Type where
-- Works, in a degenerate way, for SigT, and puts parens round (ty :: kind)
-- See Note [Pretty-printing kind signatures]
instance Ppr TypeArg where
ppr (TANormal ty) = ppr ty
ppr (TyArg ki) = char '@' <> ppr ki
ppr (TANormal ty) = parensIf (isStarT ty) (ppr ty)
ppr (TyArg ki) = char '@' <> parensIf (isStarT ki) (ppr ki)
pprParendTypeArg :: TypeArg -> Doc
pprParendTypeArg (TANormal ty) = pprParendType ty
pprParendTypeArg (TyArg ki) = char '@' <> pprParendType ki
pprParendTypeArg (TANormal ty) = parensIf (isStarT ty) (pprParendType ty)
pprParendTypeArg (TyArg ki) = char '@' <> parensIf (isStarT ki) (pprParendType ki)
isStarT :: Type -> Bool
isStarT StarT = True
isStarT _ = False
{- Note [Pretty-printing kind signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC's parser only recognises a kind signature in a type when there are
......@@ -810,18 +815,20 @@ pprTyApp (ArrowT, [TANormal arg1, TANormal arg2]) = sep [pprFunArgType arg1 <+>
pprTyApp (EqualityT, [TANormal arg1, TANormal arg2]) =
sep [pprFunArgType arg1 <+> text "~", ppr arg2]
pprTyApp (ListT, [TANormal arg]) = brackets (ppr arg)
pprTyApp (TupleT 1, args) = pprTyApp (ConT (tupleTypeName 1), args)
pprTyApp (PromotedTupleT 1, args) = pprTyApp (PromotedT (tupleDataName 1), args)
pprTyApp (TupleT n, args)
| length args == n
= if n == 1
then pprTyApp (ConT (tupleTypeName 1), args)
else parens (commaSep args)
| length args == n, Just args' <- traverse fromTANormal args
= parens (commaSep args')
pprTyApp (PromotedTupleT n, args)
| length args == n
= if n == 1
then pprTyApp (PromotedT (tupleDataName 1), args)
else quoteParens (commaSep args)
| length args == n, Just args' <- traverse fromTANormal args
= quoteParens (commaSep args')
pprTyApp (fun, args) = pprParendType fun <+> sep (map pprParendTypeArg args)
fromTANormal :: TypeArg -> Maybe Type
fromTANormal (TANormal arg) = Just arg
fromTANormal (TyArg _) = Nothing
pprFunArgType :: Type -> Doc -- Should really use a precedence argument
-- Everything except forall and (->) binds more tightly than (->)
pprFunArgType ty@(ForallT {}) = parens (ppr ty)
......
data Main.Proxy1 (a_0 :: Main.Id1 k_1) = Main.Proxy1
data Main.Proxy2 (a_0 :: Main.Id2 * k_1) = Main.Proxy2
data Main.Proxy2 (a_0 :: Main.Id2 (*) k_1) = Main.Proxy2
{-# LANGUAGE TemplateHaskell, TypeApplications, ExplicitForAll, StarIsType #-}
{-# OPTIONS -Wno-star-is-type #-}
module TH_PprStar where
import Data.Proxy
import Language.Haskell.TH
import System.IO
do t <- [t| (Proxy @(*) String -> *) -> Either * ((* -> *) -> *) |]
runIO $ do hPutStrLn stderr (pprint t)
return []
(Data.Proxy.Proxy @(*) GHC.Base.String -> *) ->
Data.Either.Either (*) ((* -> *) -> *)
......@@ -6,5 +6,5 @@ TH_TyInstWhere2.hs:8:2: warning:
TH_TyInstWhere2.hs:14:2: warning:
type family F1_0 (a_1 :: k_2) :: * where
F1_0 @* GHC.Types.Int = GHC.Types.Bool
F1_0 @(*) GHC.Types.Int = GHC.Types.Bool
F1_0 @GHC.Types.Bool 'GHC.Types.False = GHC.Types.Char
......@@ -494,3 +494,4 @@ test('T17394', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T17379a', normal, compile_fail, [''])
test('T17379b', normal, compile_fail, [''])
test('T17461', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('TH_PprStar', normal, compile, ['-v0 -dsuppress-uniques'])
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment