{-# OPTIONS -fno-warn-incomplete-patterns #-}
module GF.JavaScript.PrintJS (printTree, Doc, Print(..)) where
import GF.JavaScript.AbsJS
import Data.Char
printTree :: Print a => a -> String
printTree :: a -> String
printTree = Doc -> String
render (Doc -> String) -> (a -> Doc) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0
type Doc = [ShowS] -> [ShowS]
doc :: ShowS -> Doc
doc :: ShowS -> Doc
doc = (:)
render :: Doc -> String
render :: Doc -> String
render Doc
d = Integer -> [String] -> ShowS
forall t. t -> [String] -> ShowS
rend Integer
0 ((ShowS -> String) -> [ShowS] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") ([ShowS] -> [String]) -> [ShowS] -> [String]
forall a b. (a -> b) -> a -> b
$ Doc
d []) String
"" where
rend :: t -> [String] -> ShowS
rend t
i [String]
ss = case [String]
ss of
String
t:[String]
ts | Bool -> Bool
not (String -> Bool
spaceAfter String
t) -> String -> ShowS
showString String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [String] -> ShowS
rend t
i [String]
ts
String
t:ts :: [String]
ts@(String
t':[String]
_) | Bool -> Bool
not (String -> Bool
spaceBefore String
t') -> String -> ShowS
showString String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [String] -> ShowS
rend t
i [String]
ts
String
t:[String]
ts -> String -> ShowS
space String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> [String] -> ShowS
rend t
i [String]
ts
[] -> ShowS
forall a. a -> a
id
space :: String -> ShowS
space String
t = String -> ShowS
showString String
t ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\String
s -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then String
"" else (Char
' 'Char -> ShowS
forall a. a -> [a] -> [a]
:String
s))
spaceAfter :: String -> Bool
spaceAfter :: String -> Bool
spaceAfter = (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".",String
"(",String
"[",String
"{",String
"\n"])
spaceBefore :: String -> Bool
spaceBefore :: String -> Bool
spaceBefore = (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
",",String
".",String
":",String
";",String
"(",String
")",String
"[",String
"]",String
"{",String
"}",String
"\n"])
parenth :: Doc -> Doc
parenth :: Doc -> Doc
parenth Doc
ss = ShowS -> Doc
doc (Char -> ShowS
showChar Char
'(') Doc -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc
ss Doc -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS -> Doc
doc (Char -> ShowS
showChar Char
')')
concatS :: [ShowS] -> ShowS
concatS :: [ShowS] -> ShowS
concatS = (ShowS -> ShowS -> ShowS) -> ShowS -> [ShowS] -> ShowS
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
forall a. a -> a
id
concatD :: [Doc] -> Doc
concatD :: [Doc] -> Doc
concatD = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Doc -> Doc -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) Doc
forall a. a -> a
id
class Print a where
prt :: Int -> a -> Doc
prtList :: [a] -> Doc
prtList = [Doc] -> Doc
concatD ([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. Print a => Int -> a -> Doc
prt Int
0)
instance Print a => Print [a] where
prt :: Int -> [a] -> Doc
prt Int
_ = [a] -> Doc
forall a. Print a => [a] -> Doc
prtList
instance Print Char where
prt :: Int -> Char -> Doc
prt Int
_ Char
s = ShowS -> Doc
doc (Char -> ShowS
showChar Char
'\'' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Char -> ShowS
mkEsc Char
'\'' Char
s ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'\'')
prtList :: String -> Doc
prtList String
s = ShowS -> Doc
doc (Char -> ShowS
showChar Char
'"' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ShowS] -> ShowS
concatS ((Char -> ShowS) -> String -> [ShowS]
forall a b. (a -> b) -> [a] -> [b]
map (Char -> Char -> ShowS
mkEsc Char
'"') String
s) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'"')
mkEsc :: Char -> Char -> ShowS
mkEsc :: Char -> Char -> ShowS
mkEsc Char
q Char
s = case Char
s of
Char
_ | Char
s Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
q -> Char -> ShowS
showChar Char
'\\' ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
s
Char
'\\'-> String -> ShowS
showString String
"\\\\"
Char
'\n' -> String -> ShowS
showString String
"\\n"
Char
'\t' -> String -> ShowS
showString String
"\\t"
Char
_ -> Char -> ShowS
showChar Char
s
prPrec :: Int -> Int -> Doc -> Doc
prPrec :: Int -> Int -> Doc -> Doc
prPrec Int
i Int
j = if Int
jInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
i then Doc -> Doc
parenth else Doc -> Doc
forall a. a -> a
id
instance Print Int where
prt :: Int -> Int -> Doc
prt Int
_ Int
x = ShowS -> Doc
doc (Int -> ShowS
forall a. Show a => a -> ShowS
shows Int
x)
instance Print Double where
prt :: Int -> Double -> Doc
prt Int
_ Double
x = ShowS -> Doc
doc (Double -> ShowS
forall a. Show a => a -> ShowS
shows Double
x)
instance Print Ident where
prt :: Int -> Ident -> Doc
prt Int
_ (Ident String
i) = ShowS -> Doc
doc (String -> ShowS
showString String
i)
prtList :: [Ident] -> Doc
prtList [Ident]
es = case [Ident]
es of
[] -> ([Doc] -> Doc
concatD [])
[Ident
x] -> ([Doc] -> Doc
concatD [Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
x])
Ident
x:[Ident]
xs -> ([Doc] -> Doc
concatD [Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
x , ShowS -> Doc
doc (String -> ShowS
showString String
",") , Int -> [Ident] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Ident]
xs])
instance Print Program where
prt :: Int -> Program -> Doc
prt Int
i Program
e = case Program
e of
Program [Element]
elements -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> [Element] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Element]
elements])
instance Print Element where
prt :: Int -> Element -> Doc
prt Int
i Element
e = case Element
e of
FunDef Ident
id [Ident]
ids [Stmt]
stmts -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"function") , Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
id , ShowS -> Doc
doc (String -> ShowS
showString String
"(") , Int -> [Ident] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Ident]
ids , ShowS -> Doc
doc (String -> ShowS
showString String
")") , ShowS -> Doc
doc (String -> ShowS
showString String
"{") , Int -> [Stmt] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Stmt]
stmts , ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
ElStmt Stmt
stmt -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Stmt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Stmt
stmt])
prtList :: [Element] -> Doc
prtList [Element]
es = case [Element]
es of
[] -> ([Doc] -> Doc
concatD [])
Element
x:[Element]
xs -> ([Doc] -> Doc
concatD [Int -> Element -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Element
x , ShowS -> Doc
doc (String -> ShowS
showString String
"\n"), Int -> [Element] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Element]
xs])
instance Print Stmt where
prt :: Int -> Stmt -> Doc
prt Int
i Stmt
e = case Stmt
e of
SCompound [Stmt]
stmts -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"{") , Int -> [Stmt] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Stmt]
stmts , ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
Stmt
SReturnVoid -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"return") , ShowS -> Doc
doc (String -> ShowS
showString String
";")])
SReturn Expr
expr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"return") , Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expr
expr , ShowS -> Doc
doc (String -> ShowS
showString String
";")])
SDeclOrExpr DeclOrExpr
declorexpr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> DeclOrExpr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclOrExpr
declorexpr , ShowS -> Doc
doc (String -> ShowS
showString String
";")])
prtList :: [Stmt] -> Doc
prtList [Stmt]
es = case [Stmt]
es of
[] -> ([Doc] -> Doc
concatD [])
Stmt
x:[Stmt]
xs -> ([Doc] -> Doc
concatD [Int -> Stmt -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Stmt
x , Int -> [Stmt] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Stmt]
xs])
instance Print DeclOrExpr where
prt :: Int -> DeclOrExpr -> Doc
prt Int
i DeclOrExpr
e = case DeclOrExpr
e of
Decl [DeclVar]
declvars -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"var") , Int -> [DeclVar] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [DeclVar]
declvars])
DExpr Expr
expr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
1 Expr
expr])
instance Print DeclVar where
prt :: Int -> DeclVar -> Doc
prt Int
i DeclVar
e = case DeclVar
e of
DVar Ident
id -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
id])
DInit Ident
id Expr
expr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
id , ShowS -> Doc
doc (String -> ShowS
showString String
"=") , Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expr
expr])
prtList :: [DeclVar] -> Doc
prtList [DeclVar]
es = case [DeclVar]
es of
[] -> ([Doc] -> Doc
concatD [])
[DeclVar
x] -> ([Doc] -> Doc
concatD [Int -> DeclVar -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclVar
x])
DeclVar
x:[DeclVar]
xs -> ([Doc] -> Doc
concatD [Int -> DeclVar -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 DeclVar
x , ShowS -> Doc
doc (String -> ShowS
showString String
",") , Int -> [DeclVar] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [DeclVar]
xs])
instance Print Expr where
prt :: Int -> Expr -> Doc
prt Int
i Expr
e = case Expr
e of
EAssign Expr
expr0 Expr
expr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
13 ([Doc] -> Doc
concatD [Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
14 Expr
expr0 , ShowS -> Doc
doc (String -> ShowS
showString String
"=") , Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
13 Expr
expr])
ENew Ident
id [Expr]
exprs -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
14 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"new") , Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
id , ShowS -> Doc
doc (String -> ShowS
showString String
"(") , Int -> [Expr] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Expr]
exprs , ShowS -> Doc
doc (String -> ShowS
showString String
")")])
EMember Expr
expr Ident
id -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
15 ([Doc] -> Doc
concatD [Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
15 Expr
expr , ShowS -> Doc
doc (String -> ShowS
showString String
".") , Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
id])
EIndex Expr
expr0 Expr
expr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
15 ([Doc] -> Doc
concatD [Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
15 Expr
expr0 , ShowS -> Doc
doc (String -> ShowS
showString String
"[") , Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expr
expr , ShowS -> Doc
doc (String -> ShowS
showString String
"]")])
ECall Expr
expr [Expr]
exprs -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
15 ([Doc] -> Doc
concatD [Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
15 Expr
expr , ShowS -> Doc
doc (String -> ShowS
showString String
"(") , Int -> [Expr] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Expr]
exprs , ShowS -> Doc
doc (String -> ShowS
showString String
")")])
EVar Ident
id -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
id])
EInt Int
n -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [Int -> Int -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Int
n])
EDbl Double
d -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [Int -> Double -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Double
d])
EStr String
str -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [Int -> String -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 String
str])
Expr
ETrue -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"true")])
Expr
EFalse -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"false")])
Expr
ENull -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"null")])
Expr
EThis -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"this")])
EFun [Ident]
ids [Stmt]
stmts -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"function") , ShowS -> Doc
doc (String -> ShowS
showString String
"(") , Int -> [Ident] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Ident]
ids , ShowS -> Doc
doc (String -> ShowS
showString String
")") , ShowS -> Doc
doc (String -> ShowS
showString String
"{") , Int -> [Stmt] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Stmt]
stmts , ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
EArray [Expr]
exprs -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"[") , Int -> [Expr] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Expr]
exprs , ShowS -> Doc
doc (String -> ShowS
showString String
"]")])
EObj [Property]
propertys -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"{") , Int -> [Property] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Property]
propertys , ShowS -> Doc
doc (String -> ShowS
showString String
"}")])
ESeq [Expr]
exprs -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
16 ([Doc] -> Doc
concatD [ShowS -> Doc
doc (String -> ShowS
showString String
"(") , Int -> [Expr] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Expr]
exprs , ShowS -> Doc
doc (String -> ShowS
showString String
")")])
prtList :: [Expr] -> Doc
prtList [Expr]
es = case [Expr]
es of
[] -> ([Doc] -> Doc
concatD [])
[Expr
x] -> ([Doc] -> Doc
concatD [Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expr
x])
Expr
x:[Expr]
xs -> ([Doc] -> Doc
concatD [Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expr
x , ShowS -> Doc
doc (String -> ShowS
showString String
",") , Int -> [Expr] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Expr]
xs])
instance Print Property where
prt :: Int -> Property -> Doc
prt Int
i Property
e = case Property
e of
Prop PropertyName
propertyname Expr
expr -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> PropertyName -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 PropertyName
propertyname , ShowS -> Doc
doc (String -> ShowS
showString String
":") , Int -> Expr -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Expr
expr])
prtList :: [Property] -> Doc
prtList [Property]
es = case [Property]
es of
[] -> ([Doc] -> Doc
concatD [])
[Property
x] -> ([Doc] -> Doc
concatD [Int -> Property -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Property
x])
Property
x:[Property]
xs -> ([Doc] -> Doc
concatD [Int -> Property -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Property
x , ShowS -> Doc
doc (String -> ShowS
showString String
",") , Int -> [Property] -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 [Property]
xs])
instance Print PropertyName where
prt :: Int -> PropertyName -> Doc
prt Int
i PropertyName
e = case PropertyName
e of
IdentPropName Ident
id -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Ident -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Ident
id])
StringPropName String
str -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> String -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 String
str])
IntPropName Int
n -> Int -> Int -> Doc -> Doc
prPrec Int
i Int
0 ([Doc] -> Doc
concatD [Int -> Int -> Doc
forall a. Print a => Int -> a -> Doc
prt Int
0 Int
n])