{-# 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 qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as K
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 FunctionMap
fm Value
global AST
ast =
  case AST
ast of
    ASTRoot [AST]
asts -> forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Value
v AST
iast ->
                            let val :: Value
val = FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
iast
                            in Text -> Value
String forall a b. (a -> b) -> a -> b
$ Value -> Text
valueToText Value
v forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueToText Value
val)
                          (Text -> Value
String Text
"") [AST]
asts

    ASTLiteral Value
val -> Value
val

    ASTFunc Text
ident [AST]
args ->
      case forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
H.lookup Text
ident FunctionMap
fm of
        Maybe Function
Nothing -> Value
Null
        Just Function
func ->
          let argVals :: [Value]
argVals = 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 Text
ident ->
      if Text
ident forall a. Eq a => a -> a -> Bool
== Text
"@" then Value
global else
        case Value
global of
          Object Object
obj -> forall a. a -> Maybe a -> a
fromMaybe Value
Null forall a b. (a -> b) -> a -> b
$ forall v. Key -> KeyMap v -> Maybe v
K.lookup (Text -> Key
K.fromText Text
ident) Object
obj
          Value
_ -> Value
Null

    ASTIndex AST
objAst [Text]
idents ->
      forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Value
val Text
ident -> 
        case Value
val of
          Object Object
obj -> forall a. a -> Maybe a -> a
fromMaybe Value
Null forall a b. (a -> b) -> a -> b
$ forall v. Key -> KeyMap v -> Maybe v
K.lookup (Text -> Key
K.fromText Text
ident) Object
obj
          Value
_ -> Value
Null) (FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
objAst) [Text]
idents

    ASTArray Vector AST
asts -> Array -> Value
Array forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
V.map (FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global) Vector AST
asts

    ASTIf AST
cond AST
trueBranch Maybe AST
mfalseBranch ->
      let condVal :: Value
condVal = FunctionMap -> Value -> AST -> Value
evaluateAST FunctionMap
fm Value
global AST
cond
          falseBranch :: AST
falseBranch = forall a. a -> Maybe a -> a
fromMaybe (Value -> AST
ASTLiteral forall a b. (a -> b) -> a -> b
$ Text -> Value
String Text
"") Maybe AST
mfalseBranch
      in if Value
condVal forall a. Eq a => a -> a -> Bool
== Value
Null Bool -> Bool -> Bool
|| Value
condVal 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 Maybe Text
mkeyName Text
valName AST
lst AST
body 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 FunctionMap
fm Value
global Maybe Text
mkeyName Text
valName AST
lst AST
body Maybe AST
msep =
  case Value
val of
    Value
Null -> Text -> Value
String Text
""
    Bool Bool
False -> Text -> Value
String Text
""
    Array Array
vec ->
      Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall {a}. ToJSON a => [(a, Value)] -> Text -> Text
go (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..(forall a. Vector a -> Int
V.length Array
vec)] forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
V.toList Array
vec) forall a. Monoid a => a
mempty
    Object Object
obj -> Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall {a}. ToJSON a => [(a, Value)] -> Text -> Text
go (forall v. KeyMap v -> [(Key, v)]
K.toList Object
obj) forall a. Monoid a => a
mempty
    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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Text -> Value
String Text
"") (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 [] Text
accm = Text
accm
        go ((a
k,Value
v):[]) Text
accm =
          let scope :: Value
scope = Value -> Text -> Value -> Value
replaceVar (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 forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueToText Value
nv
        go ((a
k,Value
v):(a, Value)
x1:[(a, Value)]
xs) Text
accm =
          let scope :: Value
scope = Value -> Text -> Value -> Value
replaceVar (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 forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueToText Value
nv forall a. Semigroup a => a -> a -> a
<> Value -> Text
valueToText Value
sep
          in [(a, Value)] -> Text -> Text
go ((a, Value)
x1forall a. a -> [a] -> [a]
:[(a, Value)]
xs) Text
accmN
        mreplaceKey :: ToJSON a => a -> Value
        mreplaceKey :: forall a. ToJSON a => a -> Value
mreplaceKey a
v =
          forall b a. b -> (a -> b) -> Maybe a -> b
maybe Value
global (\Text
k -> Value -> Text -> Value -> Value
replaceVar Value
global Text
k forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> Value
toJSON a
v) Maybe Text
mkeyName

replaceVar :: Value -> Identifier -> Value -> Value
replaceVar :: Value -> Text -> Value -> Value
replaceVar (Object Object
orig) Text
varName Value
newVal = Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. Key -> v -> KeyMap v -> KeyMap v
K.insert (Text -> Key
K.fromText Text
varName) Value
newVal Object
orig
replaceVar Value
_ Text
varName Value
newVal = [Pair] -> Value
object [(Text -> Key
K.fromText Text
varName) forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value
newVal]

evaluate :: AST -> Template
evaluate :: AST -> Template
evaluate AST
ast = (FunctionMap -> Value -> Text) -> Template
Template forall a b. (a -> b) -> a -> b
$ \FunctionMap
fm Value
global ->
  Value -> Text
valueToText 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 Value
val =
  case Value
val of
    String Text
str -> Text
str
    Number Scientific
n -> Scientific -> Text
fromScientific Scientific
n
    Bool Bool
True -> Text
"True"
    Bool Bool
False -> Text
"False"
    Array Array
_ -> Text
"[array]"
    Object Object
_ -> Text
"[object]"
    Value
Null -> Text
""

fromScientific :: Scientific -> Text
fromScientific :: Scientific -> Text
fromScientific Scientific
n
  | Int
e forall a. Ord a => a -> a -> Bool
< Int
0 = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Scientific
n
  | Bool
otherwise = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Scientific -> Integer
coefficient Scientific
n forall a. Num a => a -> a -> a
* Integer
10 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 Text
tmpl = AST -> Template
evaluate forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
  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>
--