Source file metadata.ml

(*****************************************************************************)
(*                                                                           *)
(*  Copyright (C) 2026 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 Values = Set.Make (String)
module Properties = Map.Make (String)

module Keys = struct
  let title = "TITLE"
  let artist = "ARTIST"
  let album = "ALBUM"
  let date = "DATE"
  let comment = "COMMENT"
  let genre = "GENRE"
  let disc_number = "DISCNUMBER"
  let track = "TRACKNUMBER"
  let album_artist = "ALBUMARTIST"
  let composer = "COMPOSER"
  let title_sort = "TITLESORT"
  let artist_sort = "ARTISTSORT"
  let album_sort = "ALBUMSORT"
  let skhc_file_extension = "SHAKUHACHI_FILEEXTENSION"
  let skhc_file_size = "SHAKUHACHI_FILESIZE"
end

type t = {
  audioproperties : Otaglibc.audioproperties option;
  covers : Otaglibc.picture array;
  properties : Values.t Properties.t;
}

let init audioproperties covers properties =
  { audioproperties; covers; properties }

let of_properties ?audioproperties ?(covers = [||])
    (properties : Values.t Properties.t) =
  init audioproperties covers properties

let empty =
  { audioproperties = None; covers = [||]; properties = Properties.empty }

let int_of_string_conv s =
  let negative = String.starts_with ~prefix:"-" s in
  let seq = String.to_seq s in
  let seq = match negative with true -> Seq.drop 1 seq | false -> seq in
  let s =
    seq
    |> Seq.take_while (function '0' .. '9' -> true | _ -> false)
    |> String.of_seq
  in
  let s = match negative with true -> "-" ^ s | false -> s in
  int_of_string_opt s

let set_property key value metadata =
  {
    metadata with
    properties = Properties.add key (Values.singleton value) metadata.properties;
  }

let add_property key value metadata =
  let properties =
    Properties.update key
      (function
        | None ->
            Some (Values.singleton value)
        | Some values ->
            Some (Values.add value values)
        )
      metadata.properties
  in
  if properties == metadata.properties then
    metadata
  else
    { metadata with properties }

let property key metadata = Properties.find_opt key metadata.properties
let properties metadata = metadata.properties

let remove_property key metadata =
  let properties = Properties.remove key metadata.properties in
  if properties == metadata.properties then
    metadata
  else
    { metadata with properties }

let property_min key metadata =
  match property key metadata with
  | Some values ->
      Values.min_elt_opt values
  | None ->
      None

let property_list key metadata =
  match property key metadata with
  | Some values ->
      Values.elements values
  | None ->
      []

let property_match conv key metadata =
  match property key metadata with
  | None ->
      None
  | Some values ->
      let found =
        Values.find_first_opt (fun s -> Option.is_some (conv s)) values
      in
      Option.bind found conv

let equal lhs rhs =
  lhs.audioproperties = rhs.audioproperties
  && lhs.covers = rhs.covers
  && Properties.equal Values.equal lhs.properties rhs.properties

let is_empty m = equal m empty

(* title *)
let title metadata = property_min Keys.title metadata
let set_title title m = set_property Keys.title title m

(* title sort *)
let title_sort m = property_min Keys.title_sort m
let set_title_sort title m = set_property Keys.title_sort title m

(* artist *)
let artists metadata = property_list Keys.artist metadata
let artist ~sep metadata = String.concat sep (artists metadata)
let set_artist artist m = set_property Keys.artist artist m
let add_artist artist m = add_property Keys.artist artist m

(* artist sort *)
let artist_sort = property_min Keys.artist_sort

let set_artist_sort value metadata =
  set_property Keys.artist_sort value metadata

(* album artist *)
let album_artists m = property_list Keys.album_artist m
let album_artist ~sep m = String.concat sep (album_artists m)
let set_album_artist artist m = set_property Keys.album_artist artist m
let add_album_artist artist m = add_property Keys.album_artist artist m

(* composer *)
let composers metadata = property_list Keys.composer metadata
let composer ~sep m = String.concat sep (composers m)
let set_composer artist m = set_property Keys.composer artist m
let add_composer artist m = add_property Keys.composer artist m

(* album *)
let album metadata = property_min Keys.album metadata
let set_album album m = set_property Keys.album album m

(* album sort *)
let album_sort metadata = property_min Keys.album_sort metadata
let set_album_sort album m = set_property Keys.album_sort album m

(* track *)
let track metadata = property_match int_of_string_conv Keys.track metadata
let set_track track m = set_property Keys.track (Int.to_string track) m

(* comment *)
let comments m = property_list Keys.comment m
let comment ~sep m = String.concat sep (comments m)
let set_comment comment m = set_property Keys.comment comment m
let add_comment comment m = add_property Keys.comment comment m

(* genre *)
let genre m = property_min Keys.genre m
let set_genre genre m = set_property Keys.genre genre m

(* year *)
let year metadata = property_match int_of_string_conv Keys.date metadata
let set_year year m = set_property Keys.date (Int.to_string year) m

(* disc *)
let disc metadata = property_match int_of_string_conv Keys.disc_number metadata
let disc' m = Option.value ~default:0 (disc m)
let set_disc disc m = set_property Keys.disc_number (Int.to_string disc) m
let covers metadata = metadata.covers

let add_cover ?(first = true) cover metadata =
  let covers =
    match first with
    | true ->
        Array.append [| cover |] metadata.covers
    | false ->
        Array.append metadata.covers [| cover |]
  in
  { metadata with covers }

(** [patch base p] updates [base] with the field set in [p]. *)
let patch base p =
  let adefault base p = match p with [||] -> base | p -> p in
  let properties base p =
    Properties.merge
      (fun _ base p -> match p with Some _ -> p | None -> base)
      base p
  in
  {
    covers = adefault base.covers p.covers;
    audioproperties = base.audioproperties;
    properties = properties base.properties p.properties;
  }

let audioproperties metadata = metadata.audioproperties

let set_audioproperties audioproperties metadata =
  { metadata with audioproperties }

let set_audioproperties' audioproperties metadata =
  set_audioproperties (Some audioproperties) metadata

let properties_iter f metadata = Properties.iter f metadata.properties

let unicode_normalize (form : Uunf.form) metadata =
  {
    metadata with
    properties =
      Properties.map
        (Values.map (Uunf_string.normalize_utf_8 form))
        metadata.properties;
  }

let is_set field metadata =
  let is_set_str s = match s with None | Some "" -> false | Some _ -> true in
  match field with
  | Field.FTitle ->
      is_set_str (title metadata)
  | FArtist ->
      artists metadata <> []
  | FAlbum ->
      is_set_str (album metadata)
  | FAlbumArtist ->
      album_artists metadata <> []
  | FTitleSort ->
      is_set_str (title_sort metadata)
  | FAlbumSort ->
      is_set_str (album_sort metadata)
  | FArtistSort ->
      is_set_str (artist_sort metadata)
  | FTrack ->
      Option.is_some (track metadata)
  | FYear ->
      Option.is_some (year metadata)
  | FDisc ->
      Option.is_some (disc metadata)
  | FCover ->
      Array.length metadata.covers <> 0
  | FGenre ->
      is_set_str (genre metadata)
  | FComment ->
      comments metadata <> []

let of_taglib taglib =
  let module T = Otaglibc in
  let covers = T.pictures taglib in
  let audioproperties = T.audioproperties taglib in
  let keys = T.property_keys taglib in
  let keys =
    Option.map
      (Array.map (fun key ->
           let p =
             key |> T.property taglib |> Option.value ~default:[||]
             |> Array.to_list
           in
           (key, p)
       )
      )
      keys
  in
  let properties =
    match keys with
    | None ->
        Properties.empty
    | Some keys ->
        Array.fold_left
          (fun properties (key, values) ->
            Properties.update key
              (function
                | None ->
                    Some (Values.of_list values)
                | Some old ->
                    Some (Values.union (Values.of_list values) old)
                )
              properties
          )
          Properties.empty keys
  in
  { covers; audioproperties; properties }

let apply ~clear_picture ~save metadata taglib =
  let module T = Otaglibc in
  let { covers; audioproperties = _; properties } = metadata in
  let () =
    Properties.iter
      (fun key values -> T.set_properties taglib key (Values.elements values))
      properties
  in
  let () =
    if clear_picture then
      T.remove_pictures taglib
  in
  let () = Array.iter (T.add_picture taglib) covers in
  if save then
    T.save taglib
  else
    true

let pp format metadata =
  let { audioproperties; covers; properties } = metadata in
  let pp_audio =
    Format.pp_print_option ~none:(fun format () -> Format.fprintf format "none")
    @@ fun format (audioproperties : Otaglibc.audioproperties) ->
    Format.fprintf format
      "bitrate : %u -  channels : %u - samplerate : %u - length : %u%a"
      audioproperties.bitrate audioproperties.channels
      audioproperties.samplerate audioproperties.length Format.pp_force_newline
      ()
  in
  let pp_values format values =
    Format.pp_print_list
      ~pp_sep:(fun format () -> Format.fprintf format " - ")
      Format.pp_print_string format (Values.elements values)
  in
  let pp_properties format properties =
    Properties.iter
      (fun key values ->
        Format.fprintf format "%s = %a%a" key pp_values values
          Format.pp_force_newline ()
      )
      properties
  in
  Format.fprintf format "%aCovers = %u%a%a" pp_audio audioproperties
    (Array.length covers) Format.pp_force_newline () pp_properties properties