-- | contains a prettyprinter for the
-- Template Haskell datatypes

module Language.Haskell.TH.Ppr where
    -- All of the exports from this module should
    -- be "public" functions.  The main module TH
    -- re-exports them all.

import Text.PrettyPrint (render)
import Language.Haskell.TH.PprLib
import Language.Haskell.TH.Syntax
import Data.Word ( Word8 )
import Data.Char ( toLower, chr)
import GHC.Show  ( showMultiLineString )
import GHC.Lexeme( startsVarSym )
import Data.Ratio ( numerator, denominator )
import Prelude hiding ((<>))

nestDepth :: Int
nestDepth :: Int
nestDepth = 4

type Precedence = Int
appPrec, opPrec, unopPrec, sigPrec, noPrec :: Precedence
appPrec :: Int
appPrec  = 4    -- Argument of a function application
opPrec :: Int
opPrec   = 3    -- Argument of an infix operator
unopPrec :: Int
unopPrec = 2    -- Argument of an unresolved infix operator
sigPrec :: Int
sigPrec  = 1    -- Argument of an explicit type signature
noPrec :: Int
noPrec   = 0    -- Others

parensIf :: Bool -> Doc -> Doc
parensIf :: Bool -> Doc -> Doc
parensIf True d :: Doc
d = Doc -> Doc
parens Doc
d
parensIf False d :: Doc
d = Doc
d

------------------------------

pprint :: Ppr a => a -> String
pprint :: a -> String
pprint x :: a
x = Doc -> String
render (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$ Doc -> Doc
to_HPJ_Doc (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ a -> Doc
forall a. Ppr a => a -> Doc
ppr a
x

class Ppr a where
    ppr :: a -> Doc
    ppr_list :: [a] -> Doc
    ppr_list = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Ppr a => a -> Doc
ppr

instance Ppr a => Ppr [a] where
    ppr :: [a] -> Doc
ppr x :: [a]
x = [a] -> Doc
forall a. Ppr a => [a] -> Doc
ppr_list [a]
x

------------------------------
instance Ppr Name where
    ppr :: Name -> Doc
ppr v :: Name
v = Name -> Doc
pprName Name
v

------------------------------
instance Ppr Info where
    ppr :: Info -> Doc
ppr (TyConI d :: Dec
d)     = Dec -> Doc
forall a. Ppr a => a -> Doc
ppr Dec
d
    ppr (ClassI d :: Dec
d is :: [Dec]
is)  = Dec -> Doc
forall a. Ppr a => a -> Doc
ppr Dec
d Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Dec -> Doc) -> [Dec] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Dec -> Doc
forall a. Ppr a => a -> Doc
ppr [Dec]
is)
    ppr (FamilyI d :: Dec
d is :: [Dec]
is) = Dec -> Doc
forall a. Ppr a => a -> Doc
ppr Dec
d Doc -> Doc -> Doc
$$ [Doc] -> Doc
vcat ((Dec -> Doc) -> [Dec] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Dec -> Doc
forall a. Ppr a => a -> Doc
ppr [Dec]
is)
    ppr (PrimTyConI name :: Name
name arity :: Int
arity is_unlifted :: Bool
is_unlifted)
      = String -> Doc
text "Primitive"
        Doc -> Doc -> Doc
<+> (if Bool
is_unlifted then String -> Doc
text "unlifted" else Doc
empty)
        Doc -> Doc -> Doc
<+> String -> Doc
text "type constructor" Doc -> Doc -> Doc
<+> Doc -> Doc
quotes (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
name)
        Doc -> Doc -> Doc
<+> Doc -> Doc
parens (String -> Doc
text "arity" Doc -> Doc -> Doc
<+> Int -> Doc
int Int
arity)
    ppr (ClassOpI v :: Name
v ty :: Type
ty cls :: Name
cls)
      = String -> Doc
text "Class op from" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
cls Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> Name -> Type -> Doc
ppr_sig Name
v Type
ty
    ppr (DataConI v :: Name
v ty :: Type
ty tc :: Name
tc)
      = String -> Doc
text "Constructor from" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
tc Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> Name -> Type -> Doc
ppr_sig Name
v Type
ty
    ppr (PatSynI nm :: Name
nm ty :: Type
ty) = Name -> Type -> Doc
pprPatSynSig Name
nm Type
ty
    ppr (TyVarI v :: Name
v ty :: Type
ty)
      = String -> Doc
text "Type variable" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
v Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty
    ppr (VarI v :: Name
v ty :: Type
ty mb_d :: Maybe Dec
mb_d)
      = [Doc] -> Doc
vcat [Name -> Type -> Doc
ppr_sig Name
v Type
ty,
              case Maybe Dec
mb_d of { Nothing -> Doc
empty; Just d :: Dec
d -> Dec -> Doc
forall a. Ppr a => a -> Doc
ppr Dec
d }]

ppr_sig :: Name -> Type -> Doc
ppr_sig :: Name -> Type -> Doc
ppr_sig v :: Name
v ty :: Type
ty = NameIs -> Name -> Doc
pprName' NameIs
Applied Name
v Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty

pprFixity :: Name -> Fixity -> Doc
pprFixity :: Name -> Fixity -> Doc
pprFixity _ f :: Fixity
f | Fixity
f Fixity -> Fixity -> Bool
forall a. Eq a => a -> a -> Bool
== Fixity
defaultFixity = Doc
empty
pprFixity v :: Name
v (Fixity i :: Int
i d :: FixityDirection
d) = FixityDirection -> Doc
ppr_fix FixityDirection
d Doc -> Doc -> Doc
<+> Int -> Doc
int Int
i Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
v
    where ppr_fix :: FixityDirection -> Doc
ppr_fix InfixR = String -> Doc
text "infixr"
          ppr_fix InfixL = String -> Doc
text "infixl"
          ppr_fix InfixN = String -> Doc
text "infix"

-- | Pretty prints a pattern synonym type signature
pprPatSynSig :: Name -> PatSynType -> Doc
pprPatSynSig :: Name -> Type -> Doc
pprPatSynSig nm :: Name
nm ty :: Type
ty
  = String -> Doc
text "pattern" Doc -> Doc -> Doc
<+> Name -> Doc
pprPrefixOcc Name
nm Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
pprPatSynType Type
ty

-- | Pretty prints a pattern synonym's type; follows the usual
-- conventions to print a pattern synonym type compactly, yet
-- unambiguously. See the note on 'PatSynType' and the section on
-- pattern synonyms in the GHC user's guide for more information.
pprPatSynType :: PatSynType -> Doc
pprPatSynType :: Type -> Doc
pprPatSynType ty :: Type
ty@(ForallT uniTys :: [TyVarBndr]
uniTys reqs :: Cxt
reqs ty' :: Type
ty'@(ForallT exTys :: [TyVarBndr]
exTys provs :: Cxt
provs ty'' :: Type
ty''))
  | [TyVarBndr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndr]
exTys,  Cxt -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Cxt
provs = Type -> Doc
forall a. Ppr a => a -> Doc
ppr ([TyVarBndr] -> Cxt -> Type -> Type
ForallT [TyVarBndr]
uniTys Cxt
reqs Type
ty'')
  | [TyVarBndr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [TyVarBndr]
uniTys, Cxt -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Cxt
reqs  = Doc
noreqs Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty'
  | Cxt -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Cxt
reqs               = [TyVarBndr] -> Doc
forall a. Ppr a => [a] -> Doc
forall [TyVarBndr]
uniTys Doc -> Doc -> Doc
<+> Doc
noreqs Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty'
  | Bool
otherwise               = Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty
  where noreqs :: Doc
noreqs     = String -> Doc
text "() =>"
        forall :: [a] -> Doc
forall tvs :: [a]
tvs = String -> Doc
text "forall" Doc -> Doc -> Doc
<+> ([Doc] -> Doc
hsep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Ppr a => a -> Doc
ppr [a]
tvs)) Doc -> Doc -> Doc
<+> String -> Doc
text "."
pprPatSynType ty :: Type
ty            = Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty

------------------------------
instance Ppr Module where
  ppr :: Module -> Doc
ppr (Module pkg :: PkgName
pkg m :: ModName
m) = String -> Doc
text (PkgName -> String
pkgString PkgName
pkg) Doc -> Doc -> Doc
<+> String -> Doc
text (ModName -> String
modString ModName
m)

instance Ppr ModuleInfo where
  ppr :: ModuleInfo -> Doc
ppr (ModuleInfo imps :: [Module]
imps) = String -> Doc
text "Module" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat ((Module -> Doc) -> [Module] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Module -> Doc
forall a. Ppr a => a -> Doc
ppr [Module]
imps)

------------------------------
instance Ppr Exp where
    ppr :: Exp -> Doc
ppr = Int -> Exp -> Doc
pprExp Int
noPrec

pprPrefixOcc :: Name -> Doc
-- Print operators with parens around them
pprPrefixOcc :: Name -> Doc
pprPrefixOcc n :: Name
n = Bool -> Doc -> Doc
parensIf (Name -> Bool
isSymOcc Name
n) (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
n)

isSymOcc :: Name -> Bool
isSymOcc :: Name -> Bool
isSymOcc n :: Name
n
  = case Name -> String
nameBase Name
n of
      []    -> Bool
True  -- Empty name; weird
      (c :: Char
c:_) -> Char -> Bool
startsVarSym Char
c
                   -- c.f. OccName.startsVarSym in GHC itself

pprInfixExp :: Exp -> Doc
pprInfixExp :: Exp -> Doc
pprInfixExp (VarE v :: Name
v) = NameIs -> Name -> Doc
pprName' NameIs
Infix Name
v
pprInfixExp (ConE v :: Name
v) = NameIs -> Name -> Doc
pprName' NameIs
Infix Name
v
pprInfixExp _        = String -> Doc
text "<<Non-variable/constructor in infix context>>"

pprExp :: Precedence -> Exp -> Doc
pprExp :: Int -> Exp -> Doc
pprExp _ (VarE v :: Name
v)     = NameIs -> Name -> Doc
pprName' NameIs
Applied Name
v
pprExp _ (ConE c :: Name
c)     = NameIs -> Name -> Doc
pprName' NameIs
Applied Name
c
pprExp i :: Int
i (LitE l :: Lit
l)     = Int -> Lit -> Doc
pprLit Int
i Lit
l
pprExp i :: Int
i (AppE e1 :: Exp
e1 e2 :: Exp
e2) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Exp -> Doc
pprExp Int
opPrec Exp
e1
                                              Doc -> Doc -> Doc
<+> Int -> Exp -> Doc
pprExp Int
appPrec Exp
e2
pprExp i :: Int
i (AppTypeE e :: Exp
e t :: Type
t)
 = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Exp -> Doc
