(* 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
let book_string st = match st.book with `Full -> "full" | `Abbr -> "abbr"

(* 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 show_num (v : Parse.verse_num) = string_of_int v.Parse.n ^ v.Parse.suffix in
  let one_range (r : Parse.verse_range) =
    match r.Parse.last with
    | None -> show_num r.Parse.first
    | Some l -> subst st.range [ ("first", show_num r.Parse.first); ("last", show_num 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 }