{-# LANGUAGE OverloadedStrings, Trustworthy #-}
module Web.Simple.Templates.Language
(
compileTemplate, evaluate, evaluateAST
, valueToText, replaceVar
, module Web.Simple.Templates.Types
) where
import qualified Data.HashMap.Strict as H
import Data.Aeson
import Data.Maybe
import Data.Scientific
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Vector as V
import qualified Data.Attoparsec.Text as A
import Web.Simple.Templates.Parser
import Web.Simple.Templates.Types
evaluateAST :: FunctionMap
-> Value
-> AST -> Value
evaluateAST :: FunctionMap -> Value -> AST -> Value
evaluateAST fm :: FunctionMap
fm global :: Value
global ast :: AST
ast =
case AST
ast of
ASTRoot asts :: [AST]
asts -> (Value -> AST -> Value) -> Value -> [AST] -> Value
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\v :: Value
v iast :: AST
iast ->
let val :: Value
val = FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
iast
in Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Value -> Text
valueToText Value
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueToText Value
val)
(Text -> Value
String "") [AST]
asts
ASTLiteral val :: Value
val -> Value
val
ASTFunc ident :: Text
ident args :: [AST]
args ->
case Text -> FunctionMap -> Maybe Function
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
ident FunctionMap
fm of
Nothing -> Value
Null
Just func :: Function
func ->
let argVals :: [Value]
argVals = (AST -> Value) -> [AST] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map (FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global) [AST]
args
in Function -> [Value] -> Value
call Function
func [Value]
argVals
ASTVar ident :: Text
ident ->
if Text
ident Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "@" then Value
global else
case Value
global of
Object obj :: Object
obj -> Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
ident Object
obj
_ -> Value
Null
ASTIndex objAst :: AST
objAst idents :: [Text]
idents ->
(Value -> Text -> Value) -> Value -> [Text] -> Value
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\val :: Value
val ident :: Text
ident ->
case Value
val of
Object obj :: Object
obj -> Value -> Maybe Value -> Value
forall a. a -> Maybe a -> a
fromMaybe Value
Null (Maybe Value -> Value) -> Maybe Value -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
ident Object
obj
_ -> Value
Null) (FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
objAst) [Text]
idents
ASTArray asts :: Vector AST
asts -> Array -> Value
Array (Array -> Value) -> Array -> Value
forall a b. (a -> b) -> a -> b
$ (AST -> Value) -> Vector AST -> Array
forall a b. (a -> b) -> Vector a -> Vector b
V.map (FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global) Vector AST
asts
ASTIf cond :: AST
cond trueBranch :: AST
trueBranch mfalseBranch :: Maybe AST
mfalseBranch ->
let condVal :: Value
condVal = FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
cond
falseBranch :: AST
falseBranch = AST -> Maybe AST -> AST
forall a. a -> Maybe a -> a
fromMaybe (Value -> AST
ASTLiteral (Value -> AST) -> Value -> AST
forall a b. (a -> b) -> a -> b
$ Text -> Value
String "") Maybe AST
mfalseBranch
in if Value
condVal Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
Null Bool -> Bool -> Bool
|| Value
condVal Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
Bool Bool
False then
FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
falseBranch
else FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
trueBranch
ASTFor mkeyName :: Maybe Text
mkeyName valName :: Text
valName lst :: AST
lst body :: AST
body msep :: Maybe AST
msep ->
FunctionMap
-> Value -> Maybe Text -> Text -> AST -> AST -> Maybe AST -> Value
astForLoop FunctionMap
fm Value
global Maybe Text
mkeyName Text
valName AST
lst AST
body Maybe AST
msep
astForLoop :: FunctionMap -> Value
-> Maybe Identifier -> Identifier
-> AST -> AST -> Maybe AST -> Value
astForLoop :: FunctionMap
-> Value -> Maybe Text -> Text -> AST -> AST -> Maybe AST -> Value
astForLoop fm :: FunctionMap
fm global :: Value
global mkeyName :: Maybe Text
mkeyName valName :: Text
valName lst :: AST
lst body :: AST
body msep :: Maybe AST
msep =
case Value
val of
Null -> Text -> Value
String ""
Bool False -> Text -> Value
String ""
Array vec :: Array
vec ->
Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [(Int, Value)] -> Text -> Text
forall a. ToJSON a => [(a, Value)] -> Text -> Text
go ([Int] -> [Value] -> [(Int, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..(Array -> Int
forall a. Vector a -> Int
V.length Array
vec)] ([Value] -> [(Int, Value)]) -> [Value] -> [(Int, Value)]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
vec) Text
forall a. Monoid a => a
mempty
Object obj :: Object
obj -> Text -> Value
String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)] -> Text -> Text
forall a. ToJSON a => [(a, Value)] -> Text -> Text
go (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
H.toList Object
obj) Text
forall a. Monoid a => a
mempty
v :: Value
v -> FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm (Value -> Text -> Value -> Value
replaceVar Value
global Text
valName Value
v) AST
body
where sep :: Value
sep = Value -> (AST -> Value) -> Maybe AST -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Value
String "") (FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global) Maybe AST
msep
val :: Value
val = FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
lst
go :: [(a, Value)] -> Text -> Text
go [] accm :: Text
accm = Text
accm
go ((k :: a
k,v :: Value
v):[]) accm :: Text
accm =
let scope :: Value
scope = Value -> Text -> Value -> Value
replaceVar (a -> Value
forall a. ToJSON a => a -> Value
mreplaceKey a
k) Text
valName Value
v
nv :: Value
nv = FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
scope AST
body
in Text
accm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueToText Value
nv
go ((k :: a
k,v :: Value
v):x1 :: (a, Value)
x1:xs :: [(a, Value)]
xs) accm :: Text
accm =
let scope :: Value
scope = Value -> Text -> Value -> Value
replaceVar (a -> Value
forall a. ToJSON a => a -> Value
mreplaceKey a
k) Text
valName Value
v
nv :: Value
nv = FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
scope AST
body
accmN :: Text
accmN =
Text
accm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueToText Value
nv Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueToText Value
sep
in [(a, Value)] -> Text -> Text
go ((a, Value)
x1(a, Value) -> [(a, Value)] -> [(a, Value)]
forall a. a -> [a] -> [a]
:[(a, Value)]
xs) Text
accmN
mreplaceKey :: ToJSON a => a -> Value
mreplaceKey :: a -> Value
mreplaceKey v :: a
v =
Value -> (Text -> Value) -> Maybe Text -> Value
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
global (\k :: Text
k -> Value -> Text -> Value -> Value
replaceVar Value
global Text
k (Value -> Value) -> Value -> Value
forall a b. (a -> b) -> a -> b
$ a -> Value
forall a. ToJSON a => a -> Value
toJSON a
v) Maybe Text
mkeyName
replaceVar :: Value -> Identifier -> Value -> Value
replaceVar :: Value -> Text -> Value -> Value
replaceVar (Object orig :: Object
orig) varName :: Text
varName newVal :: Value
newVal = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Text -> Value -> Object -> Object
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Text
varName Value
newVal Object
orig
replaceVar _ varName :: Text
varName newVal :: Value
newVal = [(Text, Value)] -> Value
object [Text
varName Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Value
newVal]
evaluate :: AST -> Template
evaluate :: AST -> Template
evaluate ast :: AST
ast = (FunctionMap -> Value -> Text) -> Template
Template ((FunctionMap -> Value -> Text) -> Template)
-> (FunctionMap -> Value -> Text) -> Template
forall a b. (a -> b) -> a -> b
$ \fm :: FunctionMap
fm global :: Value
global ->
Value -> Text
valueToText (Value -> Text) -> Value -> Text
forall a b. (a -> b) -> a -> b
$ FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
ast
valueToText :: Value -> Text
valueToText :: Value -> Text
valueToText val :: Value
val =
case Value
val of
String str :: Text
str -> Text
str
Number n :: Scientific
n -> Scientific -> Text
fromScientific Scientific
n
Bool True -> "True"
Bool False -> "False"
Array _ -> "[array]"
Object _ -> "[object]"
Null -> ""
fromScientific :: Scientific -> Text
fromScientific :: Scientific -> Text
fromScientific n :: Scientific
n
| Int
e Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Scientific -> String
forall a. Show a => a -> String
show Scientific
n
| Bool
otherwise = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Integer -> String
forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
coefficient Scientific
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* 10 Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Int
e
where e :: Int
e = Scientific -> Int
base10Exponent Scientific
n
compileTemplate :: Text -> Either String Template
compileTemplate :: Text -> Either String Template
compileTemplate tmpl :: Text
tmpl = AST -> Template
evaluate (AST -> Template) -> Either String AST -> Either String Template
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Parser AST -> Text -> Either String AST
forall a. Parser a -> Text -> Either String a
A.parseOnly Parser AST
pAST Text
tmpl