{-# LANGUAGE PatternSynonyms #-}

-- | Pretty-printing types and coercions.
module GHC.Core.TyCo.Ppr
  (
        -- * Precedence
        PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,

        -- * Pretty-printing types
        pprType, pprParendType, pprTidiedType, pprPrecType, pprPrecTypeX,
        pprTypeApp, pprTCvBndr, pprTCvBndrs,
        pprSigmaType,
        pprTheta, pprParendTheta, pprForAll, pprUserForAll,
        pprTyVar, pprTyVars,
        pprThetaArrowTy, pprClassPred,
        pprKind, pprParendKind, pprTyLit,
        pprDataCons, pprWithExplicitKindsWhen,
        pprWithTYPE, pprSourceTyCon,


        -- * Pretty-printing coercions
        pprCo, pprParendCo,

        debugPprType,

        -- * Pretty-printing 'TyThing's
        pprTyThingCategory, pprShortTyThing,
  ) where

import GHC.Prelude

import {-# SOURCE #-} GHC.CoreToIface
   ( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr
   , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX )

import {-# SOURCE #-} GHC.Core.DataCon
   ( dataConFullSig , dataConUserTyVarBinders
   , DataCon )

import GHC.Core.Type ( isLiftedTypeKind, pattern One, pattern Many )

import GHC.Core.TyCon
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Tidy
import GHC.Core.TyCo.FVs
import GHC.Core.Class
import GHC.Types.Var

import GHC.Iface.Type

import GHC.Types.Var.Set
import GHC.Types.Var.Env

import GHC.Utils.Outputable
import GHC.Types.Basic ( PprPrec(..), topPrec, sigPrec, opPrec
                       , funPrec, appPrec, maybeParen )

{-
%************************************************************************
%*                                                                      *
                   Pretty-printing types

       Defined very early because of debug printing in assertions
%*                                                                      *
%************************************************************************

@pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
defined to use this.  @pprParendType@ is the same, except it puts
parens around the type, except for the atomic cases.  @pprParendType@
works just by setting the initial context precedence very high.

Note that any function which pretty-prints a @Type@ first converts the @Type@
to an @IfaceType@. See Note [IfaceType and pretty-printing] in GHC.Iface.Type.

See Note [Precedence in types] in GHC.Types.Basic.
-}

--------------------------------------------------------
-- When pretty-printing types, we convert to IfaceType,
--   and pretty-print that.
-- See Note [Pretty printing via Iface syntax] in GHC.Core.Ppr.TyThing
--------------------------------------------------------

pprType, pprParendType, pprTidiedType :: Type -> SDoc
pprType :: Type -> SDoc
pprType       = PprPrec -> Type -> SDoc
pprPrecType PprPrec
topPrec
pprParendType :: Type -> SDoc
pprParendType = PprPrec -> Type -> SDoc
pprPrecType PprPrec
appPrec

-- already pre-tidied
pprTidiedType :: Type -> SDoc
pprTidiedType = IfaceType -> SDoc
pprIfaceType (IfaceType -> SDoc) -> (Type -> IfaceType) -> Type -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
emptyVarSet

pprPrecType :: PprPrec -> Type -> SDoc
pprPrecType :: PprPrec -> Type -> SDoc
pprPrecType = TidyEnv -> PprPrec -> Type -> SDoc
pprPrecTypeX TidyEnv
emptyTidyEnv

pprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc
pprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc
pprPrecTypeX TidyEnv
env PprPrec
prec Type
ty
  = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \PprStyle
sty ->
    (Bool -> SDoc) -> SDoc
getPprDebug ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Bool
debug ->
    if Bool
debug                    -- Use debugPprType when in
    then PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
prec Type
ty   -- when in debug-style
    else PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
prec (TidyEnv -> Type -> PprStyle -> IfaceType
tidyToIfaceTypeStyX TidyEnv
env Type
ty PprStyle
sty)
    -- NB: debug-style is used for -dppr-debug
    --     dump-style  is used for -ddump-tc-trace etc

pprTyLit :: TyLit -> SDoc
pprTyLit :: TyLit -> SDoc
pprTyLit = IfaceTyLit -> SDoc
pprIfaceTyLit (IfaceTyLit -> SDoc) -> (TyLit -> IfaceTyLit) -> TyLit -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyLit -> IfaceTyLit
toIfaceTyLit

pprKind, pprParendKind :: Kind -> SDoc
pprKind :: Type -> SDoc
pprKind       = Type -> SDoc
pprType
pprParendKind :: Type -> SDoc
pprParendKind = Type -> SDoc
pprParendType

tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType
tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType
tidyToIfaceTypeStyX TidyEnv
env Type
ty PprStyle
sty
  | PprStyle -> Bool
userStyle PprStyle
sty = TidyEnv -> Type -> IfaceType
tidyToIfaceTypeX TidyEnv
env Type
ty
  | Bool
otherwise     = VarSet -> Type -> IfaceType
toIfaceTypeX (Type -> VarSet
tyCoVarsOfType Type
ty) Type
ty
     -- in latter case, don't tidy, as we'll be printing uniques.

tidyToIfaceType :: Type -> IfaceType
tidyToIfaceType :: Type -> IfaceType
tidyToIfaceType = TidyEnv -> Type -> IfaceType
tidyToIfaceTypeX TidyEnv
emptyTidyEnv

tidyToIfaceTypeX :: TidyEnv -> Type -> IfaceType
-- It's vital to tidy before converting to an IfaceType
-- or nested binders will become indistinguishable!
--
-- Also for the free type variables, tell toIfaceTypeX to
-- leave them as IfaceFreeTyVar.  This is super-important
-- for debug printing.
tidyToIfaceTypeX :: TidyEnv -> Type -> IfaceType
tidyToIfaceTypeX TidyEnv
env Type
ty = VarSet -> Type -> IfaceType
toIfaceTypeX ([Var] -> VarSet
mkVarSet [Var]
free_tcvs) (TidyEnv -> Type -> Type
tidyType TidyEnv
env' Type
ty)
  where
    env' :: TidyEnv
env'      = TidyEnv -> [Var] -> TidyEnv
tidyFreeTyCoVars TidyEnv
env [Var]
free_tcvs
    free_tcvs :: [Var]
free_tcvs = Type -> [Var]
tyCoVarsOfTypeWellScoped Type
ty

------------
pprCo, pprParendCo :: Coercion -> SDoc
pprCo :: KindCoercion -> SDoc
pprCo       KindCoercion
co = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty -> IfaceCoercion -> SDoc
pprIfaceCoercion (KindCoercion -> PprStyle -> IfaceCoercion
tidyToIfaceCoSty KindCoercion
co PprStyle
sty)
pprParendCo :: KindCoercion -> SDoc
pprParendCo KindCoercion
co = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty -> IfaceCoercion -> SDoc
pprParendIfaceCoercion (KindCoercion -> PprStyle -> IfaceCoercion
tidyToIfaceCoSty KindCoercion
co PprStyle
sty)

tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion
tidyToIfaceCoSty :: KindCoercion -> PprStyle -> IfaceCoercion
tidyToIfaceCoSty KindCoercion
co PprStyle
sty
  | PprStyle -> Bool
userStyle PprStyle
sty = KindCoercion -> IfaceCoercion
tidyToIfaceCo KindCoercion
co
  | Bool
otherwise     = VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX (KindCoercion -> VarSet
tyCoVarsOfCo KindCoercion
co) KindCoercion
co
     -- in latter case, don't tidy, as we'll be printing uniques.

tidyToIfaceCo :: Coercion -> IfaceCoercion
-- It's vital to tidy before converting to an IfaceType
-- or nested binders will become indistinguishable!
--
-- Also for the free type variables, tell toIfaceCoercionX to
-- leave them as IfaceFreeCoVar.  This is super-important
-- for debug printing.
tidyToIfaceCo :: KindCoercion -> IfaceCoercion
tidyToIfaceCo KindCoercion
co = VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX ([Var] -> VarSet
mkVarSet [Var]
free_tcvs) (TidyEnv -> KindCoercion -> KindCoercion
tidyCo TidyEnv
env KindCoercion
co)
  where
    env :: TidyEnv
env       = TidyEnv -> [Var] -> TidyEnv
tidyFreeTyCoVars TidyEnv
emptyTidyEnv [Var]
free_tcvs
    free_tcvs :: [Var]
free_tcvs = [Var] -> [Var]
scopedSort ([Var] -> [Var]) -> [Var] -> [Var]
forall a b. (a -> b) -> a -> b
$ KindCoercion -> [Var]
tyCoVarsOfCoList KindCoercion
co
------------
pprClassPred :: Class -> [Type] -> SDoc
pprClassPred :: Class -> [Type] -> SDoc
pprClassPred Class
clas [Type]
tys = TyCon -> [Type] -> SDoc
pprTypeApp (Class -> TyCon
classTyCon Class
clas) [Type]
tys

------------
pprTheta :: ThetaType -> SDoc
pprTheta :: [Type] -> SDoc
pprTheta = PprPrec -> [IfaceType] -> SDoc
pprIfaceContext PprPrec
topPrec ([IfaceType] -> SDoc) -> ([Type] -> [IfaceType]) -> [Type] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> IfaceType) -> [Type] -> [IfaceType]
forall a b. (a -> b) -> [a] -> [b]
map Type -> IfaceType
tidyToIfaceType

pprParendTheta :: ThetaType -> SDoc
pprParendTheta :: [Type] -> SDoc
pprParendTheta = PprPrec -> [IfaceType] -> SDoc
pprIfaceContext PprPrec
appPrec ([IfaceType] -> SDoc) -> ([Type] -> [IfaceType]) -> [Type] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> IfaceType) -> [Type] -> [IfaceType]
forall a b. (a -> b) -> [a] -> [b]
map Type -> IfaceType
tidyToIfaceType

pprThetaArrowTy :: ThetaType -> SDoc
pprThetaArrowTy :: [Type] -> SDoc
pprThetaArrowTy = [IfaceType] -> SDoc
pprIfaceContextArr ([IfaceType] -> SDoc) -> ([Type] -> [IfaceType]) -> [Type] -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type -> IfaceType) -> [Type] -> [IfaceType]
forall a b. (a -> b) -> [a] -> [b]
map Type -> IfaceType
tidyToIfaceType

