Source file field.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/.                 *)
(*                                                                           *)
(*****************************************************************************)

let sformat regex insensible key value =
  let key = match insensible with true -> key | false -> "%" ^ key in
  let colon = match regex with true -> "::" | false -> ":" in
  Printf.sprintf "%s%s%s" key colon value

let format = Printf.sprintf "%s:%s"

module String = struct
  module Key = struct
    type t =
      | Title
      | SortName
      | Artist
      | Album
      | AlbumArtist
      | Composer
      | Genre
      | Path
      | FileExtension
      | Arbitrary of string

    let equal : t -> t -> bool = ( = )
    let compare = compare

    let to_string = function
      | Title ->
          Keys.title
      | SortName ->
          Keys.sort_name
      | Artist ->
          Keys.artist
      | Album ->
          Keys.album
      | AlbumArtist ->
          Keys.album_artist
      | Composer ->
          Keys.composer
      | Genre ->
          Keys.genre
      | Path ->
          Keys.path
      | FileExtension ->
          Keys.extension
      | Arbitrary key ->
          let key =
            Printf.sprintf "%s%s" Util.arbitrary_prefix (Util.quote key)
          in
          key

    let default = [ Title; SortName; Artist; Album; AlbumArtist ]

    (* [assocs] is each substring associated with their key. *)
    let assocs =
      [
        (Keys.title, Title);
        (Keys.sort_name, SortName);
        (Keys.artist, Artist);
        (Keys.album, Album);
        (Keys.album_artist, AlbumArtist);
        (Keys.composer, Composer);
        (Keys.genre, Genre);
      ]

    let of_string t = List.assoc_opt t assocs
  end

  type 'a t = { regex : bool; insensible : bool; field : Key.t; value : 'a }

  let init regex insensible field value = { regex; insensible; field; value }
  let title regex insensible value = { regex; insensible; field = Title; value }

  let sort_name regex insensible value =
    { regex; insensible; field = SortName; value }

  let artist regex insensible value =
    { regex; insensible; field = Artist; value }

  let album regex insensible value = { regex; insensible; field = Album; value }

  let album_artist regex insensible value =
    { regex; insensible; field = AlbumArtist; value }

  let composer regex insensible value =
    { regex; insensible; field = Composer; value }

  let genre regex insensible value = { regex; insensible; field = Genre; value }
  let path regex insensible value = { regex; insensible; field = Path; value }

  let extension regex insensible value =
    { regex; insensible; field = FileExtension; value }

  let arbitrary regex insensible key value =
    { regex; insensible; field = Arbitrary key; value }

  let to_string s =
    let { regex; insensible; field; value } = s in
    let key = Key.to_string field in
    sformat regex insensible key value

  let to_sexp s =
    let { regex; insensible; field; value } = s in
    let key = Key.to_string field in
    sformat regex insensible key (Util.quote value)

  let regex s = s.regex
  let insensible s = s.insensible
  let key s = s.field
  let value s = s.value
end

module Bool = struct
  module Key = struct
    type t = Art | Flag

    let equal = ( = )
    let compare = Stdlib.compare
    let to_string = function Art -> Keys.art | Flag -> Keys.flag
  end

  type 'a t = { field : Key.t; value : 'a }

  let init field value = { field; value }
  let art b = { field = Art; value = b }
  let flag b = { field = Flag; value = b }

  let to_string s =
    let { field; value } = s in
    let key = Key.to_string field in
    format key (Bool.to_string value)

  let to_sexp = to_string
  let key s = s.field
  let value s = s.value
end

module Int64 = struct
  module Key = struct
    type t = Id | Size

    let equal = ( = )
    let compare = compare
    let to_string = function Id -> Keys.id | Size -> Keys.size
  end

  type 'a t = { field : Key.t; value : 'a Range.t }

  let init field value = { field; value }
  let id value = { field = Id; value }
  let size value = { field = Size; value }

  let to_string t =
    let { field; value } = t in
    let key = Key.to_string field in
    let s = Range.to_string Int64.to_string value in
    format key s

  let to_sexp = to_string
  let key s = s.field
  let value s = s.value
end

