{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module Text.HSmarty.Parser.Smarty where

import Text.HSmarty.Parser.Util
import Text.HSmarty.Types

import Control.Applicative
import Data.Attoparsec.Text
import Data.Char

import qualified Data.Aeson as A
import qualified Data.Attoparsec.Expr as E
import qualified Data.Text as T

parseSmarty :: MonadFail m => FilePath -> T.Text -> m Smarty
parseSmarty :: FilePath -> Text -> m Smarty
parseSmarty FilePath
fp Text
t =
    (FilePath -> m Smarty)
-> ([SmartyStmt] -> m Smarty)
-> Either FilePath [SmartyStmt]
-> m Smarty
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> m Smarty
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail [SmartyStmt] -> m Smarty
forall (m :: * -> *). Monad m => [SmartyStmt] -> m Smarty
mk (Either FilePath [SmartyStmt] -> m Smarty)
-> Either FilePath [SmartyStmt] -> m Smarty
forall a b. (a -> b) -> a -> b
$ Parser [SmartyStmt] -> Text -> Either FilePath [SmartyStmt]
forall a. Parser a -> Text -> Either FilePath a
parseOnly Parser [SmartyStmt]
pRoot Text
t
    where
      mk :: [SmartyStmt] -> m Smarty
mk [SmartyStmt]
exprs =
          Smarty -> m Smarty
forall (m :: * -> *) a. Monad m => a -> m a
return (Smarty -> m Smarty) -> Smarty -> m Smarty
forall a b. (a -> b) -> a -> b
$ FilePath -> [SmartyStmt] -> Smarty
Smarty FilePath
fp [SmartyStmt]
exprs

pRoot :: Parser [SmartyStmt]
pRoot :: Parser [SmartyStmt]
pRoot =
    Parser [SmartyStmt] -> Parser [SmartyStmt]
forall c. Parser c -> Parser c
stripSpace (Parser Text SmartyStmt -> Parser [SmartyStmt]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text SmartyStmt
pStmt) Parser [SmartyStmt] -> Parser Text () -> Parser [SmartyStmt]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
forall t. Chunk t => Parser t ()
endOfInput

pStmt :: Parser SmartyStmt
pStmt :: Parser Text SmartyStmt
pStmt =
    Text -> SmartyStmt
SmartyComment (Text -> SmartyStmt) -> Parser Text Text -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pComment Parser Text SmartyStmt
-> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Text -> SmartyStmt
SmartyText (Text -> SmartyStmt) -> Parser Text Text -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pLiteral Parser Text SmartyStmt
-> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    If -> SmartyStmt
SmartyIf (If -> SmartyStmt) -> Parser Text If -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text If
pIf Parser Text SmartyStmt
-> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Foreach -> SmartyStmt
SmartyForeach (Foreach -> SmartyStmt)
-> Parser Text Foreach -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Foreach
pForeach Parser Text SmartyStmt
-> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Capture -> SmartyStmt
SmartyCapture (Capture -> SmartyStmt)
-> Parser Text Capture -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Capture
pCapture Parser Text SmartyStmt
-> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Scope -> SmartyStmt
SmartyScope (Scope -> SmartyStmt)
-> Parser Text Scope -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Scope
pScope Parser Text SmartyStmt
-> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    FunctionDef -> SmartyStmt
SmartyFun (FunctionDef -> SmartyStmt)
-> Parser Text FunctionDef -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text FunctionDef
pFunDef Parser Text SmartyStmt
-> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Parser Char
-> Parser Char -> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall l r a. Parser l -> Parser r -> Parser a -> Parser a
braced (Char -> Parser Char
char Char
'{') (Char -> Parser Char
char Char
'}') (Expr -> [Text] -> SmartyStmt
SmartyPrint (Expr -> [Text] -> SmartyStmt)
-> Parser Text Expr -> Parser Text ([Text] -> SmartyStmt)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Expr
pExpr Parser Text ([Text] -> SmartyStmt)
-> Parser Text [Text] -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text Text
pPrintDirective) Parser Text SmartyStmt
-> Parser Text SmartyStmt -> Parser Text SmartyStmt
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Text -> SmartyStmt
SmartyText (Text -> SmartyStmt) -> Parser Text Text -> Parser Text SmartyStmt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Text Text
takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'{')