pprExp Int
opPrec Exp
e Doc -> Doc -> Doc
<+> Char -> Doc
char '@' Doc -> Doc -> Doc
<> Type -> Doc
pprParendType Type
t
pprExp _ (ParensE e :: Exp
e)  = Doc -> Doc
parens (Int -> Exp -> Doc
pprExp Int
noPrec Exp
e)
pprExp i :: Int
i (UInfixE e1 :: Exp
e1 op :: Exp
op e2 :: Exp
e2)
 = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Exp -> Doc
pprExp Int
unopPrec Exp
e1
                         Doc -> Doc -> Doc
<+> Exp -> Doc
pprInfixExp Exp
op
                         Doc -> Doc -> Doc
<+> Int -> Exp -> Doc
pprExp Int
unopPrec Exp
e2
pprExp i :: Int
i (InfixE (Just e1 :: Exp
e1) op :: Exp
op (Just e2 :: Exp
e2))
 = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
opPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Exp -> Doc
pprExp Int
opPrec Exp
e1
                        Doc -> Doc -> Doc
<+> Exp -> Doc
pprInfixExp Exp
op
                        Doc -> Doc -> Doc
<+> Int -> Exp -> Doc
pprExp Int
opPrec Exp
e2
pprExp _ (InfixE me1 :: Maybe Exp
me1 op :: Exp
op me2 :: Maybe Exp
me2) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Maybe Exp -> Doc
pprMaybeExp Int
noPrec Maybe Exp
me1
                                    Doc -> Doc -> Doc
<+> Exp -> Doc
pprInfixExp Exp
op
                                    Doc -> Doc -> Doc
<+> Int -> Maybe Exp -> Doc
pprMaybeExp Int
noPrec Maybe Exp
me2
pprExp i :: Int
i (LamE [] e :: Exp
e) = Int -> Exp -> Doc
pprExp Int
i Exp
e -- #13856
pprExp i :: Int
i (LamE ps :: [Pat]
ps e :: Exp
e) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '\\' Doc -> Doc -> Doc
<> [Doc] -> Doc
hsep ((Pat -> Doc) -> [Pat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pat -> Doc
pprPat Int
appPrec) [Pat]
ps)
                                           Doc -> Doc -> Doc
<+> String -> Doc
text "->" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e
pprExp i :: Int
i (LamCaseE ms :: [Match]
ms) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec)
                       (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "\\case" Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
nestDepth ([Match] -> Doc
forall a. Ppr a => a -> Doc
ppr [Match]
ms)
pprExp _ (TupE es :: [Exp]
es) = Doc -> Doc
parens ([Exp] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [Exp]
es)
pprExp _ (UnboxedTupE es :: [Exp]
es) = Doc -> Doc
hashParens ([Exp] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [Exp]
es)
pprExp _ (UnboxedSumE e :: Exp
e alt :: Int
alt arity :: Int
arity) = Doc -> Int -> Int -> Doc
unboxedSumBars (Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e) Int
alt Int
arity
-- Nesting in Cond is to avoid potential problems in do statements
pprExp i :: Int
i (CondE guard :: Exp
guard true :: Exp
true false :: Exp
false)
 = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep [String -> Doc
text "if"   Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
guard,
                       Int -> Doc -> Doc
nest 1 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "then" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
true,
                       Int -> Doc -> Doc
nest 1 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "else" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
false]
pprExp i :: Int
i (MultiIfE alts :: [(Guard, Exp)]
alts)
  = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$
      case [(Guard, Exp)]
alts of
        []            -> [String -> Doc
text "if {}"]
        (alt :: (Guard, Exp)
alt : alts' :: [(Guard, Exp)]
alts') -> String -> Doc
text "if" Doc -> Doc -> Doc
<+> Doc -> (Guard, Exp) -> Doc
pprGuarded Doc
arrow (Guard, Exp)
alt
                         Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: ((Guard, Exp) -> Doc) -> [(Guard, Exp)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest 3 (Doc -> Doc) -> ((Guard, Exp) -> Doc) -> (Guard, Exp) -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> (Guard, Exp) -> Doc
pprGuarded Doc
arrow) [(Guard, Exp)]
alts'
pprExp i :: Int
i (LetE ds_ :: [Dec]
ds_ e :: Exp
e) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "let" Doc -> Doc -> Doc
<+> [Dec] -> Doc
forall a. Ppr a => [a] -> Doc
pprDecs [Dec]
ds_
                                             Doc -> Doc -> Doc
$$ String -> Doc
text " in" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e
  where
    pprDecs :: [a] -> Doc
pprDecs []  = Doc
empty
    pprDecs [d :: a
d] = a -> Doc
forall a. Ppr a => a -> Doc
ppr a
d
    pprDecs ds :: [a]
ds  = Doc -> Doc
braces ([a] -> Doc
forall a. Ppr a => [a] -> Doc
semiSep [a]
ds)

pprExp i :: Int
i (CaseE e :: Exp
e ms :: [Match]
ms)
 = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "case" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e Doc -> Doc -> Doc
<+> String -> Doc
text "of"
                        Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
nestDepth ([Match] -> Doc
forall a. Ppr a => a -> Doc
ppr [Match]
ms)
pprExp i :: Int
i (DoE ss_ :: [Stmt]
ss_) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "do" Doc -> Doc -> Doc
<+> [Stmt] -> Doc
forall a. Ppr a => [a] -> Doc
pprStms [Stmt]
ss_
  where
    pprStms :: [a] -> Doc
pprStms []  = Doc
empty
    pprStms [s :: a
s] = a -> Doc
forall a. Ppr a => a -> Doc
ppr a
s
    pprStms ss :: [a]
ss  = Doc -> Doc
braces ([a] -> Doc
forall a. Ppr a => [a] -> Doc
semiSep [a]
ss)
pprExp i :: Int
i (MDoE ss_ :: [Stmt]
ss_) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "mdo" Doc -> Doc -> Doc
<+> [Stmt] -> Doc
forall a. Ppr a => [a] -> Doc
pprStms [Stmt]
ss_
  where
    pprStms :: [a] -> Doc
pprStms []  = Doc
empty
    pprStms [s :: a
s] = a -> Doc
forall a. Ppr a => a -> Doc
ppr a
s
    pprStms ss :: [a]
ss  = Doc -> Doc
braces ([a] -> Doc
forall a. Ppr a => [a] -> Doc
semiSep [a]
ss)

pprExp _ (CompE []) = String -> Doc
text "<<Empty CompExp>>"
-- This will probably break with fixity declarations - would need a ';'
pprExp _ (CompE ss :: [Stmt]
ss) =
    if [Stmt] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Stmt]
ss'
       -- If there are no statements in a list comprehension besides the last
       -- one, we simply treat it like a normal list.
       then String -> Doc
text "[" Doc -> Doc -> Doc
<> Stmt -> Doc
forall a. Ppr a => a -> Doc
ppr Stmt
s Doc -> Doc -> Doc
<> String -> Doc
text "]"
       else String -> Doc
text "[" Doc -> Doc -> Doc
<> Stmt -> Doc
forall a. Ppr a => a -> Doc
ppr Stmt
s
        Doc -> Doc -> Doc
<+> Doc
bar
        Doc -> Doc -> Doc
<+> [Stmt] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [Stmt]
ss'
         Doc -> Doc -> Doc
<> String -> Doc
text "]"
  where s :: Stmt
s = [Stmt] -> Stmt
forall a. [a] -> a
last [Stmt]
ss
        ss' :: [Stmt]
ss' = [Stmt] -> [Stmt]
forall a. [a] -> [a]
init [Stmt]
ss
pprExp _ (ArithSeqE d :: Range
d) = Range -> Doc
forall a. Ppr a => a -> Doc
ppr Range
d
pprExp _ (ListE es :: [Exp]
es) = Doc -> Doc
brackets ([Exp] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [Exp]
es)
pprExp i :: Int
i (SigE e :: Exp
e t :: Type
t) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Exp -> Doc
pprExp Int
sigPrec Exp
e
                                          Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t
pprExp _ (RecConE nm :: Name
nm fs :: [FieldExp]
fs) = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
nm Doc -> Doc -> Doc
<> Doc -> Doc
braces ([FieldExp] -> Doc
pprFields [FieldExp]
fs)
pprExp _ (RecUpdE e :: Exp
e fs :: [FieldExp]
fs) = Int -> Exp -> Doc
pprExp Int
appPrec Exp
e Doc -> Doc -> Doc
<> Doc -> Doc
braces ([FieldExp] -> Doc
pprFields [FieldExp]
fs)
pprExp i :: Int
i (StaticE e :: Exp
e) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                         String -> Doc
text "static"Doc -> Doc -> Doc
<+> Int -> Exp -> Doc
pprExp Int
appPrec Exp
e
pprExp _ (UnboundVarE v :: Name
v) = NameIs -> Name -> Doc
pprName' NameIs
Applied Name
v
pprExp _ (LabelE s :: String
s) = String -> Doc
text "#" Doc -> Doc -> Doc
<> String -> Doc
text String
s
pprExp _ (ImplicitParamVarE n :: String
n) = String -> Doc
text ('?' Char -> String -> String
forall a. a -> [a] -> [a]
: String
n)

pprFields :: [(Name,Exp)] -> Doc
pprFields :: [FieldExp] -> Doc
pprFields = [Doc] -> Doc
sep ([Doc] -> Doc) -> ([FieldExp] -> [Doc]) -> [FieldExp] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([FieldExp] -> [Doc]) -> [FieldExp] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldExp -> Doc) -> [FieldExp] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: Name
s,e :: Exp
e) -> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
s Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e)

pprMaybeExp :: Precedence -> Maybe Exp -> Doc
pprMaybeExp :: Int -> Maybe Exp -> Doc
pprMaybeExp _ Nothing = Doc
empty
pprMaybeExp i :: Int
i (Just e :: Exp
e) = Int -> Exp -> Doc
pprExp Int
i Exp
e

------------------------------
instance Ppr Stmt where
    ppr :: Stmt -> Doc
