Source file track.ml

(*****************************************************************************)
(*                                                                           *)
(*  Copyright (C) 2025 Yves Ndiaye                                           *)
(*                                                                           *)
(* This Source Code Form is subject to the terms of the Mozilla Public       *)
(* License, v. 2.0. If a copy of the MPL was not distributed with this       *)
(* file, You can obtain one at https://mozilla.org/MPL/2.0/.                 *)
(*                                                                           *)
(*****************************************************************************)

module Flags = Set.Make (Flag)
module Indexes = Map.Make (Int)

type t = {
  track : int * TrackMode.t;
  flags : Flags.t;
  pregap : Time.t option;
  postgap : Time.t option;
  title : string option;
  performer : string option;
  songwriter : string option;
  isrc : string option;
  rems : string list;
  indexes : Time.t Indexes.t;
}

let init ?pregap ?postgap ?title ?performer ?songwriter ?isrc ?(rems = [])
    ~track flags indexes =
  {
    track;
    flags = Flags.of_list flags;
    pregap;
    postgap;
    title;
    performer;
    songwriter;
    isrc;
    rems;
    indexes = Indexes.of_seq (List.to_seq indexes);
  }

let empty ~track = init ~track [] []
let track t = t.track
let flags t = t.flags
let pregap t = t.pregap
let postgap t = t.postgap
let title t = t.title
let performer t = t.performer
let songwriter t = t.songwriter
let isrc t = t.isrc
let rems t = t.rems
let indexes t = t.indexes

let pp format t =
  let {
    track = index, mode;
    flags = _;
    pregap;
    postgap;
    title;
    performer;
    songwriter;
    isrc;
    rems;
    indexes;
  } =
    t
  in
  let pp_nothing _ () = () in
  let pp_string_option key =
    Format.pp_print_option ~none:pp_nothing (fun format s ->
        Format.fprintf format "%s %a\n" key Format.pp_print_string
          (Cuehelp.Formating.format_string_value s))
  in
  let pp_time_option key =
    Format.pp_print_option ~none:pp_nothing (fun format ->
        Format.fprintf format "%s %a\n" key Time.pp)
  in
  let pp_indexes =
    Format.pp_print_list ~pp_sep:pp_nothing (fun format (index, time) ->
        Format.fprintf format "INDEX %02u %a%a" index Time.pp time
          Format.pp_print_newline ())
  in
  let _pp_flags = Format.pp_print_list ~pp_sep:Format.pp_print_space Flag.pp in
  let pp_rems =
    Format.pp_print_list ~pp_sep:pp_nothing (fun format s ->
        Format.fprintf format "REM %s\n" s)
  in
  Format.fprintf format "TRACK %02u %a\n%a%a%a%a%a%a%a%a" index TrackMode.pp
    mode (pp_string_option "TITLE") title
    (pp_string_option "PERFORMER")
    performer
    (pp_string_option "SONGWRITER")
    songwriter (pp_string_option "ISRC") isrc pp_rems rems
    (pp_time_option "PREGAP") pregap pp_indexes (Indexes.bindings indexes)
    (pp_time_option "POSTGAP") postgap

let compare lhs rhs = compare (fst lhs.track) (fst rhs.track)
let has_indexes track = not (Indexes.is_empty track.indexes)
let add_rem value track = { track with rems = value :: track.rems }

let add_rem' key value track =
  let key = String.uppercase_ascii key in
  let value = Printf.sprintf "%s %s" key value in
  let rems = value :: track.rems in
  { track with rems }

let add_index index time track =
  { track with indexes = Indexes.add index time track.indexes }

let add_flag flag track = { track with flags = Flags.add flag track.flags }
let add_flags flags track = { track with flags = Flags.union flags track.flags }
let add_pregap time track = { track with pregap = Some time }
let add_postgap time track = { track with postgap = Some time }
let add_arranger arranger track = add_rem' "ARRANGER" arranger track
let add_composer composer track = add_rem' "COMPOSER" composer track
let add_genre genre track = add_rem' "GENRE" genre track
let add_date date track = add_rem' "DATE" date track
let add_isrc isrc track = { track with isrc = Some isrc }
let add_performer performer track = { track with performer = Some performer }

let add_songwriter songwriter track =
  { track with songwriter = Some songwriter }

let add_title title track = { track with title = Some title }

let rem_key key sheet =
  List.find_map
    (fun rem ->
      match String.split_on_char ' ' rem with
      | [] -> None
      | t :: q -> if t = key then Some (String.concat " " q) else None)
    sheet.rems

let rem_key_ci key sheet =
  List.find_map
    (fun rem ->
      match String.split_on_char ' ' rem with
      | [] -> None
      | t :: q ->
          if String.uppercase_ascii t = String.uppercase_ascii key then
            Some (String.concat " " q)
          else None)
    sheet.rems