module Language.JavaScript.Pretty.Printer.Extended
        ( module Language.JavaScript.Pretty.Printer
        , prettyPrint
        ) where

import           Language.JavaScript.Pretty.Printer

import                      Text.PrettyPrint.Leijen
import qualified Text.PrettyPrint.Leijen as P ((<$>))
import                      Text.Printf (printf)

import                      Language.JavaScript.Parser.AST

prettyPrint :: Pretty a => a -> String
prettyPrint :: forall a. Pretty a => 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 Int
inheritedPrec Int
currentPrec Doc
t
        | Int
inheritedPrec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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

instance Pretty JSAST where
        pretty :: JSAST -> Doc
pretty (JSAstProgram [JSStatement]
xs JSAnnot
a)   = [Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JSStatement -> Doc) -> [JSStatement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty [JSStatement]
xs
        pretty (JSAstStatement JSStatement
s JSAnnot
a)  = JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
s
        pretty (JSAstExpression JSExpression
e JSAnnot
a) = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e
        pretty (JSAstLiteral JSExpression
x JSAnnot
a)    = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x

instance Pretty JSExpression where
        -- Terminals
        pretty :: JSExpression -> Doc
pretty (JSIdentifier     JSAnnot
annot String
s) = String -> Doc
text String
s
        pretty (JSDecimal        JSAnnot
annot String
i) = String -> Doc
text String
i
        pretty (JSLiteral        JSAnnot
annot String
l) = String -> Doc
text String
l
        pretty (JSHexInteger     JSAnnot
annot String
i) = String -> Doc
text String
i
        pretty (JSOctal          JSAnnot
annot String
i) = String -> Doc
text String
i
        pretty (JSStringLiteral  JSAnnot
annot String
s) = String -> Doc
text String
s
        pretty (JSRegEx          JSAnnot
annot String
s) = String -> Doc
text String
s
--
--     -- Non-Terminals
        pretty (JSArrayLiteral         JSAnnot
als [JSArrayElement]
xs JSAnnot
ars)             = String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> [Doc] -> Doc
hsep ((JSArrayElement -> Doc) -> [JSArrayElement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSArrayElement -> Doc
forall a. Pretty a => a -> Doc
pretty [JSArrayElement]
xs) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"
        pretty (JSAssignExpression     JSExpression
lhs JSAssignOp
op JSExpression
rhs)             = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
lhs Doc -> Doc -> Doc
<+> JSAssignOp -> Doc
forall a. Pretty a => a -> Doc
pretty JSAssignOp
op Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
rhs
        pretty (JSCallExpression       JSExpression
ex JSAnnot
lb JSCommaList JSExpression
xs JSAnnot
rb)            = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
ex Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
xs)
        pretty (JSCallExpressionDot    JSExpression
ex JSAnnot
os JSExpression
xs)               = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
ex Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
xs
        pretty (JSCallExpressionSquare JSExpression
ex JSAnnot
als JSExpression
xs JSAnnot
ars)          = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
ex Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"
        pretty (JSCommaExpression      JSExpression
le JSAnnot
c JSExpression
re)                = Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
le Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"," Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
re)
        pretty (JSExpressionBinary     JSExpression
lhs JSBinOp
op JSExpression
rhs)             = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
lhs Doc -> Doc -> Doc
<+> JSBinOp -> Doc
forall a. Pretty a => a -> Doc
pretty JSBinOp
op Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
rhs
        pretty (JSExpressionParen      JSAnnot
alp JSExpression
e JSAnnot
arp)              = Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e)
        pretty (JSExpressionPostfix    JSExpression
xs JSUnaryOp
op)                  = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSUnaryOp -> Doc
forall a. Pretty a => a -> Doc
pretty JSUnaryOp
op
        pretty (JSExpressionTernary    JSExpression
cond JSAnnot
h JSExpression
v1 JSAnnot
c JSExpression
v2)         = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
cond Doc -> Doc -> Doc
<+> String -> Doc
text String
"?" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
v1 Doc -> Doc -> Doc
<+> String -> Doc
text String
":" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
v2
        pretty (JSFunctionExpression   JSAnnot
annot JSIdent
n JSAnnot
lb JSCommaList JSIdent
x2s JSAnnot
rb JSBlock
x3)   = String -> Doc
text String
"function" Doc -> Doc -> Doc
<+> JSIdent -> Doc
forall a. Pretty a => a -> Doc
pretty JSIdent
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (JSCommaList JSIdent -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSIdent
x2s) Doc -> Doc -> Doc
<+> JSBlock -> Doc
forall a. Pretty a => a -> Doc
pretty JSBlock
x3
        pretty (JSMemberDot            JSExpression
xs JSAnnot
dot JSExpression
n)               = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
n
        pretty (JSMemberExpression     JSExpression
e JSAnnot
lb JSCommaList JSExpression
a JSAnnot
rb)              = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"(" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
a Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
")"
        pretty (JSMemberNew            JSAnnot
a JSExpression
lb JSAnnot
n JSCommaList JSExpression
rb JSAnnot
s)            = String -> Doc
text String
"new" Doc -> Doc -> Doc
<+> (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
lb) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
rb)
        pretty (JSMemberSquare         JSExpression
xs JSAnnot
als JSExpression
e JSAnnot
ars)           = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"[" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"]"
        pretty (JSNewExpression        JSAnnot
n JSExpression
e)                    = String -> Doc
text String
"new" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e
        pretty (JSObjectLiteral        JSAnnot
alb JSObjectPropertyList
xs JSAnnot
arb)             = JSObjectPropertyList -> Doc
forall a. Pretty a => a -> Doc
prettyNestedBracesBlock JSObjectPropertyList
xs
        pretty (JSUnaryExpression      JSUnaryOp
op JSExpression
x)                   = JSUnaryOp -> Doc
forall a. Pretty a => a -> Doc
pretty JSUnaryOp
op Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x
        pretty (JSVarInitExpression    JSExpression
x1 JSVarInitializer
x2)                  = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSVarInitializer -> Doc
forall a. Pretty a => a -> Doc
pretty JSVarInitializer
x2

