{-#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 = AST
                     { astRootStatement = NullStatement
                     , astDefs = []
                     }
        }

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
    writeStatement $ astRootStatement ast
    writeFooter

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 identifier expr stmt -> writeFor 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

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 = do
    writeWithScope identifier (writeExpression expr) stmt


writeFor :: String -> Expression -> Statement -> PWS ()
writeFor identifier expr stmt = do
    writeIndent
    write "_iteree = "
    writeExpression expr
    write ";"
    writeNewline
    writeIndentedLn "for (_index in _iteree) {"
    withIndent $ writeWithScope identifier (write "_iteree[_index]") stmt
    writeIndentedLn "}"

writeWithScope :: String -> (PWS ()) -> Statement -> PWS ()
writeWithScope identifier rhs stmt = do
    if identifier == "."
        then do
            writeIndent
            write "_scope = "
            rhs
            write ";"
            writeNewline
        else do
            writeIndent
            write "_scope = {'"
            write identifier
            write "':"
            rhs
            write "};"
            writeNewline
    writeIndentedLn "_scope.prototype = this;"
    writeIndentedLn "(function(){"
    withIndent $ writeStatement stmt
    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 $ singleQuoteString 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 "))"


singleQuoteString :: String -> String
singleQuoteString str =
    "'" ++ escape str ++ "'"
    where
        escapeChar '\'' = "\\'"
        escapeChar '\n' = "' + \"\\n\" + '"
        escapeChar '\t' = "' + \"\\t\" + '"
        escapeChar '\r' = "' + \"\\r\" + '"
        escapeChar x = [x]
        escape = concat . map escapeChar