{-# LANGUAGE CPP #-}
module Language.Java.Pretty where
import Text.PrettyPrint
import Text.Printf (printf)
import Data.Char (toLower)
import Data.List (intersperse)
import Language.Java.Syntax
#if MIN_VERSION_base(4,11,0)
import Prelude hiding ((<>))
#endif
prettyPrint :: Pretty a => a -> String
prettyPrint :: forall a. Pretty a => a -> String
prettyPrint = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> Doc
pretty
parenPrec :: Int -> Int -> Doc -> Doc
parenPrec :: Int -> Int -> Doc -> Doc
parenPrec Int
inheritedPrec Int
currentPrec Doc
t
| Int
inheritedPrec forall a. Ord a => a -> a -> Bool
<= Int
0 = Doc
t
| Int
inheritedPrec forall a. Ord a => a -> a -> Bool
< Int
currentPrec = Doc -> Doc
parens Doc
t
| Bool
otherwise = Doc
t
class Pretty a where
pretty :: a -> Doc
pretty = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
0
prettyPrec :: Int -> a -> Doc
prettyPrec Int
_ = forall a. Pretty a => a -> Doc
pretty
instance Pretty CompilationUnit where
prettyPrec :: Int -> CompilationUnit -> Doc
prettyPrec Int
p (CompilationUnit Maybe PackageDecl
mpd [ImportDecl]
ids [TypeDecl]
tds) =
[Doc] -> Doc
vcat forall a b. (a -> b) -> a -> b
$ ((forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe PackageDecl
mpd)forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [ImportDecl]
ids) forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [TypeDecl]
tds
instance Pretty PackageDecl where
prettyPrec :: Int -> PackageDecl -> Doc
prettyPrec Int
p (PackageDecl Name
name) = String -> Doc
text String
"package" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name Doc -> Doc -> Doc
<> Doc
semi
instance Pretty ImportDecl where
prettyPrec :: Int -> ImportDecl -> Doc
prettyPrec Int
p (ImportDecl Bool
st Name
name Bool
wc) =
String -> Doc
text String
"import" Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
opt Bool
st (String -> Doc
text String
"static")
Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name Doc -> Doc -> Doc
<> Bool -> Doc -> Doc
opt Bool
wc (String -> Doc
text String
".*")
Doc -> Doc -> Doc
<> Doc
semi
instance Pretty TypeDecl where
prettyPrec :: Int -> TypeDecl -> Doc
prettyPrec Int
p (ClassTypeDecl ClassDecl
cd) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ClassDecl
cd
prettyPrec Int
p (InterfaceTypeDecl InterfaceDecl
id) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p InterfaceDecl
id
instance Pretty ClassDecl where
prettyPrec :: Int -> ClassDecl -> Doc
prettyPrec Int
p (EnumDecl [Modifier]
mods Ident
ident [RefType]
impls EnumBody
body) =
[Doc] -> Doc
hsep [[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods)
, String -> Doc
text String
"enum"
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
, Int -> [RefType] -> Doc
ppImplements Int
p [RefType]
impls
] Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p EnumBody
body
prettyPrec Int
p (ClassDecl [Modifier]
mods Ident
ident [TypeParam]
tParams Maybe RefType
mSuper [RefType]
impls ClassBody
body) =
[Doc] -> Doc
hsep [[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods)
, String -> Doc
text String
"class"
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
, forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [TypeParam]
tParams
, Int -> [RefType] -> Doc
ppExtends Int
p (forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RefType
mSuper)
, Int -> [RefType] -> Doc
ppImplements Int
p [RefType]
impls
] Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ClassBody
body
instance Pretty ClassBody where
prettyPrec :: Int -> ClassBody -> Doc
prettyPrec Int
p (ClassBody [Decl]
ds) =
[Doc] -> Doc
braceBlock (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Decl]
ds)
instance Pretty EnumBody where
prettyPrec :: Int -> EnumBody -> Doc
prettyPrec Int
p (EnumBody [EnumConstant]
cs [Decl]
ds) =
[Doc] -> Doc
braceBlock forall a b. (a -> b) -> a -> b
$
Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [EnumConstant]
cs) forall a. [a] -> [a] -> [a]
++
Bool -> Doc -> Doc
opt (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Decl]
ds) Doc
semi forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Decl]
ds
instance Pretty EnumConstant where
prettyPrec :: Int -> EnumConstant -> Doc
prettyPrec Int
p (EnumConstant Ident
ident [Exp]
args Maybe ClassBody
mBody) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
Doc -> Doc -> Doc
<> Bool -> Doc -> Doc
opt (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Exp]
args) (forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args)
Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe ClassBody
mBody
instance Pretty InterfaceDecl where
prettyPrec :: Int -> InterfaceDecl -> Doc
prettyPrec Int
p (InterfaceDecl InterfaceKind
kind [Modifier]
mods Ident
ident [TypeParam]
tParams [RefType]
impls InterfaceBody
body) =
[Doc] -> Doc
hsep [[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods)
, String -> Doc
text (if InterfaceKind
kind forall a. Eq a => a -> a -> Bool
== InterfaceKind
InterfaceNormal then String
"interface" else String
"@interface")
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
, forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [TypeParam]
tParams
, Int -> [RefType] -> Doc
ppExtends Int
p [RefType]
impls
] Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p InterfaceBody
body
instance Pretty InterfaceBody where
prettyPrec :: Int -> InterfaceBody -> Doc
prettyPrec Int
p (InterfaceBody [MemberDecl]
mds) =
[Doc] -> Doc
braceBlock (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [MemberDecl]
mds)
instance Pretty Decl where
prettyPrec :: Int -> Decl -> Doc
prettyPrec Int
p (MemberDecl MemberDecl
md) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p MemberDecl
md
prettyPrec Int
p (InitDecl Bool
b Block
bl) =
Bool -> Doc -> Doc
opt Bool
b (String -> Doc
text String
"static") Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Block
bl
instance Pretty MemberDecl where
prettyPrec :: Int -> MemberDecl -> Doc
prettyPrec Int
p (FieldDecl [Modifier]
mods Type
t [VarDecl]
vds) =
[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
tforall a. a -> [a] -> [a]
:Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
",") (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [VarDecl]
vds)) Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (MethodDecl [Modifier]
mods [TypeParam]
tParams Maybe Type
mt Ident
ident [FormalParam]
fParams [RefType]
throws Maybe Exp
def MethodBody
body) =
[Doc] -> Doc
hsep [[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods)
, forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [TypeParam]
tParams
, Int -> Maybe Type -> Doc
ppResultType Int
p Maybe Type
mt
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
, forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [FormalParam]
fParams
, Int -> [RefType] -> Doc
ppThrows Int
p [RefType]
throws
, Int -> Maybe Exp -> Doc
ppDefault Int
p Maybe Exp
def
] Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p MethodBody
body
prettyPrec Int
p (ConstructorDecl [Modifier]
mods [TypeParam]
tParams Ident
ident [FormalParam]
fParams [RefType]
throws ConstructorBody
body) =
[Doc] -> Doc
hsep [[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods)
, forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [TypeParam]
tParams
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
, forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [FormalParam]
fParams
, Int -> [RefType] -> Doc
ppThrows Int
p [RefType]
throws
] Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ConstructorBody
body
prettyPrec Int
p (MemberClassDecl ClassDecl
cd) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ClassDecl
cd
prettyPrec Int
p (MemberInterfaceDecl InterfaceDecl
id) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p InterfaceDecl
id
instance Pretty VarDecl where
prettyPrec :: Int -> VarDecl -> Doc
prettyPrec Int
p (VarDecl VarDeclId
vdId Maybe VarInit
Nothing) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p VarDeclId
vdId
prettyPrec Int
p (VarDecl VarDeclId
vdId (Just VarInit
ie)) =
(forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p VarDeclId
vdId Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'=') Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p VarInit
ie
instance Pretty VarDeclId where
prettyPrec :: Int -> VarDeclId -> Doc
prettyPrec Int
p (VarId Ident
ident) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
prettyPrec Int
p (VarDeclArray VarDeclId
vId) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p VarDeclId
vId Doc -> Doc -> Doc
<> String -> Doc
text String
"[]"
instance Pretty VarInit where
prettyPrec :: Int -> VarInit -> Doc
prettyPrec Int
p (InitExp Exp
e) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e
prettyPrec Int
p (InitArray (ArrayInit [VarInit]
ai)) =
String -> Doc
text String
"{" Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [VarInit]
ai)) Doc -> Doc -> Doc
<+> String -> Doc
text String
"}"
instance Pretty FormalParam where
prettyPrec :: Int -> FormalParam -> Doc
prettyPrec Int
p (FormalParam [Modifier]
mods Type
t Bool
b VarDeclId
vId) =
[Doc] -> Doc
hsep [[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods)
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
t Doc -> Doc -> Doc
<> Bool -> Doc -> Doc
opt Bool
b (String -> Doc
text String
"...")
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p VarDeclId
vId
]
instance Pretty MethodBody where
prettyPrec :: Int -> MethodBody -> Doc
prettyPrec Int
p (MethodBody Maybe Block
mBlock) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
semi (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) Maybe Block
mBlock
instance Pretty ConstructorBody where
prettyPrec :: Int -> ConstructorBody -> Doc
prettyPrec Int
p (ConstructorBody Maybe ExplConstrInv
mECI [BlockStmt]
stmts) =
[Doc] -> Doc
braceBlock forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe ExplConstrInv
mECI forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [BlockStmt]
stmts
instance Pretty ExplConstrInv where
prettyPrec :: Int -> ExplConstrInv -> Doc
prettyPrec Int
p (ThisInvoke [RefType]
rts [Exp]
args) =
forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [RefType]
rts Doc -> Doc -> Doc
<+> String -> Doc
text String
"this" Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (SuperInvoke [RefType]
rts [Exp]
args) =
forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [RefType]
rts Doc -> Doc -> Doc
<+> String -> Doc
text String
"super" Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (PrimarySuperInvoke Exp
e [RefType]
rts [Exp]
args) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<>
forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [RefType]
rts Doc -> Doc -> Doc
<+> String -> Doc
text String
"super" Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args Doc -> Doc -> Doc
<> Doc
semi
instance Pretty Modifier where
prettyPrec :: Int -> Modifier -> Doc
prettyPrec Int
p (Annotation Annotation
ann) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Annotation
ann Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest (-Int
1) ( String -> Doc
text String
"")
prettyPrec Int
p Modifier
mod = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Modifier
mod
instance Pretty Annotation where
prettyPrec :: Int -> Annotation -> Doc
prettyPrec Int
p Annotation
x = String -> Doc
text String
"@" Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p (Annotation -> Name
annName Annotation
x) Doc -> Doc -> Doc
<> case Annotation
x of
MarkerAnnotation {} -> String -> Doc
text String
""
SingleElementAnnotation {} -> String -> Doc
text String
"(" Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p (Annotation -> ElementValue
annValue Annotation
x) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
NormalAnnotation {} -> String -> Doc
text String
"(" Doc -> Doc -> Doc
<> forall {a} {a}. (Pretty a, Pretty a) => Int -> [(a, a)] -> Doc
ppEVList Int
p (Annotation -> [(Ident, ElementValue)]
annKV Annotation
x) Doc -> Doc -> Doc
<> String -> Doc
text String
")"
ppEVList :: Int -> [(a, a)] -> Doc
ppEVList Int
p = [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\(a
k,a
v) -> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p a
k Doc -> Doc -> Doc
<+> String -> Doc
text String
"=" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p a
v)
instance Pretty ElementValue where
prettyPrec :: Int -> ElementValue -> Doc
prettyPrec Int
p (EVVal VarInit
vi) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p VarInit
vi
prettyPrec Int
p (EVAnn Annotation
ann) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Annotation
ann
instance Pretty Block where
prettyPrec :: Int -> Block -> Doc
prettyPrec Int
p (Block [BlockStmt]
stmts) = [Doc] -> Doc
braceBlock forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [BlockStmt]
stmts
instance Pretty BlockStmt where
prettyPrec :: Int -> BlockStmt -> Doc
prettyPrec Int
p (BlockStmt Stmt
stmt) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Stmt
stmt
prettyPrec Int
p (LocalClass ClassDecl
cd) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ClassDecl
cd
prettyPrec Int
p (LocalVars [Modifier]
mods Type
t [VarDecl]
vds) =
[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods) Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
t Doc -> Doc -> Doc
<+>
[Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [VarDecl]
vds) Doc -> Doc -> Doc
<> Doc
semi
instance Pretty Stmt where
prettyPrec :: Int -> Stmt -> Doc
prettyPrec Int
p (StmtBlock Block
block) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Block
block
prettyPrec Int
p (IfThen Exp
c Stmt
th) =
String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
0 Exp
c) Doc -> Doc -> Doc
$+$ Int -> Stmt -> Doc
prettyNestedStmt Int
0 Stmt
th
prettyPrec Int
p (IfThenElse Exp
c Stmt
th Stmt
el) =
String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
c) Doc -> Doc -> Doc
$+$ Int -> Stmt -> Doc
prettyNestedStmt Int
0 Stmt
th Doc -> Doc -> Doc
$+$ String -> Doc
text String
"else" Doc -> Doc -> Doc
$+$ Int -> Stmt -> Doc
prettyNestedStmt Int
0 Stmt
el
prettyPrec Int
p (While Exp
c Stmt
stmt) =
String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
c) Doc -> Doc -> Doc
$+$ Int -> Stmt -> Doc
prettyNestedStmt Int
0 Stmt
stmt
prettyPrec Int
p (BasicFor Maybe ForInit
mInit Maybe Exp
mE Maybe [Exp]
mUp Stmt
stmt) =
String -> Doc
text String
"for" Doc -> Doc -> Doc
<+> (Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe ForInit
mInit, Doc
semi
, forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe Exp
mE, Doc
semi
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty ([Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p)) Maybe [Exp]
mUp
]) Doc -> Doc -> Doc
$+$ Int -> Stmt -> Doc
prettyNestedStmt Int
p Stmt
stmt
prettyPrec Int
p (EnhancedFor [Modifier]
mods Type
t Ident
ident Exp
e Stmt
stmt) =
[Doc] -> Doc
hsep [String -> Doc
text String
"for"
, Doc -> Doc
parens forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
hsep [
[Doc] -> Doc
hsep (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods)
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
t
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
, Doc
colon
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e
]
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Stmt
stmt
]
prettyPrec Int
p Stmt
Empty = Doc
semi
prettyPrec Int
p (ExpStmt Exp
e) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (Assert Exp
ass Maybe Exp
mE) =
String -> Doc
text String
"assert" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
ass
Doc -> Doc -> Doc
<+> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty ((Doc
colon Doc -> Doc -> Doc
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) Maybe Exp
mE Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (Switch Exp
e [SwitchBlock]
sBlocks) =
String -> Doc
text String
"switch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e)
Doc -> Doc -> Doc
$$ [Doc] -> Doc
braceBlock (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [SwitchBlock]
sBlocks)
prettyPrec Int
p (Do Stmt
stmt Exp
e) =
String -> Doc
text String
"do" Doc -> Doc -> Doc
$+$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Stmt
stmt Doc -> Doc -> Doc
<+> String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e) Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (Break Maybe Ident
mIdent) =
String -> Doc
text String
"break" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe Ident
mIdent Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (Continue Maybe Ident
mIdent) =
String -> Doc
text String
"continue" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe Ident
mIdent Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (Return Maybe Exp
mE) =
String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe Exp
mE Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (Synchronized Exp
e Block
block) =
String -> Doc
text String
"synchronized" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e) Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Block
block
prettyPrec Int
p (Throw Exp
e) =
String -> Doc
text String
"throw" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e Doc -> Doc -> Doc
<> Doc
semi
prettyPrec Int
p (Try Block
block [Catch]
catches Maybe Block
mFinally) =
String -> Doc
text String
"try" Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Block
block Doc -> Doc -> Doc
$$
[Doc] -> Doc
vcat (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Catch]
catches forall a. [a] -> [a] -> [a]
++ [forall {a}. Pretty a => Maybe a -> Doc
ppFinally Maybe Block
mFinally])
where ppFinally :: Maybe a -> Doc
ppFinally Maybe a
Nothing = Doc
empty
ppFinally (Just a
bl) = String -> Doc
text String
"finally" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p a
bl
prettyPrec Int
p (Labeled Ident
ident Stmt
stmt) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident Doc -> Doc -> Doc
<> Doc
colon Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Stmt
stmt
instance Pretty Catch where
prettyPrec :: Int -> Catch -> Doc
prettyPrec Int
p (Catch FormalParam
fParam Block
block) =
[Doc] -> Doc
hsep [String -> Doc
text String
"catch", Doc -> Doc
parens (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p FormalParam
fParam)] Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Block
block
instance Pretty SwitchBlock where
prettyPrec :: Int -> SwitchBlock -> Doc
prettyPrec Int
p (SwitchBlock SwitchLabel
lbl [BlockStmt]
stmts) =
[Doc] -> Doc
vcat (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p SwitchLabel
lbl forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Int -> Doc -> Doc
nest Int
2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [BlockStmt]
stmts)
instance Pretty SwitchLabel where
prettyPrec :: Int -> SwitchLabel -> Doc
prettyPrec Int
p (SwitchCase Exp
e) =
String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e Doc -> Doc -> Doc
<> Doc
colon
prettyPrec Int
p SwitchLabel
Default = String -> Doc
text String
"default:"
instance Pretty ForInit where
prettyPrec :: Int -> ForInit -> Doc
prettyPrec Int
p (ForLocalVars [Modifier]
mods Type
t [VarDecl]
vds) =
[Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Modifier]
mods forall a. [a] -> [a] -> [a]
++
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
tforall a. a -> [a] -> [a]
: Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [VarDecl]
vds)
prettyPrec Int
p (ForInitExps [Exp]
es) =
[Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Exp]
es)
instance Pretty Exp where
prettyPrec :: Int -> Exp -> Doc
prettyPrec Int
p (Lit Literal
l) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Literal
l
prettyPrec Int
p (ClassLit Maybe Type
mT) =
Int -> Maybe Type -> Doc
ppResultType Int
p Maybe Type
mT Doc -> Doc -> Doc
<> String -> Doc
text String
".class"
prettyPrec Int
_ Exp
This = String -> Doc
text String
"this"
prettyPrec Int
p (ThisClass Name
name) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name Doc -> Doc -> Doc
<> String -> Doc
text String
".this"
prettyPrec Int
p (InstanceCreation [TypeArgument]
tArgs TypeDeclSpecifier
tds [Exp]
args Maybe ClassBody
mBody) =
[Doc] -> Doc
hsep [String -> Doc
text String
"new"
, forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [TypeArgument]
tArgs
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p TypeDeclSpecifier
tds Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args
] Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe ClassBody
mBody
prettyPrec Int
p (QualInstanceCreation Exp
e [TypeArgument]
tArgs Ident
ident [Exp]
args Maybe ClassBody
mBody) =
[Doc] -> Doc
hsep [forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> String -> Doc
text String
"new"
, forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [TypeArgument]
tArgs
, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args
] Doc -> Doc -> Doc
$$ forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe ClassBody
mBody
prettyPrec Int
p (ArrayCreate Type
t [Exp]
es Int
k) =
String -> Doc
text String
"new" Doc -> Doc -> Doc
<+>
[Doc] -> Doc
hcat (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
t forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Exp]
es
forall a. [a] -> [a] -> [a]
++ forall a. Int -> a -> [a]
replicate Int
k (String -> Doc
text String
"[]"))
prettyPrec Int
p (ArrayCreateInit Type
t Int
k ArrayInit
init) =
String -> Doc
text String
"new"
Doc -> Doc -> Doc
<+> [Doc] -> Doc
hcat (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
t forall a. a -> [a] -> [a]
: forall a. Int -> a -> [a]
replicate Int
k (String -> Doc
text String
"[]"))
Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ArrayInit
init
prettyPrec Int
p (FieldAccess FieldAccess
fa) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
1 FieldAccess
fa
prettyPrec Int
p (MethodInv MethodInvocation
mi) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
1 MethodInvocation
mi
prettyPrec Int
p (ArrayAccess ArrayIndex
ain) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
1 ArrayIndex
ain
prettyPrec Int
p (ExpName Name
name) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name
prettyPrec Int
p (PostIncrement Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e Doc -> Doc -> Doc
<> String -> Doc
text String
"++"
prettyPrec Int
p (PostDecrement Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
1 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e Doc -> Doc -> Doc
<> String -> Doc
text String
"--"
prettyPrec Int
p (PreIncrement Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
1 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"++" Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e
prettyPrec Int
p (PreDecrement Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
1 forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"--" Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e
prettyPrec Int
p (PrePlus Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'+' Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e
prettyPrec Int
p (PreMinus Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'-' Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e
prettyPrec Int
p (PreBitCompl Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'~' Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e
prettyPrec Int
p (PreNot Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 forall a b. (a -> b) -> a -> b
$ Char -> Doc
char Char
'!' Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e
prettyPrec Int
p (Cast Type
t Exp
e) = Int -> Int -> Doc -> Doc
parenPrec Int
p Int
2 forall a b. (a -> b) -> a -> b
$ Doc -> Doc
parens (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
t) Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
2 Exp
e
prettyPrec Int
p (BinOp Exp
e1 Op
op Exp
e2) =
let prec :: Int
prec = forall {a}. Num a => Op -> a
opPrec Op
op in
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
prec (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
prec Exp
e1 Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Op
op Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
prec Exp
e2)
prettyPrec Int
p (InstanceOf Exp
e RefType
rt) =
let cp :: Int
cp = forall {a}. Num a => Op -> a
opPrec Op
LThan in
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
cp forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
cp Exp
e
Doc -> Doc -> Doc
<+> String -> Doc
text String
"instanceof" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
cp RefType
rt
prettyPrec Int
p (Cond Exp
c Exp
th Exp
el) =
Int -> Int -> Doc -> Doc
parenPrec Int
p Int
13 forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
13 Exp
c Doc -> Doc -> Doc
<+> Char -> Doc
char Char
'?'
Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
th Doc -> Doc -> Doc
<+> Doc
colon Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
13 Exp
el
prettyPrec Int
p (Assign Lhs
lhs AssignOp
aop Exp
e) =
[Doc] -> Doc
hsep [forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Lhs
lhs, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p AssignOp
aop, forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e]
prettyPrec Int
p (Lambda LambdaParams
params LambdaExpression
body) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p LambdaParams
params Doc -> Doc -> Doc
<+> String -> Doc
text String
"->" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p LambdaExpression
body
prettyPrec Int
p (MethodRef Name
i1 Ident
i2) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
i1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"::" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
i2
instance Pretty LambdaParams where
prettyPrec :: Int -> LambdaParams -> Doc
prettyPrec Int
p (LambdaSingleParam Ident
ident) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
prettyPrec Int
p (LambdaFormalParams [FormalParam]
params) = forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [FormalParam]
params
prettyPrec Int
p (LambdaInferredParams [Ident]
idents) = forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Ident]
idents
instance Pretty LambdaExpression where
prettyPrec :: Int -> LambdaExpression -> Doc
prettyPrec Int
p (LambdaExpression Exp
exp) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
exp
prettyPrec Int
p (LambdaBlock Block
block) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Block
block
instance Pretty Literal where
prettyPrec :: Int -> Literal -> Doc
prettyPrec Int
p (Int Integer
i) = String -> Doc
text (forall a. Show a => a -> String
show Integer
i)
prettyPrec Int
p (Word Integer
i) = String -> Doc
text (forall a. Show a => a -> String
show Integer
i) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'L'
prettyPrec Int
p (Float Double
f) = String -> Doc
text (forall a. Show a => a -> String
show Double
f) Doc -> Doc -> Doc
<> Char -> Doc
char Char
'F'
prettyPrec Int
p (Double Double
d) = String -> Doc
text (forall a. Show a => a -> String
show Double
d)
prettyPrec Int
p (Boolean Bool
b) = String -> Doc
text forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Bool
b
prettyPrec Int
p (Char Char
c) = Doc -> Doc
quotes forall a b. (a -> b) -> a -> b
$ String -> Doc
text (Char -> String
escapeChar Char
c)
prettyPrec Int
p (String String
s) = Doc -> Doc
doubleQuotes forall a b. (a -> b) -> a -> b
$ String -> Doc
text (forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escapeString String
s)
prettyPrec Int
p (Literal
Null) = String -> Doc
text String
"null"
instance Pretty Op where
prettyPrec :: Int -> Op -> Doc
prettyPrec Int
p Op
op = String -> Doc
text forall a b. (a -> b) -> a -> b
$ case Op
op of
Op
Mult -> String
"*"
Op
Div -> String
"/"
Op
Rem -> String
"%"
Op
Add -> String
"+"
Op
Sub -> String
"-"
Op
LShift -> String
"<<"
Op
RShift -> String
">>"
Op
RRShift -> String
">>>"
Op
LThan -> String
"<"
Op
GThan -> String
">"
Op
LThanE -> String
"<="
Op
GThanE -> String
">="
Op
Equal -> String
"=="
Op
NotEq -> String
"!="
Op
And -> String
"&"
Op
Xor -> String
"^"
Op
Or -> String
"|"
Op
CAnd -> String
"&&"
Op
COr -> String
"||"
instance Pretty AssignOp where
prettyPrec :: Int -> AssignOp -> Doc
prettyPrec Int
p AssignOp
aop = String -> Doc
text forall a b. (a -> b) -> a -> b
$ case AssignOp
aop of
AssignOp
EqualA -> String
"="
AssignOp
MultA -> String
"*="
AssignOp
DivA -> String
"/="
AssignOp
RemA -> String
"%="
AssignOp
AddA -> String
"+="
AssignOp
SubA -> String
"-="
AssignOp
LShiftA -> String
"<<="
AssignOp
RShiftA -> String
">>="
AssignOp
RRShiftA -> String
">>>="
AssignOp
AndA -> String
"&="
AssignOp
XorA -> String
"^="
AssignOp
OrA -> String
"|="
instance Pretty Lhs where
prettyPrec :: Int -> Lhs -> Doc
prettyPrec Int
p (NameLhs Name
name) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name
prettyPrec Int
p (FieldLhs FieldAccess
fa) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p FieldAccess
fa
prettyPrec Int
p (ArrayLhs ArrayIndex
ain) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ArrayIndex
ain
instance Pretty ArrayIndex where
prettyPrec :: Int -> ArrayIndex -> Doc
prettyPrec Int
p (ArrayIndex Exp
ref [Exp]
e) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
ref Doc -> Doc -> Doc
<> ([Doc] -> Doc
hcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Doc -> Doc
brackets forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p)) [Exp]
e)
instance Pretty FieldAccess where
prettyPrec :: Int -> FieldAccess -> Doc
prettyPrec Int
p (PrimaryFieldAccess Exp
e Ident
ident) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
prettyPrec Int
p (SuperFieldAccess Ident
ident) =
String -> Doc
text String
"super." Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
prettyPrec Int
p (ClassFieldAccess Name
name Ident
ident) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name Doc -> Doc -> Doc
<> String -> Doc
text String
"." Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
instance Pretty MethodInvocation where
prettyPrec :: Int -> MethodInvocation -> Doc
prettyPrec Int
p (MethodCall Name
name [Exp]
args) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args
prettyPrec Int
p (PrimaryMethodCall Exp
e [RefType]
tArgs Ident
ident [Exp]
args) =
[Doc] -> Doc
hcat [forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
e, Char -> Doc
char Char
'.', forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [RefType]
tArgs,
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident, forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args]
prettyPrec Int
p (SuperMethodCall [RefType]
tArgs Ident
ident [Exp]
args) =
[Doc] -> Doc
hcat [String -> Doc
text String
"super.", forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [RefType]
tArgs,
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident, forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args]
prettyPrec Int
p (ClassMethodCall Name
name [RefType]
tArgs Ident
ident [Exp]
args) =
[Doc] -> Doc
hcat [forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name, String -> Doc
text String
".super.", forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [RefType]
tArgs,
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident, forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args]
prettyPrec Int
p (TypeMethodCall Name
name [RefType]
tArgs Ident
ident [Exp]
args) =
[Doc] -> Doc
hcat [forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Name
name, Char -> Doc
char Char
'.', forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [RefType]
tArgs,
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident, forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p [Exp]
args]
instance Pretty ArrayInit where
prettyPrec :: Int -> ArrayInit -> Doc
prettyPrec Int
p (ArrayInit [VarInit]
vInits) =
[Doc] -> Doc
braceBlock forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\VarInit
v -> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p VarInit
v Doc -> Doc -> Doc
<> Doc
comma) [VarInit]
vInits
ppArgs :: Pretty a => Int -> [a] -> Doc
ppArgs :: forall a. Pretty a => Int -> [a] -> Doc
ppArgs Int
p = Doc -> Doc
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
hsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p)
instance Pretty Type where
prettyPrec :: Int -> Type -> Doc
prettyPrec Int
p (PrimType PrimType
pt) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p PrimType
pt
prettyPrec Int
p (RefType RefType
rt) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p RefType
rt
instance Pretty RefType where
prettyPrec :: Int -> RefType -> Doc
prettyPrec Int
p (ClassRefType ClassType
ct) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ClassType
ct
prettyPrec Int
p (ArrayType Type
t) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
t Doc -> Doc -> Doc
<> String -> Doc
text String
"[]"
instance Pretty ClassType where
prettyPrec :: Int -> ClassType -> Doc
prettyPrec Int
p (ClassType [(Ident, [TypeArgument])]
itas) =
[Doc] -> Doc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
'.') forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map (\(Ident
i,[TypeArgument]
tas) -> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
i Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
p [TypeArgument]
tas) [(Ident, [TypeArgument])]
itas
instance Pretty TypeArgument where
prettyPrec :: Int -> TypeArgument -> Doc
prettyPrec Int
p (ActualType RefType
rt) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p RefType
rt
prettyPrec Int
p (Wildcard Maybe WildcardBound
mBound) = Char -> Doc
char Char
'?' Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p Maybe WildcardBound
mBound
instance Pretty TypeDeclSpecifier where
prettyPrec :: Int -> TypeDeclSpecifier -> Doc
prettyPrec Int
p (TypeDeclSpecifier ClassType
ct) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ClassType
ct
prettyPrec Int
p (TypeDeclSpecifierWithDiamond ClassType
ct Ident
i Diamond
d) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p ClassType
ct Doc -> Doc -> Doc
<> Char -> Doc
char Char
'.' Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
i Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Diamond
d
prettyPrec Int
p (TypeDeclSpecifierUnqualifiedWithDiamond Ident
i Diamond
d) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
i Doc -> Doc -> Doc
<> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Diamond
d
instance Pretty Diamond where
prettyPrec :: Int -> Diamond -> Doc
prettyPrec Int
p Diamond
Diamond = String -> Doc
text String
"<>"
instance Pretty WildcardBound where
prettyPrec :: Int -> WildcardBound -> Doc
prettyPrec Int
p (ExtendsBound RefType
rt) = String -> Doc
text String
"extends" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p RefType
rt
prettyPrec Int
p (SuperBound RefType
rt) = String -> Doc
text String
"super" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p RefType
rt
instance Pretty PrimType where
prettyPrec :: Int -> PrimType -> Doc
prettyPrec Int
p PrimType
BooleanT = String -> Doc
text String
"boolean"
prettyPrec Int
p PrimType
ByteT = String -> Doc
text String
"byte"
prettyPrec Int
p PrimType
ShortT = String -> Doc
text String
"short"
prettyPrec Int
p PrimType
IntT = String -> Doc
text String
"int"
prettyPrec Int
p PrimType
LongT = String -> Doc
text String
"long"
prettyPrec Int
p PrimType
CharT = String -> Doc
text String
"char"
prettyPrec Int
p PrimType
FloatT = String -> Doc
text String
"float"
prettyPrec Int
p PrimType
DoubleT = String -> Doc
text String
"double"
instance Pretty TypeParam where
prettyPrec :: Int -> TypeParam -> Doc
prettyPrec Int
p (TypeParam Ident
ident [RefType]
rts) =
forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Ident
ident
Doc -> Doc -> Doc
<+> Bool -> Doc -> Doc
opt (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [RefType]
rts)
([Doc] -> Doc
hsep forall a b. (a -> b) -> a -> b
$ String -> Doc
text String
"extends"forall a. a -> [a] -> [a]
:
Doc -> [Doc] -> [Doc]
punctuate (String -> Doc
text String
" &") (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [RefType]
rts))
ppTypeParams :: Pretty a => Int -> [a] -> Doc
ppTypeParams :: forall a. Pretty a => Int -> [a] -> Doc
ppTypeParams Int
_ [] = Doc
empty
ppTypeParams Int
p [a]
tps = Char -> Doc
char Char
'<'
Doc -> Doc -> Doc
<> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [a]
tps))
Doc -> Doc -> Doc
<> Char -> Doc
char Char
'>'
ppImplements :: Int -> [RefType] -> Doc
ppImplements :: Int -> [RefType] -> Doc
ppImplements Int
_ [] = Doc
empty
ppImplements Int
p [RefType]
rts = String -> Doc
text String
"implements"
Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [RefType]
rts))
ppExtends :: Int -> [RefType] -> Doc
ppExtends :: Int -> [RefType] -> Doc
ppExtends Int
_ [] = Doc
empty
ppExtends Int
p [RefType]
rts = String -> Doc
text String
"extends"
Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [RefType]
rts))
ppThrows :: Int -> [ExceptionType] -> Doc
ppThrows :: Int -> [RefType] -> Doc
ppThrows Int
_ [] = Doc
empty
ppThrows Int
p [RefType]
ets = String -> Doc
text String
"throws"
Doc -> Doc -> Doc
<+> [Doc] -> Doc
hsep (Doc -> [Doc] -> [Doc]
punctuate Doc
comma (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [RefType]
ets))
ppDefault :: Int -> Maybe Exp -> Doc
ppDefault :: Int -> Maybe Exp -> Doc
ppDefault Int
_ Maybe Exp
Nothing = Doc
empty
ppDefault Int
p (Just Exp
exp) = String -> Doc
text String
"default" Doc -> Doc -> Doc
<+> forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Exp
exp
ppResultType :: Int -> Maybe Type -> Doc
ppResultType :: Int -> Maybe Type -> Doc
ppResultType Int
_ Maybe Type
Nothing = String -> Doc
text String
"void"
ppResultType Int
p (Just Type
a) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p Type
a
instance Pretty Name where
prettyPrec :: Int -> Name -> Doc
prettyPrec Int
p (Name [Ident]
is) =
[Doc] -> Doc
hcat (Doc -> [Doc] -> [Doc]
punctuate (Char -> Doc
char Char
'.') forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p) [Ident]
is)
instance Pretty Ident where
prettyPrec :: Int -> Ident -> Doc
prettyPrec Int
p (Ident String
s) = String -> Doc
text String
s
prettyNestedStmt :: Int -> Stmt -> Doc
prettyNestedStmt :: Int -> Stmt -> Doc
prettyNestedStmt Int
prio p :: Stmt
p@(StmtBlock Block
b) = forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
prio Stmt
p
prettyNestedStmt Int
prio Stmt
p = Int -> Doc -> Doc
nest Int
2 (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
prio Stmt
p)
maybePP :: Pretty a => Int -> Maybe a -> Doc
maybePP :: forall a. Pretty a => Int -> Maybe a -> Doc
maybePP Int
p = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (forall a. Pretty a => Int -> a -> Doc
prettyPrec Int
p)
opt :: Bool -> Doc -> Doc
opt :: Bool -> Doc -> Doc
opt Bool
x Doc
a = if Bool
x then Doc
a else Doc
empty
braceBlock :: [Doc] -> Doc
braceBlock :: [Doc] -> Doc
braceBlock [Doc]
xs = Char -> Doc
char Char
'{'
Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
vcat [Doc]
xs)
Doc -> Doc -> Doc
$+$ Char -> Doc
char Char
'}'
opPrec :: Op -> a
opPrec Op
Mult = a
3
opPrec Op
Div = a
3
opPrec Op
Rem = a
3
opPrec Op
Add = a
4
opPrec Op
Sub = a
4
opPrec Op
LShift = a
5
opPrec Op
RShift = a
5
opPrec Op
RRShift = a
5
opPrec Op
LThan = a
6
opPrec Op
GThan = a
6
opPrec Op
LThanE = a
6
opPrec Op
GThanE = a
6
opPrec Op
Equal = a
7
opPrec Op
NotEq = a
7
opPrec Op
And = a
8
opPrec Op
Xor = a
9
opPrec Op
Or = a
10
opPrec Op
CAnd = a
11
opPrec Op
COr = a
12
escapeGeneral :: Char -> String
escapeGeneral :: Char -> String
escapeGeneral Char
'\b' = String
"\\b"
escapeGeneral Char
'\t' = String
"\\t"
escapeGeneral Char
'\n' = String
"\\n"
escapeGeneral Char
'\f' = String
"\\f"
escapeGeneral Char
'\r' = String
"\\r"
escapeGeneral Char
'\\' = String
"\\\\"
escapeGeneral Char
c | Char
c forall a. Ord a => a -> a -> Bool
>= Char
' ' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
< Char
'\DEL' = [Char
c]
| Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFFFF' = forall r. PrintfType r => String -> r
printf String
"\\u%04x" (forall a. Enum a => a -> Int
fromEnum Char
c)
| Bool
otherwise = forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Language.Java.Pretty.escapeGeneral: Char " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Char
c forall a. [a] -> [a] -> [a]
++ String
" too large for Java char"
escapeChar :: Char -> String
escapeChar :: Char -> String
escapeChar Char
'\'' = String
"\\'"
escapeChar Char
c = Char -> String
escapeGeneral Char
c
escapeString :: Char -> String
escapeString :: Char -> String
escapeString Char
'"' = String
"\\\""
escapeString Char
c | Char
c forall a. Ord a => a -> a -> Bool
<= Char
'\xFFFF' = Char -> String
escapeGeneral Char
c
| Bool
otherwise = Char -> String
escapeGeneral Char
lead forall a. [a] -> [a] -> [a]
++ Char -> String
escapeGeneral Char
trail
where c' :: Int
c' = forall a. Enum a => a -> Int
fromEnum Char
c forall a. Num a => a -> a -> a
- Int
0x010000
lead :: Char
lead = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int
0xD800 forall a. Num a => a -> a -> a
+ Int
c' forall a. Integral a => a -> a -> a
`div` Int
0x0400
trail :: Char
trail = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Int
0xDC00 forall a. Num a => a -> a -> a
+ Int
c' forall a. Integral a => a -> a -> a
`mod` Int
0x0400