instance Pretty JSBinOp where
        pretty :: JSBinOp -> Doc
pretty (JSBinOpAnd        JSAnnot
annot)  = String -> Doc
text String
"&&"
        pretty (JSBinOpBitAnd     JSAnnot
annot)  = String -> Doc
text String
"&"
        pretty (JSBinOpBitOr      JSAnnot
annot)  = String -> Doc
text String
"|"
        pretty (JSBinOpBitXor     JSAnnot
annot)  = String -> Doc
text String
"^"
        pretty (JSBinOpDivide     JSAnnot
annot)  = String -> Doc
text String
"/"
        pretty (JSBinOpEq         JSAnnot
annot)  = String -> Doc
text String
"=="
        pretty (JSBinOpGe         JSAnnot
annot)  = String -> Doc
text String
">="
        pretty (JSBinOpGt         JSAnnot
annot)  = String -> Doc
text String
">"
        pretty (JSBinOpIn         JSAnnot
annot)  = String -> Doc
text String
"in"
        pretty (JSBinOpInstanceOf JSAnnot
annot)  = String -> Doc
text String
"instanceof"
        pretty (JSBinOpLe         JSAnnot
annot)  = String -> Doc
text String
"<="
        pretty (JSBinOpLsh        JSAnnot
annot)  = String -> Doc
text String
"<<"
        pretty (JSBinOpLt         JSAnnot
annot)  = String -> Doc
text String
"<"
        pretty (JSBinOpMinus      JSAnnot
annot)  = String -> Doc
text String
"-"
        pretty (JSBinOpMod        JSAnnot
annot)  = String -> Doc
text String
"%"
        pretty (JSBinOpNeq        JSAnnot
annot)  = String -> Doc
text String
"!="
        pretty (JSBinOpOr         JSAnnot
annot)  = String -> Doc
text String
"||"
        pretty (JSBinOpPlus       JSAnnot
annot)  = String -> Doc
text String
"+"
        pretty (JSBinOpRsh        JSAnnot
annot)  = String -> Doc
text String
">>"
        pretty (JSBinOpStrictEq   JSAnnot
annot)  = String -> Doc
text String
"==="
        pretty (JSBinOpStrictNeq  JSAnnot
annot)  = String -> Doc
text String
"!=="
        pretty (JSBinOpTimes      JSAnnot
annot)  = String -> Doc
text String
"*"
        pretty (JSBinOpUrsh       JSAnnot
annot)  = String -> Doc
text String
">>>"