pPrintDirective :: Parser PrintDirective
pPrintDirective :: Parser Text Text
pPrintDirective =
    Char -> Parser Char
char Char
'|' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName

pExpr :: Parser Expr
pExpr :: Parser Text Expr
pExpr =
    [[Operator Text Expr]] -> Parser Text Expr -> Parser Text Expr
forall t b.
Monoid t =>
[[Operator t b]] -> Parser t b -> Parser t b
E.buildExpressionParser [[Operator Text Expr]]
opTable Parser Text Expr
pValExpr

pValExpr :: Parser Expr
pValExpr :: Parser Text Expr
pValExpr =
    Parser Char -> Parser Char -> Parser Text Expr -> Parser Text Expr
forall l r a. Parser l -> Parser r -> Parser a -> Parser a
braced (Char -> Parser Char
char Char
'(') (Char -> Parser Char
char Char
')') Parser Text Expr
pExpr Parser Text Expr -> Parser Text Expr -> Parser Text Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Variable -> Expr
ExprVar (Variable -> Expr) -> Parser Text Variable -> Parser Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Variable
pVar Parser Text Expr -> Parser Text Expr -> Parser Text Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Value -> Expr
ExprLit (Value -> Expr) -> Parser Text Value -> Parser Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Value
pLit Parser Text Expr -> Parser Text Expr -> Parser Text Expr
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    FunctionCall -> Expr
ExprFun (FunctionCall -> Expr)
-> Parser Text FunctionCall -> Parser Text Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text FunctionCall
pFunCall

pLit :: Parser A.Value
pLit :: Parser Text Value
pLit =
    Text -> Value
A.String (Text -> Value) -> Parser Text Text -> Parser Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
stringP Parser Text Value -> Parser Text Value -> Parser Text Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Bool -> Value
A.Bool (Bool -> Value) -> Parser Text Bool -> Parser Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Bool
boolP Parser Text Value -> Parser Text Value -> Parser Text Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    Scientific -> Value
A.Number (Scientific -> Value)
-> Parser Text Scientific -> Parser Text Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Scientific
scientific

pVar :: Parser Variable
pVar :: Parser Text Variable
pVar =
    Text -> [Text] -> Maybe Expr -> Maybe Text -> Variable
