module Text.HPaco.Writers.Javascript
( writeJavascript
, defJsWriterOptions
, WrapMode (..)
)
where
import Control.Monad.RWS
import Data.FileEmbed
import Data.List (intersperse)
import Data.Maybe
import Data.Typeable
import Text.HPaco.AST.AST
import Text.HPaco.AST.Expression
import Text.HPaco.AST.Statement
import Text.HPaco.Writer
import Text.HPaco.Writers.Internal.WrapMode
import Text.HPaco.Writers.Internal.CodeWriter
import qualified Data.ByteString.Char8 as BS8
import qualified Data.Map as M
defJsWriterOptions =
defaultWriterOptions { woWriteFunc = "_write" }
data JavascriptWriterState =
JavascriptWriterState
{ jwsIndent :: Int
, jwsAST :: AST
}
defaultJavascriptWriterState =
JavascriptWriterState
{ jwsIndent = 0
, jwsAST = defAST
}
type PWS = RWS WriterOptions String JavascriptWriterState
instance CodeWriterState JavascriptWriterState where
cwsGetIndent = jwsIndent
cwsSetIndent f s = s { jwsIndent = f }
cwsGetFilters s = []
cwsSetFilters f = id
writeJavascript :: WriterOptions -> Writer
writeJavascript opts ast =
let (s, w) = execRWS (writeAST ast) opts defaultJavascriptWriterState { jwsAST = ast}
in w
writeAST :: AST -> PWS ()
writeAST ast = do
writeHeader
writeDefs $ astDefs ast
writeStatement $ astRootStatement ast
writeFooter
writeDefs = mapM_ writeDef
writeDef (identifier, body) = do
writeIndented $ "var _macro_" ++ identifier ++ " = function() {"
withIndent $ writeStatement body
writeIndented "};"
writePreamble :: PWS ()
writePreamble = do
let src = BS8.unpack $(embedFile "snippets/js/preamble.js")
write src
endl
writeHeader :: PWS ()
writeHeader = do
templateName <- woTemplateName `liftM` ask
wrapMode <- woWrapMode `liftM` ask
case wrapMode of
WrapFunction -> do
let funcName =
if null templateName
then "runTemplate"
else "runTemplate_" ++ templateName
writeIndented $ "function " ++ funcName ++ "(context) {"
pushIndent
otherwise -> return ()
writeIndented "(function(){"
pushIndent
includePreamble <- asks woIncludePreamble
when includePreamble writePreamble
writeFooter :: PWS ()
writeFooter = do
wrapMode <- woWrapMode `liftM` ask
popIndent
writeIndented "}).apply(context);"
case wrapMode of
WrapFunction -> do
popIndent
writeIndented "}"
otherwise -> return ()
writeStatement :: Statement -> PWS ()
writeStatement stmt =
case stmt of
StatementSequence ss -> mapM_ writeStatement ss
PrintStatement expr -> do
wfunc <- woWriteFunc `liftM` ask
writeIndent
write $ wfunc ++ "(_f("
writeExpression expr
write "));"
endl
NullStatement -> return ()
IfStatement { } -> writeIf stmt
LetStatement identifier expr stmt -> writeLet identifier expr stmt
ForStatement Nothing identifier expr stmt -> writeFor identifier expr stmt
ForStatement (Just iter) identifier expr stmt -> writeForExt iter identifier expr stmt
SwitchStatement masterExpr branches -> writeSwitch masterExpr branches
CallStatement identifier ->
writeIndented $ "_macro_" ++ identifier ++ ".apply(this);"
SourcePositionStatement fn ln -> do
c <- asks woSourcePositionComments
when c $ do
writeIndent
write "/* "
write fn
write ":"
write $ show ln
write " */"
endl
writeIf :: Statement -> PWS ()
writeIf (IfStatement cond true false) = do
writeIndent
write "if ("
writeExpression cond
write ") {"
endl
withIndent $ writeStatement true
writeIndented "}"
unless (false == NullStatement) $ do
writeIndented "else {"
withIndent $ writeStatement false
writeIndented "}"
writeLet :: String -> Expression -> Statement -> PWS ()
writeLet identifier expr stmt =
writeWithScope identifier (writeExpression expr) (writeStatement stmt)
writeFor :: String -> Expression -> Statement -> PWS ()
writeFor identifier expr stmt =
writeFor_ identifier expr $
withIndent $
writeWithScope identifier (write "_iteree[_index]") (writeStatement stmt)
writeForExt :: String -> String -> Expression -> Statement -> PWS ()
writeForExt ident identifier expr stmt =
writeFor_ identifier expr $
withIndent $
writeWithScope ident (write "_index") $
writeWithScope identifier (write "_iteree[_index]") (writeStatement stmt)
writeFor_ :: String -> Expression -> PWS () -> PWS ()
writeFor_ identifier expr writeInner = do
writeIndented "(function(){"
withIndent $ do
writeIndent
write "var _iteree = "
writeExpression expr
write ";"
endl
writeIndented "if (Array.isArray(_iteree)) {"
withIndent $ do
writeIndented "for (var _index = 0; _index < _iteree.length; ++_index) {"
writeInner
writeIndented "}"
writeIndented "}"
writeIndented "else {"
withIndent $ do
writeIndented "for (var _index in _iteree) {"
writeInner
writeIndented "}"
writeIndented "}"
writeIndented "}).apply(this);"
writeWithScope :: String -> PWS () -> PWS () -> PWS ()
writeWithScope identifier rhs inner = do
if identifier == "."
then do
writeIndent
write "_newscope = "
rhs
write ";"
endl
else do
writeIndent
write "_newscope = {'"
write identifier
write "':"
rhs
write "};"
endl
writeIndented "_scope = _merge(this, _newscope);"
writeIndented "(function(){"
withIndent $ do
writeIndented "var _scope = null; var _newscope = null;"
inner
writeIndented "}).apply(_scope);"
writeSwitch :: Expression -> [(Expression, Statement)] -> PWS ()
writeSwitch masterExpr branches = do
writeIndent
write "switch ("
writeExpression masterExpr
write ") {"
endl
withIndent $
mapM writeSwitchBranch branches
writeIndented "}"
where
writeSwitchBranch :: (Expression, Statement) -> PWS ()
writeSwitchBranch (expr, stmt) = do
writeIndent
write "case "
writeExpression expr
write ":"
endl
withIndent $ do
writeStatement stmt
writeIndented "break;"
writeExpression :: Expression -> PWS ()
writeExpression expr =
case expr of
StringLiteral str -> write $ quoteJavascriptString str
IntLiteral i -> write $ show i
FloatLiteral i -> write $ show i
BooleanLiteral b -> write $ if b then "true" else "false"
ListExpression items -> do
write "["
sequence_ $
intersperse (write ", ") $
map writeExpression items
write "]"
AListExpression items -> do
write "{"
sequence_ $
intersperse (write ", ") $
map writeElem items
write "}"
where
writeElem (key, value) = do
writeExpression key
write " : "
writeExpression value
VariableReference vn ->
if vn == "."
then write "this"
else do
write "this['"
write vn
write "']"
EscapeExpression mode e -> do
let escapefunc =
case mode of
EscapeHTML -> "_htmlencode"
EscapeURL -> "encodeURI"
write escapefunc
write "(_f("
writeExpression e
write "))"
TernaryExpression cond trueBranch falseBranch -> do
write "(("
writeExpression cond
write ") ? ("
writeExpression trueBranch
write ") : ("
writeExpression falseBranch
write "))"
BinaryExpression (Flipped op) left right ->
writeExpression $ BinaryExpression op right left
BinaryExpression OpMember left right -> do
writeExpression left
write "["
writeExpression right
write "]"
BinaryExpression OpInList left right -> do
write "_in("
writeExpression left
write ", "
writeExpression right
write ")"
BinaryExpression OpBooleanXor left right -> do
write "(function(a,b){return (a||b) && !(a&&b);})("
writeExpression left
write ","
writeExpression right
write ")"
BinaryExpression OpCoalesce left right -> do
write "((function(a,b){if (a) return a; if (typeof(a) == 'undefined' || typeof(a) == 'object') return b; return a;})("
writeExpression left
write ","
writeExpression right
write "))"
BinaryExpression o left right -> do
let opstr = case o of
OpPlus -> "+"
OpMinus -> "-"
OpMul -> "*"
OpDiv -> "/"
OpMod -> "%"
OpEquals -> "==="
OpLooseEquals -> "=="
OpNotEquals -> "!=="
OpLooseNotEquals -> "!="
OpGreater -> ">"
OpLess -> "<"
OpNotGreater -> "<="
OpNotLess -> ">="
OpBooleanAnd -> "&&"
OpBooleanOr -> "||"
OpConcat -> "+"
write "("
wrappedArg o left
write opstr
wrappedArg o right
write ")"
where
numericOps = [
OpPlus,
OpMinus,
OpMul,
OpDiv,
OpMod,
OpGreater,
OpLess,
OpNotGreater,
OpNotLess ]
stringOps = [
OpConcat ]
wrappedArg o i =
let wrapWord =
if o `elem` numericOps
then "Number"
else if o `elem` stringOps
then "String"
else ""
in write wrapWord >> write "(" >> writeExpression i >> write ")"
UnaryExpression o e -> do
let opstr = case o of
OpNot -> "!"
write "("
write opstr
write "("
writeExpression e
write "))"
FunctionCallExpression (VariableReference "library") (libnameExpr:_) -> do
write "(_loadlib("
writeExpression libnameExpr
write "))"
FunctionCallExpression fn args -> do
write "("
writeExpression fn
write "("
sequence_ . intersperse (write ",") $ map writeExpression args
write "))"
quoteJavascriptString :: String -> String
quoteJavascriptString str =
"'" ++ escape str ++ "'"
where
escapeChar '\'' = "\\'"
escapeChar '\n' = "' + \"\\n\" + '"
escapeChar '\t' = "' + \"\\t\" + '"
escapeChar '\r' = "' + \"\\r\" + '"
escapeChar x = [x]
escape = concatMap escapeChar