instance Pretty JSUnaryOp where
        pretty :: JSUnaryOp -> Doc
pretty (JSUnaryOpDecr   JSAnnot
annot) = String -> Doc
text String
"--"
        pretty (JSUnaryOpDelete JSAnnot
annot) = String -> Doc
text String
"delete "
        pretty (JSUnaryOpIncr   JSAnnot
annot) = String -> Doc
text String
"++"
        pretty (JSUnaryOpMinus  JSAnnot
annot) = String -> Doc
text String
"-"
        pretty (JSUnaryOpNot    JSAnnot
annot) = String -> Doc
text String
"!"
        pretty (JSUnaryOpPlus   JSAnnot
annot) = String -> Doc
text String
"+"
        pretty (JSUnaryOpTilde  JSAnnot
annot) = String -> Doc
text String
"~"
        pretty (JSUnaryOpTypeof JSAnnot
annot) = String -> Doc
text String
"typeof "
        pretty (JSUnaryOpVoid   JSAnnot
annot) = String -> Doc
text String
"void "


instance Pretty JSAssignOp where
        pretty :: JSAssignOp -> Doc
pretty (JSAssign       JSAnnot
annot) = String -> Doc
text String
"="
        pretty (JSTimesAssign  JSAnnot
annot) = String -> Doc
text String
"*="
        pretty (JSDivideAssign JSAnnot
annot) = String -> Doc
text String
"/="
        pretty (JSModAssign    JSAnnot
annot) = String -> Doc
text String
"%="
        pretty (JSPlusAssign   JSAnnot
annot) = String -> Doc
text String
"+="
        pretty (JSMinusAssign  JSAnnot
annot) = String -> Doc
text String
"-="
        pretty (JSLshAssign    JSAnnot
annot) = String -> Doc
text String
"<<="
        pretty (JSRshAssign    JSAnnot
annot) = String -> Doc
text String
">>="
        pretty (JSUrshAssign   JSAnnot
annot) = String -> Doc
text String
">>>="
        pretty (JSBwAndAssign  JSAnnot
annot) = String -> Doc
text String
"&="
        pretty (JSBwXorAssign  JSAnnot
annot) = String -> Doc
text String
"^="
        pretty (JSBwOrAssign   JSAnnot
annot) = String -> Doc
text String
"|="


instance Pretty JSSemi where
        pretty :: JSSemi -> Doc
pretty (JSSemi JSAnnot
annot) = String -> Doc
text String
";"
        pretty JSSemi
JSSemiAuto     = String -> Doc
text String
""


instance Pretty JSTryCatch where
        pretty :: JSTryCatch -> Doc
pretty (JSCatch JSAnnot
anc JSAnnot
alb JSExpression
x1 JSAnnot
arb JSBlock
x3) = [Doc] -> Doc
hsep [String -> Doc
text String
"catch", Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1)] Doc -> Doc -> Doc
<+> JSBlock -> Doc
forall a. Pretty a => a -> Doc
pretty JSBlock
x3
        pretty (JSCatchIf JSAnnot
anc JSAnnot
alb JSExpression
x1 JSAnnot
aif JSExpression
ex JSAnnot
arb JSBlock
x3) = [Doc] -> Doc
hsep [String -> Doc
text String
"catch", Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
ex)] Doc -> Doc -> Doc
<+> JSBlock -> Doc
forall a. Pretty a => a -> Doc
pretty JSBlock
x3


instance Pretty JSTryFinally where
        pretty :: JSTryFinally -> Doc