Variable (Text -> [Text] -> Maybe Expr -> Maybe Text -> Variable)
-> Parser Text Text
-> Parser Text ([Text] -> Maybe Expr -> Maybe Text -> Variable)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Parser Char
char Char
'$' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName) Parser Text ([Text] -> Maybe Expr -> Maybe Text -> Variable)
-> Parser Text [Text]
-> Parser Text (Maybe Expr -> Maybe Text -> Variable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text Text
pVarPath Parser Text (Maybe Expr -> Maybe Text -> Variable)
-> Parser Text (Maybe Expr) -> Parser Text (Maybe Text -> Variable)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Expr -> Parser Text (Maybe Expr)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text Expr
pVarIndex Parser Text (Maybe Text -> Variable)
-> Parser Text (Maybe Text) -> Parser Text Variable
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text Text
pVarProp
    where
      pVarProp :: Parser Text Text
pVarProp =
          Char -> Parser Char
char Char
'@' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName
      pVarIndex :: Parser Text Expr
pVarIndex =
          Parser Char -> Parser Char -> Parser Text Expr -> Parser Text Expr
forall l r a. Parser l -> Parser r -> Parser a -> Parser a
braced (Char -> Parser Char
char Char
'[') (Char -> Parser Char
char Char
']') Parser Text Expr
pExpr
      pVarPath :: Parser Text Text
pVarPath =
          Char -> Parser Char
char Char
'.' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName

pName :: Parser T.Text
pName :: Parser Text Text
pName =
    (Char -> Bool) -> (Char -> Bool) -> Parser Text Text
identP (\Char
c -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')

pLiteral :: Parser T.Text
pLiteral :: Parser Text Text
pLiteral =
    (Text -> Parser Text Text
pOpen Text
"literal") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (FilePath -> Text
T.pack (FilePath -> Text) -> Parser Text FilePath -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser Text Text -> Parser Text FilePath
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text Text
pClose Text
"literal"))

pComment :: Parser T.Text
pComment :: Parser Text Text
pComment =
    (Text -> Parser Text Text
string Text
"{*") Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (FilePath -> Text
T.pack (FilePath -> Text) -> Parser Text FilePath -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser Text Text -> Parser Text FilePath
forall (f :: * -> *) a b. Alternative f => f a -> f b -> f [a]
manyTill Parser Char
anyChar (Text -> Parser Text Text
string Text
"*}"))

pFunCall :: Parser FunctionCall
pFunCall :: Parser Text FunctionCall
pFunCall =
    Text -> [(Text, Expr)] -> FunctionCall
FunctionCall (Text -> [(Text, Expr)] -> FunctionCall)
-> Parser Text Text -> Parser Text ([(Text, Expr)] -> FunctionCall)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pName Parser Text ([(Text, Expr)] -> FunctionCall)
-> Parser Text [(Text, Expr)] -> Parser Text FunctionCall
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text (Text, Expr) -> Parser Text [(Text, Expr)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Text (Text, Expr)
pArg
    where
      pArg :: Parser Text (Text, Expr)
pArg =
          (,) (Text -> Expr -> (Text, Expr))
-> Parser Text Text -> Parser Text (Expr -> (Text, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text ()
space_ Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Char -> Parser Char
forall c. Parser c -> Parser c
stripSpace (Parser Char -> Parser Char) -> Parser Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
'='))
              Parser Text (Expr -> (Text, Expr))
-> Parser Text Expr -> Parser Text (Text, Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Expr
pExpr

pOpen :: T.Text -> Parser T.Text
pOpen :: Text -> Parser Text Text
pOpen Text
t =
    Text -> Parser Text Text
string (Text -> Parser Text Text) -> Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [ Text
"{", Text
t, Text
"}" ]

pOpenExpr :: T.Text -> Parser Expr
pOpenExpr :: Text -> Parser Text Expr
pOpenExpr Text
t =
    (Text -> Parser Text Text
string ([Text] -> Text
T.concat [ Text
"{", Text
t]) Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space_) Parser Text () -> Parser Text Expr -> Parser Text Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Expr
pExpr Parser Text Expr -> Parser Char -> Parser Text Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}'

pClose :: T.Text -> Parser T.Text
pClose :: Text -> Parser Text Text
pClose Text
t =
    Text -> Parser Text Text
string (Text -> Parser Text Text) -> Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.concat [ Text
"{/", Text
t, Text
"}" ]

pLet :: Parser Let
pLet :: Parser Let
pLet =
    Text -> Expr -> Let
Let
    (Text -> Expr -> Let)
-> Parser Text Text -> Parser Text (Expr -> Let)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text Text
string Text
"{$" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'=')
    Parser Text (Expr -> Let) -> Parser Text Expr -> Parser Let
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Expr
pExpr Parser Let -> Parser Char -> Parser Let
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}'

pScope :: Parser Scope
pScope :: Parser Text Scope
pScope =
    [SmartyStmt] -> Scope
Scope ([SmartyStmt] -> Scope) -> Parser [SmartyStmt] -> Parser Text Scope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Parser Text Text
pOpen Text
"scope" Parser Text Text -> Parser [SmartyStmt] -> Parser [SmartyStmt]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text SmartyStmt -> Parser [SmartyStmt]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text SmartyStmt
pStmt Parser [SmartyStmt] -> Parser Text Text -> Parser [SmartyStmt]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
pClose Text
"scope")

pCapture :: Parser Capture
pCapture :: Parser Text Capture
pCapture =
    Text -> Maybe Text -> [SmartyStmt] -> Capture
Capture
    (Text -> Maybe Text -> [SmartyStmt] -> Capture)
-> Parser Text Text
-> Parser Text (Maybe Text -> [SmartyStmt] -> Capture)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> Parser Text Text
string Text
"{capture name=" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
optSpace_) Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
stringP)
    Parser Text (Maybe Text -> [SmartyStmt] -> Capture)
-> Parser Text (Maybe Text)
-> Parser Text ([SmartyStmt] -> Capture)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text ()
optSpace_ Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Text Text
string Text
"assign=" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName)
    Parser Text ([SmartyStmt] -> Capture)
-> Parser [SmartyStmt] -> Parser Text Capture
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text ()
optSpace_ Parser Text () -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
char Char
'}' Parser Char -> Parser [SmartyStmt] -> Parser [SmartyStmt]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text SmartyStmt -> Parser [SmartyStmt]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text SmartyStmt
pStmt Parser [SmartyStmt] -> Parser Text Text -> Parser [SmartyStmt]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
pClose Text
"capture")

