{-# LANGUAGE FlexibleInstances, CPP, Trustworthy #-}
module Web.Simple.Templates.Types where
import qualified Data.HashMap.Strict as H
import Data.Text (Text)
import Data.Aeson
import qualified Data.Vector as V
newtype Function = Function { Function -> [Value] -> Value
call :: [Value] -> Value }
#define TypesConds(macro) \
macro(a1 -> a2, \
(FromJSON a1, FromJSON a2)); \
macro(a1 -> a2 -> a3, \
(FromJSON a1, FromJSON a2, FromJSON a3)); \
macro(a1 -> a2 -> a3 -> a4, \
(FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4)); \
macro(a1 -> a2 -> a3 -> a4 -> a5, \
(FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4, FromJSON a5)); \
macro(a1 -> a2 -> a3 -> a4 -> a5 -> a6, \
(FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4, FromJSON a5, FromJSON a6)); \
macro(a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7, \
(FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4, FromJSON a5, FromJSON a6, FromJSON a7)); \
macro(a1 -> a2 -> a3 -> a4 -> a5 -> a6 -> a7 -> a8, \
(FromJSON a1, FromJSON a2, FromJSON a3, FromJSON a4, FromJSON a5, FromJSON a6, FromJSON a7, FromJSON a8))
class ToFunction a where
toFunction :: a -> Function
fromJSONStrict :: FromJSON a => Value -> a
fromJSONStrict :: forall a. FromJSON a => Value -> a
fromJSONStrict Value
val = case forall a. FromJSON a => Value -> Result a
fromJSON Value
val of
Error String
err -> forall a. HasCallStack => String -> a
error String
err
Success a
result -> a
result
#define TOFUNCTION(types, conds) \
instance (conds) => ToFunction (types -> Value) where { \
toFunction f = Function $ \args -> \
case args of { \
[] -> call (toFunction (f $ fromJSONStrict Null)) [] ; \
a:as -> call (toFunction (f $ fromJSONStrict a)) as} ; \
}
instance (FromJSON a) => ToFunction (a -> Value) where
toFunction :: (a -> Value) -> Function
toFunction a -> Value
f = ([Value] -> Value) -> Function
Function forall a b. (a -> b) -> a -> b
$ \[Value]
args ->
case [Value]
args of
[] -> forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ a -> Value
f forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> a
fromJSONStrict Value
Null
Value
a:[Value]
_ -> forall a. ToJSON a => a -> Value
toJSON forall a b. (a -> b) -> a -> b
$ a -> Value
f forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => Value -> a
fromJSONStrict Value
a
TypesConds(TOFUNCTION)
type FunctionMap = H.HashMap Identifier Function
newtype Template = Template
{ Template -> FunctionMap -> Value -> Text
renderTemplate :: FunctionMap -> Value -> Text }
instance Semigroup Template where
Template
tm1 <> :: Template -> Template -> Template
<> Template
tm2 = (FunctionMap -> Value -> Text) -> Template
Template forall a b. (a -> b) -> a -> b
$ \FunctionMap
fm Value
global ->
Template -> FunctionMap -> Value -> Text
renderTemplate Template
tm1 FunctionMap
fm Value
global forall a. Semigroup a => a -> a -> a
<> Template -> FunctionMap -> Value -> Text
renderTemplate Template
tm2 FunctionMap
fm Value
global
instance Monoid Template where
mempty :: Template
mempty = (FunctionMap -> Value -> Text) -> Template
Template forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. Monoid a => a
mempty
type Identifier = Text
data AST = ASTRoot [AST]
| ASTLiteral Value
| ASTFunc Identifier [AST]
| ASTVar Identifier
| ASTIndex AST [Identifier]
| ASTArray (V.Vector AST)
| ASTIf AST AST (Maybe AST)
| ASTFor (Maybe Identifier) Identifier AST AST (Maybe AST)
deriving (Int -> AST -> ShowS
[AST] -> ShowS
AST -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AST] -> ShowS
$cshowList :: [AST] -> ShowS
show :: AST -> String
$cshow :: AST -> String
showsPrec :: Int -> AST -> ShowS
$cshowsPrec :: Int -> AST -> ShowS
Show, AST -> AST -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AST -> AST -> Bool
$c/= :: AST -> AST -> Bool
== :: AST -> AST -> Bool
$c== :: AST -> AST -> Bool
Eq)
fromLiteral :: ToJSON a => a -> AST
fromLiteral :: forall a. ToJSON a => a -> AST
fromLiteral = Value -> AST
ASTLiteral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON
astListToArray :: [AST] -> AST
astListToArray :: [AST] -> AST
astListToArray = Vector AST -> AST
ASTArray forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Vector a
V.fromList