pretty (JSFinally      JSAnnot
annot JSBlock
x) = String -> Doc
text String
"finally" Doc -> Doc -> Doc
<+> JSBlock -> Doc
forall a. Pretty a => a -> Doc
pretty JSBlock
x
        pretty JSTryFinally
JSNoFinally              = String -> Doc
text String
""


instance Pretty JSSwitchParts where
        pretty :: JSSwitchParts -> Doc
pretty (JSCase    JSAnnot
annot JSExpression
x1 JSAnnot
c [JSStatement]
x2s) = String -> Doc
text String
"case" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1 Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> Doc -> Doc
align ([Doc] -> Doc
vsep ((JSStatement -> Doc) -> [JSStatement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty [JSStatement]
x2s))
        pretty (JSDefault JSAnnot
annot JSAnnot
c [JSStatement]
xs)     = String -> Doc
text String
"default" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> Doc -> Doc
align ([Doc] -> Doc
vsep ((JSStatement -> Doc) -> [JSStatement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty [JSStatement]
xs))


instance Pretty JSStatement where
        pretty :: JSStatement -> Doc
pretty (JSStatementBlock JSAnnot
alb [JSStatement]
blk JSAnnot
arb JSSemi
s)             = [Doc] -> Doc
braceBlock ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JSStatement -> Doc) -> [JSStatement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty [JSStatement]
blk -- Not printing semicolon b/c came like this, didn't fix
        pretty (JSBreak JSAnnot
annot JSIdent
mi JSSemi
s)                         = String -> Doc
text String
"break" Doc -> Doc -> Doc
<+> JSIdent -> Doc
forall a. Pretty a => a -> Doc
pretty JSIdent
mi Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSContinue JSAnnot
annot JSIdent
mi JSSemi
s)                      = String -> Doc
text String
"continue" Doc -> Doc -> Doc
<+> JSIdent -> Doc
forall a. Pretty a => a -> Doc
pretty JSIdent
mi Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSConstant JSAnnot
annot JSCommaList JSExpression
xs JSSemi
s)                      = String -> Doc
text String
"const" Doc -> Doc -> Doc
<+> JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSDoWhile JSAnnot
ad JSStatement
x1 JSAnnot
aw JSAnnot
alb JSExpression
x2 JSAnnot
arb JSSemi
x3)           = String -> Doc
text String
"do" Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
x1 Doc -> Doc -> Doc
<+> String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x2) Doc -> Doc -> Doc
<+> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
x3
        pretty (JSFor JSAnnot
af JSAnnot
alb JSCommaList JSExpression
x1s JSAnnot
s1 JSCommaList JSExpression
x2s JSAnnot
s2 JSCommaList JSExpression
x3s JSAnnot
arb JSStatement
x4)      = String -> Doc
text String
"for" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens ([Doc] -> Doc
hsep [JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
x1s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
";" , JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
x2s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
";" , JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
x3s]) Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
x4
        pretty (JSForIn JSAnnot
af JSAnnot
alb JSExpression
x1s JSBinOp
i JSExpression
x2 JSAnnot
arb JSStatement
x3)             = String -> Doc
text String
"for" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1s Doc -> Doc -> Doc
<+> JSBinOp -> Doc
forall a. Pretty a => a -> Doc
pretty JSBinOp
i Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x2) Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
x3
        pretty (JSForVar JSAnnot
af JSAnnot
alb JSAnnot
v JSCommaList JSExpression
x1s JSAnnot
s1 JSCommaList JSExpression
x2s JSAnnot
s2 JSCommaList JSExpression
x3s JSAnnot
arb JSStatement
x4) = String -> Doc
text String
"for" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (String -> Doc
text String
"var " Doc -> Doc -> Doc
<+> JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
x1s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
";" Doc -> Doc -> Doc
<+> JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
x2s Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
";" Doc -> Doc -> Doc
<+> JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
x3s) Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
x4
        pretty (JSForVarIn JSAnnot
af JSAnnot
alb JSAnnot
v JSExpression
x1 JSBinOp
i JSExpression
x2 JSAnnot
arb JSStatement
x3)         = String -> Doc
text String
"for" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (String -> Doc
text String
"var " Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1 Doc -> Doc -> Doc
<+> JSBinOp -> Doc
forall a. Pretty a => a -> Doc
pretty JSBinOp
i Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x2) Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
x3
        pretty (JSFunction JSAnnot
af JSIdent
n JSAnnot
alb JSCommaList JSIdent
x2s JSAnnot
arb JSBlock
x3 JSSemi
s)           = String -> Doc
text String
"function" Doc -> Doc -> Doc
<+> JSIdent -> Doc
forall a. Pretty a => a -> Doc
pretty JSIdent
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (JSCommaList JSIdent -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSIdent
x2s) Doc -> Doc -> Doc
<+> JSBlock -> Doc
forall a. Pretty a => a -> Doc
pretty JSBlock
x3
        pretty (JSIf JSAnnot
annot JSAnnot
alb JSExpression
x1 JSAnnot
arb JSStatement
x2s)                  = String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1) Doc -> Doc -> Doc
<+> JSStatement -> Doc
prettyNestedStmt JSStatement
x2s
        pretty (JSIfElse JSAnnot
annot JSAnnot
alb JSExpression
x1 JSAnnot
arb JSStatement
x2s JSAnnot
ea JSStatement
x3s)       = String -> Doc
text String
"if" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1) Doc -> Doc -> Doc
<+> JSStatement -> Doc
prettyNestedStmt JSStatement
x2s Doc -> Doc -> Doc
<+> String -> Doc
text String
"else" Doc -> Doc -> Doc
<+> JSStatement -> Doc
prettyNestedStmt JSStatement
x3s
        pretty (JSLabelled JSIdent
l JSAnnot
c JSStatement
v)                           = JSIdent -> Doc
forall a. Pretty a => a -> Doc
pretty JSIdent
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
v
        pretty (JSEmptyStatement JSAnnot
a)                         = String -> Doc
text String
";"
        pretty (JSExpressionStatement JSExpression
l JSSemi
s)                  = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
l Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSAssignStatement JSExpression
lhs JSAssignOp
op JSExpression
rhs JSSemi
s)             = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
lhs Doc -> Doc -> Doc
<+> JSAssignOp -> Doc
forall a. Pretty a => a -> Doc
pretty JSAssignOp
op Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
rhs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSMethodCall JSExpression
e JSAnnot
lp JSCommaList JSExpression
a JSAnnot
rp JSSemi
s)                   = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
a) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSReturn JSAnnot
annot Maybe JSExpression
me JSSemi
s)                        = String -> Doc
text String
"return" Doc -> Doc -> Doc
<+> (Maybe JSExpression -> Doc
forall a. Pretty a => Maybe a -> Doc
maybePP Maybe JSExpression
me) Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSSwitch JSAnnot
annot JSAnnot
alp JSExpression
x JSAnnot
arp JSAnnot
alb [JSSwitchParts]
x2 JSAnnot
arb JSSemi
s)      = String -> Doc
text String
"switch" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x) Doc -> Doc -> Doc
<+> [Doc] -> Doc
braceBlock ((JSSwitchParts -> Doc) -> [JSSwitchParts] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSSwitchParts -> Doc
forall a. Pretty a => a -> Doc
pretty [JSSwitchParts]
x2)
        pretty (JSThrow JSAnnot
annot JSExpression
x JSSemi
s)                          = String -> Doc
text String
"throw" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSTry JSAnnot
annot JSBlock
tb [JSTryCatch]
tcs JSTryFinally
tf)                      = String -> Doc
text String
"try" Doc -> Doc -> Doc
<+> JSBlock -> Doc
forall a. Pretty a => a -> Doc
pretty JSBlock
tb Doc -> Doc -> Doc
<$$>
                                                                                                                                    [Doc] -> Doc
