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 :: 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

instance Pretty JSAST where
        pretty :: JSAST -> Doc
pretty (JSAstProgram xs :: [JSStatement]
xs a :: 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 s :: JSStatement
s a :: JSAnnot
a)  = JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
s
        pretty (JSAstExpression e :: JSExpression
e a :: JSAnnot
a) = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e
        pretty (JSAstLiteral x :: JSExpression
x a :: JSAnnot
a)    = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x

instance Pretty JSExpression where
        -- Terminals
        pretty :: JSExpression -> Doc
pretty (JSIdentifier     annot :: JSAnnot
annot s :: String
s) = String -> Doc
text String
s
        pretty (JSDecimal        annot :: JSAnnot
annot i :: String
i) = String -> Doc
text String
i
        pretty (JSLiteral        annot :: JSAnnot
annot l :: String
l) = String -> Doc
text String
l
        pretty (JSHexInteger     annot :: JSAnnot
annot i :: String
i) = String -> Doc
text String
i
        pretty (JSOctal          annot :: JSAnnot
annot i :: String
i) = String -> Doc
text String
i
        pretty (JSStringLiteral  annot :: JSAnnot
annot s :: String
s) = String -> Doc
text String
s
        pretty (JSRegEx          annot :: JSAnnot
annot s :: String
s) = String -> Doc
text String
s
--
--     -- Non-Terminals
        pretty (JSArrayLiteral         als :: JSAnnot
als xs :: [JSArrayElement]
xs ars :: JSAnnot
ars)             = String -> Doc
text "[" 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 "]"
        pretty (JSAssignExpression     lhs :: JSExpression
lhs op :: JSAssignOp
op rhs :: 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       ex :: JSExpression
ex lb :: JSAnnot
lb xs :: JSCommaList JSExpression
xs rb :: 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    ex :: JSExpression
ex os :: JSAnnot
os xs :: 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 "." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
xs
        pretty (JSCallExpressionSquare ex :: JSExpression
ex als :: JSAnnot
als xs :: JSExpression
xs ars :: 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 "[" 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 "]"
        pretty (JSCommaExpression      le :: JSExpression
le c :: JSAnnot
c re :: 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 "," Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
re)
        pretty (JSExpressionBinary     lhs :: JSExpression
lhs op :: JSBinOp
op rhs :: 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      alp :: JSAnnot
alp e :: JSExpression
e arp :: JSAnnot
arp)              = Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e)
        pretty (JSExpressionPostfix    xs :: JSExpression
xs op :: 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    cond :: JSExpression
cond h :: JSAnnot
h v1 :: JSExpression
v1 c :: JSAnnot
c v2 :: JSExpression
v2)         = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
cond Doc -> Doc -> Doc
<+> String -> Doc
text "?" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
v1 Doc -> Doc -> Doc
<+> String -> Doc
text ":" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
v2
        pretty (JSFunctionExpression   annot :: JSAnnot
annot n :: JSIdent
n lb :: JSAnnot
lb x2s :: JSCommaList JSIdent
x2s rb :: JSAnnot
rb x3 :: JSBlock
x3)   = String -> Doc
text "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            xs :: JSExpression
xs dot :: JSAnnot
dot n :: 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 "." Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
n
        pretty (JSMemberExpression     e :: JSExpression
e lb :: JSAnnot
lb a :: JSCommaList JSExpression
a rb :: 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 "(" 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 ")"
        pretty (JSMemberNew            a :: JSAnnot
a lb :: JSExpression
lb n :: JSAnnot
n rb :: JSCommaList JSExpression
rb s :: JSAnnot
s)            = String -> Doc
text "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         xs :: JSExpression
xs als :: JSAnnot
als e :: JSExpression
e ars :: 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 "[" 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 "]"
        pretty (JSNewExpression        n :: JSAnnot
n e :: JSExpression
e)                    = String -> Doc
text "new" Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e
        pretty (JSObjectLiteral        alb :: JSAnnot
alb xs :: JSObjectPropertyList
xs arb :: JSAnnot
arb)             = JSObjectPropertyList -> Doc
forall a. Pretty a => a -> Doc
prettyNestedBracesBlock JSObjectPropertyList
xs
        pretty (JSUnaryExpression      op :: JSUnaryOp
op x :: 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    x1 :: JSExpression
x1 x2 :: 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        annot :: JSAnnot
annot)  = String -> Doc
text "&&"
        pretty (JSBinOpBitAnd     annot :: JSAnnot
annot)  = String -> Doc
text "&"
        pretty (JSBinOpBitOr      annot :: JSAnnot
annot)  = String -> Doc
text "|"
        pretty (JSBinOpBitXor     annot :: JSAnnot
annot)  = String -> Doc
text "^"
        pretty (JSBinOpDivide     annot :: JSAnnot
annot)  = String -> Doc
text "/"
        pretty (JSBinOpEq         annot :: JSAnnot
annot)  = String -> Doc
text "=="
        pretty (JSBinOpGe         annot :: JSAnnot
annot)  = String -> Doc
text ">="
        pretty (JSBinOpGt         annot :: JSAnnot
annot)  = String -> Doc
text ">"
        pretty (JSBinOpIn         annot :: JSAnnot
annot)  = String -> Doc
text "in"
        pretty (JSBinOpInstanceOf annot :: JSAnnot
annot)  = String -> Doc
text "instanceof"
        pretty (JSBinOpLe         annot :: JSAnnot
annot)  = String -> Doc
text "<="
        pretty (JSBinOpLsh        annot :: JSAnnot
annot)  = String -> Doc
text "<<"
        pretty (JSBinOpLt         annot :: JSAnnot
annot)  = String -> Doc
text "<"
        pretty (JSBinOpMinus      annot :: JSAnnot
annot)  = String -> Doc
text "-"
        pretty (JSBinOpMod        annot :: JSAnnot
annot)  = String -> Doc
text "%"
        pretty (JSBinOpNeq        annot :: JSAnnot
annot)  = String -> Doc
text "!="
        pretty (JSBinOpOr         annot :: JSAnnot
annot)  = String -> Doc
text "||"
        pretty (JSBinOpPlus       annot :: JSAnnot
annot)  = String -> Doc
text "+"
        pretty (JSBinOpRsh        annot :: JSAnnot
annot)  = String -> Doc
text ">>"
        pretty (JSBinOpStrictEq   annot :: JSAnnot
annot)  = String -> Doc
text "==="
        pretty (JSBinOpStrictNeq  annot :: JSAnnot
annot)  = String -> Doc
text "!=="
        pretty (JSBinOpTimes      annot :: JSAnnot
annot)  = String -> Doc
text "*"
        pretty (JSBinOpUrsh       annot :: JSAnnot
annot)  = String -> Doc
text ">>>"


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


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


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


instance Pretty JSTryCatch where
        pretty :: JSTryCatch -> Doc
pretty (JSCatch anc :: JSAnnot
anc alb :: JSAnnot
alb x1 :: JSExpression
x1 arb :: JSAnnot
arb x3 :: JSBlock
x3) = [Doc] -> Doc
hsep [String -> Doc
text "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 anc :: JSAnnot
anc alb :: JSAnnot
alb x1 :: JSExpression
x1 aif :: JSAnnot
aif ex :: JSExpression
ex arb :: JSAnnot
arb x3 :: JSBlock
x3) = [Doc] -> Doc
hsep [String -> Doc
text "catch", Doc -> Doc
parens (JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x1 Doc -> Doc -> Doc
<+> String -> Doc
text "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      annot :: JSAnnot
annot x :: JSBlock
x) = String -> Doc
text "finally" Doc -> Doc -> Doc
<+> JSBlock -> Doc
forall a. Pretty a => a -> Doc
pretty JSBlock
x
        pretty JSNoFinally              = String -> Doc
text ""


instance Pretty JSSwitchParts where
        pretty :: JSSwitchParts -> Doc
pretty (JSCase    annot :: JSAnnot
annot x1 :: JSExpression
x1 c :: JSAnnot
c x2s :: [JSStatement]
x2s) = String -> Doc
text "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 annot :: JSAnnot
annot c :: JSAnnot
c xs :: [JSStatement]
xs)     = String -> Doc
text "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 alb :: JSAnnot
alb blk :: [JSStatement]
blk arb :: JSAnnot
arb s :: 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 annot :: JSAnnot
annot mi :: JSIdent
mi s :: JSSemi
s)                         = String -> Doc
text "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 annot :: JSAnnot
annot mi :: JSIdent
mi s :: JSSemi
s)                      = String -> Doc
text "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 annot :: JSAnnot
annot xs :: JSCommaList JSExpression
xs s :: JSSemi
s)                      = String -> Doc
text "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 ad :: JSAnnot
ad x1 :: JSStatement
x1 aw :: JSAnnot
aw alb :: JSAnnot
alb x2 :: JSExpression
x2 arb :: JSAnnot
arb x3 :: JSSemi
x3)           = String -> Doc
text "do" Doc -> Doc -> Doc
<+> JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
x1 Doc -> Doc -> Doc
<+> String -> Doc
text "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 af :: JSAnnot
af alb :: JSAnnot
alb x1s :: JSCommaList JSExpression
x1s s1 :: JSAnnot
s1 x2s :: JSCommaList JSExpression
x2s s2 :: JSAnnot
s2 x3s :: JSCommaList JSExpression
x3s arb :: JSAnnot
arb x4 :: JSStatement
x4)      = String -> Doc
text "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 ";" , 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 ";" , 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 af :: JSAnnot
af alb :: JSAnnot
alb x1s :: JSExpression
x1s i :: JSBinOp
i x2 :: JSExpression
x2 arb :: JSAnnot
arb x3 :: JSStatement
x3)             = String -> Doc
text "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 af :: JSAnnot
af alb :: JSAnnot
alb v :: JSAnnot
v x1s :: JSCommaList JSExpression
x1s s1 :: JSAnnot
s1 x2s :: JSCommaList JSExpression
x2s s2 :: JSAnnot
s2 x3s :: JSCommaList JSExpression
x3s arb :: JSAnnot
arb x4 :: JSStatement
x4) = String -> Doc
text "for" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (String -> Doc
text "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 ";" 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 ";" 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 af :: JSAnnot
af alb :: JSAnnot
alb v :: JSAnnot
v x1 :: JSExpression
x1 i :: JSBinOp
i x2 :: JSExpression
x2 arb :: JSAnnot
arb x3 :: JSStatement
x3)         = String -> Doc
text "for" Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc -> Doc
parens (String -> Doc
text "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 af :: JSAnnot
af n :: JSIdent
n alb :: JSAnnot
alb x2s :: JSCommaList JSIdent
x2s arb :: JSAnnot
arb x3 :: JSBlock
x3 s :: JSSemi
s)           = String -> Doc
text "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 annot :: JSAnnot
annot alb :: JSAnnot
alb x1 :: JSExpression
x1 arb :: JSAnnot
arb x2s :: JSStatement
x2s)                  = String -> Doc
text "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 annot :: JSAnnot
annot alb :: JSAnnot
alb x1 :: JSExpression
x1 arb :: JSAnnot
arb x2s :: JSStatement
x2s ea :: JSAnnot
ea x3s :: JSStatement
x3s)       = String -> Doc
text "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 "else" Doc -> Doc -> Doc
<+> JSStatement -> Doc
prettyNestedStmt JSStatement
x3s
        pretty (JSLabelled l :: JSIdent
l c :: JSAnnot
c v :: 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 a :: JSAnnot
a)                         = String -> Doc
text ";"
        pretty (JSExpressionStatement l :: JSExpression
l s :: 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 lhs :: JSExpression
lhs op :: JSAssignOp
op rhs :: JSExpression
rhs s :: 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 e :: JSExpression
e lp :: JSAnnot
lp a :: JSCommaList JSExpression
a rp :: JSAnnot
rp s :: 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 annot :: JSAnnot
annot me :: Maybe JSExpression
me s :: JSSemi
s)                        = String -> Doc
text "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 annot :: JSAnnot
annot alp :: JSAnnot
alp x :: JSExpression
x arp :: JSAnnot
arp alb :: JSAnnot
alb x2 :: [JSSwitchParts]
x2 arb :: JSAnnot
arb s :: JSSemi
s)      = String -> Doc
text "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 annot :: JSAnnot
annot x :: JSExpression
x s :: JSSemi
s)                          = String -> Doc
text "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 annot :: JSAnnot
annot tb :: JSBlock
tb tcs :: [JSTryCatch]
tcs tf :: JSTryFinally
tf)                      = String -> Doc
text "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 annot :: JSAnnot
annot xs :: JSCommaList JSExpression
xs s :: JSSemi
s)                      = String -> Doc
text "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 annot :: JSAnnot
annot alp :: JSAnnot
alp x1 :: JSExpression
x1 arp :: JSAnnot
arp x2 :: JSStatement
x2)                = String -> Doc
text "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 annot :: JSAnnot
annot alp :: JSAnnot
alp x1 :: JSExpression
x1 arp :: JSAnnot
arp x :: JSStatement
x s :: JSSemi
s)                = String -> Doc
text "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 _s :: JSStatement
_s             = String -> Doc
forall a. HasCallStack => String -> a
error "TODO JSStatement"
--
--
-- instance Pretty [JSStatement] where
--     (|>) = foldl' (|>)
--
instance Pretty JSBlock where
        pretty :: JSBlock -> Doc