------------------
pprSigmaType :: Type -> SDoc
pprSigmaType :: Type -> SDoc
pprSigmaType = ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType ShowForAllFlag
ShowForAllWhen (IfaceType -> SDoc) -> (Type -> IfaceType) -> Type -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> IfaceType
tidyToIfaceType

pprForAll :: [TyCoVarBinder] -> SDoc
pprForAll :: [TyCoVarBinder] -> SDoc
pprForAll [TyCoVarBinder]
tvs = [IfaceForAllBndr] -> SDoc
pprIfaceForAll ((TyCoVarBinder -> IfaceForAllBndr)
-> [TyCoVarBinder] -> [IfaceForAllBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVarBinder -> IfaceForAllBndr
forall flag. VarBndr Var flag -> VarBndr IfaceBndr flag
toIfaceForAllBndr [TyCoVarBinder]
tvs)

-- | Print a user-level forall; see @Note [When to print foralls]@ in
-- "GHC.Iface.Type".
pprUserForAll :: [TyCoVarBinder] -> SDoc
pprUserForAll :: [TyCoVarBinder] -> SDoc
pprUserForAll = [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll ([IfaceForAllBndr] -> SDoc)
-> ([TyCoVarBinder] -> [IfaceForAllBndr])
-> [TyCoVarBinder]
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TyCoVarBinder -> IfaceForAllBndr)
-> [TyCoVarBinder] -> [IfaceForAllBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVarBinder -> IfaceForAllBndr
forall flag. VarBndr Var flag -> VarBndr IfaceBndr flag
toIfaceForAllBndr

pprTCvBndrs :: [TyCoVarBinder] -> SDoc
pprTCvBndrs :: [TyCoVarBinder] -> SDoc
pprTCvBndrs [TyCoVarBinder]
tvs = [SDoc] -> SDoc
sep ((TyCoVarBinder -> SDoc) -> [TyCoVarBinder] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVarBinder -> SDoc
pprTCvBndr [TyCoVarBinder]
tvs)

pprTCvBndr :: TyCoVarBinder -> SDoc
pprTCvBndr :: TyCoVarBinder -> SDoc
pprTCvBndr = Var -> SDoc
pprTyVar (Var -> SDoc) -> (TyCoVarBinder -> Var) -> TyCoVarBinder -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCoVarBinder -> Var
forall tv argf. VarBndr tv argf -> tv
binderVar

pprTyVars :: [TyVar] -> SDoc
pprTyVars :: [Var] -> SDoc
pprTyVars [Var]
tvs = [SDoc] -> SDoc
sep ((Var -> SDoc) -> [Var] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Var -> SDoc
pprTyVar [Var]
tvs)

pprTyVar :: TyVar -> SDoc
-- Print a type variable binder with its kind (but not if *)
-- Here we do not go via IfaceType, because the duplication with
-- pprIfaceTvBndr is minimal, and the loss of uniques etc in
-- debug printing is disastrous
pprTyVar :: Var -> SDoc
pprTyVar Var
tv
  | Type -> Bool
isLiftedTypeKind Type
kind = Var -> SDoc
forall a. Outputable a => a -> SDoc
ppr Var
tv
  | Bool
otherwise             = SDoc -> SDoc
parens (Var -> SDoc
forall a. Outputable a => a -> SDoc
ppr Var
tv SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
kind)
  where
    kind :: Type
kind = Var -> Type
tyVarKind Var
tv

-----------------
debugPprType :: Type -> SDoc
-- ^ debugPprType is a simple pretty printer that prints a type
-- without going through IfaceType.  It does not format as prettily
-- as the normal route, but it's much more direct, and that can
-- be useful for debugging.  E.g. with -dppr-debug it prints the
-- kind on type-variable /occurrences/ which the normal route
-- fundamentally cannot do.
debugPprType :: Type -> SDoc
debugPprType Type
ty = PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
topPrec Type
ty

debug_ppr_ty :: PprPrec -> Type -> SDoc
debug_ppr_ty :: PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
_ (LitTy TyLit
l)
  = TyLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyLit
l

debug_ppr_ty PprPrec
_ (TyVarTy Var
tv)
  = Var -> SDoc
forall a. Outputable a => a -> SDoc
ppr Var
tv  -- With -dppr-debug we get (tv :: kind)

debug_ppr_ty PprPrec
prec ty :: Type
ty@(FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_mult :: Type -> Type
ft_mult = Type
mult, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res })
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    [SDoc] -> SDoc
sep [PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
funPrec Type
arg, SDoc
arr SDoc -> SDoc -> SDoc
<+> PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
prec Type
res]
  where
    arr :: SDoc
arr = case AnonArgFlag
af of
            AnonArgFlag
VisArg   -> case Type
mult of
                          Type
One -> SDoc
lollipop
                          Type
Many -> SDoc
arrow
                          Type
w -> SDoc -> SDoc
mulArrow (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
w)
            AnonArgFlag
InvisArg -> case Type
mult of
                          Type
Many -> SDoc
darrow
                          Type
_ -> String -> SDoc -> SDoc
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"unexpected multiplicity" (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty)

debug_ppr_ty PprPrec
prec (TyConApp TyCon
tc [Type]
tys)
  | [Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys  = TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc
  | Bool
otherwise = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
prec PprPrec
appPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                SDoc -> Int -> SDoc -> SDoc
hang (TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tc) Int
2 ([SDoc] -> SDoc
sep ((Type -> SDoc) -> [Type] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
appPrec) [Type]
tys))

debug_ppr_ty PprPrec
_ (AppTy Type
t1 Type
t2)
  = SDoc -> Int -> SDoc -> SDoc
hang (PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
appPrec Type
t1)  -- Print parens so we see ((a b) c)
       Int
2 (PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
appPrec Type
t2)  -- so that we can distinguish
                                    -- TyConApp from AppTy

debug_ppr_ty PprPrec
prec (CastTy Type
ty KindCoercion
co)
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
prec PprPrec
topPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    SDoc -> Int -> SDoc -> SDoc
hang (PprPrec -> Type -> SDoc
debug_ppr_ty PprPrec
topPrec Type
ty)
       Int
2 (String -> SDoc
text String
"|>" SDoc -> SDoc -> SDoc
<+> KindCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr KindCoercion
co)

debug_ppr_ty PprPrec
_ (CoercionTy KindCoercion
co)
  = SDoc -> SDoc
parens (String -> SDoc
text String
"CO" SDoc -> SDoc -> SDoc
<+> KindCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr KindCoercion
co)

debug_ppr_ty PprPrec
prec ty :: Type
ty@(ForAllTy {})
  | ([TyCoVarBinder]
tvs, Type
body) <- Type -> ([TyCoVarBinder], Type)
split Type
ty
  = PprPrec -> PprPrec -> SDoc -> SDoc
maybeParen PprPrec
prec PprPrec
funPrec (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
    SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"forall" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
fsep ((TyCoVarBinder -> SDoc) -> [TyCoVarBinder] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVarBinder -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TyCoVarBinder]
tvs) SDoc -> SDoc -> SDoc
<> SDoc
dot)
         -- The (map ppr tvs) will print kind-annotated
         -- tvs, because we are (usually) in debug-style
       Int
