module B = Colitur_citation.Book

let s = Alcotest.string

let test_both_spellings_are_one_book () =
  (* The books listed here arrive in more than one spelling and must
     collapse onto one id. This is the whole reason the parser exists rather
     than a regex. Most pairs are dotted/undotted; "Sir"/"Ecclus" and
     "Apoc"/"Rev" are a modern spelling sitting inside otherwise-Vulgate
     data -- see book.mli. *)
  let same a b =
    match B.of_token a, B.of_token b with
    | Some x, Some y ->
        Alcotest.(check s) (a ^ " = " ^ b) (B.to_string x) (B.to_string y)
    | _ -> Alcotest.failf "%s or %s did not resolve" a b
  in
  same "Isa" "Isa.";
  same "Matt" "Matt.";
  same "1 Cor" "1 Cor.";
  same "1 Pet" "1 Pet.";
  same "1 Thess" "1 Thess.";
  same "Eph" "Eph.";
  same "3 Kgs." "3 Kings";
  same "Sir" "Ecclus";
  same "Apoc" "Rev";
  same "2 Cor" "2 Cor.";
  same "Col" "Col.";
  same "Wis" "Wis.";
  same "2 Tim" "2 Tim.";
  same "Ex" "Exod";
  same "Ezech" "Ezek";
  same "Jas" "James"

let test_unknown_token_is_none () =
  Alcotest.(check bool) "not a book" true (B.of_token "Nonesuch" = None)

let test_vulgate_is_identity () =
  match B.of_token "3 Kings" with
  | None -> Alcotest.fail "3 Kings did not resolve"
  | Some k ->
      Alcotest.(check s) "unmapped" "kings_3" (B.to_string (B.map B.vulgate k))

let test_modern_renumbers () =
  let modern = B.tradition_of_fields [ ("kings_3", "kings_1") ] in
  match B.of_token "3 Kings" with
  | None -> Alcotest.fail "3 Kings did not resolve"
  | Some k ->
      Alcotest.(check s) "renumbered" "kings_1" (B.to_string (B.map modern k))

let test_tokens_has_no_duplicate_spelling () =
  (* [of_token] resolves via [List.assoc_opt], which silently prefers the
     first match on a duplicate key. A copy-paste collision in the table
     would therefore mis-map a book in total silence, never an exception --
     assert the invariant directly rather than trust it by inspection. *)
  let spellings = List.map fst B.tokens in
  let sorted = List.sort compare spellings in
  let rec find_dup = function
    | a :: (b :: _ as rest) -> if a = b then Some a else find_dup rest
    | _ -> None
  in
  match find_dup sorted with
  | None -> ()
  | Some dup -> Alcotest.failf "duplicate spelling in Book.tokens: %S" dup

(* Read a whole file into a string. Test-only I/O; the library itself never
   touches the filesystem. *)
let read_file path =
  let ic = open_in_bin path in
  let n = in_channel_length ic in
  let content = really_input_string ic n in
  close_in ic;
  content

let starts_with_at content pos prefix =
  let plen = String.length prefix in
  pos + plen <= String.length content && String.sub content pos plen = prefix

(* Every [(reference ...)] payload in a data file, in file order. No
   [Str]/regex -- a plain forward scan for the marker, then read to the
   closing quote. Mirrors the coordinator's own survey command (grep -oh
   over the reference marker, quote-delimited). *)
let references content =
  let marker = "(reference \"" in
  let mlen = String.length marker in
  let len = String.length content in
  let rec loop pos acc =
    if pos >= len then List.rev acc
    else if starts_with_at content pos marker then
      let start = pos + mlen in
      match String.index_from_opt content start '"' with
      | None -> List.rev acc
      | Some close ->
          let payload = String.sub content start (close - start) in
          loop (close + 1) (payload :: acc)
    else loop (pos + 1) acc
  in
  loop 0 []

let is_alpha c = (c >= 'A' && c <= 'Z') || (c >= 'a' && c <= 'z')
let is_one_to_four c = c >= '1' && c <= '4'

(* The leading book token of one reference payload, e.g. ["2 Tim 4:1-8"] ->
   ["2 Tim"], ["Wis. 5:1-5"] -> ["Wis."]. Mirrors the coordinator's own
   survey command's second stage:
   `sed -E 's/^(([1-4] )?[A-Za-z]+\.?).*/\1/'`. *)
let book_token r =
  let len = String.length r in
  let start = if len >= 2 && is_one_to_four r.[0] && r.[1] = ' ' then 2 else 0 in
  let i = ref start in
  while !i < len && is_alpha r.[!i] do
    incr i
  done;
  let stop = if !i < len && r.[!i] = '.' then !i + 1 else !i in
  String.sub r 0 stop

