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
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
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