{-# LANGUAGE OverloadedStrings, Trustworthy #-}
module Web.Simple.Templates.Parser
( reservedWords
, pAST
, pRaw
, pEscapedDollar
, pEscapedExpr, pExpr
, pIf, pFor
, pFunc, pValue, pVar
, pIndex, pIdentifier, pLiteral, pNull, pBoolean, pString, pNumber, pArray
, module Web.Simple.Templates.Types
) where
import Control.Applicative
import Control.Monad
import Data.Char (isAlphaNum)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Aeson
import qualified Data.Attoparsec.Text as A
import Web.Simple.Templates.Types
reservedWords :: [Text]
reservedWords :: [Text]
reservedWords =
[ Text
"for", Text
"endfor", Text
"sep"
, Text
"if", Text
"else", Text
"endif"
, Text
"true", Text
"false"]
pAST :: A.Parser AST
pAST :: Parser AST
pAST = [AST] -> AST
ASTRoot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser AST
pRaw forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pEscapedExpr)
pRaw :: A.Parser AST
pRaw :: Parser AST
pRaw = Value -> AST
ASTLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 forall a b. (a -> b) -> a -> b
$
(Char -> Bool) -> Parser Text Text
A.takeWhile1 (forall a. Eq a => a -> a -> Bool
/= Char
'$') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Text
pEscapedDollar)
pEscapedDollar :: A.Parser Text
pEscapedDollar :: Parser Text Text
pEscapedDollar = Text -> Parser Text Text
A.string Text
"$$" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return Text
"$"
pEscapedExpr :: A.Parser AST
pEscapedExpr :: Parser AST
pEscapedExpr = do
Char -> Parser Char
A.char Char
'$' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser AST
pExpr forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'$'
pExpr :: A.Parser AST
pExpr :: Parser AST
pExpr = Parser AST
pFor forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pIf forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pValue
pIf :: A.Parser AST
pIf :: Parser AST
pIf = do
Text -> Parser Text Text
A.string Text
"if"
Char
brace <- (Char -> Bool) -> Parser Char
A.satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'(')
AST
cond <- Parser AST
pValue
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
brace forall a. Eq a => a -> a -> Bool
== Char
'(') forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
A.char Char
')' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Char -> Parser Char
A.char Char
'$'
AST
trueBranch <- Parser AST
pAST
Maybe AST
falseBranch <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do
Text -> Parser Text Text
A.string Text
"$else$"
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AST
pAST
Text -> Parser Text Text
A.string Text
"$endif"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AST -> AST -> Maybe AST -> AST
ASTIf AST
cond AST
trueBranch Maybe AST
falseBranch
pFor :: A.Parser AST
pFor :: Parser AST
pFor = do
Text -> Parser Text Text
A.string Text
"for"
Char
brace <- (Char -> Bool) -> Parser Char
A.satisfy (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'(')
Maybe Text
mkeyName <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ Parser Text Text
pIdentifier forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
','
Text
valName <- Parser Text Text
pIdentifier
Text -> Parser Text Text
A.string Text
" in "
AST
lst <- Parser AST
pValue
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
brace forall a. Eq a => a -> a -> Bool
== Char
'(') forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
A.char Char
')' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Char -> Parser Char
A.char Char
'$'
AST
loop <- Parser AST
pAST
Maybe AST
sep <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do
Text -> Parser Text Text
A.string Text
"$sep$"
forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AST
pAST
Text -> Parser Text Text
A.string Text
"$endfor"
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> AST -> AST -> Maybe AST -> AST
ASTFor Maybe Text
mkeyName Text
valName AST
lst AST
loop Maybe AST
sep
pValue :: A.Parser AST
pValue :: Parser AST
pValue = Parser AST
pFunc forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pIndex forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pVar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pLiteral
pFunc :: A.Parser AST
pFunc :: Parser AST
pFunc = do
Text
funcName <- Parser Text Text
pIdentifier
Char -> Parser Char
A.char Char
'('
[AST]
args <- Parser AST
pValue forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy` (Parser Text ()
A.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
A.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
A.skipSpace)
Char -> Parser Char
A.char Char
')'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [AST] -> AST
ASTFunc Text
funcName [AST]
args
pVar :: A.Parser AST
pVar :: Parser AST
pVar = Text -> AST
ASTVar forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
pIdentifier
pIndex :: A.Parser AST
pIndex :: Parser AST
pIndex = do
Text
first <- Parser Text Text
pIdentifier forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'.'
[Text]
rst <- Parser Text Text
pIdentifier forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy` Char -> Parser Char
A.char Char
'.'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ AST -> [Text] -> AST
ASTIndex (Text -> AST
ASTVar Text
first) forall a b. (a -> b) -> a -> b
$ [Text]
rst
pIdentifier :: A.Parser Identifier
pIdentifier :: Parser Text Text
pIdentifier = Text -> Parser Text Text
A.string Text
"@" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
Text
a <- Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
A.letter
Text
rst <- (Char -> Bool) -> Parser Text Text
A.takeWhile (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-')
let ident :: Text
ident = Text
a forall a. Semigroup a => a -> a -> a
<> Text
rst
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Text
ident forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
reservedWords
forall (m :: * -> *) a. Monad m => a -> m a
return Text
ident
pLiteral :: A.Parser AST
pLiteral :: Parser AST
pLiteral = Parser AST
pArray forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser AST
pNumber forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser AST
pString forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser AST
pBoolean forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Parser AST
pNull
pNull :: A.Parser AST
pNull :: Parser AST
pNull = Text -> Parser Text Text
A.string Text
"null" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Value -> AST
ASTLiteral Value
Null)
pBoolean :: A.Parser AST
pBoolean :: Parser AST
pBoolean = Text -> Parser Text Text
A.string Text
"true" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> AST
fromLiteral Bool
True) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
Text -> Parser Text Text
A.string Text
"false" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> AST
fromLiteral Bool
False)
pString :: A.Parser AST
pString :: Parser AST
pString = Value -> AST
ASTLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(Char -> Parser Char
A.char Char
'"' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Char
escapedChar) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char Char
'"')
where escapedChar :: Parser Char
escapedChar = (Char -> Parser Char
A.char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
A.char Char
'"') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
(Char -> Bool) -> Parser Char
A.satisfy (forall a. Eq a => a -> a -> Bool
/= Char
'"')
pNumber :: A.Parser AST
pNumber :: Parser AST
pNumber = Value -> AST
ASTLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Value
Number forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Fractional a => Parser a
A.rational
pArray :: A.Parser AST
pArray :: Parser AST
pArray = do
Char -> Parser Char
A.char Char
'['
Parser Text ()
A.skipSpace
[AST]
vals <- Parser AST
pValue forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy` (Parser Text ()
A.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
A.char Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
A.skipSpace)
Parser Text ()
A.skipSpace
Char -> Parser Char
A.char Char
']'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [AST] -> AST
astListToArray [AST]
vals