pretty (JSBlock alb :: JSAnnot
alb ss :: [JSStatement]
ss arb :: 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     s :: JSAccessor
s n :: JSPropertyName
n alp :: JSAnnot
alp ps :: [JSExpression]
ps arp :: JSAnnot
arp b :: 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 n :: JSPropertyName
n c :: JSAnnot
c vs :: [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 an1 :: JSAnnot
an1 i :: String
i)  = String -> Doc
text String
i
        pretty (JSPropertyString an1 :: JSAnnot
an1 s :: String
s) = String -> Doc
text String
s
        pretty (JSPropertyNumber an1 :: JSAnnot
an1 n :: String
n) = String -> Doc
text String
n
--
instance Pretty JSAccessor where
        pretty :: JSAccessor -> Doc
pretty (JSAccessorGet an1 :: JSAnnot
an1) = String -> Doc
text "get"
        pretty (JSAccessorSet an1 :: JSAnnot
an1) = String -> Doc
text "set"
--
instance Pretty JSArrayElement where
        pretty :: JSArrayElement -> Doc
pretty (JSArrayElement e :: JSExpression
e) = JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
e
        pretty (JSArrayComma a :: JSAnnot
a)   = String -> Doc
text ","
--
-- instance Pretty [JSArrayElement] where
--     (|>) = foldl' (|>)
--
instance Pretty a => Pretty (JSCommaList a) where
        pretty :: JSCommaList a -> Doc
pretty (JSLCons pl :: JSCommaList a
pl a :: JSAnnot
a i :: 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 "," Doc -> Doc -> Doc
<+> a -> Doc
forall a. Pretty a => a -> Doc
pretty a
i
        pretty (JSLOne i :: a
i)       = a -> Doc
forall a. Pretty a => a -> Doc
pretty a
i
        pretty JSLNil           = String -> Doc
text ""
--
instance Pretty a => Pretty (JSCommaTrailingList a) where
        pretty :: JSCommaTrailingList a -> Doc
pretty (JSCTLComma xs :: JSCommaList a
xs a :: 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 ","
        pretty (JSCTLNone xs :: 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 a :: JSAnnot
a s :: String
s) = String -> Doc
text String
s
        pretty JSIdentNone       = String -> Doc
text ""
--
-- instance Pretty (Maybe JSExpression) where
--     pretty (Just e) = pacc |> e
--     pretty Nothing  = pacc
--
instance Pretty JSVarInitializer where
        pretty :: JSVarInitializer -> Doc
pretty (JSVarInit a :: JSAnnot
a x :: JSExpression
x) = String -> Doc
text " = " Doc -> Doc -> Doc
<+> JSExpression -> Doc
forall a. Pretty a => a -> Doc
pretty JSExpression
x
        pretty JSVarInitNone   = String -> Doc
text ""

-- 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 _ _ _ _) = JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
b
prettyNestedStmt stmt :: JSStatement
stmt = Int -> Doc -> Doc
nest 2 (JSStatement -> Doc
forall a. Pretty a => a -> Doc
pretty JSStatement
stmt)

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

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

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

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

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.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]
++ " too large for JavaScript 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