path: root/test/test_emit.ml

module V = Colitur_render.View
module Csv = Colitur_render.Emit_csv
module Json = Colitur_render.Emit_json
module Xml = Colitur_render.Emit_xml

let view_2027 () = Test_view.view_of 2027

(* Substring search shared by several live-data checks below (CSV, XML), in
   place of a repeated inline recursive finder. *)
let contains ~needle hay =
  let n = String.length needle and h = String.length hay in
  let rec go i = i + n <= h && (String.sub hay i n = needle || go (i + 1)) in
  go 0

(* A byte-accurate RFC 4180 field splitter. [String.split_on_char ','] cannot
   be trusted to count fields: a correctly QUOTED field is legally allowed to
   contain a comma (exactly what Joseph's own name field does below), so a
   naive split over-counts by the number of internal commas whether or not
   they are correctly quoted -- it cannot tell the difference, which is
   precisely why the test this replaced was vacuous. *)
let parse_csv_row line =
  let n = String.length line in
  let fields = ref [] in
  let buf = Buffer.create 32 in
  let i = ref 0 in
  while !i < n do
    if line.[!i] = '"' then begin
      incr i;
      let closed = ref false in
      while (not !closed) && !i < n do
        if line.[!i] = '"' then
          if !i + 1 < n && line.[!i + 1] = '"' then begin
            Buffer.add_char buf '"';
            i := !i + 2
          end
          else begin
            incr i;
            closed := true
          end
        else begin
          Buffer.add_char buf line.[!i];
          incr i
        end
      done
    end
    else if line.[!i] = ',' then begin
      fields := Buffer.contents buf :: !fields;
      Buffer.clear buf;
      incr i
    end
    else begin
      Buffer.add_char buf line.[!i];
      incr i
    end
  done;
  fields := Buffer.contents buf :: !fields;
  List.rev !fields

let test_csv_header_and_rows () =
  let out = Csv.year (view_2027 ()) in
  let lines = String.split_on_char '\n' out |> List.filter (fun l -> l <> "") in
  Alcotest.(check int) "366 lines: header + 365 days" 366 (List.length lines);
  Alcotest.(check string) "header"
    "date,rite,season,season_name,week,slug,name,weekday,rank,rank_name,colour,colour_name,subject,first,gospel,comms"
    (List.hd lines);
  Alcotest.(check bool) "first row is 1 January" true
    (String.length (List.nth lines 1) > 10 && String.sub (List.nth lines 1) 0 10 = "2027-01-01")

(* RFC 4180: a field containing a comma, quote or newline is quoted, and an
   embedded quote is doubled. Feast names contain commas ("St. Joseph, Spouse
   of the Bl. Virgin Mary"), so this is live on real data, not hypothetical. *)
let test_csv_quotes_commas () =
  Alcotest.(check string) "comma quoted" "\"a,b\"" (Csv.escape_field "a,b");
  Alcotest.(check string) "quote doubled" "\"a\"\"b\"" (Csv.escape_field "a\"b");
  Alcotest.(check string) "plain unquoted" "ab" (Csv.escape_field "ab");
  let out = Csv.year (view_2027 ()) in
  let joseph =
    List.find
      (fun l -> String.length l > 10 && String.sub l 0 10 = "2027-03-19")
      (String.split_on_char '\n' out)
  in
  (* The check this replaced inspected the length of the FIRST field only --
     always the 10-char ISO date, which can never contain a comma, so it
     could never fail. Parse the row as RFC 4180 actually requires
     (quote-aware) and check the FIELD COUNT against the header: a comma
     that escapes its quoting produces 14 fields, not 13. Also assert the
     quoted substring appears literally, byte for byte -- belt and braces,
     and closer to what a human reviewing the CSV would actually look for. *)
  Alcotest.(check int) "the row has exactly 16 fields, same as the header"
    16 (List.length (parse_csv_row joseph));
  Alcotest.(check bool) "Joseph's comma-bearing name is quoted whole, not split" true
    (contains ~needle:"\"St. Joseph, Spouse of the Bl. Virgin Mary\"" joseph)

let test_json_parses_back () =
  let out = Json.year (view_2027 ()) in
  Alcotest.(check bool) "starts as an object" true (out.[0] = '{');
  let count sub =
    let n = String.length sub in
    let rec go i acc =
      if i + n > String.length out then acc
      else go (i + 1) (if String.sub out i n = sub then acc + 1 else acc)
    in
    go 0 0
  in
  Alcotest.(check bool) "has a days array" true (count "\"days\":[" >= 1);
  (* Every ISO date the view produced appears in the JSON -- that is the
     property under test, not a specific occurrence count. The count is NOT
     1: the view deliberately offers both artefacts at every level (view.mli)
     -- the flat top-level [days], each month's own [days], and that month's
     [weeks] grid cell -- so an ordinary date's "iso" field appears 3 times.
     Verified against the real 2027 engine output (all 365 dates checked);
     the one exception is legitimate, not a bug: 2027-04-05 appears 6 times
     because the Annunciation (25 March, impeded by Holy Week) transfers to
     it under RG 96/98, and its own "to" target string is the identical
     literal, tripled by the same structural redundancy. *)
  Alcotest.(check int) "1 January appears (flat days + month days + week grid)" 3
    (count "\"2027-01-01\"");
  Alcotest.(check int) "31 December appears (flat days + month days + week grid)" 3
    (count "\"2027-12-31\"")

let test_json_escapes () =
  Alcotest.(check string) "quote" "\"a\\\"b\"" (Json.escape_string "a\"b");
  Alcotest.(check string) "backslash" "\"a\\\\b\"" (Json.escape_string "a\\b");
  Alcotest.(check string) "newline" "\"a\\nb\"" (Json.escape_string "a\nb");
  Alcotest.(check string) "tab" "\"a\\tb\"" (Json.escape_string "a\tb");
  (* Control characters below 0x20 must be \u-escaped (RFC 8259 section 7). *)
  Alcotest.(check string) "control" "\"a\\u0001b\"" (Json.escape_string "a\001b")

let test_utf8_passes_through_json () =
  Alcotest.(check string) "polish" "\"\xc5\x9awi\xc4\x99tej\""  (Json.escape_string "\xc5\x9awi\xc4\x99tej")

let suite =
  ( "Emit/csv+json",
    [ Alcotest.test_case "csv header and rows" `Quick test_csv_header_and_rows;
      Alcotest.test_case "csv quotes commas" `Quick test_csv_quotes_commas;
      Alcotest.test_case "json parses back" `Quick test_json_parses_back;
      Alcotest.test_case "json escapes" `Quick test_json_escapes;
      Alcotest.test_case "json passes utf8 through" `Quick test_utf8_passes_through_json ] )

let test_xml_shape () =
  let out = Xml.year (view_2027 ()) in
  Alcotest.(check bool) "declaration" true
    (String.length out > 5 && String.sub out 0 5 = "<?xml");
  Alcotest.(check bool) "root element" true
    (contains ~needle:"<calendar rite=\"ef\" year=\"2027\">" out)

(* Every '<' in the output must open a tag: an unescaped '<' inside a feast
   name is the failure that makes a whole feed unparseable. *)
let test_xml_tags_balance () =
  let out = Xml.year (view_2027 ()) in
  let opens = ref 0 and closes = ref 0 in
  String.iter (fun c -> if c = '<' then incr opens else if c = '>' then incr closes) out;
  Alcotest.(check int) "every < has a >" !opens !closes

let test_xml_escapes_data () =
  Alcotest.(check string) "amp" "a &amp; b" (Xml.escape "a & b");
  Alcotest.(check string) "angle" "&lt;x&gt;" (Xml.escape "<x>")

(* [is_entity_at s i] recognises the five predefined XML entities and a
   numeric character reference starting at [s.[i]] = '&'. Anything else
   starting at a '&' is a bare, illegal ampersand -- exactly what
   [xmllint --noout] refuses a document over. *)
let is_entity_at s i =
  let n = String.length s in
  let starts_with prefix =
    let pn = String.length prefix in
    i + pn <= n && String.sub s i pn = prefix
  in
  starts_with "&amp;" || starts_with "&lt;" || starts_with "&gt;"
  || starts_with "&quot;" || starts_with "&apos;"
  ||
  (* &#NNN; -- one or more digits then ';'. *)
  (i + 2 < n && s.[i + 1] = '#'
   &&
   let j = ref (i + 2) in
   while !j < n && s.[!j] >= '0' && s.[!j] <= '9' do
     incr j
   done;
   !j > i + 2 && !j < n && s.[!j] = ';')

(* Live-data check. [test_xml_escapes_data] above proves [Escape.Xml] is
   correct in isolation; it proves nothing about whether [Emit_xml.year]
   actually CALLS it on every interpolated value -- bypassing that call
   while leaving [Escape.Xml] itself untouched left every test in this suite
   green (mutation-proven; see the branch review that found this). Real 2035
   output carries "Sts. Fabian & Sebastian" (20 January) unescaped in the
   source data, which is exactly the case that must come out as "&amp;", and
   the whole document must then contain no OTHER bare '&' anywhere. *)
let test_xml_escapes_live_data () =
  let out = Xml.year (Test_view.view_of 2035) in
  Alcotest.(check bool) "Fabian & Sebastian's ampersand is escaped" true
    (contains ~needle:"&amp;" out);
  let bare = ref 0 in
  String.iteri (fun i c -> if c = '&' && not (is_entity_at out i) then incr bare) out;
  Alcotest.(check int) "no bare, unescaped '&' anywhere in the document" 0 !bare

let xml_suite =
  ( "Emit/xml",
    [ Alcotest.test_case "shape" `Quick test_xml_shape;
      Alcotest.test_case "tags balance" `Quick test_xml_tags_balance;
      Alcotest.test_case "escapes data" `Quick test_xml_escapes_data;
      Alcotest.test_case "escapes live data (2035, Fabian & Sebastian)" `Quick
        test_xml_escapes_live_data ] )