pFunDef :: Parser FunctionDef
pFunDef :: Parser Text FunctionDef
pFunDef =
    Text -> [(Text, Expr)] -> [SmartyStmt] -> FunctionDef
FunctionDef
    (Text -> [(Text, Expr)] -> [SmartyStmt] -> FunctionDef)
-> Parser Text Text
-> Parser Text ([(Text, Expr)] -> [SmartyStmt] -> FunctionDef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> Parser Text Text
string Text
"{function name=" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space_) Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
stringP)
    Parser Text ([(Text, Expr)] -> [SmartyStmt] -> FunctionDef)
-> Parser Text [(Text, Expr)]
-> Parser Text ([SmartyStmt] -> FunctionDef)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text (Text, Expr) -> Parser Text [(Text, Expr)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text (Text, Expr)
pArg Parser Text [(Text, Expr)]
-> Parser Char -> Parser Text [(Text, Expr)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}')
    Parser Text ([SmartyStmt] -> FunctionDef)
-> Parser [SmartyStmt] -> Parser Text FunctionDef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text SmartyStmt -> Parser [SmartyStmt]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text SmartyStmt
pStmt Parser [SmartyStmt] -> Parser Text Text -> Parser [SmartyStmt]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
pClose Text
"function")
    where
      pArg :: Parser Text (Text, Expr)
pArg =
          (,) (Text -> Expr -> (Text, Expr))
-> Parser Text Text -> Parser Text (Expr -> (Text, Expr))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text ()
space_ Parser Text () -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Char -> Parser Char
forall c. Parser c -> Parser c
stripSpace (Char -> Parser Char
char Char
'='))
              Parser Text (Expr -> (Text, Expr))
-> Parser Text Expr -> Parser Text (Text, Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Expr
pExpr

pIf :: Parser If
pIf :: Parser Text If
pIf =
    [(Expr, [SmartyStmt])] -> Maybe [SmartyStmt] -> If
If ([(Expr, [SmartyStmt])] -> Maybe [SmartyStmt] -> If)
-> Parser Text [(Expr, [SmartyStmt])]
-> Parser Text (Maybe [SmartyStmt] -> If)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text [(Expr, [SmartyStmt])]
pBranches Parser Text (Maybe [SmartyStmt] -> If)
-> Parser Text (Maybe [SmartyStmt]) -> Parser Text If
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [SmartyStmt] -> Parser Text (Maybe [SmartyStmt])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text Text
pOpen Text
"else" Parser Text Text -> Parser [SmartyStmt] -> Parser [SmartyStmt]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text SmartyStmt -> Parser [SmartyStmt]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text SmartyStmt
pStmt)
       Parser Text If -> Parser Text Text -> Parser Text If
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
pClose Text
"if"
    where
      pBranch :: Text -> Parser Text (Expr, [SmartyStmt])
pBranch Text
ty = (,) (Expr -> [SmartyStmt] -> (Expr, [SmartyStmt]))
-> Parser Text Expr
-> Parser Text ([SmartyStmt] -> (Expr, [SmartyStmt]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Text Expr
pOpenExpr Text
ty Parser Text ([SmartyStmt] -> (Expr, [SmartyStmt]))
-> Parser [SmartyStmt] -> Parser Text (Expr, [SmartyStmt])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text SmartyStmt -> Parser [SmartyStmt]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text SmartyStmt
pStmt
      pBranches :: Parser Text [(Expr, [SmartyStmt])]
pBranches =
          (:) ((Expr, [SmartyStmt])
 -> [(Expr, [SmartyStmt])] -> [(Expr, [SmartyStmt])])
-> Parser Text (Expr, [SmartyStmt])
-> Parser Text ([(Expr, [SmartyStmt])] -> [(Expr, [SmartyStmt])])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Parser Text (Expr, [SmartyStmt])
pBranch Text
"if" Parser Text ([(Expr, [SmartyStmt])] -> [(Expr, [SmartyStmt])])
-> Parser Text [(Expr, [SmartyStmt])]
-> Parser Text [(Expr, [SmartyStmt])]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser Text (Expr, [SmartyStmt])
-> Parser Text [(Expr, [SmartyStmt])]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser Text (Expr, [SmartyStmt])
 -> Parser Text [(Expr, [SmartyStmt])])
-> Parser Text (Expr, [SmartyStmt])
-> Parser Text [(Expr, [SmartyStmt])]
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text (Expr, [SmartyStmt])
pBranch Text
"elseif")

