Module Jingoo.Jg_types

exception SyntaxError of string
type environment = {
autoescape : bool;

If true, template variables are auto escaped when output.

strict_mode : bool;

If true, strict type cheking is enabled. If false, some kind of invalid type usages are just ignored. for example, following expression throws exception if strict_mode = true, but is skipped if strict_mode = false.

{# 3(Tint) is not iterable #}
{% for item in 3 %}
  {{ item }}
{% endfor %}
template_dirs : string list;

Template search path list used by {% include %} statements. Jingoo will always search in current directory in last resort.

filters : (string * tvalue) list;

User-defined filters.

extensions : string list;

Path list of shared library modules (.cms or .cmxs files) which are dynamically loaded.

}

See std_env

type context = {
frame_stack : frame list;
macro_table : (string, macro) Stdlib.Hashtbl.t;
namespace_table : (string, frame) Stdlib.Hashtbl.t;
active_filters : string list;
serialize : bool;
output : tvalue -> unit;
}
type frame = (string, tvalue) Stdlib.Hashtbl.t
type macro =
| Macro of macro_arg_names * macro_defaults * macro_code
type macro_arg_names = string list
type macro_defaults = kwargs
type macro_code = statement list
type tvalue =
| Tnull
| Tint of int
| Tbool of bool
| Tfloat of float
| Tstr of string
| Tobj of (string * tvalue) list
| Thash of (string, tvalue) Stdlib.Hashtbl.t
| Tpat of string -> tvalue
| Tlist of tvalue list
| Tset of tvalue list
| Tfun of ?⁠kwargs:kwargs -> tvalue -> tvalue
| Tarray of tvalue array
| Tlazy of tvalue Stdlib.Lazy.t
| Tvolatile of unit -> tvalue
type kwargs = (string * tvalue) list
val std_env : environment
let std_env = {
  autoescape = true;
  strict_mode = false;
  template_dirs = [];
  filters = [];
  extensions = [];
}

Boxing OCaml values

val box_int : int -> tvalue
val box_float : float -> tvalue
val box_string : string -> tvalue
val box_bool : bool -> tvalue
val box_list : tvalue list -> tvalue
val box_set : tvalue list -> tvalue
val box_obj : (string * tvalue) list -> tvalue
val box_hash : (string, tvalue) Stdlib.Hashtbl.t -> tvalue
val box_array : tvalue array -> tvalue
val box_pat : (string -> tvalue) -> tvalue
val box_lazy : tvalue Stdlib.Lazy.t -> tvalue
val box_fun : (?⁠kwargs:kwargs -> tvalue -> tvalue) -> tvalue

Unboxing OCaml values

Unboxing operations raise Invalid_argument in case of type error.

val unbox_int : tvalue -> int
val unbox_float : tvalue -> float
val unbox_string : tvalue -> string
val unbox_bool : tvalue -> bool
val unbox_list : tvalue -> tvalue list
val unbox_set : tvalue -> tvalue list
val unbox_array : tvalue -> tvalue array
val unbox_obj : tvalue -> (string * tvalue) list
val unbox_hash : tvalue -> (string, tvalue) Stdlib.Hashtbl.t
val unbox_pat : tvalue -> string -> tvalue
val unbox_lazy : tvalue -> tvalue Stdlib.Lazy.t
val unbox_fun : tvalue -> ?⁠kwargs:kwargs -> tvalue -> tvalue

Helpers for function writing

val func : (tvalue list -> tvalue) -> int -> tvalue
val func_arg1 : ?⁠name:string -> (tvalue -> tvalue) -> tvalue
val func_arg2 : ?⁠name:string -> (tvalue -> tvalue -> tvalue) -> tvalue
val func_arg3 : ?⁠name:string -> (tvalue -> tvalue -> tvalue -> tvalue) -> tvalue
val func_kw : (?⁠kwargs:kwargs -> tvalue list -> tvalue) -> int -> tvalue
val func_arg1_kw : ?⁠name:string -> (?⁠kwargs:kwargs -> tvalue -> tvalue) -> tvalue
val func_arg2_kw : ?⁠name:string -> (?⁠kwargs:kwargs -> tvalue -> tvalue -> tvalue) -> tvalue
val func_arg3_kw : ?⁠name:string -> (?⁠kwargs:kwargs -> tvalue -> tvalue -> tvalue -> tvalue) -> tvalue

Notes about some data types

tvalue.Tobj Key/value object using an associative list.

tvalue.Thash Key/value objects using a hash table.

tvalue.Tpat Key/value object using a function to map "key" to value. Faster than tvalue.Tobj and tvalue.Thash, but not iterable nor testable.

tvalue.Tset Tuples

tvalue.Tlazy Lazy values are actually computed only when needed. Useful for recursive some data structure. In the following example, your app would throw a stack overflow without lazyness.

let rec lazy_model n =
  let prev = lazy_model (n - 1) in
  let next = lazy_model (n + 1) in
  let cur = Tint n in
  Tlazy (lazy (Tobj [ ("cur", cur) ; ("prev", prev) ; ("next", next) ]) )

tvalue.Tvolatile You can use volatile values for variables that can not be defined at model's definition time or if it is subject to changes over time on ocaml's side

Function calls

Built-in functions (aka filters) expect the TARGET value to be the LAST argument, in order to be usable with the pipe notation. You are encouraged to do the same while defining your own functions.

{{ x | foo (10,20) }} is equivalent too {{ foo (10,20,x) }}.

Functions support partial application. e.g. {{ list | map (foo (10,20)) }}

There is two kind of arguments: unnamed arguments and keyword arguments.

When defining a keyword argument, label can't be omitted.

You can't use slice(4, [1,2,3,4,5], 0), because you need to explicitly bind 0 with the fill_with label.

A correct usage of the slice function would be slice(4, [1,2,3,4,5], fill_with=0).

Note that kwargs may be defined at any place: slice(4, fill_with=0, [1,2,3,4,5]).