{-#LANGUAGE TemplateHaskell #-}
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 }
    -- stubbing these out for now...
    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