{-# 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 =
  [ "for", "endfor", "sep"
  , "if", "else", "endif"
  , "true", "false"]

-- | Parse an AST
pAST :: A.Parser AST
pAST :: Parser AST
pAST = [AST] -> AST
ASTRoot ([AST] -> AST) -> Parser Text [AST] -> Parser AST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AST -> Parser Text [AST]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser AST
pRaw Parser AST -> Parser AST -> Parser AST
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 (Value -> AST) -> ([Text] -> Value) -> [Text] -> AST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> Value) -> ([Text] -> Text) -> [Text] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> AST) -> Parser Text [Text] -> Parser AST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text -> Parser Text [Text]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
A.many1 (Parser Text Text -> Parser Text [Text])
-> Parser Text Text -> Parser Text [Text]
forall a b. (a -> b) -> a -> b
$
  (Char -> Bool) -> Parser Text Text
A.takeWhile1 (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '$') Parser Text Text -> Parser Text Text -> Parser Text Text
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 "$$" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Parser Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return "$"

pEscapedExpr :: A.Parser AST
pEscapedExpr :: Parser AST
pEscapedExpr = do
  Char -> Parser Char
A.char '$' Parser Char -> Parser AST -> Parser AST
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser AST
pExpr Parser AST -> Parser Char -> Parser AST
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char '$'

-- | Anything that can be evaluated: for, if or value
pExpr :: A.Parser AST
pExpr :: Parser AST
pExpr = Parser AST
pFor Parser AST -> Parser AST -> Parser AST
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pIf Parser AST -> Parser AST -> Parser AST
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 "if"
  Char
brace <- (Char -> Bool) -> Parser Char
A.satisfy (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(')
  AST
cond <- Parser AST
pValue
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
brace Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(') (Parser Text () -> Parser Text ())
-> Parser Text () -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
A.char ')' Parser Char -> Parser Text () -> Parser Text ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser Text ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Char -> Parser Char
A.char '$'
  AST
trueBranch <- Parser AST
pAST
  Maybe AST
falseBranch <- Maybe AST -> Parser Text (Maybe AST) -> Parser Text (Maybe AST)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Maybe AST
forall a. Maybe a
Nothing (Parser Text (Maybe AST) -> Parser Text (Maybe AST))
-> Parser Text (Maybe AST) -> Parser Text (Maybe AST)
forall a b. (a -> b) -> a -> b
$ do
    Text -> Parser Text Text
A.string "$else$"
    AST -> Maybe AST
forall a. a -> Maybe a
Just (AST -> Maybe AST) -> Parser AST -> Parser Text (Maybe AST)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AST
pAST
  Text -> Parser Text Text
A.string "$endif"
  AST -> Parser AST
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Parser AST) -> AST -> Parser AST
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 "for"
  Char
brace <- (Char -> Bool) -> Parser Char
A.satisfy (\c :: Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(')
  Maybe Text
mkeyName <- Parser Text Text -> Parser Text (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser Text Text -> Parser Text (Maybe Text))
-> Parser Text Text -> Parser Text (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Parser Text Text
pIdentifier Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char ','
  Text
valName <- Parser Text Text
pIdentifier
  Text -> Parser Text Text
A.string " in "
  AST
lst <- Parser AST
pValue
  Bool -> Parser Text () -> Parser Text ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
brace Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '(') (Parser Text () -> Parser Text ())
-> Parser Text () -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
A.char ')' Parser Char -> Parser Text () -> Parser Text ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> Parser Text ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Char -> Parser Char
A.char '$'
  AST
loop <- Parser AST
pAST
  Maybe AST
sep <- Maybe AST -> Parser Text (Maybe AST) -> Parser Text (Maybe AST)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Maybe AST
forall a. Maybe a
Nothing (Parser Text (Maybe AST) -> Parser Text (Maybe AST))
-> Parser Text (Maybe AST) -> Parser Text (Maybe AST)
forall a b. (a -> b) -> a -> b
$ do
    Text -> Parser Text Text
A.string "$sep$"
    AST -> Maybe AST
forall a. a -> Maybe a
Just (AST -> Maybe AST) -> Parser AST -> Parser Text (Maybe AST)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser AST
pAST
  Text -> Parser Text Text
A.string "$endfor"
  AST -> Parser AST
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Parser AST) -> AST -> Parser AST
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 Parser AST -> Parser AST -> Parser AST
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pIndex Parser AST -> Parser AST -> Parser AST
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser AST
pVar Parser AST -> Parser AST -> Parser AST
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 '('
  [AST]
args <- Parser AST
pValue Parser AST -> Parser Text () -> Parser Text [AST]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy` (Parser Text ()
A.skipSpace Parser Text () -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
A.char ',' Parser Char -> Parser Text () -> Parser Text ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text ()
A.skipSpace)
  Char -> Parser Char
A.char ')'
  AST -> Parser AST
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Parser AST) -> AST -> Parser AST
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 (Text -> AST) -> Parser Text Text -> Parser AST
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 Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char '.'
  [Text]
rst <- Parser Text Text
pIdentifier Parser Text Text -> Parser Char -> Parser Text [Text]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy` Char -> Parser Char
A.char '.'
  AST -> Parser AST
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Parser AST) -> AST -> Parser AST
forall a b. (a -> b) -> a -> b
$ AST -> [Text] -> AST
ASTIndex (Text -> AST
ASTVar Text
first) ([Text] -> AST) -> [Text] -> AST
forall a b. (a -> b) -> a -> b
$ [Text]
rst

pIdentifier :: A.Parser Identifier
pIdentifier :: Parser Text Text
pIdentifier = Text -> Parser Text Text
A.string "@" Parser Text Text -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
  Text
a <- Char -> Text
T.singleton (Char -> Text) -> Parser Char -> Parser Text Text
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 (\c :: Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== '-')
  let ident :: Text
ident = Text
a Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
rst
  Bool -> Parser Text ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Parser Text ()) -> Bool -> Parser Text ()
forall a b. (a -> b) -> a -> b
$ Text
ident Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Text]
reservedWords
  Text -> Parser Text Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