vcat ((JSTryCatch -> Doc) -> [JSTryCatch] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSTryCatch -> Doc
forall a. Pretty a => a -> Doc
pretty [JSTryCatch]
tcs [Doc] -> [Doc] -> [Doc]
forall a. [a] -> [a] -> [a]
++ (JSTryFinally -> Doc
forall a. Pretty a => a -> Doc
pretty JSTryFinally
tf)Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
:[])
        pretty (JSVariable JSAnnot
annot JSCommaList JSExpression
xs JSSemi
s)                      = String -> Doc
text String
"var" Doc -> Doc -> Doc
<+> JSCommaList JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList JSExpression
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty (JSWhile JSAnnot
annot JSAnnot
alp JSExpression
x1 JSAnnot
arp JSStatement
x2)                = String -> Doc
text String
"while" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1) Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
x2
        pretty (JSWith JSAnnot
annot JSAnnot
alp JSExpression
x1 JSAnnot
arp JSStatement
x JSSemi
s)                = String -> Doc
text String
"with" Doc -> Doc -> Doc
<+> Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1) Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
x Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSSemi -> Doc
forall a. Pretty a => a -> Doc
pretty JSSemi
s
        pretty JSStatement
_s             = String -> Doc
forall a. HasCallStack => String -> a
error String
"TODO JSStatement"
--
--
-- instance Pretty [JSStatement] where
--     (|>) = foldl' (|>)
--
instance Pretty JSBlock where
        pretty :: JSBlock -> Doc