pForeach :: Parser Foreach
pForeach :: Parser Text Foreach
pForeach =
    Expr
-> Maybe Text
-> Text
-> [SmartyStmt]
-> Maybe [SmartyStmt]
-> Foreach
Foreach (Expr
 -> Maybe Text
 -> Text
 -> [SmartyStmt]
 -> Maybe [SmartyStmt]
 -> Foreach)
-> Parser Text Expr
-> Parser
     Text
     (Maybe Text
      -> Text -> [SmartyStmt] -> Maybe [SmartyStmt] -> Foreach)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text -> Parser Text Text
string Text
"{foreach" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space_) Parser Text () -> Parser Text Expr -> Parser Text Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Expr
pExpr Parser Text Expr -> Parser Text () -> Parser Text Expr
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text ()
space_ Parser Text () -> Parser Text Text -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Text -> Parser Text Text
string Text
"as") Parser Text () -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
space_))
            Parser
  Text
  (Maybe Text
   -> Text -> [SmartyStmt] -> Maybe [SmartyStmt] -> Foreach)
-> Parser Text (Maybe Text)
-> Parser
     Text (Text -> [SmartyStmt] -> Maybe [SmartyStmt] -> Foreach)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Char -> Parser Char
char Char
'$' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* (Parser Text Text -> Parser Text Text
forall c. Parser c -> Parser c
stripSpace (Parser Text Text -> Parser Text Text)
-> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
"=>"))
            Parser Text (Text -> [SmartyStmt] -> Maybe [SmartyStmt] -> Foreach)
-> Parser Text Text
-> Parser Text ([SmartyStmt] -> Maybe [SmartyStmt] -> Foreach)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((Parser Text Text -> Parser Text Text
forall c. Parser c -> Parser c
stripSpace (Char -> Parser Char
char Char
'$' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text Text
pName)) Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'}')
            Parser Text ([SmartyStmt] -> Maybe [SmartyStmt] -> Foreach)
-> Parser [SmartyStmt]
-> Parser Text (Maybe [SmartyStmt] -> Foreach)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Text SmartyStmt -> Parser [SmartyStmt]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text SmartyStmt
pStmt
            Parser Text (Maybe [SmartyStmt] -> Foreach)
-> Parser Text (Maybe [SmartyStmt]) -> Parser Text Foreach
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [SmartyStmt] -> Parser Text (Maybe [SmartyStmt])
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Text -> Parser Text Text
pOpen Text
"foreachelse" Parser Text Text -> Parser [SmartyStmt] -> Parser [SmartyStmt]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text SmartyStmt -> Parser [SmartyStmt]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Text SmartyStmt
pStmt)
            Parser Text Foreach -> Parser Text Text -> Parser Text Foreach
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> Parser Text Text
pClose Text
"foreach"

opTable :: [[E.Operator T.Text Expr]]
opTable :: [[Operator Text Expr]]
opTable =
    [ [ Parser Text () -> (Expr -> Expr) -> Operator Text Expr
forall b a. Parser Text b -> (a -> a) -> Operator Text a
prefix (Text -> Parser Text Text
string Text
"not" Parser Text Text -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
space_) ((Expr -> Expr) -> Operator Text Expr)
-> (Expr -> Expr) -> Operator Text Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> BinOp) -> Expr -> Expr
forall t. (t -> BinOp) -> t -> Expr
arg1 Expr -> BinOp
BinNot
      , Parser Char -> (Expr -> Expr) -> Operator Text Expr
forall b a. Parser Text b -> (a -> a) -> Operator Text a
prefix (Char -> Parser Char
char Char
'!') ((Expr -> Expr) -> Operator Text Expr)
-> (Expr -> Expr) -> Operator Text Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> BinOp) -> Expr -> Expr
forall t. (t -> BinOp) -> t -> Expr
arg1 Expr -> BinOp
BinNot
      ]
    , [ Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"*" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinMul) Assoc
E.AssocLeft
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"/" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinDiv) Assoc
E.AssocLeft
      ]
    , [ Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"+" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinPlus) Assoc
