From a2cbb6b85e79fbc59b0879362c0f853757d51c07 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Thu, 20 Aug 2026 15:09:49 +0200 Subject: feat(citation): render a parsed citation in a configurable style A style is a set of format strings, so punctuation convention is data. Values are unquoted here rather than in Overlay_ini: that parser trims every value and is shared with overlays and [defaults], so teaching it about quotes would change behaviour this feature has no business changing. --- lib/citation/render.ml | 107 ++++++++++++++++++++++++++++++++++++++++++++++ lib/citation/render.mli | 48 +++++++++++++++++++++ test/test_citation.ml | 111 ++++++++++++++++++++++++++++++++++++++++++++++++ test/test_colitur.ml | 1 + 4 files changed, 267 insertions(+) create mode 100644 lib/citation/render.ml create mode 100644 lib/citation/render.mli diff --git a/lib/citation/render.ml b/lib/citation/render.ml new file mode 100644 index 0000000..c66a0ca --- /dev/null +++ b/lib/citation/render.ml @@ -0,0 +1,107 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +type style = { + book : [ `Full | `Abbr ]; + book_sep : string; + chapter_verse : string; + range : string; + part_sep : string; + verse_sep : string; +} + +let default_style = + { book = `Abbr; + book_sep = " "; + chapter_verse = "{chapter}:{verses}"; + range = "{first}-{last}"; + part_sep = "; "; + verse_sep = ", " } + +let part_sep st = st.part_sep +let range st = st.range +let book_sep st = st.book_sep + +(* Arabic -> Roman, for the {chapter_roman} placeholder. Lifted from + [Colitur_render.View.roman_numeral], which prints "Hebdomada I" week + headings -- roman numerals are idiomatic throughout this project's + output ("Feria IV"), so a citation style may want them too. *) +let roman_numeral n = + if n <= 0 then string_of_int n + else + let table = + [ (1000, "M"); (900, "CM"); (500, "D"); (400, "CD"); (100, "C"); + (90, "XC"); (50, "L"); (40, "XL"); (10, "X"); (9, "IX"); + (5, "V"); (4, "IV"); (1, "I") ] + in + let b = Buffer.create 8 in + let n = ref n in + List.iter + (fun (v, sym) -> + while !n >= v do + Buffer.add_string b sym; + n := !n - v + done) + table; + Buffer.contents b + +let with_book b st = { st with book = b } + +(* One matching pair of surrounding double quotes, and only that -- see the + .mli for why this is not in Overlay_ini. *) +let unquote s = + let n = String.length s in + if n >= 2 && s.[0] = '"' && s.[n - 1] = '"' then String.sub s 1 (n - 2) else s + +(* Replace {name} with its value. An UNKNOWN placeholder survives + literally: a typo in a hand-written style file must be visible in the + output, not silently swallowed. *) +let subst tmpl pairs = + let n = String.length tmpl in + let b = Buffer.create (n + 16) in + let i = ref 0 in + while !i < n do + if tmpl.[!i] = '{' then + match String.index_from_opt tmpl !i '}' with + | None -> + Buffer.add_char b tmpl.[!i]; + incr i + | Some j -> + let name = String.sub tmpl (!i + 1) (j - !i - 1) in + (match List.assoc_opt name pairs with + | Some v -> Buffer.add_string b v + | None -> Buffer.add_string b (String.sub tmpl !i (j - !i + 1))); + i := j + 1 + else begin + Buffer.add_char b tmpl.[!i]; + incr i + end + done; + Buffer.contents b + +let render st ~names (t : Parse.t) = + let one_range (r : Parse.verse_range) = + match r.Parse.last with + | None -> string_of_int r.Parse.first + | Some l -> + subst st.range + [ ("first", string_of_int r.Parse.first); + ("last", string_of_int l) ] + in + let one_part (p : Parse.part) = + let verses = String.concat st.verse_sep (List.map one_range p.Parse.verses) in + subst st.chapter_verse + [ ("chapter", string_of_int p.Parse.chapter); + ("chapter_roman", roman_numeral p.Parse.chapter); + ("verses", verses) ] + in + let body = String.concat st.part_sep (List.map one_part t.Parse.parts) in + names t.Parse.book st.book ^ st.book_sep ^ body + +let style_of_fields fields = + let get k d = match List.assoc_opt k fields with Some v -> unquote v | None -> d in + { book = (if get "book" "abbr" = "full" then `Full else `Abbr); + book_sep = get "book_sep" default_style.book_sep; + chapter_verse = get "chapter_verse" default_style.chapter_verse; + range = get "range" default_style.range; + part_sep = get "part_sep" default_style.part_sep; + verse_sep = get "verse_sep" default_style.verse_sep } diff --git a/lib/citation/render.mli b/lib/citation/render.mli new file mode 100644 index 0000000..d741931 --- /dev/null +++ b/lib/citation/render.mli @@ -0,0 +1,48 @@ +(* SPDX-License-Identifier: AGPL-3.0-or-later *) + +(** Turn a parsed citation back into text, in a configurable style. + + A style is data, not code, so a tradition of punctuation is a file + someone can write: [Luke 5:12-14], [Lk 5:12-14], [Luke 5.12-14], + [{L}k 5, 12-14] are all the same citation in different conventions. + + Placeholders: [{chapter}], [{chapter_roman}] and [{verses}] in + [chapter_verse]; [{first}] and [{last}] in [range]. An UNKNOWN + placeholder survives literally, so a typo is visible in the output + rather than silently swallowed. *) + +type style + +(** The Vulgate/Latin convention: abbreviated book, [chapter:verses], + [first-last], ["; "] between parts, [", "] between verse ranges. *) +val default_style : style + +(** Read a style from a language file's [\[sigla\]] section. + + Values are UNQUOTED here: one matching pair of surrounding double quotes + is stripped, so a separator's significant trailing space survives. + {!Colitur_kernel.Overlay_ini} trims every value and has no quote + handling, and it is shared with overlays and [\[defaults\]] -- so the + unquoting belongs here, not there. An unrecognised key is ignored; + a missing key keeps {!default_style}'s value. *) +val style_of_fields : (string * string) list -> style + +(** Override the book form, for the [sigla_book] config key. *) +val with_book : [ `Full | `Abbr ] -> style -> style + +val part_sep : style -> string +val range : style -> string + +(** What separates the book name from the reference. Default [" "]. + + Settable because a typeset booklet wants a NON-BREAKING space here -- a + line break between "Luc." and "3, 1" is exactly the ugliness this + prevents. Set it to a literal U+00A0: the escapers match ASCII bytes + only, so a UTF-8 multibyte sequence passes through every flavour + untouched (verified for latex, typst, groff, html, xml, ics). A LaTeX + tie [~] does NOT work -- {!Colitur_render.Escape} turns it into + [\textasciitilde{}]. *) +val book_sep : style -> string + +val render : + style -> names:(Book.id -> [ `Full | `Abbr ] -> string) -> Parse.t -> string diff --git a/test/test_citation.ml b/test/test_citation.ml index 75fffe8..e234942 100644 --- a/test/test_citation.ml +++ b/test/test_citation.ml @@ -200,3 +200,114 @@ let parse_suite = ("modern name, vulgate id", `Quick, parses "Rev 12:1" "apocalypse|12:1"); ("unknown book", `Quick, test_rejects_unknown_book); ("garbage", `Quick, test_rejects_garbage) ] + +module R = Colitur_citation.Render + +let names id form = + let n = B.to_string id in + match form with `Abbr -> (if n = "luke" then "Luc." else n) + | `Full -> (if n = "luke" then "Evangelium secundum Lucam" else n) + +let render_with fields input expected () = + let style = R.style_of_fields fields in + match P.parse input with + | Error e -> Alcotest.failf "%s did not parse: %s" input e + | Ok t -> Alcotest.(check s) input expected (R.render style ~names t) + +let test_unquotes_trailing_space () = + let st = R.style_of_fields [ ("part_sep", "\"; \"") ] in + Alcotest.(check s) "quotes stripped, space kept" "; " (R.part_sep st) + +let test_bare_value_untouched () = + let st = R.style_of_fields [ ("range", "{first}-{last}") ] in + Alcotest.(check s) "no quotes" "{first}-{last}" (R.range st) + +(* [subst] has no test pressure of its own anywhere else in the suite, so + these three isolate its contract directly through the only surface that + calls it: a [range]/[chapter_verse] template chosen so nothing else in + the pipeline (verse-list joining, book naming) can mask the result. *) +let test_subst_no_placeholder () = + (* A template with no "{" at all passes through completely unchanged. *) + render_with [ ("book", "abbr"); ("chapter_verse", "fixed-text") ] "Luke 2:21" + "Luc. fixed-text" () + +let test_subst_two_placeholders () = + (* Two DIFFERENT known placeholders, reordered relative to the record's + own field order ([last] before [first]) -- proves substitution is by + name, not by position. *) + render_with + [ ("book", "abbr"); ("range", "{last}~{first}") ] + "Luke 5:12-14" "Luc. 5:14~12" () + +let test_subst_unknown_placeholder_alone () = + (* A template that is NOTHING but an unrecognised placeholder: it must + survive byte-for-byte, proving [subst] never touches an unmatched + "{...}" run even when there is no surrounding literal text to anchor + on. *) + render_with [ ("book", "abbr"); ("range", "{nope}") ] "Luke 5:12-14" + "Luc. 5:{nope}" () + +(* [roman_numeral] is private to Render (not in the .mli, matching + [View.roman_numeral]'s own precedent -- tested indirectly, never + exposed). Reached through [render] with a [chapter_verse] template of + bare [{chapter_roman}], [book_sep] emptied and [names] returning "", so + the assertion isolates exactly the numeral and nothing else. *) +let roman_of n = + let luke = match B.of_token "Luke" with Some id -> id | None -> assert false in + let t : P.t = { P.book = luke; parts = [ { P.chapter = n; verses = [ { P.first = 1; last = None } ] } ] } in + let style = R.style_of_fields [ ("book_sep", ""); ("chapter_verse", "{chapter_roman}") ] in + R.render style ~names:(fun _ _ -> "") t + +let test_roman_numeral_values () = + List.iter + (fun (n, expected) -> Alcotest.(check s) (string_of_int n) expected (roman_of n)) + [ (1, "I"); (4, "IV"); (9, "IX"); (14, "XIV"); (40, "XL"); (150, "CL") ] + +let test_roman_numeral_non_positive () = + (* The one input that could loop forever in a naive implementation: a + non-positive chapter returns the arabic form instead. Completing at + all is part of what this test proves. *) + Alcotest.(check s) "zero" "0" (roman_of 0); + Alcotest.(check s) "negative" "-3" (roman_of (-3)) + +let render_suite = + ( "Citation/render", + [ Alcotest.test_case "latin default" `Quick + (render_with [ ("book", "abbr") ] "Luke 5:12-14" "Luc. 5:12-14"); + Alcotest.test_case "full name" `Quick + (render_with [ ("book", "full") ] "Luke 5:12-14" + "Evangelium secundum Lucam 5:12-14"); + Alcotest.test_case "comma style" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}, {verses}") ] + "Luke 5:12-14" "Luc. 5, 12-14"); + Alcotest.test_case "multi part" `Quick + (render_with [ ("book", "abbr"); ("part_sep", "\"; \"") ] + "Joel 2:23-24; 26-27" "joel 2:23-24; 2:26-27"); + Alcotest.test_case "unquote" `Quick test_unquotes_trailing_space; + Alcotest.test_case "bare value" `Quick test_bare_value_untouched; + (* The Missal's own convention, scan-verified: "Matth. 11, 2" / + "Ioann. 1, 1" -- dotted abbreviation, comma, ARABIC chapter. *) + Alcotest.test_case "missal convention" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}, {verses}") ] + "Luke 5:12-14" "Luc. 5, 12-14"); + Alcotest.test_case "roman chapter" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter_roman}, {verses}") ] + "Luke 5:12-14" "Luc. V, 12-14"); + (* U+00A0 between book and reference, for typeset output. *) + Alcotest.test_case "nbsp book sep" `Quick + (render_with [ ("book", "abbr"); ("book_sep", "\"\xc2\xa0\"") ] + "Luke 5:12-14" "Luc.\xc2\xa05:12-14"); + Alcotest.test_case "unknown placeholder survives" `Quick + (render_with + [ ("book", "abbr"); ("chapter_verse", "{chapter}:{nope}") ] + "Luke 5:12-14" "Luc. 5:{nope}"); + Alcotest.test_case "subst: no placeholder" `Quick test_subst_no_placeholder; + Alcotest.test_case "subst: two placeholders" `Quick test_subst_two_placeholders; + Alcotest.test_case "subst: unknown placeholder alone" `Quick + test_subst_unknown_placeholder_alone; + Alcotest.test_case "roman_numeral: table values" `Quick test_roman_numeral_values; + Alcotest.test_case "roman_numeral: non-positive" `Quick + test_roman_numeral_non_positive ] ) diff --git a/test/test_colitur.ml b/test/test_colitur.ml index fb2c20c..6084adb 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -7,6 +7,7 @@ let () = Test_citation_coverage.suite; Test_citation.suite; ("parse", Test_citation.parse_suite); + Test_citation.render_suite; Test_config.suite; Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; -- cgit v1.3