From eff4b89cff4e1b8fcceb23c54cb62ec636ce62fe Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 07:47:30 +0200 Subject: feat(render): per-flavour escaping and RFC 5545 line folding Six flavours: latex, groff, html, xml, ics, none. Markdown, AsciiDoc and plain text map to none deliberately -- their metacharacters are context-dependent and escaping them aggressively produces worse output than not escaping. An unrecognised extension returns None rather than falling back to none: guessing the flavour wrong produces malformed output that looks fine until it does not. Folding backs off to a non-continuation byte, so a fold never splits a UTF-8 sequence -- the failure mode that would corrupt Polish and Latin names in a published feed. --- test/test_colitur.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'test/test_colitur.ml') diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 76ff685..2295a3f 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -6,4 +6,5 @@ let () = Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; Test_differential.suite; Test_oracle.suite; Test_oracle.suite_2038; Test_oracle.suite_2035; Test_golden.suite; ("lectionary", Test_lectionary.suite); - ("lectionary-ef", Test_lectionary_ef.suite) ] + ("lectionary-ef", Test_lectionary_ef.suite); + Test_escape.suite ] -- cgit v1.3 From eacb54ae44f655c010fdfc2b7292d24f06ffc445 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 08:01:11 +0200 Subject: feat(render): logic-less template parser Placeholders, sections, inverted sections, comments. Nothing else: no partials, no lambdas, no expression evaluation, no raw form. A template is data, never a program, which is what keeps an untrusted template safe. Errors rather than silence on a malformed template: an unterminated tag, an unclosed section, a mismatched close and a partial all return Error. Swallowing '{{name' as text is how a typo becomes invisible missing output in a printed booklet. --- lib/render/template.ml | 86 +++++++++++++++++++++++++++++++++++++++++++++++++ lib/render/template.mli | 28 ++++++++++++++++ test/test_colitur.ml | 3 +- test/test_template.ml | 61 +++++++++++++++++++++++++++++++++++ 4 files changed, 177 insertions(+), 1 deletion(-) create mode 100644 lib/render/template.ml create mode 100644 lib/render/template.mli create mode 100644 test/test_template.ml (limited to 'test/test_colitur.ml') 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 diff --git a/lib/render/template.mli b/lib/render/template.mli new file mode 100644 index 0000000..3f9ef97 --- /dev/null +++ b/lib/render/template.mli @@ -0,0 +1,28 @@ +(** A deliberately logic-less template engine (spec section 5). + + A template is DATA, never a program: placeholders, sections, inverted + sections and comments, and nothing else. There are no partials, no lambdas, + no expression evaluation, no arithmetic, and no filesystem or process + access. There is deliberately no "raw" or triple-brace form -- a template + cannot opt out of its flavour's escaping. + + Anything a calendar needs that this cannot express (a month grid's leading + blanks, week bucketing) is computed in {!View} and handed in as data. That + division is the design, not a workaround. *) + +(** What a template can be rendered against. *) +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 (** dotted path, e.g. ["name"; "la"] *) + | Section of string list * node list + | Inverted of string list * node list + +(** Never raises; a malformed template is an [Error] with a human-readable + reason, because the template is user input. *) +val parse : string -> (node list, string) result diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 2295a3f..a264174 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -7,4 +7,5 @@ let () = Test_differential.suite; Test_oracle.suite; Test_oracle.suite_2038; Test_oracle.suite_2035; Test_golden.suite; ("lectionary", Test_lectionary.suite); ("lectionary-ef", Test_lectionary_ef.suite); - Test_escape.suite ] + Test_escape.suite; + Test_template.suite ] diff --git a/test/test_template.ml b/test/test_template.ml new file mode 100644 index 0000000..dee281b --- /dev/null +++ b/test/test_template.ml @@ -0,0 +1,61 @@ +module T = Colitur_render.Template + +let parse_ok s = match T.parse s with Ok ns -> ns | Error e -> Alcotest.failf "parse: %s" e + +let test_plain_text () = + Alcotest.(check bool) "text only" true (parse_ok "hello" = [ T.Text "hello" ]) + +let test_var () = + Alcotest.(check bool) "var" true (parse_ok "{{name}}" = [ T.Var [ "name" ] ]); + Alcotest.(check bool) "dotted" true (parse_ok "{{name.la}}" = [ T.Var [ "name"; "la" ] ]); + Alcotest.(check bool) "spaces trimmed" true (parse_ok "{{ name.la }}" = [ T.Var [ "name"; "la" ] ]) + +let test_section () = + Alcotest.(check bool) "section" true + (parse_ok "{{#days}}x{{/days}}" = [ T.Section ([ "days" ], [ T.Text "x" ]) ]); + Alcotest.(check bool) "inverted" true + (parse_ok "{{^days}}x{{/days}}" = [ T.Inverted ([ "days" ], [ T.Text "x" ]) ]) + +let test_nested_sections () = + Alcotest.(check bool) "nested" true + (parse_ok "{{#months}}{{#weeks}}w{{/weeks}}{{/months}}" + = [ T.Section ([ "months" ], [ T.Section ([ "weeks" ], [ T.Text "w" ]) ]) ]) + +let test_comment_is_dropped () = + Alcotest.(check bool) "comment" true (parse_ok "a{{! note }}b" = [ T.Text "a"; T.Text "b" ]) + +let test_unclosed_section_is_an_error () = + match T.parse "{{#days}}x" with + | Error _ -> () + | Ok _ -> Alcotest.fail "an unclosed section must be a parse error, not silently accepted" + +let test_mismatched_close_is_an_error () = + match T.parse "{{#days}}x{{/weeks}}" with + | Error _ -> () + | Ok _ -> Alcotest.fail "a mismatched close tag must be a parse error" + +let test_unterminated_tag_is_an_error () = + match T.parse "{{name" with + | Error _ -> () + | Ok _ -> Alcotest.fail "an unterminated tag must be a parse error" + +(* The safety promise (spec section 5): a template is data, never a program. + There is no raw/triple-brace form to opt out of escaping, and no partial. *) +let test_no_raw_or_partial_form () = + Alcotest.(check bool) "triple brace is not an unescaped var" true + (match T.parse "{{{name}}}" with Ok [ T.Var [ "{name" ] ] -> false | Ok _ -> true | Error _ -> true); + match T.parse "{{>partial}}" with + | Error _ -> () + | Ok _ -> Alcotest.fail "partials must not parse: a template may not pull in another file" + +let suite = + ( "Template/parse", + [ Alcotest.test_case "plain text" `Quick test_plain_text; + Alcotest.test_case "vars" `Quick test_var; + Alcotest.test_case "sections" `Quick test_section; + Alcotest.test_case "nested sections" `Quick test_nested_sections; + Alcotest.test_case "comments dropped" `Quick test_comment_is_dropped; + Alcotest.test_case "unclosed section errors" `Quick test_unclosed_section_is_an_error; + Alcotest.test_case "mismatched close errors" `Quick test_mismatched_close_is_an_error; + Alcotest.test_case "unterminated tag errors" `Quick test_unterminated_tag_is_an_error; + Alcotest.test_case "no raw or partial form" `Quick test_no_raw_or_partial_form ] ) -- cgit v1.3 From da9cf402ceed8102aec1a9d008f8e918a23d39f3 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 08:17:30 +0200 Subject: feat(render): template renderer with mandatory escaping Every interpolated value is escaped for the template's flavour; the template's own literal text never is, because that is the author's markup. There is no raw form, so a template cannot opt out. Scope is a stack with outward fallback, so a grid template can reach the year number from inside a week without the view duplicating it into every cell. A missing key renders empty -- the one deliberate silence, so a template survives a rite that does not set every optional field. Mutation-tested: dropping the Escape.apply call reddens the data-cannot-escape-flavour case. --- lib/render/template.ml | 55 ++++++++++++++++++++++++++++++++++ lib/render/template.mli | 9 ++++++ test/test_colitur.ml | 3 +- test/test_template.ml | 79 +++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 145 insertions(+), 1 deletion(-) (limited to 'test/test_colitur.ml') diff --git a/lib/render/template.ml b/lib/render/template.ml index 3e35d53..7efa92b 100644 --- a/lib/render/template.ml +++ b/lib/render/template.ml @@ -94,3 +94,58 @@ let build items = 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) diff --git a/lib/render/template.mli b/lib/render/template.mli index 3f9ef97..4118496 100644 --- a/lib/render/template.mli +++ b/lib/render/template.mli @@ -26,3 +26,12 @@ type node = (** Never raises; a malformed template is an [Error] with a human-readable reason, because the template is user input. *) val parse : string -> (node list, string) result + +(** Render against a value. Escaping is applied to every interpolated value and + NEVER to the template's own literal text, which is the author's markup. + A missing key renders as the empty string -- the one deliberate silence, so + that a template survives a rite that does not set every optional field. *) +val render : flavour:Escape.flavour -> node list -> value -> string + +(** [parse] then [render]. *) +val render_string : flavour:Escape.flavour -> string -> value -> (string, string) result diff --git a/test/test_colitur.ml b/test/test_colitur.ml index a264174..f12dab5 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -8,4 +8,5 @@ let () = ("lectionary", Test_lectionary.suite); ("lectionary-ef", Test_lectionary_ef.suite); Test_escape.suite; - Test_template.suite ] + Test_template.suite; + Test_template.render_suite ] diff --git a/test/test_template.ml b/test/test_template.ml index cfb3b04..b83c378 100644 --- a/test/test_template.ml +++ b/test/test_template.ml @@ -84,3 +84,82 @@ let suite = Alcotest.test_case "unterminated tag errors" `Quick test_unterminated_tag_is_an_error; Alcotest.test_case "no raw or partial form" `Quick test_no_raw_or_partial_form; Alcotest.test_case "empty path errors" `Quick test_empty_path_is_an_error ] ) + +module E = Colitur_render.Escape + +let render ?(flavour = E.None_) tpl v = + match T.render_string ~flavour tpl v with Ok s -> s | Error e -> Alcotest.failf "render: %s" e + +let obj kvs = T.Obj kvs + +let test_render_var () = + Alcotest.(check string) "var" "Hilary" (render "{{name}}" (obj [ ("name", T.Str "Hilary") ])); + Alcotest.(check string) "dotted" "Hilarii" + (render "{{name.la}}" (obj [ ("name", obj [ ("la", T.Str "Hilarii") ]) ])) + +(* A missing key renders empty. This is the ONE silent case, and it is + deliberate: a template written for a rite that does not set every optional + field must still render (spec section 5). *) +let test_missing_key_is_empty () = + Alcotest.(check string) "missing" "[]" (render "[{{nope}}]" (obj [ ("name", T.Str "x") ])) + +let test_section_iterates () = + let v = obj [ ("days", T.List [ obj [ ("dom", T.Str "1") ]; obj [ ("dom", T.Str "2") ] ]) ] in + Alcotest.(check string) "iterate" "1|2|" (render "{{#days}}{{dom}}|{{/days}}" v) + +let test_bool_section () = + Alcotest.(check string) "true" "yes" (render "{{#f}}yes{{/f}}" (obj [ ("f", T.Bool true) ])); + Alcotest.(check string) "false" "" (render "{{#f}}yes{{/f}}" (obj [ ("f", T.Bool false) ])); + Alcotest.(check string) "inverted true" "" (render "{{^f}}no{{/f}}" (obj [ ("f", T.Bool true) ])); + Alcotest.(check string) "inverted false" "no" (render "{{^f}}no{{/f}}" (obj [ ("f", T.Bool false) ])) + +let test_empty_list_section_is_skipped () = + Alcotest.(check string) "empty list" "" (render "{{#days}}x{{/days}}" (obj [ ("days", T.List []) ])); + Alcotest.(check string) "inverted empty list" "none" + (render "{{^days}}none{{/days}}" (obj [ ("days", T.List []) ])) + +let test_outer_scope_visible_inside_section () = + let v = obj [ ("year", T.Str "2027"); ("days", T.List [ obj [ ("dom", T.Str "1") ] ]) ] in + Alcotest.(check string) "outer visible" "2027-1" + (render "{{#days}}{{year}}-{{dom}}{{/days}}" v) + +(* THE safety property (spec section 9.2): a data value can never escape its + flavour. This is the test that must redden if any escape rule is broken. *) +let test_data_cannot_escape_flavour () = + let nasty = obj [ ("name", T.Str "A & B \\ 50% {x} $y_z") ] in + let out = render ~flavour:E.Latex "{{name}}" nasty in + Alcotest.(check string) "fully escaped" "A \\& B \\textbackslash{} 50\\% \\{x\\} \\$y\\_z" out; + let hout = render ~flavour:E.Html "{{name}}" (obj [ ("name", T.Str "