pretty (JSBlock JSAnnot
alb [JSStatement]
ss JSAnnot
arb) = [Doc] -> Doc
braceBlock ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JSStatement -> Doc) -> [JSStatement] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty [JSStatement]
ss
--
instance Pretty JSObjectProperty where
        pretty :: JSObjectProperty -> Doc
pretty (JSPropertyAccessor     JSAccessor
s JSPropertyName
n JSAnnot
alp [JSExpression]
ps JSAnnot
arp JSBlock
b)       = JSAccessor -> Doc
forall a. Pretty a => a -> Doc
pretty JSAccessor
s Doc -> Doc -> Doc
<+> JSPropertyName -> Doc
forall a. Pretty a => a -> Doc
pretty JSPropertyName
n Doc -> Doc -> Doc
<+> Doc -> Doc
parens ([Doc] -> Doc
vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (JSExpression -> Doc) -> [JSExpression] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty [JSExpression]
ps) Doc -> Doc -> Doc
<+> JSBlock -> Doc
forall a. Pretty a => a -> Doc
pretty JSBlock
b
        pretty (JSPropertyNameandValue JSPropertyName
n JSAnnot
c [JSExpression]
vs)                 = JSPropertyName -> Doc
forall a. Pretty a => a -> Doc
pretty JSPropertyName
n Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
colon Doc -> Doc -> Doc
<+> [Doc] -> Doc
vcat ((JSExpression -> Doc) -> [JSExpression] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty [JSExpression]
vs)
--
instance Pretty JSPropertyName where
        pretty :: JSPropertyName -> Doc
pretty (JSPropertyIdent JSAnnot
an1 String
i)  = String -> Doc
text String
i
        pretty (JSPropertyString JSAnnot
an1 String
s) = String -> Doc
text String
s
        pretty (JSPropertyNumber JSAnnot
an1 String
n) = String -> Doc
text String
n
--
instance Pretty JSAccessor where
        pretty :: JSAccessor -> Doc
pretty (JSAccessorGet JSAnnot
an1) = String -> Doc
text String
"get"
        pretty (JSAccessorSet JSAnnot
an1) = String -> Doc
text String
"set"
--
instance Pretty JSArrayElement where
        pretty :: JSArrayElement -> Doc
pretty (JSArrayElement JSExpression
e) = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e
        pretty (JSArrayComma JSAnnot
a)   = String -> Doc
text String
","
--
-- instance Pretty [JSArrayElement] where
--     (|>) = foldl' (|>)
--
instance Pretty a => Pretty (JSCommaList a) where
        pretty :: JSCommaList a -> Doc
pretty (JSLCons JSCommaList a
pl JSAnnot
a a
i) = JSCommaList a -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList a
pl Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
"," Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
i
        pretty (JSLOne a
i)       = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
i
        pretty JSCommaList a
