path: root/lib/citation/parse.ml

(* SPDX-License-Identifier: AGPL-3.0-or-later *)

(* Fix wave I2 (final-review.md, 2026-08-25-colitur-of-phases-3-5): a VERSE
   number (never a chapter number -- see [num_opt]'s own citation below) may
   carry a trailing lowercase-letter sub-verse marker, standard lectionary
   notation for "part of this verse" ("11a" = the first clause of verse 11)
   and sometimes several run together ("1bcde" = parts b through e of verse
   1). [suffix] is [""] for the overwhelming majority of verse numbers --
   every EF citation, checked: none carries one at all (grep across
   data/ef/{lectionary,sanctoral,commons}.sexp finds zero) -- so this is
   purely additive for EF and does not change how any existing citation
   parses or renders. Carried through and RENDERED, not stripped: dropping
   it would silently lose real precision a reader can see in the source
   text, trading "wrong format, complete" for "right format, incomplete". *)
type verse_num = { n : int; suffix : string }

(* See parse.mli's own citation for [verse_end]'s rationale. *)
type verse_end = { chapter : int option; verse : verse_num }
type verse_range = { first : verse_num; last : verse_end option }
type part = { chapter : int; verses : verse_range list }
type t = { book : Book.id; parts : part list }

let split_on c s = String.split_on_char c s |> List.map String.trim

(* Split at the FIRST ':' only, unlike [split_on ':'] which splits at every
   one. [parse_part] needs this: a "chapter:verses" part whose verses
   themselves contain a chapter-crossing hyphen range ("1:5-2:2") carries a
   SECOND colon that belongs to the verses side, not to a second chapter
   marker -- splitting on every ':' would see three pieces there and fail
   to parse at all (the exact shape [parse_range]'s own citation above
   restores). *)
let split_first_colon s =
  match String.index_opt s ':' with
  | None -> None
  | Some i ->
      Some
        ( String.trim (String.sub s 0 i),
          String.trim (String.sub s (i + 1) (String.length s - i - 1)) )

(* The book is the longest leading run of non-digit words, allowing one
   leading ordinal ("1 Cor", "3 Kings"). Everything after it is the
   reference tail. *)
(* Longest REGISTERED token that prefixes [s] and is followed by a space and
   a digit. This is what lets a MULTI-WORD title parse: the heuristic below
   stops at the first space, so "Evangelium secundum Lucam 5:12-14" would
   otherwise split as the book "Evangelium" and fail.

   Longest-match matters and is not decoration: "Liber Regum III" and
   "Liber Regum IV" share a prefix with each other, and a shortest-match
   would read both as some other book entirely. *)
let longest_token_prefix s =
  let n = String.length s in
  let best = ref None in
  List.iter
    (fun (tok, _) ->
      let tl = String.length tok in
      if
        tl < n
        && String.sub s 0 tl = tok
        && s.[tl] = ' '
        (* a digit must follow, or "Job" would swallow the start of a
           different book whose name merely begins the same way *)
        && (let j = ref (tl + 1) in
            while !j < n && s.[!j] = ' ' do incr j done;
            !j < n && s.[!j] >= '0' && s.[!j] <= '9')
      then
        match !best with
        | Some (b, _) when String.length b >= tl -> ()
        | _ -> best := Some (tok, String.trim (String.sub s tl (n - tl)))
    )
    Book.tokens;
  !best

let split_book s =
  match longest_token_prefix s with
  | Some (book, tail) when tail <> "" -> Some (book, tail)
  | _ ->
  let n = String.length s in
  let i = ref 0 in
  (* optional leading ordinal digit *)
  if !i < n && s.[!i] >= '1' && s.[!i] <= '4' then begin
    incr i;
    while !i < n && s.[!i] = ' ' do incr i done
  end;
  (* letters and dots *)
  while !i < n && (s.[!i] = '.' || (s.[!i] >= 'A' && s.[!i] <= 'z')) do incr i done;
  if !i = 0 then None
  else
    let book = String.trim (String.sub s 0 !i) in
    let tail = String.trim (String.sub s !i (n - !i)) in
    if book = "" || tail = "" then None else Some (book, tail)

(* A citation number is PLAIN DIGITS and positive -- nothing else.
   [int_of_string_opt] also accepts OCaml's own integer-literal syntax, so
   "1_1" would read as 11 and "+5" as 5: a transcription typo silently
   becoming a DIFFERENT chapter, which nothing downstream could detect. A
   user overlay supplies arbitrary strings, so this is reachable, not
   theoretical. Chapter and verse numbering both start at 1, so zero is
   rejected too. *)
let int_opt s =
  let s = String.trim s in
  let ok =
    s <> ""
    && String.for_all (function '0' .. '9' -> true | _ -> false) s
  in
  if not ok then None
  else match int_of_string_opt s with Some n when n > 0 -> Some n | _ -> None

(* [num_opt] is [int_opt] widened to accept a trailing sub-verse letter run
   ([verse_num]'s own citation above) -- used ONLY for verse numbers inside
   [parse_range] below. Chapter numbers ([parse_part]'s own [int_opt c]
   calls) are deliberately left on plain [int_opt]: nothing in the data ever
   attaches a sub-verse letter to a CHAPTER, and keeping chapter-parsing on
   the original, narrower function means this change cannot loosen what a
   chapter number is allowed to look like. *)
let split_num_suffix s =
  let n = String.length s in
  let i = ref 0 in
  while !i < n && s.[!i] >= '0' && s.[!i] <= '9' do incr i done;
  if !i = 0 then None
  else
    let digits = String.sub s 0 !i and suffix = String.sub s !i (n - !i) in
    if String.for_all (fun c -> c >= 'a' && c <= 'z') suffix then Some (digits, suffix) else None

let num_opt s : verse_num option =
  match split_num_suffix (String.trim s) with
  | None -> None
  | Some (digits, suffix) -> ( match int_opt digits with Some n -> Some { n; suffix } | None -> None)

(* "20-32" -> {first=20; last=Some{chapter=None; verse=32}};
   "21" -> {first=21; last=None};
   "35-10:1" -> {first=35; last=Some{chapter=Some 10; verse=1}} -- the
   RIGHT side of a hyphen range may itself carry an explicit "chapter:verse"
   (a range whose hyphen crosses a chapter boundary, [verse_end]'s own
   citation in the .mli). The LEFT side never does: it is always the
   chapter already in effect at that point in the part (parse_part's own
   [c], or the chapter a PRECEDING range in the same part most recently
   crossed into -- an ambiguity the source text itself never resolves and
   this function does not try to, since nothing downstream needs the first
   side's chapter: {!Colitur_citation.Render} only ever prints a part's
   OWN [chapter] once, at the front, from [parse_part]'s [c]). *)
let parse_range s =
  match split_on '-' s with
  | [ a ] -> ( match num_opt a with Some f -> Some { first = f; last = None } | None -> None)
  | [ a; b ] -> (
      match num_opt a with
      | None -> None
      | Some f ->
          if String.contains b ':' then
            (* The right side names its own chapter explicitly: no verse-
               number ordering constraint applies (a later chapter is
               always "ahead", whatever its own verse numbers are). *)
            match split_on ':' b with
            | [ cs; vs ] -> (
                match (int_opt cs, num_opt vs) with
                | Some c, Some v -> Some { first = f; last = Some { chapter = Some c; verse = v } }
                | _ -> None)
            | _ -> None
          else
            match num_opt b with
            (* A descending range ("1:20-10") is always a transcription
               error; accepting it would render back out as a citation
               nobody can follow. Compared on the NUMBER only -- "11a-11b"
               is a real, ascending sub-verse range even though nothing
               here orders letters. *)
            | Some l when l.n >= f.n -> Some { first = f; last = Some { chapter = None; verse = l } }
            | _ -> None)
  | _ -> None

let parse_ranges s =
  let pieces = split_on ',' s in
  List.fold_right
    (fun p acc ->
      match (parse_range p, acc) with
      | Some r, Some rest -> Some (r :: rest)
      | _ -> None)
    pieces (Some [])

(* One ";"-separated part. [inherited] is the chapter of the previous part,
   used when this one names none (rule 1 in the grammar table).
   [single_chapter] ({!Book.is_single_chapter}, fix wave I2) skips rule 3
   entirely: a single-chapter book's citations are bare verses with no
   chapter at all, so a leading comma-piece that looks like a number is
   always a VERSE, never a chapter introduction -- see book.ml's own
   citation for the real, wrongly-parsed example this was found on. *)
let parse_part ~single_chapter ~inherited s =
  match split_first_colon s with
  | Some (c, v) -> (
      (* explicit "chapter:verses" -- [v] may itself carry further colons,
         from a chapter-crossing hyphen range inside it; [parse_ranges] /
         [parse_range] read those, this function does not need to. *)
      match (int_opt c, parse_ranges v) with
      | Some ch, Some vs -> Some { chapter = ch; verses = vs }
      | _ -> None)
  | None -> (
      let only = s in
      if single_chapter then
        match parse_ranges only with
        | Some vs -> Some { chapter = Option.value inherited ~default:1; verses = vs }
        | None -> None
      else (
        (* Either "chapter, verses" (rule 3) or bare verses inheriting a
           chapter. Distinguish on whether the FIRST comma-piece is a lone
           number followed by more pieces -- a leading number followed by
           at least one further piece is a chapter introduction ("15, 1-46");
           a lone piece on its own, or a part with no more pieces to follow,
           can only be verses inheriting the previous chapter. *)
        let pieces = split_on ',' only in
        match (pieces, inherited) with
        | first :: (_ :: _ as rest), _ when int_opt first <> None && String.contains only ',' -> (
            (* "15, 1-46" -> chapter 15. This never fires for a part that
               already named its chapter via ":" -- those match the [c; v]
               branch above and never reach here. *)
            match (int_opt first, parse_ranges (String.concat "," rest)) with
            | Some ch, Some vs -> Some { chapter = ch; verses = vs }
            | _ -> None)
        | _, Some ch -> (
            match parse_ranges only with
            | Some vs -> Some { chapter = ch; verses = vs }
            | None -> None)
        | _, None -> None))

let parse s =
  let s = String.trim s in
  (* A trailing period is decoration, not data: 22 citations carry one. *)
  let s =
    let n = String.length s in
    if n > 0 && s.[n - 1] = '.' then String.sub s 0 (n - 1) else s
  in
  match split_book s with
  | None -> Error "no book"
  | Some (btok, tail) -> (
      match Book.of_token btok with
      | None -> Error ("unknown book: " ^ btok)
      | Some book ->
          (* A trailing ";" leaves an empty piece: drop it rather than
             failing. Only if nothing remains is it an error. *)
          let pieces = List.filter (fun p -> p <> "") (split_on ';' tail) in
          let single_chapter = Book.is_single_chapter book in
          let rec go inherited = function
            | [] -> Ok []
            | p :: rest -> (
                match parse_part ~single_chapter ~inherited p with
                | None -> Error ("cannot read reference: " ^ p)
                | Some part -> (
                    match go (Some part.chapter) rest with
                    | Error e -> Error e
                    | Ok more -> Ok (part :: more)))
          in
          (match go None pieces with
           | Error e -> Error e
           | Ok [] -> Error "empty reference"
           | Ok parts -> Ok { book; parts }))