{-#LANGUAGE TupleSections #-}
module Text.HPaco.Readers.Capo.Statements
( statements, statement )
where

import Control.Monad
import Control.Monad.IO.Class
import Control.Applicative ( (<$>), (<*>) )
import Text.HPaco.Reader
import Text.HPaco.Readers.Paco.Basics
import Text.HPaco.Readers.Paco.ParserInternals
import Text.HPaco.Readers.Common hiding (Parser)
import Text.HPaco.Readers.Paco.Expressions
import Text.HPaco.Readers.Paco.Include
import Text.HPaco.AST.AST
import Text.HPaco.AST.Statement
import Text.HPaco.AST.Expression
import Control.Exception (throw)
import System.IO (withFile, IOMode (ReadMode))
import System.IO.Strict
import System.FilePath

statements :: Parser [Statement]
statements = do
    ss_
    stmts <- manySepBy statement ss_
    ss_
    return stmts

statement =
    try defStatement
    <|> try callStatement
    <|> try letStatement
    <|> standaloneStatement

letStatement = do
    (ident, expr) <- withSemicolon assignment
    ss_
    body <- option [NullStatement] statements
    -- TODO: warn if null statement
    return $ LetStatement ident expr $ StatementSequence body

defStatement = do
    keyword "def"
    ss_
    defName <- identifier
    ss_
    char '='
    ss_
    body <- standaloneStatement
    addDef defName body
    return NullStatement

callStatement = do
    CallStatement <$> withSemicolon identifier

assignment :: Parser (String, Expression)
assignment =
    (,) <$> identifier <*> (betweenSpaces (char '=') >> expression)

betweenSpaces a = do
    ss_
    v <- a
    ss_
    return v

-- A standalone statement can appear at any level of the parse tree; it does
-- not need to be explicitly enclosed in a block.
standaloneStatement =
    try lineComment
    <|> try blockComment
    <|> try printStatement
    <|> try printHtmlStatement
    <|> try printUrlStatement
    <|> try ifStatement
    <|> try withStatement
    <|> try forStatement
    <|> try switchStatement
    <|> try includeStatement
    <|> try block
    <?> "Statement"

lineComment = do
    string "//"
    many (noneOf ['\n'])
    char '\n'
    return NullStatement

blockComment = do
    string "/*"
    manyTill (try (discard blockComment) <|> discard anyChar) (try $ string "*/")
    return NullStatement

printStatement = printStatementBase "print" id
printHtmlStatement = printStatementBase "printHtml" (EscapeExpression EscapeHTML)
printUrlStatement = printStatementBase "printUrl" (EscapeExpression EscapeURL)

printStatementBase kw enc =
    withSemicolon $
        StatementSequence . map (PrintStatement . enc) <$>
            (ss_ >> keyword kw >> ss_ >> (parenthesized  $ manySepBy expression (betweenSpaces $ char ',')))

includeStatement :: Parser Statement
includeStatement = do
    ss_
    keyword "include"
    ss_
    filename <- (parenthesized . betweenSpaces) anyQuotedString
    ss_
    char ';'
    ss_
    performInclude filename Nothing

ifStatement = do
    ss_
    keyword "if"
    cond <- parenthesized expression
    true <- standaloneStatement
    false <- option NullStatement $ try falseBranch
    return $ IfStatement cond true false
    where falseBranch = do
            ss_
            keyword "else"
            assertEndOfWord
            ss_
            standaloneStatement

switchStatement = do
    ss_
    keyword "switch"
    SwitchStatement <$> parenthesized expression <*> switchBody
    where
        switchBody = braced $ many switchCase
        switchCase = do
            ss_
            keyword "case"
            ss_
            expr <- expression
            ss_
            char ':'
            body <- StatementSequence <$> statements
            ss_
            optional $ withSemicolon $ keyword "break"
            ss_
            return (expr, body)
    
withStatement =
    withOrFor "with" letAssignment foldLetStatement
    where
        letAssignment = try assignment <|> try ( (".",) <$> expression)
        foldLetStatement :: [(String, Expression)] -> Statement -> Statement
        foldLetStatement assignments body =
            foldr combineAssignment body assignments
            where combineAssignment (ident, expr) stmt = LetStatement ident expr stmt

forStatement =
    withOrFor "for" forAssignment foldForStatement
    where
        forAssignment = try complexForAssignment <|> try ( (Nothing, ".",) <$> expression )
        complexForAssignment = do
            expr <- expression
            ss_
            discard (keyword "as") <|> discard (string ":")
            ss_
            ident1 <- identifier
            ident2 <- optionMaybe $ do
                            ss_
                            string "=>" <|> string "->"
                            ss_
                            identifier
            case ident2 of
                Nothing -> return (Nothing, ident1, expr)
                Just valIdent -> return (Just ident1, valIdent, expr)
        foldForStatement :: [(Maybe String, String, Expression)] -> Statement -> Statement
        foldForStatement assignments body =
            foldr combineAssignment body assignments
            where combineAssignment (keyIdent, valueIdent, expr) stmt = ForStatement keyIdent valueIdent expr stmt

withOrFor :: String -> Parser a -> ([a] -> Statement -> Statement) -> Parser Statement
withOrFor kw a combine = do
    keyword kw
    assignments <- parenthesized $ manySepBy a (ss_ >> char ',' >> ss_)
    body <- standaloneStatement
    return $ combine assignments body

block = StatementSequence <$> braced statements

withSemicolon :: Parser a -> Parser a
withSemicolon p = do
    v <- p 
    ss_ 
    char ';' 
    return v

parenthesized = bracedWith '(' ')'
braced = bracedWith '{' '}'

bracedWith :: Char -> Char -> Parser a -> Parser a
bracedWith l r p = do
    ss_
    char l
    ss_
    val <- p
    ss_
    char r
    ss_
    return val