module Language.ECMAScript3.PrettyPrint
(
javaScript
, renderStatements
, renderExpression
) where
import Text.PrettyPrint.HughesPJ
import Language.ECMAScript3.Syntax
import Prelude hiding (maybe)
renderStatements :: [Statement a] -> String
renderStatements = render . stmtList
renderExpression :: Expression a -> String
renderExpression = render . (ppExpression True)
inBlock:: Statement a -> Doc
inBlock s@(BlockStmt _ _) = ppStatement s
inBlock s = asBlock [s]
asBlock :: [Statement a] -> Doc
asBlock ss = lbrace $+$ nest 2 (stmtList ss) $$ rbrace
ppId (Id _ str) = text str
forInit :: ForInit a -> Doc
forInit t = case t of
NoInit -> empty
VarInit vs -> text "var" <+> cat (punctuate comma $ map (ppVarDecl False) vs)
ExprInit e -> ppExpression False e
forInInit :: ForInInit a -> Doc
forInInit t = case t of
ForInVar id -> text "var" <+> ppId id
ForInLVal lv -> ppLValue lv
caseClause :: CaseClause a -> Doc
caseClause (CaseClause _ e ss) =
text "case" $+$ ppExpression True e <+> colon $$ nest 2 (stmtList ss)
caseClause (CaseDefault _ ss) =
text "default:" $$ nest 2 (stmtList ss)
ppVarDecl :: Bool -> VarDecl a -> Doc
ppVarDecl hasIn vd = case vd of
VarDecl _ id Nothing -> ppId id
VarDecl _ id (Just e) -> ppId id <+> equals <+> ppAssignmentExpression hasIn e
ppStatement :: Statement a -> Doc
ppStatement s = case s of
BlockStmt _ ss -> asBlock ss
EmptyStmt _ -> semi
ExprStmt _ e@(CallExpr _ (FuncExpr {}) _ ) ->
parens (ppExpression True e) <> semi
ExprStmt _ e -> ppExpression True e <> semi
IfSingleStmt _ test cons -> text "if" <+>
parens (ppExpression True test) $$
ppStatement cons
IfStmt _ test cons alt -> text "if" <+> parens (ppExpression True test) $$
ppStatement cons $$ text "else" <+> ppStatement alt
SwitchStmt _ e cases ->
text "switch" <+> parens (ppExpression True e) $$
braces (nest 2 (vcat (map caseClause cases)))
WhileStmt _ test body -> text "while" <+> parens (ppExpression True test) $$
ppStatement body
ReturnStmt _ Nothing -> text "return"
ReturnStmt _ (Just e) -> text "return" <+> ppExpression True e
DoWhileStmt _ s e ->
text "do" $$
(ppStatement s <+> text "while" <+> parens (ppExpression True e) <> semi)
BreakStmt _ Nothing -> text "break" <> semi
BreakStmt _ (Just label) -> text "break" <+> ppId label <> semi
ContinueStmt _ Nothing -> text "continue" <> semi
ContinueStmt _ (Just label) -> text"continue" <+> ppId label <> semi
LabelledStmt _ label s -> ppId label <> colon $$ ppStatement s
ForInStmt p init e body ->
text "for" <+>
parens (forInInit init <+> text "in" <+> ppExpression True e) $+$
ppStatement body
ForStmt _ init incr test body ->
text "for" <+>
parens (forInit init <> semi <+> maybe incr (ppExpression True) <>
semi <+> maybe test (ppExpression True)) $$
ppStatement body
TryStmt _ stmt mcatch mfinally ->
text "try" $$ inBlock stmt $$ ppCatch $$ ppFinally
where ppFinally = case mfinally of
Nothing -> empty
Just stmt -> text "finally" <> inBlock stmt
ppCatch = case mcatch of
Nothing -> empty
Just (CatchClause _ id s) ->
text "catch" <+> (parens.ppId) id <+> inBlock s
ThrowStmt _ e -> text "throw" <+> ppExpression True e <> semi
WithStmt _ e s -> text "with" <+> parens (ppExpression True e) $$ ppStatement s
VarDeclStmt _ decls ->
text "var" <+> cat (punctuate comma (map (ppVarDecl True) decls)) <> semi
FunctionStmt _ name args body ->
text "function" <+> ppId name <>
parens (cat $ punctuate comma (map ppId args)) $$
asBlock body
stmtList :: [Statement a] -> Doc
stmtList = vcat . map ppStatement
prop :: Prop a -> Doc
prop p = case p of
PropId _ id -> ppId id
PropString _ str -> doubleQuotes (text (jsEscape str))
PropNum _ n -> text (show n)
infixOp op = text $ case op of
OpMul -> "*"
OpDiv -> "/"
OpMod -> "%"
OpAdd -> "+"
OpSub -> "-"
OpLShift -> "<<"
OpSpRShift -> ">>"
OpZfRShift -> ">>>"
OpLT -> "<"
OpLEq -> "<="
OpGT -> ">"
OpGEq -> ">="
OpIn -> "in"
OpInstanceof -> "instanceof"
OpEq -> "=="
OpNEq -> "!="
OpStrictEq -> "==="
OpStrictNEq -> "!=="
OpBAnd -> "&"
OpBXor -> "^"
OpBOr -> "|"
OpLAnd -> "&&"
OpLOr -> "||"
prefixOp op = text $ case op of
PrefixLNot -> "!"
PrefixBNot -> "~"
PrefixPlus -> "+"
PrefixMinus -> "-"
PrefixTypeof -> "typeof"
PrefixVoid -> "void"
PrefixDelete -> "delete"
assignOp op = text $ case op of
OpAssign -> "="
OpAssignAdd -> "+="
OpAssignSub -> "-="
OpAssignMul -> "*="
OpAssignDiv -> "/="
OpAssignMod -> "%="
OpAssignLShift -> "<<="
OpAssignSpRShift -> ">>="
OpAssignZfRShift -> ">>>="
OpAssignBAnd -> "&="
OpAssignBXor -> "^="
OpAssignBOr -> "|="
jsEscape:: String -> String
jsEscape "" = ""
jsEscape (ch:chs) = sel ch ++ jsEscape chs where
sel '\b' = "\\b"
sel '\f' = "\\f"
sel '\n' = "\\n"
sel '\r' = "\\r"
sel '\t' = "\\t"
sel '\v' = "\\v"
sel '\'' = "\\'"
sel '\"' = "\\\""
sel '\\' = "\\\\"
sel x = [x]
regexpEscape :: String -> String
regexpEscape "" = ""
regexpEscape "\\" = "\\\\"
regexpEscape ('\\':c:rest) = '\\':c:(regexpEscape rest)
regexpEscape ('/':rest) = '\\':'/':regexpEscape rest
regexpEscape (c:rest) = c:regexpEscape rest
ppLValue :: LValue a -> Doc
ppLValue (LVar _ x) = text x
ppLValue (LDot _ e x) = ppMemberExpression e <> text "." <> text x
ppLValue (LBracket _ e1 e2) = ppMemberExpression e1 <>
brackets (ppExpression True e2)
ppPrimaryExpression :: Expression a -> Doc
ppPrimaryExpression e = case e of
ThisRef _ -> text "this"
VarRef _ id -> ppId id
NullLit _ -> text "null"
BoolLit _ True -> text "true"
BoolLit _ False -> text "false"
NumLit _ n -> text (show n)
IntLit _ n -> text (show n)
StringLit _ str -> doubleQuotes (text (jsEscape str))
RegexpLit _ reg g ci -> text "/" <> (text (regexpEscape reg)) <> text "/" <>
(if g then text "g" else empty) <>
(if ci then text "i" else empty)
ArrayLit _ es ->
brackets $ cat $ punctuate comma (map (ppAssignmentExpression True) es)
ObjectLit _ xs ->
braces (hsep (punctuate comma (map pp' xs))) where
pp' (n,v) = prop n <> colon <+> ppAssignmentExpression True v
_ -> parens $ ppExpression True e
ppMemberExpression :: Expression a -> Doc
ppMemberExpression e = case e of
FuncExpr _ name params body ->
text "function" <+> maybe name ppId <+>
parens (cat $ punctuate comma (map ppId params)) $$
asBlock body
DotRef _ obj id -> ppMemberExpression obj <> text "." <> ppId id
BracketRef _ obj key ->
ppMemberExpression obj <> brackets (ppExpression True key)
NewExpr _ ctor args ->
text "new" <+> ppMemberExpression ctor <> ppArguments args
_ -> ppPrimaryExpression e
ppCallExpression :: Expression a -> Doc
ppCallExpression e = case e of
CallExpr _ f args -> ppCallExpression f <> ppArguments args
DotRef _ obj id -> ppCallExpression obj <> text "." <> ppId id
BracketRef _ obj key ->ppCallExpression obj <> brackets (ppExpression True key)
_ -> ppMemberExpression e
ppArguments :: [Expression a] -> Doc
ppArguments es =
parens $ cat $ punctuate comma (map (ppAssignmentExpression True) es)
ppLHSExpression :: Expression a -> Doc
ppLHSExpression = ppCallExpression
ppPostfixExpression :: Expression a -> Doc
ppPostfixExpression e = case e of
UnaryAssignExpr _ PostfixInc e' -> ppLValue e' <> text "++"
UnaryAssignExpr _ PostfixDec e' -> ppLValue e' <> text "--"
_ -> ppLHSExpression e
ppUnaryExpression :: Expression a -> Doc
ppUnaryExpression e = case e of
PrefixExpr _ op e' -> prefixOp op <+> ppUnaryExpression e'
UnaryAssignExpr _ PrefixInc e' -> text "++" <> ppLValue e'
UnaryAssignExpr _ PrefixDec e' -> text "--" <> ppLValue e'
_ -> ppPostfixExpression e
ppMultiplicativeExpression :: Expression a -> Doc
ppMultiplicativeExpression e = case e of
InfixExpr _ op e1 e2 | op `elem` [OpMul, OpDiv, OpMod] ->
ppMultiplicativeExpression e1 <+> infixOp op <+> ppUnaryExpression e2
_ -> ppUnaryExpression e
ppAdditiveExpression :: Expression a -> Doc
ppAdditiveExpression e = case e of
InfixExpr _ op e1 e2 | op `elem` [OpAdd, OpSub] ->
ppAdditiveExpression e1 <+> infixOp op <+> ppMultiplicativeExpression e2
_ -> ppMultiplicativeExpression e
ppShiftExpression :: Expression a -> Doc
ppShiftExpression e = case e of
InfixExpr _ op e1 e2 | op `elem` [OpLShift, OpSpRShift, OpZfRShift] ->
ppShiftExpression e1 <+> infixOp op <+> ppAdditiveExpression e2
_ -> ppAdditiveExpression e
ppRelationalExpression :: Bool -> Expression a -> Doc
ppRelationalExpression hasIn e =
let opsNoIn = [OpLT, OpGT, OpLEq, OpGEq, OpInstanceof]
ops = if hasIn then OpIn:opsNoIn else opsNoIn
in case e of
InfixExpr _ op e1 e2 | op `elem` ops ->
ppRelationalExpression hasIn e1 <+> infixOp op <+> ppShiftExpression e2
_ -> ppShiftExpression e
ppEqualityExpression :: Bool -> Expression a -> Doc
ppEqualityExpression hasIn e = case e of
InfixExpr _ op e1 e2 | op `elem` [OpEq, OpNEq, OpStrictEq, OpStrictNEq] ->
ppEqualityExpression hasIn e1 <+> infixOp op <+>
ppRelationalExpression hasIn e2
_ -> ppRelationalExpression hasIn e
ppBitwiseANDExpression :: Bool -> Expression a -> Doc
ppBitwiseANDExpression hasIn e = case e of
InfixExpr _ op@OpBAnd e1 e2 -> ppBitwiseANDExpression hasIn e1 <+>
infixOp op <+>
ppEqualityExpression hasIn e2
_ -> ppEqualityExpression hasIn e
ppBitwiseXORExpression :: Bool -> Expression a -> Doc
ppBitwiseXORExpression hasIn e = case e of
InfixExpr _ op@OpBXor e1 e2 -> ppBitwiseXORExpression hasIn e1 <+>
infixOp op <+>
ppBitwiseANDExpression hasIn e2
_ -> ppBitwiseANDExpression hasIn e
ppBitwiseORExpression :: Bool -> Expression a -> Doc
ppBitwiseORExpression hasIn e = case e of
InfixExpr _ op@OpBOr e1 e2 -> ppBitwiseORExpression hasIn e1 <+>
infixOp op <+>
ppBitwiseXORExpression hasIn e2
_ -> ppBitwiseXORExpression hasIn e
ppLogicalANDExpression :: Bool -> Expression a -> Doc
ppLogicalANDExpression hasIn e = case e of
InfixExpr _ op@OpLAnd e1 e2 -> ppLogicalANDExpression hasIn e1 <+>
infixOp op <+>
ppBitwiseORExpression hasIn e2
_ -> ppBitwiseORExpression hasIn e
ppLogicalORExpression :: Bool -> Expression a -> Doc
ppLogicalORExpression hasIn e = case e of
InfixExpr _ op@OpLOr e1 e2 -> ppLogicalORExpression hasIn e1 <+>
infixOp op <+>
ppLogicalANDExpression hasIn e2
_ -> ppLogicalANDExpression hasIn e
ppConditionalExpression :: Bool -> Expression a -> Doc
ppConditionalExpression hasIn e = case e of
CondExpr _ c et ee -> ppLogicalORExpression hasIn c <+> text "?" <+>
ppAssignmentExpression hasIn et <+> colon <+>
ppAssignmentExpression hasIn ee
_ -> ppLogicalORExpression hasIn e
ppAssignmentExpression :: Bool -> Expression a -> Doc
ppAssignmentExpression hasIn e = case e of
AssignExpr _ op l r -> ppLValue l <+> assignOp op <+>
ppAssignmentExpression hasIn r
_ -> ppConditionalExpression hasIn e
ppExpression :: Bool -> Expression a -> Doc
ppExpression hasIn e = case e of
ListExpr _ es -> cat $ punctuate comma (map (ppExpression hasIn) es)
_ -> ppAssignmentExpression hasIn e
maybe :: Maybe a -> (a -> Doc) -> Doc
maybe Nothing _ = empty
maybe (Just a) f = f a
javaScript :: JavaScript a -> Doc
javaScript (Script _ ss) = stmtList ss