ident

-- Literals --

pLiteral :: A.Parser AST
pLiteral :: Parser AST
pLiteral = Parser AST
pArray Parser AST -> Parser AST -> Parser AST
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
           Parser AST
pNumber Parser AST -> Parser AST -> Parser AST
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
           Parser AST
pString Parser AST -> Parser AST -> Parser AST
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
           Parser AST
pBoolean Parser AST -> Parser AST -> Parser AST
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 "null" Parser Text Text -> Parser AST -> Parser AST
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AST -> Parser AST
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Parser AST) -> AST -> Parser AST
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 "true" Parser Text Text -> Parser AST -> Parser AST
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AST -> Parser AST
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Parser AST) -> AST -> Parser AST
forall a b. (a -> b) -> a -> b
$ Bool -> AST
forall a. ToJSON a => a -> AST
fromLiteral Bool
True) Parser AST -> Parser AST -> Parser AST
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
           Text -> Parser Text Text
A.string "false" Parser Text Text -> Parser AST -> Parser AST
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (AST -> Parser AST
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Parser AST) -> AST -> Parser AST
forall a b. (a -> b) -> a -> b
$ Bool -> AST
forall a. ToJSON a => a -> AST
fromLiteral Bool
False)

pString :: A.Parser AST
pString :: Parser AST
pString = Value -> AST
ASTLiteral (Value -> AST) -> (Text -> Value) -> Text -> AST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Value
String (Text -> AST) -> Parser Text Text -> Parser AST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  (Char -> Parser Char
A.char '"' Parser Char -> Parser Text Text -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (String -> Text
T.pack (String -> Text) -> Parser Text String -> Parser Text Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser Char
escapedChar) Parser Text Text -> Parser Char -> Parser Text Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
A.char '"')
  where escapedChar :: Parser Char
escapedChar = (Char -> Parser Char
A.char '\\' Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
A.char '"') Parser Char -> Parser Char -> Parser Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                      (Char -> Bool) -> Parser Char
A.satisfy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '"')

pNumber :: A.Parser AST
pNumber :: Parser AST
pNumber = Value -> AST
ASTLiteral (Value -> AST) -> (Scientific -> Value) -> Scientific -> AST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Value
Number (Scientific -> AST) -> Parser Text Scientific -> Parser AST
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Scientific
forall a. Fractional a => Parser a
A.rational

pArray :: A.Parser AST
pArray :: Parser AST
pArray = do
  Char -> Parser Char
A.char '['
  Parser Text ()
A.skipSpace
  [AST]
vals <- Parser AST
pValue Parser AST -> Parser Text () -> Parser Text [AST]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`A.sepBy` (Parser Text ()
A.skipSpace Parser Text () -> Parser Char -> Parser Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Char
A.char ',' Parser Char -> Parser Text () -> Parser Text ()
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 ']'
  AST -> Parser AST
forall (m :: * -> *) a. Monad m => a -> m a
return (AST -> Parser AST) -> AST -> Parser AST
forall a b. (a -> b) -> a -> b
$ [AST] -> AST
astListToArray [AST]
vals