E.AssocLeft
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"-" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinMinus) Assoc
E.AssocLeft
      ]
    , [ Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"<" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinSmaller) Assoc
E.AssocNone
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
">" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinLarger) Assoc
E.AssocNone
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"<=" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinSmallerEq) Assoc
E.AssocNone
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
">=" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinLargerEq) Assoc
E.AssocNone
      ]
    , [ Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"==" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinEq) Assoc
E.AssocNone
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"!=" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 (\Expr
x Expr
y ->
                            Expr -> BinOp
BinNot (Expr -> BinOp) -> Expr -> BinOp
forall a b. (a -> b) -> a -> b
$ BinOp -> Expr
ExprBin (BinOp -> Expr) -> BinOp -> Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> BinOp
BinEq Expr
x Expr
y
                       )) Assoc
E.AssocNone
      ]
    , [ Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
wsym Text
"and" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinAnd) Assoc
E.AssocLeft
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
wsym Text
"or" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinOr) Assoc
E.AssocLeft
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"&&" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinAnd) Assoc
E.AssocLeft
      , Text -> (Expr -> Expr -> Expr) -> Assoc -> Operator Text Expr
forall a. Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
"||" ((Expr -> Expr -> BinOp) -> Expr -> Expr -> Expr
forall t t. (t -> t -> BinOp) -> t -> t -> Expr
arg2 Expr -> Expr -> BinOp
BinOr) Assoc
E.AssocLeft
      ]
    ]
    where
      arg1 :: (t -> BinOp) -> t -> Expr
arg1 t -> BinOp
fun t
x = BinOp -> Expr
ExprBin (BinOp -> Expr) -> BinOp -> Expr
forall a b. (a -> b) -> a -> b
$ t -> BinOp
fun t
x
      arg2 :: (t -> t -> BinOp) -> t -> t -> Expr
arg2 t -> t -> BinOp
fun t
x t
y = BinOp -> Expr
ExprBin (BinOp -> Expr) -> BinOp -> Expr
forall a b. (a -> b) -> a -> b
$ t -> t -> BinOp
fun t
x t
y

      binary :: Parser Text b -> (a -> a -> a) -> Assoc -> Operator Text a
binary Parser Text b
op a -> a -> a
fun Assoc
assoc =
          Parser Text (a -> a -> a) -> Assoc -> Operator Text a
forall t a. Parser t (a -> a -> a) -> Assoc -> Operator t a
E.Infix (a -> a -> a
fun (a -> a -> a) -> Parser Text b -> Parser Text (a -> a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text b
op Parser Text (a -> a -> a)
-> Parser Text () -> Parser Text (a -> a -> a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
optSpace_) Assoc
assoc
      prefix :: Parser Text b -> (a -> a) -> Operator Text a
prefix Parser Text b
op a -> a
fun =
          Parser Text (a -> a) -> Operator Text a
forall t a. Parser t (a -> a) -> Operator t a
E.Prefix (a -> a
fun (a -> a) -> Parser Text b -> Parser Text (a -> a)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser Text b
op Parser Text (a -> a) -> Parser Text () -> Parser Text (a -> a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser Text ()
optSpace_)
      sym :: Text -> (a -> a -> a) -> Assoc -> Operator Text a
sym Text
s =
          Parser Text Text -> (a -> a -> a) -> Assoc -> Operator Text a
forall b a.
Parser Text b -> (a -> a -> a) -> Assoc -> Operator Text a
binary (Parser Text Text -> Parser Text Text
forall c. Parser c -> Parser c
stripSpace (Parser Text Text -> Parser Text Text)
-> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
s)
      wsym :: Text -> (a -> a -> a) -> Assoc -> Operator Text a
wsym Text
w =
          Parser Text Text -> (a -> a -> a) -> Assoc -> Operator Text a
forall b a.
Parser Text b -> (a -> a -> a) -> Assoc -> Operator Text a
binary (Parser Text ()
-> Parser Text () -> Parser Text Text -> Parser Text Text
forall l r a. Parser l -> Parser r -> Parser a -> Parser a
between Parser Text ()
optSpace_ Parser Text ()
space_ (Parser Text Text -> Parser Text Text)
-> Parser Text Text -> Parser Text Text
forall a b. (a -> b) -> a -> b
$ Text -> Parser Text Text
string Text
w)