{-# LANGUAGE OverloadedStrings, Trustworthy #-}

{-| Language parser -}
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

-- | Reserved words: for, endfor, sep, if, else, endif, true, false
reservedWords :: [Text]
reservedWords :: [Text]
reservedWords =
  [ Text
"for", Text
"endfor", Text
"sep"
  , Text
"if", Text
"else", Text
"endif"
  , Text
"true", Text
"false"]

-- | Parse an AST
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
'$'

-- | Anything that can be evaluated: for, if or value
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

-- | A variable, function call, literal, etc
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

-- Literals --

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