JSLNil           = String -> Doc
text String
""
--
instance Pretty a => Pretty (JSCommaTrailingList a) where
        pretty :: JSCommaTrailingList a -> Doc
pretty (JSCTLComma JSCommaList a
xs JSAnnot
a) = JSCommaList a -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList a
xs Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> String -> Doc
text String
","
        pretty (JSCTLNone JSCommaList a
xs)   = JSCommaList a -> Doc
forall a. Pretty a => a -> Doc
pretty JSCommaList a
xs
--
instance Pretty JSIdent where
        pretty :: JSIdent -> Doc
pretty (JSIdentName JSAnnot
a String
s) = String -> Doc
text String
s
        pretty JSIdent
JSIdentNone       = String -> Doc
text String
""
--
-- instance Pretty (Maybe JSExpression) where
--     pretty (Just e) = pacc |> e
--     pretty Nothing  = pacc
--
instance Pretty JSVarInitializer where
        pretty :: JSVarInitializer -> Doc
pretty (JSVarInit JSAnnot
a JSExpression
x) = String -> Doc
text String
" = " Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x
        pretty JSVarInitializer
JSVarInitNone   = String -> Doc
text String
""

-- instance Pretty JSObjectPropertyList where
--         pretty (JSCommaTrailingList prop) = text "{" <$$> pretty prop <$$> text "}"

-- EOF

-----------------------------------------------------------------------
-- Help functionality
prettyNestedStmt :: JSStatement -> Doc
prettyNestedStmt :: JSStatement -> Doc
prettyNestedStmt b :: JSStatement
b@(JSStatementBlock JSAnnot
_ [JSStatement]
_ JSAnnot
_ JSSemi
_) = JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
b
prettyNestedStmt JSStatement
stmt = Int -> Doc -> Doc
nest Int
2 (JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
stmt)

prettyNestedBracesBlock :: Pretty a => a -> Doc
prettyNestedBracesBlock :: forall a. Pretty a => a -> Doc
prettyNestedBracesBlock a
p = Int -> Doc -> Doc
nest Int
2 (Char -> Doc
char Char
'{' Doc -> Doc -> Doc
P.<$> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
p) Doc -> Doc -> Doc
P.<$> Char -> Doc
char Char
'}'

prettyNestedBlock :: Pretty a => a -> Doc
prettyNestedBlock :: forall a. Pretty a => a -> Doc
prettyNestedBlock a
p = Int -> Doc -> Doc
nest Int
2 (a -> Doc
forall a. Pretty a => a -> Doc
pretty a
p)

maybePP :: Pretty a => Maybe a -> Doc
maybePP :: forall a. Pretty a => Maybe a -> Doc
maybePP = Doc -> (a -> Doc) -> Maybe a -> Doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
empty (a -> Doc
forall a. Pretty a => a -> Doc
pretty)

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 = Int -> Doc -> Doc
nest Int
2 (Char -> Doc
char Char
'{' Doc -> Doc -> Doc
<$$> ([Doc] -> Doc
vcat [Doc]
xs))
                Doc -> Doc -> Doc
<$$> Char -> Doc
char Char
'}'

bracketBlock :: [Doc] -> Doc
bracketBlock :: [Doc] -> Doc
bracketBlock [Doc]
xs = Char -> Doc
char Char
'['
        Doc -> Doc -> Doc
<$$> Int -> Doc -> Doc
nest Int
2 ([Doc] -> Doc
hcat [Doc]
xs)
        Doc -> Doc -> Doc
<$$> Char -> Doc
char Char
']'

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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
' ' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
< Char
'\DEL' = [Char
c]
                                | Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xFFFF' = String -> Int -> String
forall r. PrintfType r => String -> r
printf String
"\\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
$ String
"Language.JavaScript.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]
++ String
" too large for JavaScript 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 Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\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
- Int
0x010000
                         lead :: Char
lead = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
0xD800 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
0x0400
                         trail :: Char
trail = Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Int
0xDC00 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
0x0400