module Int = struct
  module Key = struct
    type t =
      | Track
      | Year
      | Disc
      | Plays
      | Length (* in secondes *)
      | Rating
      | AlbumCount

    let equal = ( = )
    let compare = compare

    let to_string = function
      | Track ->
          Keys.track
      | Year ->
          Keys.year
      | Disc ->
          Keys.disc
      | Plays ->
          Keys.plays
      | Length ->
          Keys.length
      | Rating ->
          Keys.rating
      | AlbumCount ->
          Keys.album_count
  end

  type 'a t = { field : Key.t; value : 'a Range.t }

  let init field value = { field; value }
  let track value = { field = Track; value }
  let year value = { field = Year; value }
  let disc value = { field = Disc; value }
  let plays value = { field = Plays; value }
  let length value = { field = Length; value }
  let rating value = { field = Rating; value }
  let album_count value = { field = AlbumCount; value }

  let to_string t =
    let { field; value } = t in
    let key = Key.to_string field in
    let s = Range.to_string Int.to_string value in
    format key s

  let to_sexp = to_string
  let key s = s.field
  let value s = s.value
end

module Float = struct
  module Key = struct
    type t = AvgDuration | AvgRating | AvgSize

    let equal = ( = )
    let compare = compare

    let to_string = function
      | AvgDuration ->
          Keys.avg_duration
      | AvgRating ->
          Keys.avg_rating
      | AvgSize ->
          Keys.avg_size
  end

  type 'a t = { field : Key.t; value : 'a Range.t }

  let init field value = { field; value }
  let avg_duration value = { field = AvgDuration; value }
  let avg_rating value = { field = AvgRating; value }
  let avg_size value = { field = AvgSize; value }

  let to_string f =
    let { field; value } = f in
    let key = Key.to_string field in
    let s = Range.to_string Float.to_string value in
    format key s

  let to_sexp = to_string
  let key s = s.field
  let value s = s.value
end

type ('s, 'b, 'i, 'i64, 'f) t =
  | FString of 's String.t
  | FBool of 'b Bool.t
  | FInt of 'i Int.t
  | FInt64 of 'i64 Int64.t
  | FFloat of 'f Float.t

let string s = FString s
let bool b = FBool b
let int i = FInt i
let int64 i = FInt64 i
let float f = FFloat f

(* String *)
let title regex insensible s = string (String.title regex insensible s)
let sort_name regex insensible s = string (String.sort_name regex insensible s)
let artist regex insensible s = string (String.artist regex insensible s)
let album regex insensible s = string (String.album regex insensible s)

let album_artist regex insensible s =
  string (String.album_artist regex insensible s)

let composer regex insensible s = string (String.composer regex insensible s)
let genre regex insensible s = string (String.genre regex insensible s)
let path regex insensible s = string (String.path regex insensible s)
let extension regex insensible s = string (String.extension regex insensible s)

let arbitrary regex insensible key value =
  string (String.arbitrary regex insensible key value)

(* Bool *)
let art r = bool (Bool.art r)
let flag r = bool (Bool.flag r)

(* Int64 *)
let id i = int64 (Int64.id i)
let size r = int64 (Int64.size r)

(* Int *)
let track r = int (Int.track r)
let year r = int (Int.year r)
let disc r = int (Int.disc r)
let length r = int (Int.length r)
let plays r = int (Int.plays r)
let rating r = int (Int.rating r)
let album_count r = int (Int.album_count r)

(* Float *)
let avg_duration r = float (Float.avg_duration r)
let avg_rating r = float (Float.avg_rating r)
let avg_size r = float (Float.avg_size r)

let fold s b i i64 f = function
  | FString e ->
      s e
  | FBool e ->
      b e
  | FInt64 e ->
      i64 e
  | FInt e ->
      i e
  | FFloat e ->
      f e

let to_string = function
  | FString s ->
      String.to_string s
  | FBool b ->
      Bool.to_string b
  | FInt i ->
      Int.to_string i
  | FInt64 i ->
      Int64.to_string i
  | FFloat f ->
      Float.to_string f

let to_sexp = function
  | FString s ->
      String.to_sexp s
  | FBool b ->
      Bool.to_sexp b
  | FInt64 i ->
      Int64.to_sexp i
  | FInt i ->
      Int.to_sexp i
  | FFloat f ->
      Float.to_sexp f

let is_string = function
  | FString _ ->
      true
  | FBool _ | FInt _ | FFloat _ | FInt64 _ ->
      false