{-# LANGUAGE OverloadedStrings, Trustworthy #-}
{-|
A simple templating system with variable substitution, function invokation, for
loops and conditionals. Most callers should use 'compileTemplate' and invoke
the template with 'renderTemplate'. E.g.:

> let myTemplate = compileTemplate "Hello, $@$!"
> print $ renderTemplate myTemplate mempty "World"

-}
module Web.Simple.Templates.Language
  (
  -- * Language Description
  -- $lang_def

  -- ** Literals
  -- $literals

  -- ** Variable substitution
  -- $variables

  -- ** Function Invokation
  -- $functions

  -- ** Conditionals
  -- $conditionals

  -- ** For Loops
  -- $loops

  -- * Compilation
  compileTemplate, evaluate, evaluateAST
  -- * Helpers
  , 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 -- ^ Mapping of functions accessible to the template
            -> Value -- ^ The global 'Object' or '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

-- $lang_def
-- A template may contain plain-text, which is reproduced as is, as well as
-- blocks of code, escaped by surrounding with dollar-signs ($), for variable
-- expansion, function invokation, conditionals and loops. For example, given
-- a global variable \"answer\" with the value /42/,
--
-- > The answer to the universe is $answer$.
--
-- would expand to
--
-- > The answer to the universe is 42.
--
-- Since the dollar-sign is used to denote code sections, it must be escaped
-- in plaintext sections by typing two dollar-signs. For example, to reproduce
-- the lyrics for /Bonzo Goes to Bitburg/, by The Ramones:
--
-- > Shouldn't wish you happiness,
-- > wish her the very best.
-- > $$50,000 dress
-- > Shaking hands with your highness

-- $literals
-- 'Data.Aeson.Bool's, 'Number's, 'String's, 'Array's and 'Null' can be typed
-- as literals.
--
-- * 'Data.Aeson.Bool's are the lower-case \"true\" and \"false\"
--
-- * 'Number's are simply typed as decimals
--
-- > Pi is approximately $3.14159$
--
-- * 'String's are surrounded by double-quotes (\"). Double-quotes inside a
-- string can be escaped by proceeding it with a backslash (\\\"), however
-- backslashes themselves do not need to be escaped:
--
-- > And then, Dr. Evil said: $"Mini Me, stop humping the \"laser\"."$
--
-- * 'Array's are surrounded by square-brackets (\[ \]) and elements are comma
-- separated. Elements can be literals, variables or function invokations, and
-- do not have to be the same type:
--
-- > $["Foo", 42, ["bar", "baz"], length([1, 2, 3, 6])]$
--
-- * 'Null' is type as the literal /null/ (in lower case):
--
-- > $null$
--

-- $variables
-- Templates are evaluated with a single global variable called /@/. For
-- example, you can refernce the global in your template like so:
--
-- > The value in my global is $@$.
--
-- If the global is an 'Object', it can be indexed using dot-notation:
--
-- > The Sex Pistols' bassist was $@.bassist.name.first$
--
-- In this case, you may also discard the /@/ global reference and simply name
-- the field in the global object, for example:
--
-- > Field 'foo' is $foo$.
-- > Field 'bar.baz' is $bar.baz$.
--
-- 'String's, 'Number's and 'Data.Aeson.Bool's are meaningful when evaluated to
-- text in a template, while 'Object's, 'Array's and 'Null's simply render as
-- strings representing their types (e.g. \"[object]\"). However, all types can
-- be used as arguments to functions, or in conditionals and loops.

-- $functions
-- Functions are invoked with similar syntax to imperative languages:
--
-- > $myfunc(arg1, arg2, arg3)$
--
-- where arguments can be literals, variables or other function calls --
-- basically anything that can be evaluated can be an argument to a function.
-- Function names are in a separate namespace than variables, so there can be
-- a function and variable both named /foo/ and they are differentiated by
-- their use. For example:
--
-- > $mysymbol$
--
-- is a variable expansion, whereas
--
-- > $mysymbol()$
--
-- is a function invokation.
--

-- $conditionals
-- Branching is supported through the common /if/ statement with an optional
-- /else/ branch. Conditions can be any expression. /false/ and /null/ are
-- evaluated as /false/, while everything else is evaluated as /true/.
--
-- /if/ blocks are surround by an /if/-statement and and /endif/, each
-- surrounded separately by dollar signs. Optionally, the /else/ branch is
-- declared by with \"$else$\". The blocks themselves are templates and may
-- contain regular text as well as evaluable expressions.
--
-- > Should I stay or should I go?
-- > $if(go)$
-- > Trouble will be $trouble$.
-- > $else$
-- > Trouble will be $double(trouble)$
-- > $endif$
--

-- $loops
-- For loops iterate over collections, setting a variable name to one element
-- in the collection for each iteration of the loop. Collections are usually
-- 'Array's, however non-false expressions (e.g., 'String's and 'Number's) are
-- treated as collections with one element. A loop starts with a
-- /for/-statement surrounded by dollar-signs and end with an \"$endfor$\":
--
-- > <h1>The Clash</h1>
-- > <ul>
-- > $for(member in band)$
-- > <li>$member.name$ played the $member.instrument$</li>
-- > $endfor$
-- > </ul>
--
-- There is also an optional \"$sep$\" (for /separator/) clause, which is
-- rendered /between/ iterations. So if I have a collection with three items,
-- the /sep/ clause will be rendered after the first and second, but not third
-- elements:
--
-- > <h1>Grocery list</h1>
-- > <p>
-- > $for(item in groceries)$
-- > $item.quantity$ $item.name$(s).
-- > $sep$
-- > <br/>
-- > $endfor$
-- > </p>
--
-- Will render something like:
--
-- > <h1>Grocery list</h1>
-- > <p>
-- > 2 MC(s).
-- > <br/>
-- > 1 DJ(s)
-- > <br/>
-- > </p>
--