2 (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
body)
  where
    split :: Type -> ([TyCoVarBinder], Type)
split Type
ty | ForAllTy TyCoVarBinder
tv Type
ty' <- Type
ty
             , ([TyCoVarBinder]
tvs, Type
body) <- Type -> ([TyCoVarBinder], Type)
split Type
ty'
             = (TyCoVarBinder
tvTyCoVarBinder -> [TyCoVarBinder] -> [TyCoVarBinder]
forall a. a -> [a] -> [a]
:[TyCoVarBinder]
tvs, Type
body)
             | Bool
otherwise
             = ([], Type
ty)

{-
Note [Infix type variables]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
With TypeOperators you can say

   f :: (a ~> b) -> b

and the (~>) is considered a type variable.  However, the type
pretty-printer in this module will just see (a ~> b) as

   App (App (TyVarTy "~>") (TyVarTy "a")) (TyVarTy "b")

So it'll print the type in prefix form.  To avoid confusion we must
remember to parenthesise the operator, thus

   (~>) a b -> b

See #2766.
-}

pprDataCons :: TyCon -> SDoc
pprDataCons :: TyCon -> SDoc
pprDataCons = [SDoc] -> SDoc
sepWithVBars ([SDoc] -> SDoc) -> (TyCon -> [SDoc]) -> TyCon -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DataCon -> SDoc) -> [DataCon] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap DataCon -> SDoc
pprDataConWithArgs ([DataCon] -> [SDoc]) -> (TyCon -> [DataCon]) -> TyCon -> [SDoc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> [DataCon]
tyConDataCons
  where
    sepWithVBars :: [SDoc] -> SDoc
sepWithVBars [] = SDoc
empty
    sepWithVBars [SDoc]
docs = [SDoc] -> SDoc
sep (SDoc -> [SDoc] -> [SDoc]
punctuate (SDoc
space SDoc -> SDoc -> SDoc
<> SDoc
vbar) [SDoc]
docs)

pprDataConWithArgs :: DataCon -> SDoc
pprDataConWithArgs :: DataCon -> SDoc
pprDataConWithArgs DataCon
dc = [SDoc] -> SDoc
sep [SDoc
forAllDoc, SDoc
thetaDoc, DataCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr DataCon
dc SDoc -> SDoc -> SDoc
<+> SDoc
argsDoc]
  where
    ([Var]
_univ_tvs, [Var]
_ex_tvs, [EqSpec]
_eq_spec, [Type]
theta, [Scaled Type]
arg_tys, Type
_res_ty) = DataCon -> ([Var], [Var], [EqSpec], [Type], [Scaled Type], Type)
dataConFullSig DataCon
dc
    user_bndrs :: [TyCoVarBinder]
user_bndrs = [VarBndr Var Specificity] -> [TyCoVarBinder]
forall a. [VarBndr a Specificity] -> [VarBndr a ArgFlag]
tyVarSpecToBinders ([VarBndr Var Specificity] -> [TyCoVarBinder])
-> [VarBndr Var Specificity] -> [TyCoVarBinder]
forall a b. (a -> b) -> a -> b
$ DataCon -> [VarBndr Var Specificity]
dataConUserTyVarBinders DataCon
dc
    forAllDoc :: SDoc
forAllDoc  = [TyCoVarBinder] -> SDoc
pprUserForAll [TyCoVarBinder]
user_bndrs
    thetaDoc :: SDoc
thetaDoc   = [Type] -> SDoc
pprThetaArrowTy [Type]
theta
    argsDoc :: SDoc
argsDoc    = [SDoc] -> SDoc
hsep ((Type -> SDoc) -> [Type] -> [SDoc]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Type -> SDoc
pprParendType ((Scaled Type -> Type) -> [Scaled Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map Scaled Type -> Type
forall a. Scaled a -> a
scaledThing [Scaled Type]
arg_tys))


pprTypeApp :: TyCon -> [Type] -> SDoc
pprTypeApp :: TyCon -> [Type] -> SDoc
pprTypeApp TyCon
tc [Type]
tys
  = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp PprPrec
topPrec (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc)
                            (TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs TyCon
tc [Type]
tys)
    -- TODO: toIfaceTcArgs seems rather wasteful here

------------------
-- | Display all kind information (with @-fprint-explicit-kinds@) when the
-- provided 'Bool' argument is 'True'.
-- See @Note [Kind arguments in error messages]@ in "GHC.Tc.Errors".
pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc
pprWithExplicitKindsWhen Bool
b
  = (SDocContext -> SDocContext) -> SDoc -> SDoc
updSDocContext ((SDocContext -> SDocContext) -> SDoc -> SDoc)
-> (SDocContext -> SDocContext) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ \SDocContext
ctx ->
      if Bool
b then SDocContext
ctx { sdocPrintExplicitKinds :: Bool
sdocPrintExplicitKinds = Bool
True }
           else SDocContext
ctx

-- | This variant preserves any use of TYPE in a type, effectively
-- locally setting -fprint-explicit-runtime-reps.
pprWithTYPE :: Type -> SDoc
pprWithTYPE :: Type -> SDoc
pprWithTYPE Type
ty = (SDocContext -> SDocContext) -> SDoc -> SDoc
updSDocContext (\SDocContext
ctx -> SDocContext
ctx { sdocPrintExplicitRuntimeReps :: Bool
sdocPrintExplicitRuntimeReps = Bool
True }) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                 Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr Type
ty

-- | Pretty prints a 'TyCon', using the family instance in case of a
-- representation tycon.  For example:
--
-- > data T [a] = ...
--
-- In that case we want to print @T [a]@, where @T@ is the family 'TyCon'
pprSourceTyCon :: TyCon -> SDoc
pprSourceTyCon :: TyCon -> SDoc
pprSourceTyCon TyCon
tycon
  | Just (TyCon
fam_tc, [Type]
tys) <- TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe TyCon
tycon
  = Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Type -> SDoc) -> Type -> SDoc
forall a b. (a -> b) -> a -> b
$ TyCon
fam_tc TyCon -> [Type] -> Type
`TyConApp` [Type]
tys        -- can't be FunTyCon
  | Bool
otherwise
  = TyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr TyCon
tycon