summaryrefslogtreecommitdiff
path: root/lib/render/template.ml
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 11:48:30 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 11:48:30 +0200
commit6762ce46af3cb12bc6ae37cda762c5d95add7903 (patch)
treebc1d8c86050d0149ff961a9a4ff838f9c474ac2a /lib/render/template.ml
parent897c274fd28402159ca6d45eedc1257b1ce98696 (diff)
parent390bc6ac5196a946c473d0dbe7760fa41837c428 (diff)
downloadcolitur-6762ce46af3cb12bc6ae37cda762c5d95add7903.tar.gz
colitur-6762ce46af3cb12bc6ae37cda762c5d95add7903.zip
feat: output, rendering and publishing
Gives colitur a publishable exit. Until now its only output was terminal rows; it can now print an ordo booklet and a wall calendar, publish an iCalendar feed people subscribe to, and serve a static JSON/XML API. lib/render escaping (six flavours + RFC 5545 folding), a deliberately logic-less template engine, the view model, and five emitters (CSV, JSON, XML, iCalendar, S-expression) CLI emit, table, render, publish -- all accepting --overlay templates ordo booklet in six flavours, wall grid in three schema day-v1.json and colitur-v1.xsd, the published contract man colitur-templates.5, plus colitur.1 updates The view model is why the engine can stay logic-less: a month grid needs leading blank cells, week bucketing and an in-month test, and a logic-less template can compute none of it. Shaping the data in OCaml keeps the engine safe for untrusted templates and makes the grid trivial. Formats split by whether correctness is mechanical. Presentation goes through templates; iCalendar and XML get dedicated emitters, because folding, exclusive DTEND, stable UIDs and schema fidelity are rules a template cannot enforce and each fails silently in a subscriber's client rather than loudly at generation. publish is deterministic and non-destructive: two runs produce a byte-identical tree, and --prune removes only files a previous run created, refusing any manifest entry that escapes the output directory. No new dependencies. The kernel and rite modules are untouched, and colitur day and colitur readings remain byte-identical.
Diffstat (limited to 'lib/render/template.ml')
-rw-r--r--lib/render/template.ml151
1 files changed, 151 insertions, 0 deletions
diff --git a/lib/render/template.ml b/lib/render/template.ml
new file mode 100644
index 0000000..7efa92b
--- /dev/null
+++ b/lib/render/template.ml
@@ -0,0 +1,151 @@
+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
+ (* Every sigil form (var, #, ^, /) resolves a dotted path; an
+ empty path ("{{.}}", "{{#}}", "{{^}}", "{{/}}") names
+ nothing -- there is no "current context" concept for a bare
+ dot to mean, so it is a parse error rather than an invented
+ behaviour Task 3 would have to define. *)
+ let with_path ctor rest =
+ match path rest with
+ | [] -> Error "empty tag path: {{.}} and {{#}} name nothing"
+ | p -> Ok (ctor p)
+ in
+ match b.[0] with
+ | '#' -> with_path (fun p -> TOpen p) (String.sub b 1 (String.length b - 1))
+ | '^' -> with_path (fun p -> TInv p) (String.sub b 1 (String.length b - 1))
+ | '/' -> with_path (fun p -> TClose p) (String.sub b 1 (String.length b - 1))
+ | '!' -> Ok TComment
+ | '>' -> Error "partials are not supported: a template may not include another file"
+ | _ -> with_path (fun p -> TVar p) 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
+
+(* Scope is a STACK, innermost first: a section pushes its own object, and a
+ lookup falls back outward. Without the fallback a grid template could not
+ reach the year number from inside a week. *)
+let rec lookup stack path =
+ match stack with
+ | [] -> None
+ | top :: rest -> (
+ match descend top path with Some v -> Some v | None -> lookup rest path)
+
+and descend v path =
+ match (v, path) with
+ | _, [] -> Some v
+ | Obj kvs, k :: tl -> (
+ match List.assoc_opt k kvs with Some v' -> descend v' tl | None -> None)
+ | _ -> None
+
+let truthy = function
+ | Bool b -> b
+ | Str "" -> false
+ | Str _ -> true
+ | List [] -> false
+ | List _ -> true
+ | Obj _ -> true
+
+let render ~flavour nodes value =
+ let b = Buffer.create 4096 in
+ let rec go stack nodes =
+ List.iter
+ (fun node ->
+ match node with
+ | Text t -> Buffer.add_string b t
+ | Var p -> (
+ match lookup stack p with
+ | Some (Str s) -> Buffer.add_string b (Escape.apply flavour s)
+ | Some (Bool true) -> Buffer.add_string b "true"
+ | Some (Bool false) -> ()
+ | Some (List _) | Some (Obj _) | None -> ())
+ | Section (p, body) -> (
+ match lookup stack p with
+ | None -> ()
+ | Some (List items) -> List.iter (fun it -> go (it :: stack) body) items
+ | Some v when truthy v -> go (v :: stack) body
+ | Some _ -> ())
+ | Inverted (p, body) -> (
+ match lookup stack p with
+ | None -> go stack body
+ | Some v -> if not (truthy v) then go stack body))
+ nodes
+ in
+ go [ value ] nodes;
+ Buffer.contents b
+
+let render_string ~flavour src value =
+ match parse src with Error e -> Error e | Ok nodes -> Ok (render ~flavour nodes value)