module Text.HPaco.Readers.Paco.Statements
    ( statements, statement
    )
where

import Control.Monad
import Control.Monad.IO.Class
import System.IO.Strict
import System.FilePath
import System.IO (withFile, IOMode (ReadMode))
import Text.HPaco.Readers.Paco.Basics
import Text.HPaco.Readers.Paco.ParserInternals
import Text.HPaco.Readers.Paco.Expressions
import Text.HPaco.AST.AST
import Text.HPaco.AST.Statement
import Text.HPaco.AST.Expression
import Text.Parsec.Pos (SourcePos, sourceLine, sourceColumn, sourceName)

statements :: Parser [Statement]
statements =
    concat `liftM` many statementPair
    where statementPair = do
                l <- lineNumberStatement
                s <- statement
                return [l,s]

statement :: Parser Statement
statement = try ifStatement 
          <|> try withStatement
          <|> try switchStatement
          <|> try forStatement
          <|> try defStatement
          <|> try callStatement
          <|> try commentStatement
          <|> try includeStatement
          <|> try interpolateStatement
          <|> try newlineStatement
          <|> try escapeSequenceStatement
          <|> try rawTextStatement

lineNumberStatement :: Parser Statement
lineNumberStatement = do
    pos <- getPosition
    return $ SourcePositionStatement (sourceName pos) (sourceLine pos)

commentStatement :: Parser Statement
commentStatement = do
    string "{%--"
    manyTill
        (try (discard commentStatement) <|> discard anyChar)
        (try $ string "--%}")
    return NullStatement

includeStatement :: Parser Statement
includeStatement = do
    (basename, innerContext) <- complexTag "include" inner
    dirname <- psBasePath `liftM` getState
    extension <- psIncludeExtension `liftM` getState
    reader <- psHandleInclude `liftM` getState
    let fn0 = joinPath [ dirname, basename ]
    let fn = maybe fn0 (fillExtension fn0) extension
    src <- liftIO $ withFile fn ReadMode hGetContents
    subAst <- liftIO $ reader fn src
    let stmt = astRootStatement subAst
    modifyState (\s -> s { psDeps = fn:psDeps s ++ astDeps subAst })
    return $ maybe stmt (\(ident, expr) -> LetStatement ident expr stmt) innerContext
    where
        path :: Parser String
        path = many1 $ try $ noneOf " \t\r\n%"

        inner :: Parser (String, Maybe (String, Expression))
        inner = do
            basename <- path
            ss_
            innerContext <- optionMaybe $ try (ss_ >> string "with" >> ss_ >> letPair)
            return (basename, innerContext)

interpolateStatement :: Parser Statement
interpolateStatement = do
    char '{'
    em <- option (Just EscapeHTML) escapeMode
    ss_
    expr <- expression
    ss_
    char '}'
    let expr' = maybe
                    expr
                    (\m -> EscapeExpression m expr)
                    em
    return $ PrintStatement $ expr'

rawTextStatement :: Parser Statement
rawTextStatement = do
    chrs <- many1 $ noneOf "{\\\n"
    return $ PrintStatement $ StringLiteral chrs

newlineStatement :: Parser Statement
newlineStatement = do
    char '\n'
    ss_
    return $ PrintStatement $ StringLiteral "\n"

escapeSequenceStatement :: Parser Statement
escapeSequenceStatement = do
    char '\\'
    c <- anyChar
    case c of
        '\n' -> return NullStatement
        otherwise -> return $ PrintStatement $ StringLiteral [ '\\', c ]

ifStatement :: Parser Statement
ifStatement = do
        cond <- complexTag "if" expression
        trueStmts <- statements
        let trueBranch = StatementSequence trueStmts
        falseBranch <- option NullStatement $ try elseBranch
        simpleTag "endif"
        return $ IfStatement cond trueBranch falseBranch
        where elseBranch =
                do
                    simpleTag "else"
                    stmts <- statements
                    return . StatementSequence $ stmts

withStatement :: Parser Statement
withStatement = withOrForStatement (\(n,v) -> LetStatement n v) "with" letPairs

forStatement :: Parser Statement
forStatement = withOrForStatement (\(k, n, v) -> ForStatement k n v) "for" forDefs

withOrForStatement :: (a -> Statement -> Statement) -> String -> Parser [a] -> Parser Statement
withOrForStatement ctor keyword innerP = do
    lets <- complexTag keyword innerP
    stmts <- statements
    simpleTag $ "end" ++ keyword
    return $ foldr ctor (StatementSequence stmts) lets

letPairs :: Parser [(String, Expression)]
letPairs = manySepBy (try letPair) (try $ char ',')

forDefs :: Parser [(Maybe String, String, Expression)]
forDefs = manySepBy (try forDef) (try $ char ',')

letPair :: Parser (String, Expression)
letPair = do
    ss_
    expr <- expression
    ss_
    ident <- option "." $ try $ char ':' >> ss_ >> identifier
    ss_
    return (ident, expr)

forDef :: Parser (Maybe String, String, Expression)
forDef = try forTriple <|> forPair

forPair :: Parser (Maybe String, String, Expression)
forPair = do
    (ident, expr) <- letPair
    return (Nothing, ident, expr)

forTriple :: Parser (Maybe String, String, Expression)
forTriple = do
    ss_
    expr <- expression
    ss_
    char ':'
    ss_
    key <- identifier
    ss_
    doFlip <- option False $ flip
    ss_
    val <- identifier
    ss_
    if doFlip
        then return (Just val, key, expr)
        else return (Just key, val, expr)
    where
        flip = try fwdArr <|> try revArr
        fwdArr = string "->" >> return False
        revArr = string "<-" >> return True

switchStatement :: Parser Statement
switchStatement = do
    masterExpr <- complexTag "switch" expression
    ss_
    branches <- many switchBranch
    ss_
    simpleTag "endswitch"
    return $ SwitchStatement masterExpr branches
    where switchBranch = do
            ss_
            switchExpr <- complexTag "case" expression
            stmts <- statements
            simpleTag "endcase"
            ss_
            return (switchExpr, StatementSequence stmts)

defStatement :: Parser Statement
defStatement = do
    name <- complexTag "def" identifier
    body <- statements
    simpleTag "enddef"
    addDef name $ StatementSequence body
    return NullStatement

callStatement :: Parser Statement
callStatement = do
    name <- complexTag "call" identifier
    optional $ char '\n'
    return $ CallStatement name

simpleTag tag = complexTag tag (return ())
complexTag tag inner = 
    let go = do
            string "{%" 
            ss_ 
            string tag 
            ss_ 
            i <- inner
            ss_
            string "%}" 
            return i
        standalone = do
            assertStartOfLine
            ss_
            v <- go
            char '\n'
            return v

    in try standalone <|> try go

escapeMode :: Parser (Maybe EscapeMode)
escapeMode = (char '!' >> return Nothing)
          <|> (char '@' >> return (Just EscapeURL))