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