ppr (BindS p :: Pat
p e :: Exp
e) = Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
p Doc -> Doc -> Doc
<+> String -> Doc
text "<-" Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e
    ppr (LetS ds :: [Dec]
ds) = String -> Doc
text "let" Doc -> Doc -> Doc
<+> (Doc -> Doc
braces ([Dec] -> Doc
forall a. Ppr a => [a] -> Doc
semiSep [Dec]
ds))
    ppr (NoBindS e :: Exp
e) = Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e
    ppr (ParS sss :: [[Stmt]]
sss) = [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
bar
                         ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ ([Stmt] -> Doc) -> [[Stmt]] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map [Stmt] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [[Stmt]]
sss
    ppr (RecS ss :: [Stmt]
ss) = String -> Doc
text "rec" Doc -> Doc -> Doc
<+> (Doc -> Doc
braces ([Stmt] -> Doc
forall a. Ppr a => [a] -> Doc
semiSep [Stmt]
ss))

------------------------------
instance Ppr Match where
    ppr :: Match -> Doc
ppr (Match p :: Pat
p rhs :: Body
rhs ds :: [Dec]
ds) = Pat -> Doc
pprMatchPat Pat
p Doc -> Doc -> Doc
<+> Bool -> Body -> Doc
pprBody Bool
False Body
rhs
                        Doc -> Doc -> Doc
$$ [Dec] -> Doc
where_clause [Dec]
ds

pprMatchPat :: Pat -> Doc
-- Everything except pattern signatures bind more tightly than (->)
pprMatchPat :: Pat -> Doc
pprMatchPat p :: Pat
p@(SigP {}) = Doc -> Doc
parens (Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
p)
pprMatchPat p :: Pat
p           = Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
p

------------------------------
pprGuarded :: Doc -> (Guard, Exp) -> Doc
pprGuarded :: Doc -> (Guard, Exp) -> Doc
pprGuarded eqDoc :: Doc
eqDoc (guard :: Guard
guard, expr :: Exp
expr) = case Guard
guard of
  NormalG guardExpr :: Exp
guardExpr -> Doc
bar Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
guardExpr Doc -> Doc -> Doc
<+> Doc
eqDoc Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
expr
  PatG    stmts :: [Stmt]
stmts     -> Doc
bar Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Stmt -> Doc) -> [Stmt] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Stmt -> Doc
forall a. Ppr a => a -> Doc
ppr [Stmt]
stmts) Doc -> Doc -> Doc
$$
                         Int -> Doc -> Doc
nest Int
nestDepth (Doc
eqDoc Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
expr)

------------------------------
pprBody :: Bool -> Body -> Doc
pprBody :: Bool -> Body -> Doc
pprBody eq :: Bool
eq body :: Body
body = case Body
body of
    GuardedB xs :: [(Guard, Exp)]
xs -> Int -> Doc -> Doc
nest Int
nestDepth (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ ((Guard, Exp) -> Doc) -> [(Guard, Exp)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc -> (Guard, Exp) -> Doc
pprGuarded Doc
eqDoc) [(Guard, Exp)]
xs
    NormalB  e :: Exp
e  -> Doc
eqDoc Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e
  where eqDoc :: Doc
eqDoc | Bool
eq        = Doc
equals
              | Bool
otherwise = Doc
arrow

------------------------------
instance Ppr Lit where
  ppr :: Lit -> Doc
ppr = Int -> Lit -> Doc
pprLit Int
noPrec

pprLit :: Precedence -> Lit -> Doc
pprLit :: Int -> Lit -> Doc
pprLit i :: Int
i (IntPrimL x :: Integer
x)    = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0)
                                    (Integer -> Doc
integer Integer
x Doc -> Doc -> Doc
<> Char -> Doc
char '#')
pprLit _ (WordPrimL x :: Integer
x)    = Integer -> Doc
integer Integer
x Doc -> Doc -> Doc
<> String -> Doc
text "##"
pprLit i :: Int
i (FloatPrimL x :: Rational
x)  = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0)
                                    (Float -> Doc
float (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
x) Doc -> Doc -> Doc
<> Char -> Doc
char '#')
pprLit i :: Int
i (DoublePrimL x :: Rational
x) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec Bool -> Bool -> Bool
&& Rational
x Rational -> Rational -> Bool
forall a. Ord a => a -> a -> Bool
< 0)
                                    (Double -> Doc
double (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
x) Doc -> Doc -> Doc
<> String -> Doc
text "##")
pprLit i :: Int
i (IntegerL x :: Integer
x)    = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< 0) (Integer -> Doc
integer Integer
x)
pprLit _ (CharL c :: Char
c)       = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c)
pprLit _ (CharPrimL c :: Char
c)   = String -> Doc
text (Char -> String
forall a. Show a => a -> String
show Char
c) Doc -> Doc -> Doc
<> Char -> Doc
char '#'
pprLit _ (StringL s :: String
s)     = String -> Doc
pprString String
s
pprLit _ (StringPrimL s :: [Word8]
s) = String -> Doc
pprString ([Word8] -> String
bytesToString [Word8]
s) Doc -> Doc -> Doc
<> Char -> Doc
char '#'
pprLit i :: Int
i (RationalL rat :: Rational
rat) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
                           Integer -> Doc
integer (Rational -> Integer
forall a. Ratio a -> a
numerator Rational
rat) Doc -> Doc -> Doc
<+> Char -> Doc
char '/'
                              Doc -> Doc -> Doc
<+> Integer -> Doc
integer (Rational -> Integer
forall a. Ratio a -> a
denominator Rational
rat)

bytesToString :: [Word8] -> String
bytesToString :: [Word8] -> String
bytesToString = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
chr (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)

pprString :: String -> Doc
-- Print newlines as newlines with Haskell string escape notation,
-- not as '\n'.  For other non-printables use regular escape notation.
pprString :: String -> Doc
pprString s :: String
s = [Doc] -> Doc
vcat ((String -> Doc) -> [String] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map String -> Doc
text (String -> [String]
showMultiLineString String
s))

------------------------------
instance Ppr Pat where
    ppr :: Pat -> Doc
ppr = Int -> Pat -> Doc
pprPat Int
noPrec

pprPat :: Precedence -> Pat -> Doc
pprPat :: Int -> Pat -> Doc
pprPat i :: Int
i (LitP l :: Lit
l)     = Int -> Lit -> Doc
pprLit Int
i Lit
l
pprPat _ (VarP v :: Name
v)     = NameIs -> Name -> Doc
pprName' NameIs
Applied Name
v
pprPat _ (TupP ps :: [Pat]
ps)    = Doc -> Doc
parens ([Pat] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [Pat]
ps)
pprPat _ (UnboxedTupP ps :: [Pat]
ps) = Doc -> Doc
hashParens ([Pat] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [Pat]
ps)
pprPat _ (UnboxedSumP p :: Pat
p alt :: Int
alt arity :: Int
arity) = Doc -> Int -> Int -> Doc
unboxedSumBars (Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
p) Int
alt Int
arity
pprPat i :: Int
i (ConP s :: Name
s ps :: [Pat]
ps)  = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ NameIs -> Name -> Doc
pprName' NameIs
Applied Name
s
                                              Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep ((Pat -> Doc) -> [Pat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pat -> Doc
pprPat Int
appPrec) [Pat]
ps)
pprPat _ (ParensP p :: Pat
p)  = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Pat -> Doc
pprPat Int
noPrec Pat
p
pprPat i :: Int
i (UInfixP p1 :: Pat
p1 n :: Name
n p2 :: Pat
p2)
                      = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
unopPrec) (Int -> Pat -> Doc
pprPat Int
unopPrec Pat
p1 Doc -> Doc -> Doc
<+>
                                                 NameIs -> Name -> Doc
pprName' NameIs
Infix Name
n   Doc -> Doc -> Doc
<+>
                                                 Int -> Pat -> Doc
pprPat Int
unopPrec Pat
p2)
pprPat i :: Int
i (InfixP p1 :: Pat
p1 n :: Name
n p2 :: Pat
p2)
                      = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
opPrec) (Int -> Pat -> Doc
pprPat Int
opPrec Pat
p1 Doc -> Doc -> Doc
<+>
                                                NameIs -> Name -> Doc
pprName' NameIs
Infix Name
n Doc -> Doc -> Doc
<+>
                                                Int -> Pat -> Doc
pprPat Int
opPrec Pat
p2)
pprPat i :: Int
i (TildeP p :: Pat
p)   = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '~' Doc -> Doc -> Doc
<> Int -> Pat -> Doc
pprPat Int
appPrec Pat
p
pprPat i :: Int
i (BangP p :: Pat
p)    = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '!' Doc -> Doc -> Doc
<> Int -> Pat -> Doc
pprPat Int
appPrec Pat
p
pprPat i :: Int
i (AsP v :: Name
v p :: Pat
p)    = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
v Doc -> Doc -> Doc
<> String -> Doc
text "@"
                                                      Doc -> Doc -> Doc
<> Int -> Pat -> Doc
pprPat Int
appPrec Pat
p
pprPat _ WildP        = String -> Doc
text "_"
pprPat _ (RecP nm :: Name
nm fs :: [FieldPat]
fs)
 = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$     Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
nm
            Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$
                        (FieldPat -> Doc) -> [FieldPat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\(s :: Name
s,p :: Pat
p) -> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
s Doc -> Doc -> Doc
<+> Doc
equals Doc -> Doc -> Doc
<+> Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
p) [FieldPat]
fs)
pprPat _ (ListP ps :: [Pat]
ps) = Doc -> Doc
brackets ([Pat] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [Pat]
ps)
pprPat i :: Int
i (SigP p :: Pat
p t :: Type
t) = Bool -> Doc -> Doc
parensIf (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
noPrec) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
p Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t
pprPat _ (ViewP e :: Exp
e p :: Pat
p) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Exp -> Doc
pprExp Int
noPrec Exp
e Doc -> Doc -> Doc
<+> String -> Doc
text "->" Doc -> Doc -> Doc
<+> Int -> Pat -> Doc
pprPat Int
noPrec Pat
p

------------------------------
instance Ppr Dec where
    ppr :: Dec -> Doc
ppr = Bool -> Dec -> Doc
ppr_dec Bool
True

ppr_dec :: Bool     -- declaration on the toplevel?
        -> Dec
        -> Doc
ppr_dec :: Bool -> Dec -> Doc
ppr_dec _ (FunD f :: Name
f cs :: [Clause]
cs)   = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Clause -> Doc) -> [Clause] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\c :: Clause
c -> Name -> Doc
pprPrefixOcc Name
f Doc -> Doc -> Doc
<+> Clause -> Doc
forall a. Ppr a => a -> Doc
ppr Clause
c) [Clause]
cs
ppr_dec _ (ValD p :: Pat
p r :: Body
r ds :: [Dec]
ds) = Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
p Doc -> Doc -> Doc
<+> Bool -> Body -> Doc
pprBody Bool
True Body
r
                          Doc -> Doc -> Doc
$$ [Dec] -> Doc
where_clause [Dec]
ds
ppr_dec _ (TySynD t :: Name
t xs :: [TyVarBndr]
xs rhs :: Type
rhs)
  = Doc -> Maybe Name -> Doc -> Type -> Doc
