1 files changed, 86 insertions, 0 deletions
diff --git a/lib/render/template.ml b/lib/render/template.ml
new file mode 100644
index 0000000..8de91a6
--- /dev/null
+++ b/lib/render/template.ml
@@ -0,0 +1,86 @@
+type value =
+  | Str of string
+  | Bool of bool
+  | List of value list
+  | Obj of (string * value) list
+
+type node =
+  | Text of string
+  | Var of string list
+  | Section of string list * node list
+  | Inverted of string list * node list
+
+type tag = TVar of string list | TOpen of string list | TInv of string list | TClose of string list | TComment
+
+let trim = String.trim
+
+let path s =
+  String.split_on_char '.' (trim s) |> List.map trim |> List.filter (fun x -> x <> "")
+
+(* Lex into a flat list of text and tags. Returns Error on an unterminated tag
+   rather than treating the remainder as text: silently swallowing "{{name" is
+   how a typo becomes invisible missing output. *)
+let lex src =
+  let n = String.length src in
+  let out = ref [] in
+  let buf = Buffer.create 256 in
+  let flush () =
+    if Buffer.length buf > 0 then (out := `Text (Buffer.contents buf) :: !out; Buffer.clear buf)
+  in
+  let rec go i =
+    if i >= n then (flush (); Ok (List.rev !out))
+    else if i + 1 < n && src.[i] = '{' && src.[i + 1] = '{' then
+      match String.index_from_opt src (i + 2) '}' with
+      | Some j when j + 1 < n && src.[j + 1] = '}' ->
+          let body = String.sub src (i + 2) (j - i - 2) in
+          flush ();
+          let tag =
+            let b = trim body in
+            if b = "" then Error "empty tag {{}}"
+            else
+              match b.[0] with
+              | '#' -> Ok (TOpen (path (String.sub b 1 (String.length b - 1))))
+              | '^' -> Ok (TInv (path (String.sub b 1 (String.length b - 1))))
+              | '/' -> Ok (TClose (path (String.sub b 1 (String.length b - 1))))
+              | '!' -> Ok TComment
+              | '>' -> Error "partials are not supported: a template may not include another file"
+              | _ -> Ok (TVar (path b))
+          in
+          (match tag with
+           | Error e -> Error e
+           | Ok t -> out := `Tag t :: !out; go (j + 2))
+      | _ -> Error "unterminated tag: '{{' with no matching '}}'"
+    else (Buffer.add_char buf src.[i]; go (i + 1))
+  in
+  go 0
+
+(* Fold the flat list into a tree, checking that every close matches its open. *)
+let build items =
+  let rec go acc stack items =
+    match items with
+    | [] -> (
+        match stack with
+        | [] -> Ok (List.rev acc)
+        | (p, _, _) :: _ -> Error ("unclosed section {{#" ^ String.concat "." p ^ "}}"))
+    | `Text "" :: rest -> go acc stack rest
+    | `Text t :: rest -> go (Text t :: acc) stack rest
+    | `Tag TComment :: rest -> go acc stack rest
+    | `Tag (TVar p) :: rest -> go (Var p :: acc) stack rest
+    | `Tag (TOpen p) :: rest -> go [] ((p, `Sec, acc) :: stack) rest
+    | `Tag (TInv p) :: rest -> go [] ((p, `Inv, acc) :: stack) rest
+    | `Tag (TClose p) :: rest -> (
+        match stack with
+        | [] -> Error ("close tag {{/" ^ String.concat "." p ^ "}} with no open section")
+        | (op, kind, outer) :: tl ->
+            if op <> p then
+              Error
+                ("mismatched close: {{#" ^ String.concat "." op ^ "}} closed by {{/"
+               ^ String.concat "." p ^ "}}")
+            else
+              let inner = List.rev acc in
+              let node = match kind with `Sec -> Section (op, inner) | `Inv -> Inverted (op, inner) in
+              go (node :: outer) tl rest)
+  in
+  go [] [] items
+
+let parse src = match lex src with Error e -> Error e | Ok items -> build items