{-#LANGUAGE TemplateHaskell #-}
module Text.HPaco.Writers.Javascript
    ( writeJavascript
    , WriterOptions (..)
    , defaultWriterOptions
    , 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 qualified Data.ByteString.Char8 as BS8
import qualified Data.Map as M

data WriterOptions =
    WriterOptions { woPrettyPrint :: Bool
                  , woIndentStr :: String
                  , woTemplateName :: String
                  , woWrapMode :: WrapMode
                  , woExposeAllFunctions :: Bool
                  , woWriteFunc :: String
                  }

defaultWriterOptions =
    WriterOptions { woPrettyPrint = False
                  , woIndentStr = "\t"
                  , woTemplateName = ""
                  , woWrapMode = WrapNone
                  , woExposeAllFunctions = False
                  , woWriteFunc = "_write"
                  }

data JavascriptWriterState =
    JavascriptWriterState
        { jwsIndent :: Int
        , jwsAST :: AST
        }

defaultJavascriptWriterState =
    JavascriptWriterState
        { jwsIndent = 0
        , jwsAST = defAST
        }

type PWS = RWS WriterOptions String JavascriptWriterState

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
    writeIndentedLn $ "var _macro_" ++ identifier ++ " = function() {"
    withIndent $ writeStatement body
    writeIndentedLn "};"

write :: String -> PWS ()
write = tell

pushIndent :: PWS ()
pushIndent = modify (\s -> s { jwsIndent = jwsIndent s + 1 })

popIndent :: PWS ()
popIndent = modify (\s -> s { jwsIndent = jwsIndent s - 1 })

withIndent :: PWS a -> PWS a
withIndent a = do
    pushIndent
    x <- a
    popIndent
    return x

writeIndent :: PWS ()
writeIndent = do
    pretty <- woPrettyPrint `liftM` ask
    istr <- woIndentStr `liftM` ask
    indent <- gets jwsIndent
    if pretty
        then write $ concat $ take indent $ repeat istr
        else return ()

writeNewline :: PWS ()
writeNewline = do
    pretty <- woPrettyPrint `liftM` ask
    if pretty
        then write "\n"
        else write " "

writeIndented :: String -> PWS ()
writeIndented str = writeIndent >> write str

writeIndentedLn :: String -> PWS ()
writeIndentedLn str = writeIndent >> write str >> writeNewline

writePreamble :: PWS ()
writePreamble = do
    let src = BS8.unpack $(embedFile "snippets/js/preamble.js")
    write src
    writeNewline

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
            writeIndentedLn $ "function " ++ funcName ++ "(context) {"
            pushIndent
        otherwise -> return ()
    writeIndentedLn "(function(){"
    pushIndent
    writePreamble


writeFooter :: PWS ()
writeFooter = do
    wrapMode <- woWrapMode `liftM` ask

    popIndent
    writeIndentedLn "}).apply(context);"

    case wrapMode of
        WrapFunction -> do
            popIndent
            writeIndentedLn "}"
        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 "));"
            writeNewline
        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 -> do
            -- ast <- gets jwsAST
            -- let body = fromMaybe NullStatement $ lookup identifier $ astDefs ast
            -- writeStatement body
            writeIndentedLn $ "_macro_" ++ identifier ++ ".apply(this);"
        SourcePositionStatement fn ln -> do
            writeIndent
            write "/* "
            write fn
            write ":"
            write $ show ln
            write " */"
            writeNewline

writeIf :: Statement -> PWS ()
writeIf (IfStatement cond true false) = do
    writeIndent
    write "if ("
    writeExpression cond
    write ") {"
    writeNewline
    withIndent $ writeStatement true
    writeIndentedLn "}"
    if false == NullStatement
        then return ()
        else do
                writeIndentedLn "else {"
                withIndent $ writeStatement false
                writeIndentedLn "}"

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
    writeIndentedLn "(function(){"
    withIndent $ do
        writeIndent
        write "var _iteree = "
        writeExpression expr
        write ";"
        writeNewline
        writeIndentedLn "if (Array.isArray(_iteree)) {"
        withIndent $ do
            writeIndentedLn "for (var _index = 0; _index < _iteree.length; ++_index) {"
            writeInner
            writeIndentedLn "}"
        writeIndentedLn "}"
        writeIndentedLn "else {"
        withIndent $ do
            writeIndentedLn "for (var _index in _iteree) {"
            writeInner
            writeIndentedLn "}"
        writeIndentedLn "}"
    writeIndentedLn "}).apply(this);"

writeWithScope :: String -> (PWS ()) -> (PWS ()) -> PWS ()
writeWithScope identifier rhs inner = do
    if identifier == "."
        then do
            writeIndent
            write "_newscope = "
            rhs
            write ";"
            writeNewline
        else do
            writeIndent
            write "_newscope = {'"
            write identifier
            write "':"
            rhs
            write "};"
            writeNewline
    writeIndentedLn "_scope = _merge(this, _newscope);"
    writeIndentedLn "(function(){"
    withIndent $ do
        writeIndentedLn "var _scope = null; var _newscope = null;"
        inner
    writeIndentedLn "}).apply(_scope);"

writeSwitch :: Expression -> [(Expression, Statement)] -> PWS ()
writeSwitch masterExpr branches = do
    writeIndent
    write "switch ("
    writeExpression masterExpr
    write ") {"
    writeNewline
    withIndent $
        mapM writeSwitchBranch branches
    writeIndentedLn "}"
    where
        writeSwitchBranch :: (Expression, Statement) -> PWS ()
        writeSwitchBranch (expr, stmt) = do
            writeIndent
            write "case "
            writeExpression expr
            write ":"
            writeNewline
            withIndent $ do
                writeStatement stmt
                writeIndentedLn "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 -> do
            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 "))"

        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 o left right -> do
            let opstr = case o of
                            OpPlus -> "+"
                            OpMinus -> "-"
                            OpMul -> "*"
                            OpDiv -> "/"
                            OpMod -> "%"
                            OpEquals -> "==="
                            OpLooseEquals -> "=="
                            OpNotEquals -> "!=="
                            OpLooseNotEquals -> "!="
                            OpGreater -> ">"
                            OpLess -> "<"
                            OpNotGreater -> "<="
                            OpNotLess -> ">="
                            OpBooleanAnd -> "&&"
                            OpBooleanOr -> "||"
            if o `elem` numericOps
                then write "(Number("
                else write "(("
            writeExpression left
            write ")"
            write opstr
            if o `elem` numericOps
                then write "Number("
                else write "("
            writeExpression right
            write "))"
            where numericOps = [
                     OpPlus,
                     OpMinus,
                     OpMul,
                     OpDiv,
                     OpMod,
                     OpGreater,
                     OpLess,
                     OpNotGreater,
                     OpNotLess ]

        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 = concat . map escapeChar