ppr_tySyn Doc
empty (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
t) ([Doc] -> Doc
hsep ((TyVarBndr -> Doc) -> [TyVarBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [TyVarBndr]
xs)) Type
rhs
ppr_dec _ (DataD ctxt :: Cxt
ctxt t :: Name
t xs :: [TyVarBndr]
xs ksig :: Maybe Type
ksig cs :: [Con]
cs decs :: [DerivClause]
decs)
  = Doc
-> Cxt
-> Maybe Name
-> Doc
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Doc
ppr_data Doc
empty Cxt
ctxt (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
t) ([Doc] -> Doc
hsep ((TyVarBndr -> Doc) -> [TyVarBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [TyVarBndr]
xs)) Maybe Type
ksig [Con]
cs [DerivClause]
decs
ppr_dec _ (NewtypeD ctxt :: Cxt
ctxt t :: Name
t xs :: [TyVarBndr]
xs ksig :: Maybe Type
ksig c :: Con
c decs :: [DerivClause]
decs)
  = Doc
-> Cxt
-> Maybe Name
-> Doc
-> Maybe Type
-> Con
-> [DerivClause]
-> Doc
ppr_newtype Doc
empty Cxt
ctxt (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
t) ([Doc] -> Doc
sep ((TyVarBndr -> Doc) -> [TyVarBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [TyVarBndr]
xs)) Maybe Type
ksig Con
c [DerivClause]
decs
ppr_dec _  (ClassD ctxt :: Cxt
ctxt c :: Name
c xs :: [TyVarBndr]
xs fds :: [FunDep]
fds ds :: [Dec]
ds)
  = String -> Doc
text "class" Doc -> Doc -> Doc
<+> Cxt -> Doc
pprCxt Cxt
ctxt Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
c Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((TyVarBndr -> Doc) -> [TyVarBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [TyVarBndr]
xs) Doc -> Doc -> Doc
<+> [FunDep] -> Doc
forall a. Ppr a => a -> Doc
ppr [FunDep]
fds
    Doc -> Doc -> Doc
$$ [Dec] -> Doc
where_clause [Dec]
ds
ppr_dec _ (InstanceD o :: Maybe Overlap
o ctxt :: Cxt
ctxt i :: Type
i ds :: [Dec]
ds) =
        String -> Doc
text "instance" Doc -> Doc -> Doc
<+> Doc -> (Overlap -> Doc) -> Maybe Overlap -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Overlap -> Doc
ppr_overlap Maybe Overlap
o Doc -> Doc -> Doc
<+> Cxt -> Doc
pprCxt Cxt
ctxt Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
i
                                  Doc -> Doc -> Doc
$$ [Dec] -> Doc
where_clause [Dec]
ds
ppr_dec _ (SigD f :: Name
f t :: Type
t)    = Name -> Doc
pprPrefixOcc Name
f Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t
ppr_dec _ (ForeignD f :: Foreign
f)  = Foreign -> Doc
forall a. Ppr a => a -> Doc
ppr Foreign
f
ppr_dec _ (InfixD fx :: Fixity
fx n :: Name
n) = Name -> Fixity -> Doc
pprFixity Name
n Fixity
fx
ppr_dec _ (PragmaD p :: Pragma
p)   = Pragma -> Doc
forall a. Ppr a => a -> Doc
ppr Pragma
p
ppr_dec isTop :: Bool
isTop (DataFamilyD tc :: Name
tc tvs :: [TyVarBndr]
tvs kind :: Maybe Type
kind)
  = String -> Doc
text "data" Doc -> Doc -> Doc
<+> Doc
maybeFamily Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
tc Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((TyVarBndr -> Doc) -> [TyVarBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [TyVarBndr]
tvs) Doc -> Doc -> Doc
<+> Doc
maybeKind
  where
    maybeFamily :: Doc
maybeFamily | Bool
isTop     = String -> Doc
text "family"
                | Bool
otherwise = Doc
empty
    maybeKind :: Doc
maybeKind | (Just k' :: Type
k') <- Maybe Type
kind = Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
k'
              | Bool
otherwise = Doc
empty
ppr_dec isTop :: Bool
isTop (DataInstD ctxt :: Cxt
ctxt bndrs :: Maybe [TyVarBndr]
bndrs ty :: Type
ty ksig :: Maybe Type
ksig cs :: [Con]
cs decs :: [DerivClause]
decs)
  = Doc
-> Cxt
-> Maybe Name
-> Doc
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Doc
ppr_data (Doc
maybeInst Doc -> Doc -> Doc
<+> Maybe [TyVarBndr] -> Doc
ppr_bndrs Maybe [TyVarBndr]
bndrs)
             Cxt
ctxt Maybe Name
forall a. Maybe a
Nothing (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty) Maybe Type
ksig [Con]
cs [DerivClause]
decs
  where
    maybeInst :: Doc
maybeInst | Bool
isTop     = String -> Doc
text "instance"
              | Bool
otherwise = Doc
empty
ppr_dec isTop :: Bool
isTop (NewtypeInstD ctxt :: Cxt
ctxt bndrs :: Maybe [TyVarBndr]
bndrs ty :: Type
ty ksig :: Maybe Type
ksig c :: Con
c decs :: [DerivClause]
decs)
  = Doc
-> Cxt
-> Maybe Name
-> Doc
-> Maybe Type
-> Con
-> [DerivClause]
-> Doc
ppr_newtype (Doc
maybeInst Doc -> Doc -> Doc
<+> Maybe [TyVarBndr] -> Doc
ppr_bndrs Maybe [TyVarBndr]
bndrs)
                Cxt
ctxt Maybe Name
forall a. Maybe a
Nothing (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty) Maybe Type
ksig Con
c [DerivClause]
decs
  where
    maybeInst :: Doc
maybeInst | Bool
isTop     = String -> Doc
text "instance"
              | Bool
otherwise = Doc
empty
ppr_dec isTop :: Bool
isTop (TySynInstD (TySynEqn mb_bndrs :: Maybe [TyVarBndr]
mb_bndrs ty :: Type
ty rhs :: Type
rhs))
  = Doc -> Maybe Name -> Doc -> Type -> Doc
ppr_tySyn (Doc
maybeInst Doc -> Doc -> Doc
<+> Maybe [TyVarBndr] -> Doc
ppr_bndrs Maybe [TyVarBndr]
mb_bndrs)
              Maybe Name
forall a. Maybe a
Nothing (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty) Type
rhs
  where
    maybeInst :: Doc
maybeInst | Bool
isTop     = String -> Doc
text "instance"
              | Bool
otherwise = Doc
empty
ppr_dec isTop :: Bool
isTop (OpenTypeFamilyD tfhead :: TypeFamilyHead
tfhead)
  = String -> Doc
text "type" Doc -> Doc -> Doc
<+> Doc
maybeFamily Doc -> Doc -> Doc
<+> TypeFamilyHead -> Doc
ppr_tf_head TypeFamilyHead
tfhead
  where
    maybeFamily :: Doc
maybeFamily | Bool
isTop     = String -> Doc
text "family"
                | Bool
otherwise = Doc
empty
ppr_dec _ (ClosedTypeFamilyD tfhead :: TypeFamilyHead
tfhead eqns :: [TySynEqn]
eqns)
  = Doc -> Int -> Doc -> Doc
hang (String -> Doc
text "type family" Doc -> Doc -> Doc
<+> TypeFamilyHead -> Doc
ppr_tf_head TypeFamilyHead
tfhead Doc -> Doc -> Doc
<+> String -> Doc
text "where")
      Int
nestDepth ([Doc] -> Doc
vcat ((TySynEqn -> Doc) -> [TySynEqn] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TySynEqn -> Doc
ppr_eqn [TySynEqn]
eqns))
  where
    ppr_eqn :: TySynEqn -> Doc
ppr_eqn (TySynEqn mb_bndrs :: Maybe [TyVarBndr]
mb_bndrs lhs :: Type
lhs rhs :: Type
rhs)
      = Maybe [TyVarBndr] -> Doc
ppr_bndrs Maybe [TyVarBndr]
mb_bndrs Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
lhs Doc -> Doc -> Doc
<+> String -> Doc
text "=" Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
rhs
ppr_dec _ (RoleAnnotD name :: Name
name roles :: [Role]
roles)
  = [Doc] -> Doc
hsep [ String -> Doc
text "type role", Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
name ] Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Role -> Doc) -> [Role] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Role -> Doc
forall a. Ppr a => a -> Doc
ppr [Role]
roles)
ppr_dec _ (StandaloneDerivD ds :: Maybe DerivStrategy
ds cxt :: Cxt
cxt ty :: Type
ty)
  = [Doc] -> Doc
hsep [ String -> Doc
text "deriving"
         , Doc -> (DerivStrategy -> Doc) -> Maybe DerivStrategy -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty DerivStrategy -> Doc
ppr_deriv_strategy Maybe DerivStrategy
ds
         , String -> Doc
text "instance"
         , Cxt -> Doc
pprCxt Cxt
cxt
         , Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty ]
ppr_dec _ (DefaultSigD n :: Name
n ty :: Type
ty)
  = [Doc] -> Doc
hsep [ String -> Doc
text "default", Name -> Doc
pprPrefixOcc Name
n, Doc
dcolon, Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty ]
ppr_dec _ (PatSynD name :: Name
name args :: PatSynArgs
args dir :: PatSynDir
dir pat :: Pat
pat)
  = String -> Doc
text "pattern" Doc -> Doc -> Doc
<+> Doc
pprNameArgs Doc -> Doc -> Doc
<+> PatSynDir -> Doc
forall a. Ppr a => a -> Doc
ppr PatSynDir
dir Doc -> Doc -> Doc
<+> Doc
pprPatRHS
  where
    pprNameArgs :: Doc
pprNameArgs | InfixPatSyn a1 :: Name
a1 a2 :: Name
a2 <- PatSynArgs
args = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
a1 Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
name Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
a2
                | Bool
otherwise                 = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
name Doc -> Doc -> Doc
<+> PatSynArgs -> Doc
forall a. Ppr a => a -> Doc
ppr PatSynArgs
args
    pprPatRHS :: Doc
pprPatRHS   | ExplBidir cls :: [Clause]
cls <- PatSynDir
dir = Doc -> Int -> Doc -> Doc
hang (Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
pat Doc -> Doc -> Doc
<+> String -> Doc
text "where")
                                           Int
nestDepth (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
name Doc -> Doc -> Doc
<+> [Clause] -> Doc
forall a. Ppr a => a -> Doc
ppr [Clause]
cls)
                | Bool
otherwise            = Pat -> Doc
forall a. Ppr a => a -> Doc
ppr Pat
pat
ppr_dec _ (PatSynSigD name :: Name
name ty :: Type
ty)
  = Name -> Type -> Doc
pprPatSynSig Name
name Type
ty
ppr_dec _ (ImplicitParamBindD n :: String
n e :: Exp
e)
  = [Doc] -> Doc
hsep [String -> Doc
text ('?' Char -> String -> String
forall a. a -> [a] -> [a]
: String
n), String -> Doc
text "=", Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e]

ppr_deriv_strategy :: DerivStrategy -> Doc
ppr_deriv_strategy :: DerivStrategy -> Doc
ppr_deriv_strategy ds :: DerivStrategy
ds =
  case DerivStrategy
ds of
    StockStrategy    -> String -> Doc
text "stock"
    AnyclassStrategy -> String -> Doc
text "anyclass"
    NewtypeStrategy  -> String -> Doc
text "newtype"
    ViaStrategy ty :: Type
ty   -> String -> Doc
text "via" Doc -> Doc -> Doc
<+> Type -> Doc
pprParendType Type
ty

ppr_overlap :: Overlap -> Doc
ppr_overlap :: Overlap -> Doc
ppr_overlap o :: Overlap
o = String -> Doc
text (String -> Doc) -> String -> Doc
forall a b. (a -> b) -> a -> b
$
  case Overlap
o of
    Overlaps      -> "{-# OVERLAPS #-}"
    Overlappable  -> "{-# OVERLAPPABLE #-}"
    Overlapping   -> "{-# OVERLAPPING #-}"
    Incoherent    -> "{-# INCOHERENT #-}"

ppr_data :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> [Con] -> [DerivClause]
         -> Doc
ppr_data :: Doc
-> Cxt
-> Maybe Name
-> Doc
-> Maybe Type
-> [Con]
-> [DerivClause]
-> Doc
ppr_data maybeInst :: Doc
maybeInst ctxt :: Cxt
ctxt t :: Maybe Name
t argsDoc :: Doc
argsDoc ksig :: Maybe Type
ksig cs :: [Con]
cs decs :: [DerivClause]
decs
  = [Doc] -> Doc
sep [String -> Doc
text "data" Doc -> Doc -> Doc
<+> Doc
maybeInst
            Doc -> Doc -> Doc
<+> Cxt -> Doc
pprCxt Cxt
ctxt
            Doc -> Doc -> Doc
<+> case Maybe Name
t of
                 Just n :: Name
n -> NameIs -> Name -> Doc
pprName' NameIs
Applied Name
n Doc -> Doc -> Doc
<+> Doc
argsDoc
                 Nothing -> Doc
argsDoc
            Doc -> Doc -> Doc
<+> Doc
ksigDoc Doc -> Doc -> Doc
<+> Doc
maybeWhere,
         Int -> Doc -> Doc
nest Int
nestDepth ([Doc] -> Doc
sep ([Doc] -> [Doc]
pref ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Con -> Doc) -> [Con] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Con -> Doc
forall a. Ppr a => a -> Doc
ppr [Con]
cs)),
         if [DerivClause] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DerivClause]
decs
           then Doc
empty
           else Int -> Doc -> Doc
nest Int
nestDepth
              (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (DerivClause -> Doc) -> [DerivClause] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DerivClause -> Doc
ppr_deriv_clause [DerivClause]
decs]
  where
    pref :: [Doc] -> [Doc]
    pref :: [Doc] -> [Doc]
pref xs :: [Doc]
xs | Bool
isGadtDecl = [Doc]
xs
    pref []              = []      -- No constructors; can't happen in H98
    pref (d :: Doc
d:ds :: [Doc]
ds)          = (Char -> Doc
char '=' Doc -> Doc -> Doc
<+> Doc
d)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:(Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Doc
bar Doc -> Doc -> Doc
<+>) [Doc]
ds

    maybeWhere :: Doc
    maybeWhere :: Doc
maybeWhere | Bool
isGadtDecl = String -> Doc
text "where"
               | Bool
otherwise  = Doc
empty

    isGadtDecl :: Bool
    isGadtDecl :: Bool
isGadtDecl = Bool -> Bool
not ([Con] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Con]
cs) Bool -> Bool -> Bool
&& (Con -> Bool) -> [Con] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Con -> Bool
isGadtCon [Con]
cs
        where isGadtCon :: Con -> Bool
isGadtCon (GadtC _ _ _   ) = Bool
True
              isGadtCon (RecGadtC _ _ _) = Bool
True
              isGadtCon (ForallC _ _ x :: Con
x ) = Con -> Bool
isGadtCon Con
x
              isGadtCon  _               = Bool
False

    ksigDoc :: Doc
ksigDoc = case Maybe Type
ksig of
                Nothing -> Doc
empty
                Just k :: Type
k  -> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
k

ppr_newtype :: Doc -> Cxt -> Maybe Name -> Doc -> Maybe Kind -> Con -> [DerivClause]
            -> Doc
ppr_newtype :: Doc
-> Cxt
-> Maybe Name
-> Doc
-> Maybe Type
-> Con
-> [DerivClause]
-> Doc
ppr_newtype maybeInst :: Doc
maybeInst ctxt :: Cxt
ctxt t :: Maybe Name
t argsDoc :: Doc
argsDoc ksig :: Maybe Type
ksig c :: Con
c decs :: [DerivClause]
decs
  = [Doc] -> Doc
sep [String -> Doc
text "newtype" Doc -> Doc -> Doc
<+> Doc
maybeInst
            Doc -> Doc -> Doc
<+> Cxt -> Doc
pprCxt Cxt
ctxt
            Doc -> Doc -> Doc
<+> case Maybe Name
t of
                 Just n :: Name
n -> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
n Doc -> Doc -> Doc
<+> Doc
argsDoc
                 Nothing -> Doc
argsDoc
            Doc -> Doc -> Doc
<+> Doc
ksigDoc,
         Int -> Doc -> Doc
nest 2 (Char -> Doc
char '=' Doc -> Doc -> Doc
<+> Con -> Doc
forall a. Ppr a => a -> Doc
ppr Con
c),
         if [DerivClause] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [DerivClause]
decs
           then Doc
empty
           else Int -> Doc -> Doc
nest Int
nestDepth
                (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (DerivClause -> Doc) -> [DerivClause] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map DerivClause -> Doc
ppr_deriv_clause [DerivClause]
decs]
  where
    ksigDoc :: Doc
ksigDoc = case Maybe Type
ksig of
                Nothing -> Doc
empty
                Just k :: Type
k  -> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
k

ppr_deriv_clause :: DerivClause -> Doc
ppr_deriv_clause :: DerivClause -> Doc
ppr_deriv_clause (DerivClause ds :: Maybe DerivStrategy
ds ctxt :: Cxt
ctxt)
  = String -> Doc
text "deriving" Doc -> Doc -> Doc
<+> Doc
pp_strat_before
                    Doc -> Doc -> Doc
<+> Cxt -> Doc
ppr_cxt_preds Cxt
ctxt
                    Doc -> Doc -> Doc
<+> Doc
pp_strat_after
  where
    -- @via@ is unique in that in comes /after/ the class being derived,
    -- so we must special-case it.
    (pp_strat_before :: Doc
pp_strat_before, pp_strat_after :: Doc
pp_strat_after) =
      case Maybe DerivStrategy
ds of
        Just (via :: DerivStrategy
via@ViaStrategy{}) -> (Doc
empty, DerivStrategy -> Doc
ppr_deriv_strategy DerivStrategy
via)
        _                        -> (Doc -> (DerivStrategy -> Doc) -> Maybe DerivStrategy -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty DerivStrategy -> Doc
ppr_deriv_strategy Maybe DerivStrategy
ds, Doc
empty)

ppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc
ppr_tySyn :: Doc -> Maybe Name -> Doc -> Type -> Doc
ppr_tySyn maybeInst :: Doc
maybeInst t :: Maybe Name
t argsDoc :: Doc
argsDoc rhs :: Type
rhs
  = String -> Doc
text "type" Doc -> Doc -> Doc
<+> Doc
maybeInst
    Doc -> Doc -> Doc
<+> case Maybe Name
t of
         Just n :: Name
n -> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
n Doc -> Doc -> Doc
<+> Doc
argsDoc
         Nothing -> Doc
argsDoc
    Doc -> Doc -> Doc
<+> String -> Doc
text "=" Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
rhs

ppr_tf_head :: TypeFamilyHead -> Doc
ppr_tf_head :: TypeFamilyHead -> Doc
ppr_tf_head (TypeFamilyHead tc :: Name
tc tvs :: [TyVarBndr]
tvs res :: FamilyResultSig
res inj :: Maybe InjectivityAnn
inj)
  = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
tc Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((TyVarBndr -> Doc) -> [TyVarBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [TyVarBndr]
tvs) Doc -> Doc -> Doc
<+> FamilyResultSig -> Doc
forall a. Ppr a => a -> Doc
ppr FamilyResultSig
res Doc -> Doc -> Doc
<+> Doc
maybeInj
  where
    maybeInj :: Doc
maybeInj | (Just inj' :: InjectivityAnn
inj') <- Maybe InjectivityAnn
inj = InjectivityAnn -> Doc
forall a. Ppr a => a -> Doc
ppr InjectivityAnn
inj'
             | Bool
otherwise          = Doc
empty

ppr_bndrs :: Maybe [TyVarBndr] -> Doc
ppr_bndrs :: Maybe [TyVarBndr] -> Doc
ppr_bndrs (Just bndrs :: [TyVarBndr]
bndrs) = String -> Doc
text "forall" Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep ((TyVarBndr -> Doc) -> [TyVarBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [TyVarBndr]
bndrs) Doc -> Doc -> Doc
<> String -> Doc
text "."
ppr_bndrs Nothing = Doc
empty

------------------------------
instance Ppr FunDep where
    ppr :: FunDep -> Doc
ppr (FunDep xs :: [Name]
xs ys :: [Name]
ys) = [Doc] -> Doc
hsep ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Ppr a => a -> Doc
ppr [Name]
xs) Doc -> Doc -> Doc
<+> String -> Doc
text "->" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Ppr a => a -> Doc
ppr [Name]
ys)
    ppr_list :: [FunDep] -> Doc
ppr_list [] = Doc
empty
    ppr_list xs :: [FunDep]
xs = Doc
bar Doc -> Doc -> Doc
<+> [FunDep] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [FunDep]
xs

------------------------------
instance Ppr FamilyResultSig where
    ppr :: FamilyResultSig -> Doc
ppr NoSig           = Doc
empty
    ppr (KindSig k :: Type
k)     = Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
k
    ppr (TyVarSig bndr :: TyVarBndr
bndr) = String -> Doc
text "=" Doc -> Doc -> Doc
<+> TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr TyVarBndr
bndr

------------------------------
instance Ppr InjectivityAnn where
    ppr :: InjectivityAnn -> Doc
ppr (InjectivityAnn lhs :: Name
lhs rhs :: [Name]
rhs) =
        Doc
bar Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
lhs Doc -> Doc -> Doc
<+> String -> Doc
text "->" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Ppr a => a -> Doc
ppr [Name]
rhs)

------------------------------
instance Ppr Foreign where
    ppr :: Foreign -> Doc
ppr (ImportF callconv :: Callconv
callconv safety :: Safety
safety impent :: String
impent as :: Name
as typ :: Type
typ)
       = String -> Doc
text "foreign import"
     Doc -> Doc -> Doc
<+> Callconv -> Doc
forall a. Show a => a -> Doc
showtextl Callconv
callconv
     Doc -> Doc -> Doc
<+> Safety -> Doc
forall a. Show a => a -> Doc
showtextl Safety
safety
     Doc -> Doc -> Doc
<+> String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
impent)
     Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
as
     Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
typ
    ppr (ExportF callconv :: Callconv
callconv expent :: String
expent as :: Name
as typ :: Type
typ)
        = String -> Doc
text "foreign export"
      Doc -> Doc -> Doc
<+> Callconv -> Doc
forall a. Show a => a -> Doc
showtextl Callconv
callconv
      Doc -> Doc -> Doc
<+> String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
expent)
      Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
as
      Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
typ

------------------------------
instance Ppr Pragma where
    ppr :: Pragma -> Doc
ppr (InlineP n :: Name
n inline :: Inline
inline rm :: RuleMatch
rm phases :: Phases
phases)
       = String -> Doc
text "{-#"
     Doc -> Doc -> Doc
<+> Inline -> Doc
forall a. Ppr a => a -> Doc
ppr Inline
inline
     Doc -> Doc -> Doc
<+> RuleMatch -> Doc
forall a. Ppr a => a -> Doc
ppr RuleMatch
rm
     Doc -> Doc -> Doc
<+> Phases -> Doc
forall a. Ppr a => a -> Doc
ppr Phases
phases
     Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
n
     Doc -> Doc -> Doc
<+> String -> Doc
text "#-}"
    ppr (SpecialiseP n :: Name
n ty :: Type
ty inline :: Maybe Inline
inline phases :: Phases
phases)
       =   String -> Doc
text "{-# SPECIALISE"
       Doc -> Doc -> Doc
<+> Doc -> (Inline -> Doc) -> Maybe Inline -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty Inline -> Doc
forall a. Ppr a => a -> Doc
ppr Maybe Inline
inline
       Doc -> Doc -> Doc
<+> Phases -> Doc
forall a. Ppr a => a -> Doc
ppr Phases
phases
       Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep [ Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
n Doc -> Doc -> Doc
<+> Doc
dcolon
               , Int -> Doc -> Doc
nest 2 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty ]
       Doc -> Doc -> Doc
<+> String -> Doc
text "#-}"
    ppr (SpecialiseInstP inst :: Type
inst)
       = String -> Doc
text "{-# SPECIALISE instance" Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
inst Doc -> Doc -> Doc
<+> String -> Doc
text "#-}"
    ppr (RuleP n :: String
n ty_bndrs :: Maybe [TyVarBndr]
ty_bndrs tm_bndrs :: [RuleBndr]
tm_bndrs lhs :: Exp
lhs rhs :: Exp
rhs phases :: Phases
phases)
       = [Doc] -> Doc
sep [ String -> Doc
text "{-# RULES" Doc -> Doc -> Doc
<+> String -> Doc
pprString String
n Doc -> Doc -> Doc
<+> Phases -> Doc
forall a. Ppr a => a -> Doc
ppr Phases
phases
             , Int -> Doc -> Doc
nest 4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Maybe [TyVarBndr] -> Doc
forall a. Ppr a => Maybe [a] -> Doc
ppr_ty_forall Maybe [TyVarBndr]
ty_bndrs Doc -> Doc -> Doc
<+> Maybe [TyVarBndr] -> Doc
forall a. Maybe a -> Doc
ppr_tm_forall Maybe [TyVarBndr]
ty_bndrs
                                               Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
lhs
             , Int -> Doc -> Doc
nest 4 (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '=' Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
rhs Doc -> Doc -> Doc
<+> String -> Doc
text "#-}" ]
      where ppr_ty_forall :: Maybe [a] -> Doc
ppr_ty_forall Nothing      = Doc
empty
            ppr_ty_forall (Just bndrs :: [a]
bndrs) = String -> Doc
text "forall"
                                         Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Ppr a => a -> Doc
ppr [a]
bndrs)
                                         Doc -> Doc -> Doc
<+> Char -> Doc
char '.'
            ppr_tm_forall :: Maybe a -> Doc
ppr_tm_forall Nothing | [RuleBndr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RuleBndr]
tm_bndrs = Doc
empty
            ppr_tm_forall _ = String -> Doc
text "forall"
                              Doc -> Doc -> Doc
<+> [Doc] -> Doc
fsep ((RuleBndr -> Doc) -> [RuleBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map RuleBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [RuleBndr]
tm_bndrs)
                              Doc -> Doc -> Doc
<+> Char -> Doc
char '.'
    ppr (AnnP tgt :: AnnTarget
tgt expr :: Exp
expr)
       = String -> Doc
text "{-# ANN" Doc -> Doc -> Doc
<+> AnnTarget -> Doc
target1 AnnTarget
tgt Doc -> Doc -> Doc
<+> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
expr Doc -> Doc -> Doc
<+> String -> Doc
text "#-}"
      where target1 :: AnnTarget -> Doc
target1 ModuleAnnotation    = String -> Doc
text "module"
            target1 (TypeAnnotation t :: Name
t)  = String -> Doc
text "type" Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
t
            target1 (ValueAnnotation v :: Name
v) = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
v
    ppr (LineP line :: Int
line file :: String
file)
       = String -> Doc
text "{-# LINE" Doc -> Doc -> Doc
<+> Int -> Doc
int Int
line Doc -> Doc -> Doc
<+> String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
file) Doc -> Doc -> Doc
<+> String -> Doc
text "#-}"
    ppr (CompleteP cls :: [Name]
cls mty :: Maybe Name
mty)
       = String -> Doc
text "{-# COMPLETE" Doc -> Doc -> Doc
<+> ([Doc] -> Doc
fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Ppr a => a -> Doc
ppr [Name]
cls)
                Doc -> Doc -> Doc
<+> Doc -> (Name -> Doc) -> Maybe Name -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (\ty :: Name
ty -> Doc
dcolon Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
ty) Maybe Name
mty

------------------------------
instance Ppr Inline where
    ppr :: Inline -> Doc
ppr NoInline  = String -> Doc
text "NOINLINE"
    ppr Inline    = String -> Doc
text "INLINE"
    ppr Inlinable = String -> Doc
text "INLINABLE"

------------------------------
instance Ppr RuleMatch where
    ppr :: RuleMatch -> Doc
ppr ConLike = String -> Doc
text "CONLIKE"
    ppr FunLike = Doc
empty

------------------------------
instance Ppr Phases where
    ppr :: Phases -> Doc
ppr AllPhases       = Doc
empty
    ppr (FromPhase i :: Int
i)   = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc
int Int
i
    ppr (BeforePhase i :: Int
i) = Doc -> Doc
brackets (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Char -> Doc
char '~' Doc -> Doc -> Doc
<> Int -> Doc
int Int
i

------------------------------
instance Ppr RuleBndr where
    ppr :: RuleBndr -> Doc
ppr (RuleVar n :: Name
n)         = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
n
    ppr (TypedRuleVar n :: Name
n ty :: Type
ty) = Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
n Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty

------------------------------
instance Ppr Clause where
    ppr :: Clause -> Doc
ppr (Clause ps :: [Pat]
ps rhs :: Body
rhs ds :: [Dec]
ds) = [Doc] -> Doc
hsep ((Pat -> Doc) -> [Pat] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Pat -> Doc
pprPat Int
appPrec) [Pat]
ps) Doc -> Doc -> Doc
<+> Bool -> Body -> Doc
pprBody Bool
True Body
rhs
                             Doc -> Doc -> Doc
$$ [Dec] -> Doc
where_clause [Dec]
ds

------------------------------
instance Ppr Con where
    ppr :: Con -> Doc
ppr (NormalC c :: Name
c sts :: [BangType]
sts) = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
c Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep ((BangType -> Doc) -> [BangType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BangType -> Doc
pprBangType [BangType]
sts)

    ppr (RecC c :: Name
c vsts :: [VarBangType]
vsts)
        = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
c Doc -> Doc -> Doc
<+> Doc -> Doc
braces ([Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (VarBangType -> Doc) -> [VarBangType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VarBangType -> Doc
pprVarBangType [VarBangType]
vsts))

    ppr (InfixC st1 :: BangType
st1 c :: Name
c st2 :: BangType
st2) = BangType -> Doc
pprBangType BangType
st1
                         Doc -> Doc -> Doc
<+> NameIs -> Name -> Doc
pprName' NameIs
Infix Name
c
                         Doc -> Doc -> Doc
<+> BangType -> Doc
pprBangType BangType
st2

    ppr (ForallC ns :: [TyVarBndr]
ns ctxt :: Cxt
ctxt (GadtC c :: [Name]
c sts :: [BangType]
sts ty :: Type
ty))
        = [Name] -> Doc
commaSepApplied [Name]
c Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> [TyVarBndr] -> Cxt -> Doc
pprForall [TyVarBndr]
ns Cxt
ctxt
      Doc -> Doc -> Doc
<+> [BangType] -> Type -> Doc
pprGadtRHS [BangType]
sts Type
ty

    ppr (ForallC ns :: [TyVarBndr]
ns ctxt :: Cxt
ctxt (RecGadtC c :: [Name]
c vsts :: [VarBangType]
vsts ty :: Type
ty))
        = [Name] -> Doc
commaSepApplied [Name]
c Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> [TyVarBndr] -> Cxt -> Doc
pprForall [TyVarBndr]
ns Cxt
ctxt
      Doc -> Doc -> Doc
<+> [VarBangType] -> Type -> Doc
pprRecFields [VarBangType]
vsts Type
ty

    ppr (ForallC ns :: [TyVarBndr]
ns ctxt :: Cxt
ctxt con :: Con
con)
        = [TyVarBndr] -> Cxt -> Doc
pprForall [TyVarBndr]
ns Cxt
ctxt Doc -> Doc -> Doc
<+> Con -> Doc
forall a. Ppr a => a -> Doc
ppr Con
con

    ppr (GadtC c :: [Name]
c sts :: [BangType]
sts ty :: Type
ty)
        = [Name] -> Doc
commaSepApplied [Name]
c Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> [BangType] -> Type -> Doc
pprGadtRHS [BangType]
sts Type
ty

    ppr (RecGadtC c :: [Name]
c vsts :: [VarBangType]
vsts ty :: Type
ty)
        = [Name] -> Doc
commaSepApplied [Name]
c Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> [VarBangType] -> Type -> Doc
pprRecFields [VarBangType]
vsts Type
ty

instance Ppr PatSynDir where
  ppr :: PatSynDir -> Doc
ppr Unidir        = String -> Doc
text "<-"
  ppr ImplBidir     = String -> Doc
text "="
  ppr (ExplBidir _) = String -> Doc
text "<-"
    -- the ExplBidir's clauses are pretty printed together with the
    -- entire pattern synonym; so only print the direction here.

instance Ppr PatSynArgs where
  ppr :: PatSynArgs -> Doc
ppr (PrefixPatSyn args :: [Name]
args) = [Doc] -> Doc
sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Ppr a => a -> Doc
ppr [Name]
args
  ppr (InfixPatSyn a1 :: Name
a1 a2 :: Name
a2) = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
a1 Doc -> Doc -> Doc
<+> Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
a2
  ppr (RecordPatSyn sels :: [Name]
sels) = Doc -> Doc
braces (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ((Name -> Doc) -> [Name] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map Name -> Doc
forall a. Ppr a => a -> Doc
ppr [Name]
sels))

commaSepApplied :: [Name] -> Doc
commaSepApplied :: [Name] -> Doc
commaSepApplied = (Name -> Doc) -> [Name] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaSepWith (NameIs -> Name -> Doc
pprName' NameIs
Applied)

pprForall :: [TyVarBndr] -> Cxt -> Doc
pprForall :: [TyVarBndr] -> Cxt -> Doc
pprForall tvs :: [TyVarBndr]
tvs cxt :: Cxt
cxt
  -- even in the case without any tvs, there could be a non-empty
  -- context cxt (e.g., in the case of pattern synonyms, where there
  -- are multiple forall binders and contexts).
  | [] <- [TyVarBndr]
tvs = Cxt -> Doc
pprCxt Cxt
cxt
  | Bool
otherwise = String -> Doc
text "forall" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep ((TyVarBndr -> Doc) -> [TyVarBndr] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TyVarBndr -> Doc
forall a. Ppr a => a -> Doc
ppr [TyVarBndr]
tvs) Doc -> Doc -> Doc
<+> Char -> Doc
char '.' Doc -> Doc -> Doc
<+> Cxt -> Doc
pprCxt Cxt
cxt

pprRecFields :: [(Name, Strict, Type)] -> Type -> Doc
pprRecFields :: [VarBangType] -> Type -> Doc
pprRecFields vsts :: [VarBangType]
vsts ty :: Type
ty
    = Doc -> Doc
braces ([Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> [Doc] -> [Doc]
forall a b. (a -> b) -> a -> b
$ (VarBangType -> Doc) -> [VarBangType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map VarBangType -> Doc
pprVarBangType [VarBangType]
vsts))
  Doc -> Doc -> Doc
<+> Doc
arrow Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty

pprGadtRHS :: [(Strict, Type)] -> Type -> Doc
pprGadtRHS :: [BangType] -> Type -> Doc
pprGadtRHS [] ty :: Type
ty
    = Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty
pprGadtRHS sts :: [BangType]
sts ty :: Type
ty
    = [Doc] -> Doc
sep (Doc -> [Doc] -> [Doc]
punctuate (Doc
space Doc -> Doc -> Doc
<> Doc
arrow) ((BangType -> Doc) -> [BangType] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map BangType -> Doc
pprBangType [BangType]
sts))
  Doc -> Doc -> Doc
<+> Doc
arrow Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty

------------------------------
pprVarBangType :: VarBangType -> Doc
-- Slight infelicity: with print non-atomic type with parens
pprVarBangType :: VarBangType -> Doc
pprVarBangType (v :: Name
v, bang :: Bang
bang, t :: Type
t) = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
v Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> BangType -> Doc
pprBangType (Bang
bang, Type
t)

------------------------------
pprBangType :: BangType -> Doc
-- Make sure we print
--
-- Con {-# UNPACK #-} a
--
-- rather than
--
-- Con {-# UNPACK #-}a
--
-- when there's no strictness annotation. If there is a strictness annotation,
-- it's okay to not put a space between it and the type.
pprBangType :: BangType -> Doc
pprBangType (bt :: Bang
bt@(Bang _ NoSourceStrictness), t :: Type
t) = Bang -> Doc
forall a. Ppr a => a -> Doc
ppr Bang
bt Doc -> Doc -> Doc
<+> Type -> Doc
pprParendType Type
t
pprBangType (bt :: Bang
bt, t :: Type
t) = Bang -> Doc
forall a. Ppr a => a -> Doc
ppr Bang
bt Doc -> Doc -> Doc
<> Type -> Doc
pprParendType Type
t

------------------------------
instance Ppr Bang where
    ppr :: Bang -> Doc
ppr (Bang su :: SourceUnpackedness
su ss :: SourceStrictness
ss) = SourceUnpackedness -> Doc
forall a. Ppr a => a -> Doc
ppr SourceUnpackedness
su Doc -> Doc -> Doc
<+> SourceStrictness -> Doc
forall a. Ppr a => a -> Doc
ppr SourceStrictness
ss

------------------------------
instance Ppr SourceUnpackedness where
    ppr :: SourceUnpackedness -> Doc
ppr NoSourceUnpackedness = Doc
empty
    ppr SourceNoUnpack       = String -> Doc
text "{-# NOUNPACK #-}"
    ppr SourceUnpack         = String -> Doc
text "{-# UNPACK #-}"

------------------------------
instance Ppr SourceStrictness where
    ppr :: SourceStrictness -> Doc
ppr NoSourceStrictness = Doc
empty
    ppr SourceLazy         = Char -> Doc
char '~'
    ppr SourceStrict       = Char -> Doc
char '!'

------------------------------
instance Ppr DecidedStrictness where
    ppr :: DecidedStrictness -> Doc
ppr DecidedLazy   = Doc
empty
    ppr DecidedStrict = Char -> Doc
char '!'
    ppr DecidedUnpack = String -> Doc
text "{-# UNPACK #-} !"

------------------------------
{-# DEPRECATED pprVarStrictType
               "As of @template-haskell-2.11.0.0@, 'VarStrictType' has been replaced by 'VarBangType'. Please use 'pprVarBangType' instead." #-}
pprVarStrictType :: (Name, Strict, Type) -> Doc
pprVarStrictType :: VarBangType -> Doc
pprVarStrictType = VarBangType -> Doc
pprVarBangType

------------------------------
{-# DEPRECATED pprStrictType
               "As of @template-haskell-2.11.0.0@, 'StrictType' has been replaced by 'BangType'. Please use 'pprBangType' instead." #-}
pprStrictType :: (Strict, Type) -> Doc
pprStrictType :: BangType -> Doc
pprStrictType = BangType -> Doc
pprBangType

------------------------------
pprParendType :: Type -> Doc
pprParendType :: Type -> Doc
pprParendType (VarT v :: Name
v)            = NameIs -> Name -> Doc
pprName' NameIs
Applied Name
v
-- `Applied` is used here instead of `ppr` because of infix names (#13887)
pprParendType (ConT c :: Name
c)            = NameIs -> Name -> Doc
pprName' NameIs
Applied Name
c
pprParendType (TupleT 0)          = String -> Doc
text "()"
pprParendType (TupleT n :: Int
n)          = Doc -> Doc
parens ([Doc] -> Doc
hcat (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Doc
comma))
pprParendType (UnboxedTupleT n :: Int
n)   = Doc -> Doc
hashParens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Doc
comma
pprParendType (UnboxedSumT arity :: Int
arity) = Doc -> Doc
hashParens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (Int
arityInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Doc
bar
pprParendType ArrowT              = Doc -> Doc
parens (String -> Doc
text "->")
pprParendType ListT               = String -> Doc
text "[]"
pprParendType (LitT l :: TyLit
l)            = TyLit -> Doc
pprTyLit TyLit
l
pprParendType (PromotedT c :: Name
c)       = String -> Doc
text "'" Doc -> Doc -> Doc
<> NameIs -> Name -> Doc
pprName' NameIs
Applied Name
c
pprParendType (PromotedTupleT 0)  = String -> Doc
text "'()"
pprParendType (PromotedTupleT n :: Int
n)  = Doc -> Doc
quoteParens ([Doc] -> Doc
hcat (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Doc
comma))
pprParendType PromotedNilT        = String -> Doc
text "'[]"
pprParendType PromotedConsT       = String -> Doc
text "'(:)"
pprParendType StarT               = Char -> Doc
char '*'
pprParendType ConstraintT         = String -> Doc
text "Constraint"
pprParendType (SigT ty :: Type
ty k :: Type
k)         = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
k)
pprParendType WildCardT           = Char -> Doc
char '_'
pprParendType (InfixT x :: Type
x n :: Name
n y :: Type
y)      = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
x Doc -> Doc -> Doc
<+> NameIs -> Name -> Doc
pprName' NameIs
Infix Name
n Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
y)
pprParendType t :: Type
t@(UInfixT {})      = Doc -> Doc
parens (Type -> Doc
pprUInfixT Type
t)
pprParendType (ParensT t :: Type
t)         = Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t
pprParendType tuple :: Type
tuple | (TupleT n :: Int
n, args :: [TypeArg]
args) <- Type -> (Type, [TypeArg])
split Type
tuple
                    , [TypeArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeArg]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n
                    = Doc -> Doc
parens ([TypeArg] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [TypeArg]
args)
pprParendType (ImplicitParamT n :: String
n t :: Type
t)= String -> Doc
text ('?'Char -> String -> String
forall a. a -> [a] -> [a]
:String
n) Doc -> Doc -> Doc
<+> String -> Doc
text "::" Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t
pprParendType EqualityT           = String -> Doc
text "(~)"
pprParendType t :: Type
t@(ForallT {})      = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t)
pprParendType t :: Type
t@(AppT {})         = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t)
pprParendType t :: Type
t@(AppKindT {})     = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t)

pprUInfixT :: Type -> Doc
pprUInfixT :: Type -> Doc
pprUInfixT (UInfixT x :: Type
x n :: Name
n y :: Type
y) = Type -> Doc
pprUInfixT Type
x Doc -> Doc -> Doc
<+> NameIs -> Name -> Doc
pprName' NameIs
Infix Name
n Doc -> Doc -> Doc
<+> Type -> Doc
pprUInfixT Type
y
pprUInfixT t :: Type
t               = Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t

instance Ppr Type where
    ppr :: Type -> Doc
ppr (ForallT tvars :: [TyVarBndr]
tvars ctxt :: Cxt
ctxt ty :: Type
ty) = [Doc] -> Doc
sep [[TyVarBndr] -> Cxt -> Doc
pprForall [TyVarBndr]
tvars Cxt
ctxt, Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty]
    ppr ty :: Type
ty = (Type, [TypeArg]) -> Doc
pprTyApp (Type -> (Type, [TypeArg])
split Type
ty)
       -- Works, in a degnerate way, for SigT, and puts parens round (ty :: kind)
       -- See Note [Pretty-printing kind signatures]
instance Ppr TypeArg where
    ppr :: TypeArg -> Doc
ppr (TANormal ty :: Type
ty) = Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty
    ppr (TyArg ki :: Type
ki) = Char -> Doc
char '@' Doc -> Doc -> Doc
<> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ki

pprParendTypeArg :: TypeArg -> Doc
pprParendTypeArg :: TypeArg -> Doc
pprParendTypeArg (TANormal ty :: Type
ty) = Type -> Doc
pprParendType Type
ty
pprParendTypeArg (TyArg ki :: Type
ki) = Char -> Doc
char '@' Doc -> Doc -> Doc
<> Type -> Doc
pprParendType Type
ki
{- Note [Pretty-printing kind signatures]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC's parser only recognises a kind signature in a type when there are
parens around it.  E.g. the parens are required here:
   f :: (Int :: *)
   type instance F Int = (Bool :: *)
So we always print a SigT with parens (see Trac #10050). -}

pprTyApp :: (Type, [TypeArg]) -> Doc
pprTyApp :: (Type, [TypeArg]) -> Doc
pprTyApp (ArrowT, [TANormal arg1 :: Type
arg1, TANormal arg2 :: Type
arg2]) = [Doc] -> Doc
sep [Type -> Doc
pprFunArgType Type
arg1 Doc -> Doc -> Doc
<+> String -> Doc
text "->", Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
arg2]
pprTyApp (EqualityT, [TANormal arg1 :: Type
arg1, TANormal arg2 :: Type
arg2]) =
    [Doc] -> Doc
sep [Type -> Doc
pprFunArgType Type
arg1 Doc -> Doc -> Doc
<+> String -> Doc
text "~", Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
arg2]
pprTyApp (ListT, [TANormal arg :: Type
arg]) = Doc -> Doc
brackets (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
arg)
pprTyApp (TupleT n :: Int
n, args :: [TypeArg]
args)
 | [TypeArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeArg]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Doc -> Doc
parens ([TypeArg] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [TypeArg]
args)
pprTyApp (PromotedTupleT n :: Int
n, args :: [TypeArg]
args)
 | [TypeArg] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeArg]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = Doc -> Doc
quoteParens ([TypeArg] -> Doc
forall a. Ppr a => [a] -> Doc
commaSep [TypeArg]
args)
pprTyApp (fun :: Type
fun, args :: [TypeArg]
args) = Type -> Doc
pprParendType Type
fun Doc -> Doc -> Doc
<+> [Doc] -> Doc
sep ((TypeArg -> Doc) -> [TypeArg] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map TypeArg -> Doc
pprParendTypeArg [TypeArg]
args)

pprFunArgType :: Type -> Doc    -- Should really use a precedence argument
-- Everything except forall and (->) binds more tightly than (->)
pprFunArgType :: Type -> Doc
pprFunArgType ty :: Type
ty@(ForallT {})                 = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty)
pprFunArgType ty :: Type
ty@((ArrowT `AppT` _) `AppT` _) = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty)
pprFunArgType ty :: Type
ty@(SigT _ _)                   = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty)
pprFunArgType ty :: Type
ty                              = Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
ty

data TypeArg = TANormal Type
             | TyArg Kind

split :: Type -> (Type, [TypeArg])    -- Split into function and args
split :: Type -> (Type, [TypeArg])
split t :: Type
t = Type -> [TypeArg] -> (Type, [TypeArg])
go Type
t []
    where go :: Type -> [TypeArg] -> (Type, [TypeArg])
go (AppT t1 :: Type
t1 t2 :: Type
t2) args :: [TypeArg]
args = Type -> [TypeArg] -> (Type, [TypeArg])
go Type
t1 (Type -> TypeArg
TANormal Type
t2TypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:[TypeArg]
args)
          go (AppKindT ty :: Type
ty ki :: Type
ki) args :: [TypeArg]
args = Type -> [TypeArg] -> (Type, [TypeArg])
go Type
ty (Type -> TypeArg
TyArg Type
kiTypeArg -> [TypeArg] -> [TypeArg]
forall a. a -> [a] -> [a]
:[TypeArg]
args)
          go ty :: Type
ty           args :: [TypeArg]
args = (Type
ty, [TypeArg]
args)

pprTyLit :: TyLit -> Doc
pprTyLit :: TyLit -> Doc
pprTyLit (NumTyLit n :: Integer
n) = Integer -> Doc
integer Integer
n
pprTyLit (StrTyLit s :: String
s) = String -> Doc
text (String -> String
forall a. Show a => a -> String
show String
s)

instance Ppr TyLit where
  ppr :: TyLit -> Doc
ppr = TyLit -> Doc
pprTyLit

------------------------------
instance Ppr TyVarBndr where
    ppr :: TyVarBndr -> Doc
ppr (PlainTV nm :: Name
nm)    = Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
nm
    ppr (KindedTV nm :: Name
nm k :: Type
k) = Doc -> Doc
parens (Name -> Doc
forall a. Ppr a => a -> Doc
ppr Name
nm Doc -> Doc -> Doc
<+> Doc
dcolon Doc -> Doc -> Doc
<+> Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
k)

instance Ppr Role where
    ppr :: Role -> Doc
ppr NominalR          = String -> Doc
text "nominal"
    ppr RepresentationalR = String -> Doc
text "representational"
    ppr PhantomR          = String -> Doc
text "phantom"
    ppr InferR            = String -> Doc
text "_"

------------------------------
pprCxt :: Cxt -> Doc
pprCxt :: Cxt -> Doc
pprCxt [] = Doc
empty
pprCxt ts :: Cxt
ts = Cxt -> Doc
ppr_cxt_preds Cxt
ts Doc -> Doc -> Doc
<+> String -> Doc
text "=>"

ppr_cxt_preds :: Cxt -> Doc
ppr_cxt_preds :: Cxt -> Doc
ppr_cxt_preds [] = Doc
empty
ppr_cxt_preds [t :: Type
t@ImplicitParamT{}] = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t)
ppr_cxt_preds [t :: Type
t@ForallT{}] = Doc -> Doc
parens (Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t)
ppr_cxt_preds [t :: Type
t] = Type -> Doc
forall a. Ppr a => a -> Doc
ppr Type
t
ppr_cxt_preds ts :: Cxt
ts = Doc -> Doc
parens (Cxt -> Doc
forall a. Ppr a => [a] -> Doc
commaSep Cxt
ts)

------------------------------
instance Ppr Range where
    ppr :: Range -> Doc
ppr = Doc -> Doc
brackets (Doc -> Doc) -> (Range -> Doc) -> Range -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range -> Doc
pprRange
        where pprRange :: Range -> Doc
              pprRange :: Range -> Doc
pprRange (FromR e :: Exp
e) = Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e Doc -> Doc -> Doc
<> String -> Doc
text ".."
              pprRange (FromThenR e1 :: Exp
e1 e2 :: Exp
e2) = Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e1 Doc -> Doc -> Doc
<> String -> Doc
text ","
                                        Doc -> Doc -> Doc
<> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e2 Doc -> Doc -> Doc
<> String -> Doc
text ".."
              pprRange (FromToR e1 :: Exp
e1 e2 :: Exp
e2) = Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e1 Doc -> Doc -> Doc
<> String -> Doc
text ".." Doc -> Doc -> Doc
<> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e2
              pprRange (FromThenToR e1 :: Exp
e1 e2 :: Exp
e2 e3 :: Exp
e3) = Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e1 Doc -> Doc -> Doc
<> String -> Doc
text ","
                                             Doc -> Doc -> Doc
<> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e2 Doc -> Doc -> Doc
<> String -> Doc
text ".."
                                             Doc -> Doc -> Doc
<> Exp -> Doc
forall a. Ppr a => a -> Doc
ppr Exp
e3

------------------------------
where_clause :: [Dec] -> Doc
where_clause :: [Dec] -> Doc
where_clause [] = Doc
empty
where_clause ds :: [Dec]
ds = Int -> Doc -> Doc
nest Int
nestDepth (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
text "where" Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat ((Dec -> Doc) -> [Dec] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Dec -> Doc
ppr_dec Bool
False) [Dec]
ds)

showtextl :: Show a => a -> Doc
showtextl :: a -> Doc
showtextl = String -> Doc
text (String -> Doc) -> (a -> String) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (a -> String) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

hashParens :: Doc -> Doc
hashParens :: Doc -> Doc
hashParens d :: Doc
d = String -> Doc
text "(# " Doc -> Doc -> Doc
<> Doc
d Doc -> Doc -> Doc
<> String -> Doc
text " #)"

quoteParens :: Doc -> Doc
quoteParens :: Doc -> Doc
quoteParens d :: Doc
d = String -> Doc
text "'(" Doc -> Doc -> Doc
<> Doc
d Doc -> Doc -> Doc
<> String -> Doc
text ")"

-----------------------------
instance Ppr Loc where
  ppr :: Loc -> Doc
ppr (Loc { loc_module :: Loc -> String
loc_module = String
md
           , loc_package :: Loc -> String
loc_package = String
pkg
           , loc_start :: Loc -> CharPos
loc_start = (start_ln :: Int
start_ln, start_col :: Int
start_col)
           , loc_end :: Loc -> CharPos
loc_end = (end_ln :: Int
end_ln, end_col :: Int
end_col) })
    = [Doc] -> Doc
hcat [ String -> Doc
text String
pkg, Doc
colon, String -> Doc
text String
md, Doc
colon
           , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc
int Int
start_ln Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<> Int -> Doc
int Int
start_col
           , String -> Doc
text "-"
           , Doc -> Doc
parens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ Int -> Doc
int Int
end_ln Doc -> Doc -> Doc
<> Doc
comma Doc -> Doc -> Doc
<> Int -> Doc
int Int
end_col ]

-- Takes a list of printable things and prints them separated by commas followed
-- by space.
commaSep :: Ppr a => [a] -> Doc
commaSep :: [a] -> Doc
commaSep = (a -> Doc) -> [a] -> Doc
forall a. (a -> Doc) -> [a] -> Doc
commaSepWith a -> Doc
forall a. Ppr a => a -> Doc
ppr

-- Takes a list of things and prints them with the given pretty-printing
-- function, separated by commas followed by space.
commaSepWith :: (a -> Doc) -> [a] -> Doc
commaSepWith :: (a -> Doc) -> [a] -> Doc
commaSepWith pprFun :: a -> Doc
pprFun = [Doc] -> Doc
sep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
pprFun

-- Takes a list of printable things and prints them separated by semicolons
-- followed by space.
semiSep :: Ppr a => [a] -> Doc
semiSep :: [a] -> Doc
semiSep = [Doc] -> Doc
sep ([Doc] -> Doc) -> ([a] -> [Doc]) -> [a] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
semi ([Doc] -> [Doc]) -> ([a] -> [Doc]) -> [a] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map a -> Doc
forall a. Ppr a => a -> Doc
ppr

-- Prints out the series of vertical bars that wraps an expression or pattern
-- used in an unboxed sum.
unboxedSumBars :: Doc -> SumAlt -> SumArity -> Doc
unboxedSumBars :: Doc -> Int -> Int -> Doc
unboxedSumBars d :: Doc
d alt :: Int
alt arity :: Int
arity = Doc -> Doc
hashParens (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$
    Int -> Doc
bars (Int
altInt -> Int -> Int
forall a. Num a => a -> a -> a
-1) Doc -> Doc -> Doc
<> Doc
d Doc -> Doc -> Doc
<> Int -> Doc
bars (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
alt)
  where
    bars :: Int -> Doc
bars i :: Int
i = [Doc] -> Doc
hsep (Int -> Doc -> [Doc]
forall a. Int -> a -> [a]
replicate Int
i Doc
bar)

-- Text containing the vertical bar character.
bar :: Doc
bar :: Doc
bar = Char -> Doc
char '|'