{-# LANGUAGE FlexibleInstances, CPP, Trustworthy #-}
{- | Types and helpers to encode the language AST -}
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

-- | A funcation that's callable from inside a template
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

-- | Like 'fromJSON' but throws an error if there is a parse failure.
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

-- | A compiled template is a function that takes a 'FunctionMap' and a global
-- aeson 'Value' and renders the template.
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

-- | A symbol identifier following the format [a-z][a-zA-Z0-9_-]*
type Identifier = Text

-- | 'AST's encode the various types of expressions in the language.
data AST = ASTRoot [AST] -- ^ A series of sub-ASTs
         | ASTLiteral Value -- ^ A literal that does not require evaluation
         | ASTFunc Identifier [AST] -- ^ A function call and list of arguments
         | ASTVar Identifier -- ^ Variable dereference
         | ASTIndex AST [Identifier] -- ^ Nested index into an object
         | ASTArray (V.Vector AST)
         -- ^ A literal array (may contain non-literals)
         | ASTIf AST AST (Maybe AST)
         -- ^ If - condition, true branch and optional false branch
         | ASTFor (Maybe Identifier) Identifier AST AST (Maybe AST)
         -- ^ for([k,]v in expr) body separator
  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)

-- | Lift a 'ToJSON' to an 'ASTLiteral'
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