let test_every_data_file_token_resolves () =
  (* The check whose absence caused fix round 1: the brief surveyed only
     the lectionary and missed 21 tokens, several common, living in
     sanctoral.sexp and commons.sexp. Read all three files at test time and
     re-derive the token set from them, rather than hardcoding a list, so
     this keeps working when the data changes. *)
  let files =
    [ "../data/ef/lectionary.sexp"; "../data/ef/sanctoral.sexp"; "../data/ef/commons.sexp" ]
  in
  let tokens =
    files
    |> List.concat_map (fun f -> references (read_file f))
    |> List.map book_token
    |> List.sort_uniq compare
  in
  Alcotest.(check bool) "at least one token found" true (List.length tokens > 0);
  let unresolved = List.filter (fun t -> B.of_token t = None) tokens in
  match unresolved with
  | [] -> ()
  | _ ->
      Alcotest.failf "unresolved book tokens in shipped data: %s"
        (String.concat ", " unresolved)

let suite =
  ( "book",
    [ Alcotest.test_case "both spellings one book" `Quick test_both_spellings_are_one_book;
      Alcotest.test_case "unknown token" `Quick test_unknown_token_is_none;
      Alcotest.test_case "vulgate identity" `Quick test_vulgate_is_identity;
      Alcotest.test_case "modern renumbers" `Quick test_modern_renumbers;
      Alcotest.test_case "tokens has no duplicate spelling" `Quick
        test_tokens_has_no_duplicate_spelling;
      Alcotest.test_case "every data file token resolves" `Quick
        test_every_data_file_token_resolves ] )

module P = Colitur_citation.Parse

(* Render a parse back to a debug string so a test can assert shape
   compactly: "book|chapter:v-v,v-v|chapter:v". *)
let show (t : P.t) =
  let range (r : P.verse_range) =
    match r.P.last with
    | None -> string_of_int r.P.first
    | Some l -> Printf.sprintf "%d-%d" r.P.first l
  in
  let part (p : P.part) =
    Printf.sprintf "%d:%s" p.P.chapter
      (String.concat "," (List.map range p.P.verses))
  in
  B.to_string t.P.book ^ "|" ^ String.concat "|" (List.map part t.P.parts)

let parses input expected () =
  match P.parse input with
  | Error e -> Alcotest.failf "%s did not parse: %s" input e
  | Ok t -> Alcotest.(check s) input expected (show t)

let test_rejects_unknown_book () =
  Alcotest.(check bool) "error" true (Result.is_error (P.parse "Nonesuch 1:1"))

let test_rejects_garbage () =
  List.iter
    (fun bad ->
      Alcotest.(check bool) bad true (Result.is_error (P.parse bad)))
    [ ""; "Luke"; "Luke :"; "Luke 1:"; "Luke abc:1" ]

let parse_suite =
  [ ("simple",            `Quick, parses "1 Cor 11:20-32" "corinthians_1|11:20-32");
    ("trailing period",   `Quick, parses "1 John 3:13-18." "john_1|3:13-18");
    ("single verse",      `Quick, parses "Luke 2:21" "luke|2:21");
    ("dotted spelling",   `Quick, parses "Isa. 1:16-19" "isaiah|1:16-19");
    ("verse list",        `Quick, parses "Acts 10:34, 42-48" "acts|10:34,42-48");
    ("new chapter",       `Quick, parses "1 Cor. 9:24-27; 10:1-5"
                                   "corinthians_1|9:24-27|10:1-5");
    (* Rule 1: the second part names no chapter, so it inherits chapter 2. *)
    ("inherited chapter", `Quick, parses "Joel 2:23-24; 26-27" "joel|2:23-24|2:26-27");
    (* Rule 2: comma separates chapter from verses in the second part. *)
    ("comma chapter",     `Quick, parses "Mark 14:32-72; 15, 1-46"
                                   "mark|14:32-72|15:1-46");
    ("four ranges",       `Quick, parses "Dan 13:1-9, 15-17, 19-30, 33-62."
                                   "daniel|13:1-9,15-17,19-30,33-62");
    ("mixed",             `Quick, parses "Num 20:1, 3; 6-13." "numbers|20:1,3|20:6-13");
    ("trailing semicolon", `Quick, parses "1 Cor 1:18-25; 1:30;"
                                   "corinthians_1|1:18-25|1:30");
    ("four parts",        `Quick, parses "Eccli 24:5; 14:7; 14:9-11; 24:30-31"
                                   "ecclesiasticus|24:5|14:7|14:9-11|24:30-31");
    ("modern name, vulgate id", `Quick, parses "Rev 12:1" "apocalypse|12:1");
    ("unknown book",      `Quick, test_rejects_unknown_book);
    ("garbage",           `Quick, test_rejects_garbage) ]