{-# OPTIONS_HADDOCK -ignore-exports #-}
{-|
Module      : Data.EasyTpl
Description : Easy Template compiler and renderer.
Copyright   : (c) Kayo, 2014
License     : GPL-3
Maintainer  : kayo@illumium.org
Stability   : experimental
Portability : POSIX

This module implements compiler and renderer for easy runtime templates.
It can be used for advanced code preprocessing or simple substitution of some variables in string.

Since template engine uses /Aeson's/ 'Value' type, you must use types, which have 'ToJSON' instances, for rendering it.
Also you can use 'Object' with variables as fields.

-}

module Data.EasyTpl (
    -- * Usage example
    -- $usageExample
    
    -- * Template format
    -- $docFormat

    -- ** Statements
    -- $docStatements

    -- ** Expressions
    -- $docExpressions
  
    -- * Template examples
  
    -- ** Assets json
    -- $exampleStr
  
    -- ** EJS-like template
    -- $exampleEjs
  
    -- * Types
    Template
  , TemplateToken
    -- ** Json types
  , Value(..)
  , ByteString
  , HashMap
  , Vector
    -- * Functions
    -- ** Compile and render
  , compile
  , render
  , compile'
  , render'
    -- ** Parsers
  , parseTemplate
  , parseTemplate'
  , parseExpression
    -- ** Utily
  , defaultData
  ) where

import Data.Aeson (Value(..), ToJSON, toJSON)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BSC
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.Vector (Vector)

import Data.Attoparsec.ByteString.Char8 (parseOnly)

import Data.EasyTpl.Types
import Data.EasyTpl.Parser
import Data.EasyTpl.Render

-- | Default data for render.
--   Empty data for using with standalone render.
defaultData :: Value
defaultData = Object H.empty

-- | Compile template from string.
compile' :: String -> Either String Template
compile' = compile . BSC.pack

-- | Compile template from ByteString.
compile :: ByteString -> Either String Template
compile = parseOnly parseTemplate

-- | Render template to string.
render' :: (ToJSON e) => Template -> e -> String
render' tpl = BSC.unpack . render tpl

-- | Render template to ByteString.
render :: (ToJSON e) => Template -> e -> ByteString
render tpl env = renderTemplate tpl $ toJSON env

-- <% for key, value of iterable %>
--   <% if condition %>
--     <%= literal =%>
--   <% end %>
-- <% end %>

{- $usageExample

> import Data.Aeson
> import Data.EasyTpl (compile, render)
> import Data.ByteString (readFile, writeFile)
>
> data TplVars = TplVars { ... }
>
> instance ToJSON TplVars
>   ...
>
> main = do
>
>   template <- readFile "template.tpl" >>=
>     either error return . compile
>
>   let result = render Template $ TplVars { ... }
>
>   writeFile "output.txt" result

-}

{- $docFormat

Templates consists of:

  [Control structures] Entities, enclosed by @\<%@ and @%\>@.

  [Substitution expressions] Entities, enclosed by @\<%=@ and @%\>@.

  [Raw content] Anything not controls and literals, interprets as is.

-}

{- $docStatements

Control structures:

  [@/if/@ control]

  @
  \<% if /expression/ %\>
    The content, which will be displayed, if result of /expression/ evaluation is /true/.
  \<% end %\>
  @

  [@/for/@ control]
  
  Basic form:

  @
  \<% for /value/ /[,/ /index/ /]/ in /expression/ %\>
    The content, which will be displayed for each entry in result of /expression/ evaluation.
    Variables /value/ and (optional) /index/ contains entry value and number respectively.
  \<% end %\>
  @

  Alternative form:
  
  @
  \<% for /field/ /[,/ /value/ /]/ in /expression/ %\>
    The content, which will be displayed for each entry in result of /expression/ evaluation.
    Variables /field/ and (optional) /value/ contains entry key and value respectively.
  \<% end %\>
  @

  The /expression/ must be iteratable, like /Array/ or /Object/.

-}

{- $docExpressions

Expressions is:

  [Constants] Json Values, like /string/, /number/, /object/, /array/, /true/, /false/, /null/

  [Variables] Text entities, identified by name

  [Ranges] Generated arrays of integers

  [Regexps] Regular expressions, enclosed by @\/@ and @\/@ with @i@ and @m@ options.

  [Unary operators] Applied to single expression

  [Binary operators] Applied to twin expressions

/Prefix unary operations/:

  [Get length @#@] Applied to /string/, /object/, /array/. For anything other gives /null/.

  [Stringify @\@@] Converts value to /JSON/ string.

  [Logical not @!@] Inverts boolean value.

  [Numeric negate @-@] Negates numeric value.

  [To number @+@] Forces value to be a numeric.

/Postfix unary operations/:

  [Evaluate @=@] Evaluates string as expression.

  [Not null @?@] Tests value to not be a /null/.

/Generic binary operations/:

  [Equal @==@, Not equal @!=@] Tests values to be an equal.

  [Compare @\<@, @\>@, @\<=@, @\>=@] Compares values.

/Numeric binary operations/:

  [Arithmetic @+@, @-@, @*@, @/@] Simple calculations.

  [Integer division @:@, Extract module @\%@]

/String binary operations/:

  [Concat @+@] Concatenates two strings.

  [Split @:@] Splits string to array of strings by sepatator.

  [Repeat @*@] Repeats string N times.

  [Regex test @~@] Tests string to match regex.

  [Regex match @~\>@] Extract matches from string by appling regex.

  [Regex split @~:@] Split string to array of strings by regex.

/Logical binary operations/:

  [Logical and @&&@]

  [Logical or @||@]

/Container indexing operations/:

  [Get field @.@ /fieldName/] Extracts field, which identified by name.

  [Get index @\[@ /expression/ @\]@] Extracts field by number or evaluated name.

  This operations applyed sequentially to container types, like /string/, /array/, /object/.

/Range expressions/:

  @\[@ \[/from/\] @..@ /to/ \[, /step/\] @\]@

  This expressins generates arrays of numeric values in range /from/ including /to/ by /step/.

  By default /from/ is /0/, and /step/ is /1/.

/Regular expressions/:

  @\/@ /expression/ @\/@ \[/i/\] \[/m/\]

  Posix regular expressions are supported.

  * @i@-modifier forses case-insensitive mode.

  * @m@-modifier forces multiline mode.

-}

{- $exampleStr

* Template:

> {<%
>   for res, num in assets
>     %>
>   "<%=
>       res.name
>     %>": "<%
>       if #root>0
>         %><%=
>           root
>         %>/<%
>       end
>     %><%=
>       prefix[res.type]
>     %><%=
>       res.name
>     %><%
>       if suffix[res.type]?
>         %><%=
>           suffix[res.type]
>         %><%
>       end
>     %>"<%
>       if num+1<#assets
>         %>,<%
>       end
>     %><%
>   end
> %>
> }

* Compiled template:

> (Template [
>   ContentToken "{",
>   ControlToken
>     (Iteration ("num","res") (Variable "assets"))
>     (Template [
>       ContentToken "\n  \"",
>       LiteralToken
>         (BinaryOperation GetField
>           (Variable "res")
>           (Constant (String "name"))),
>       ContentToken "\": \"",
>       ControlToken
>         (Condition
>           (BinaryOperation GreatThan
>             (UnaryOperation GetLength
>               (Variable "root"))
>             (Constant (Number 0))))
>         (Template [
>           LiteralToken
>             (Variable "root"),
>           ContentToken "/"
>         ]),
>       LiteralToken
>         (BinaryOperation GetField
>           (Variable "prefix")
>           (BinaryOperation GetField
>             (Variable "res")
>             (Constant (String "type")))),
>       LiteralToken
>         (BinaryOperation GetField
>           (Variable "res")
>           (Constant (String "name"))),
>       ControlToken
>         (Condition
>           (UnaryOperation NotNull
>             (BinaryOperation GetField
>               (Variable "suffix")
>               (BinaryOperation GetField
>                 (Variable "res")
>                 (Constant (String "type"))))))
>         (Template [
>           LiteralToken
>             (BinaryOperation GetField
>               (Variable "suffix")
>               (BinaryOperation GetField
>                 (Variable "res")
>                 (Constant (String "type"))))]),
>       ContentToken "\"",
>       ControlToken
>         (Condition
>           (BinaryOperation LessThan
>             (BinaryOperation Append
>               (Variable "num")
>               (Constant (Number 1)))
>             (UnaryOperation GetLength
>               (Variable "assets"))))
>         (Template [
>           ContentToken ","
>         ])
>     ]),
>   ContentToken "\n}\n"
> ])

* Yaml Dataset:

> prefix:
>   script: js/
>   style: css/
>   image: gfx/
> suffix:
>   script: .min.js
>   style: .min.css
> assets:
>   - type: script
>     name: client
>   - type: style
>     name: styles
>   - type: style
>     name: bootstrap
>   - type: script
>     name: react
>   - type: image
>     name: icons.png
>   - type: image
>     name: photo.jpg

* Render result:

> {
>   "client": "js/client.min.js",
>   "styles": "css/styles.min.css",
>   "bootstrap": "css/bootstrap.min.css",
>   "react": "js/react.min.js",
>   "icons.png": "gfx/icons.png",
>   "photo.jpg": "gfx/photo.jpg"
> }

-}

{- $exampleEjs

* Template:

> <ul><%
>   for item in items %>
>   <li><%
>     if item.url ~ /^http/
>       %><a href="<%= item.url %>"<%
>         if item.description?
>           %> title="<%= item.description %>"<%
>         end
>         %>><%
>         if item.title?
>           %><%= item.title %><%
>         end
>         %><%
>         if !(item.title?)
>           %><%= (item.url ~> /[^\:]*\:\/\/([^\/]+)/)[0] %><%
>         end
>       %></a><%
>     end
>     %><%
>     if !(item.url ~ /^http/)
>       %><button link="<%= item.url %>"><%= item.title %></button><%
>     end
>     %></li><%
>   end %>
> </ul>

* Compiled template:

> (Template [
>   ContentToken "<ul>",
>   ControlToken
>     (Iteration ("","item") (Variable "items"))
>     (Template [
>       ContentToken "\n  <li>",
>       ControlToken
>         (Condition
>           (BinaryOperation RegexTest
>             (BinaryOperation GetField
>               (Variable "item")
>               (Constant (String "url")))
>             (Regexp "^http" True False)))
>         (Template [
>           ContentToken "<a href=\"",
>           LiteralToken
>             (BinaryOperation GetField
>               (Variable "item")
>               (Constant (String "url"))),
>           ContentToken "\"",
>           ControlToken
>             (Condition
>               (UnaryOperation NotNull
>                 (BinaryOperation GetField
>                   (Variable "item")
>                   (Constant (String "description")))))
>             (Template [
>               ContentToken " title=\"",
>               LiteralToken
>                 (BinaryOperation GetField
>                   (Variable "item")
>                   (Constant (String "description"))),
>               ContentToken "\""
>             ]),
>           ContentToken ">",
>           ControlToken
>             (Condition
>               (UnaryOperation NotNull
>                 (BinaryOperation GetField
>                   (Variable "item")
>                   (Constant (String "title")))))
>             (Template [
>               LiteralToken
>                 (BinaryOperation GetField
>                   (Variable "item")
>                   (Constant (String "title")))
>             ]),
>           ControlToken
>             (Condition
>               (UnaryOperation LogicNot
>                 (UnaryOperation NotNull
>                   (BinaryOperation GetField
>                     (Variable "item")
>                     (Constant (String "title"))))))
>             (Template [
>               LiteralToken
>                 (BinaryOperation GetField
>                   (BinaryOperation RegexMatch
>                     (BinaryOperation GetField
>                       (Variable "item")
>                       (Constant (String "url")))
>                     (Regexp "[^\\:]*\\://([^/]+)" True False))
>                   (Constant (Number 0)))
>             ]),
>           ContentToken "</a>"
>         ]),
>       ControlToken
>         (Condition
>           (UnaryOperation LogicNot
>             (BinaryOperation RegexTest
>               (BinaryOperation GetField
>                 (Variable "item")
>                 (Constant (String "url")))
>               (Regexp "^http" True False))))
>         (Template [
>            ContentToken "<button link=\"",LiteralToken (BinaryOperation GetField (Variable "item") (Constant (String "url"))),
>            ContentToken "\">",
>            LiteralToken (BinaryOperation GetField (Variable "item") (Constant (String "title"))),
>            ContentToken "</button>"
>         ]),
>       ContentToken "</li>"
>     ]),
>   ContentToken "\n</ul>\n"
> ])

* Yaml Dataset:

> items:
>   - url: /
>     title: Front page
>   - url: http://example.org/
>     title: Example site
>   - url: https://example.com/example.html
>     description: External link
>   - url: /about
>     title: About

* Render result:

> <ul>
>   <li><button link="/">Front page</button></li>
>   <li><a href="http://example.org/">Example site</a></li>
>   <li><a href="https://example.com/example.html" title="External link">example.com</a></li>
>   <li><button link="/about">About</button></li>
> </ul>
-}