Source file collection.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 Config = SkhcConfig.Config
module Metadata = SkhcMetadata.Metadata

type t = { config : SkhcConfig.Config.t }

module Utils = struct
  let conf_prefix_path library p =
    let music_directory = Config.music_directory library.config in
    Filename.concat music_directory p

  let _read_all_safe path =
    try Ok (In_channel.with_open_bin path SkhcUtil.FileSys.read_chan)
    with exn -> Error exn

  let rec fold_ok' f acc = function
    | [] ->
        Result.ok acc
    | t :: q ->
        let ( let* ) = Result.bind in
        let* acc = f acc t in
        fold_ok' f acc q

  let rec fold_ok f acc properties =
    match Metadata.Properties.min_binding_opt properties with
    | None ->
        Ok acc
    | Some (key, value) -> (
        let properties = Metadata.Properties.remove key properties in
        match f acc key value with
        | Ok acc ->
            fold_ok f acc properties
        | Error _ as e ->
            e
      )

  let rec fold_values_ok f acc values =
    match Metadata.Values.min_elt_opt values with
    | None ->
        Ok acc
    | Some value -> (
        let values = Metadata.Values.remove value values in
        match f acc value with
        | Ok acc ->
            fold_values_ok f acc values
        | Error _ as e ->
            e
      )

  let add_participant participants (role : SkhcDb.Role.t) artist database =
    match artist with
    | None ->
        participants
    | Some artist -> (
        let artist =
          SkhcDb.Artist.init ~sort_name:None ~description:None ~artwork:None
            ~flag:false ~rating:None artist
        in
        match SkhcDb.Artist.find_or_insert database artist with
        | Ok (artist, _) ->
            (artist, role) :: participants
        | Error _rc ->
            participants
      )

  let participants m env =
    let add_participants role artists participants =
      List.fold_left
        (fun participants artist ->
          add_participant participants role (Some artist) env
        )
        participants artists
    in
    let participants =
      add_participants Artist (SkhcMetadata.Metadata.artists m) []
    in
    let participants =
      add_participants AlbumArtist
        (SkhcMetadata.Metadata.album_artists m)
        participants
    in
    add_participants Composer (SkhcMetadata.Metadata.composers m) participants

  let cover_exists ~prefix coverdirectory =
    match Sys.(file_exists coverdirectory && is_directory coverdirectory) with
    | false ->
        None
    | true ->
        coverdirectory |> Sys.readdir
        |> Array.find_map (fun entry ->
            (* before skhc 0.1.0 = prefix:cover *)
            match String.starts_with ~prefix entry with
            | true ->
                Some (Filename.concat coverdirectory entry)
            | false ->
                None
        )

  let set_elt_rating database value frating fset_rating update elt =
    match frating elt = value with
    | true ->
        Ok elt
    | false ->
        let elt = fset_rating value elt in
        update database elt

  let flag_elt database value fflag fset_flag update elt =
    match fflag elt = value with
    | true ->
        Ok elt
    | false ->
        let elt = fset_flag value elt in
        update database elt
end

let open' (config : Config.t) = { config }

let database ?mode ?uri ?memory ?mutex ?cache ?vfs library =
  SkhcDb.Database.open' ?mode ?uri ?memory ?mutex ?cache ?vfs
    (Config.music_database library.config)

let with_database ?mode ?uri ?memory ?mutex ?cache ?vfs collection f =
  let db = database ?mode ?uri ?memory ?mutex ?cache ?vfs collection in
  Fun.protect ~finally:(fun () ->
      try ignore @@ SkhcDb.Database.close db with _ -> ()
  )
  @@ fun () -> f db

let realpath library p =
  if Filename.is_relative p then
    Utils.conf_prefix_path library p
  else
    p

let dir_artist library metadata =
  let default_artist = SkhcConfig.Config.default_artist library.config in
  let aa = Metadata.album_artist ~sep:", " metadata in
  let a = Metadata.artist ~sep:", " metadata in
  let s =
    match aa with
    | "" -> (
        match a with "" -> default_artist | _ -> a
      )
    | _ ->
        aa
  in
  SkhcUtil.StringUtil.make_path_safe s

let dir_artist_absolute library m =
  let s = dir_artist library m in
  realpath library s

let dir_album library m =
  let default = SkhcConfig.Config.default_album library.config in
  let artist = dir_artist library m in
  let album = Option.value ~default @@ Metadata.album m in
  let album = SkhcUtil.StringUtil.make_path_safe album in
  Filename.concat artist album

let dir_album_absolute library m =
  let album = dir_album library m in
  realpath library album

module Album = struct
  let musics_from_album_id (_library : t) database id =
    SkhcDb.Query.musics database
    @@ fun music album roles properties ->
    match Int64.equal (SkhcDb.Album.id album) id with
    | true ->
        Some (music, album, roles, properties)
    | false ->
        None

  let sort keys albums =
    SkhcQuery.Query.sort_with_keys List.sort keys
      SkhcQuery.Query.compare_album_key albums

  let set_rating (_ : t) database album rating =
    Utils.set_elt_rating database rating SkhcDb.Album.rating
      SkhcDb.Album.set_rating SkhcDb.Album.update album

  let set_flag (_ : t) database album =
    Utils.flag_elt database true SkhcDb.Album.flag SkhcDb.Album.set_flag
      SkhcDb.Album.update album

  let unset_flag (_ : t) database album =
    Utils.flag_elt database false SkhcDb.Album.flag SkhcDb.Album.set_flag
      SkhcDb.Album.update album

  let cover library album =
    match Option.map (realpath library) (SkhcDb.Album.cover_path album) with
    | None ->
        None
    | Some p ->
        Some (In_channel.with_open_bin p SkhcUtil.FileSys.read_chan)
end

module Artist = struct
  let set_rating (_ : t) database artist rating =
    Utils.set_elt_rating database rating SkhcDb.Artist.rating
      SkhcDb.Artist.set_rating SkhcDb.Artist.update artist

  let sort keys artists =
    SkhcQuery.Query.sort_with_keys List.sort keys
      SkhcQuery.Query.compare_artist_key artists

  let set_flag (_ : t) database artist =
    Utils.flag_elt database true SkhcDb.Artist.flag SkhcDb.Artist.set_flag
      SkhcDb.Artist.update artist

  let unset_flag (_ : t) database artist =
    Utils.flag_elt database false SkhcDb.Artist.flag SkhcDb.Artist.set_flag
      SkhcDb.Artist.update artist

  let artwork library artist =
    match Option.map (realpath library) (SkhcDb.Artist.artwork artist) with
    | None ->
        None
    | Some p ->
        Some (In_channel.with_open_bin p SkhcUtil.FileSys.read_chan)
end

module Music = struct
  let remove (_library : t) database (music : SkhcDb.MusicFile.t) =
    SkhcDb.MusicFile.remove database music

  let sort keys musics =
    SkhcQuery.Query.sort_with_keys List.sort keys
      SkhcQuery.Query.compare_music_key musics

  let path library music = realpath library (SkhcDb.MusicFile.path music)

  let add_music ?(music_old : SkhcDb.MusicFile.t option) ~database ~path ~size
      album_id participants metadata =
    let ( let* ) = Result.bind in
    let covers = SkhcMetadata.Metadata.covers metadata in
    let audioproperties = SkhcMetadata.Metadata.audioproperties metadata in
    let mediafile =
      (* Little hack : if music_old, it probably came from skhc-modify
        and if the [read] option was given, metadata doesnt contains a cover so
        if [music_old], we use it [has_cover] field.
         *)
      let has_cover =
        Array.length covers <> 0
        || Option.fold ~none:false ~some:SkhcDb.MusicFile.has_cover music_old
      in
      SkhcDb.MusicFile.init ~album_id ~size ~has_cover ~audioproperties
        ~flag:false ~rating:None path
    in
    let* () =
      match music_old with
      | None ->
          Ok ()
      | Some music_old ->
          SkhcDb.MusicFile.remove database music_old
    in
    let* music_file =
      SkhcDb.MusicFile.insert ?old:music_old database mediafile
    in
    let* () =
      Utils.fold_ok
        (fun () key values ->
          Utils.fold_values_ok
            (fun () value ->
              let property =
                SkhcDb.MusicProperty.init
                  (SkhcDb.MusicFile.id music_file)
                  key value
              in
              SkhcDb.MusicProperty.insert database property
            )
            () values
        )
        ()
        (SkhcMetadata.Metadata.properties metadata)
    in
    let* () =
      SkhcUtil.ListUtil.fold_ok
        (fun () (artist, role) ->
          let music_participant =
            SkhcDb.MusicParticipant.init
              ~music_id:(SkhcDb.MusicFile.id music_file)
              ~artist_id:(SkhcDb.Artist.id artist) role
          in
          Result.map ignore
          @@ SkhcDb.MusicParticipant.insert database music_participant
        )
        () participants
    in
    Ok music_file

  let add_album ?sort_name ~config ~database ~compilation ~music_target_dir
      ~genre year participants albumname =
    (* Already the music_target_dir *)
    let prefix = SkhcConfig.(config |> Config.format |> Format.album_cover) in
    let cover_path = Utils.cover_exists ~prefix music_target_dir in
    let cover_path =
      Option.map
        (SkhcUtil.FileSys.remove_prefix (Config.music_directory config))
        cover_path
    in
    let album =
      SkhcDb.Album.init ~sort_name ~year ~compilation ~flag:false ~rating:None
        ~comment:None ~cover_path ~genre albumname
    in
    SkhcDb.AlbumParticipant.find_or_insert ~insert_on_found:true ~compilation
      database participants album

  let add library database ?music_old ~compilation path metadata =
    let ( let* ) = Result.bind in
    let music_realpath = realpath library path in
    let size =
      let stats = Unix.stat music_realpath in
      stats.st_size
    in
    let music_path =
      SkhcUtil.FileSys.remove_prefix
        (library.config |> Config.music_directory |> Unix.realpath)
        music_realpath
    in
    let album = Metadata.album metadata in
    let year = Metadata.year metadata in
    let genre = Metadata.genre metadata in
    SkhcDb.Database.transaction database
    @@ fun database ->
    let participants = Utils.participants metadata database in
    let* album =
      match album with
      | None ->
          Ok None
      | Some albumname ->
          let sort_name = Metadata.album_sort metadata in
          let music_target_dir = Filename.dirname music_realpath in
          let r =
            add_album ?sort_name ~config:library.config ~database ~compilation
              ~genre ~music_target_dir year participants albumname
          in
          Result.map Option.some r
    in
    let album_id = Option.map SkhcDb.Album.id album in
    add_music ?music_old ~database ~path:music_path ~size album_id participants
      metadata

  let matches library database query f =
    let matches =
     fun music album artist_roles properties ->
      if
        SkhcQuery.Query.matches_musics
          (Config.query_fields library.config)
          music album artist_roles properties query
      then
        Some (music, album, artist_roles, properties)
      else
        None
    in
    f (SkhcDb.Query.musics database matches)

  let scrobble (_library : t) database music_file =
    let play_count = SkhcDb.MusicFile.play_count music_file in
    let music_file =
      music_file
      |> SkhcDb.MusicFile.set_play_count (play_count + 1)
      |> SkhcDb.MusicFile.set_played_at (Some (Unix.time ()))
    in
    SkhcDb.MusicFile.update database music_file

  let set_rating (_ : t) database music_file rating =
    Utils.set_elt_rating database rating SkhcDb.MusicFile.rating
      SkhcDb.MusicFile.set_rating SkhcDb.MusicFile.update music_file

  let set_flag (_ : t) database music_file =
    Utils.flag_elt database true SkhcDb.MusicFile.flag SkhcDb.MusicFile.set_flag
      SkhcDb.MusicFile.update music_file

  let unset_flag (_ : t) database music_file =
    Utils.flag_elt database false SkhcDb.MusicFile.flag
      SkhcDb.MusicFile.set_flag SkhcDb.MusicFile.update music_file

  let audio library music =
    let path = path library music in
    In_channel.with_open_bin path SkhcUtil.FileSys.read_chan

  let find_with_metadata ~compilation collection database metadata query =
    let albums =
      SkhcDb.AlbumParticipant.find_from_metadata ~compilation database metadata
    in
    List.find_map
      (fun album ->
        match
          Album.musics_from_album_id collection database (SkhcDb.Album.id album)
        with
        | Error _ ->
            None
        | Ok musics ->
            List.find_map
              (fun ((music, _, _, properties) as e) ->
                let met =
                  SkhcMetadata.Metadata.of_properties
                    ~audioproperties:(SkhcDb.MusicFile.audioproperties music)
                    properties
                in
                let met =
                  SkhcMetadata.Metadata.(
                    met
                    |> set_property Keys.skhc_file_size
                         (string_of_int @@ SkhcDb.MusicFile.size music)
                    |> set_property Keys.skhc_file_extension
                         (Filename.extension @@ SkhcDb.MusicFile.path music)
                  )
                in
                if SkhcQuery.Query.matches_metadata_subset met metadata query
                then
                  Some e
                else
                  None
              )
              musics
      )
      albums
end

module Playlist = struct
  let create library database ~smart ~flag ~rating name query =
    let ( let* ) = Result.bind in
    let sexp = SkhcQuery.Query.to_sexp query in
    let* matches = Music.matches library database query Fun.id in
    let playlist =
      SkhcDb.Playlist.init ~name ~smart ~query:sexp ~flag ~rating
        ~cover_path:None
    in
    SkhcDb.Database.transaction database
    @@ fun database ->
    let* playlist = SkhcDb.Playlist.insert database playlist in
    match SkhcDb.Playlist.smart playlist with
    | true ->
        Ok (playlist, matches)
    | false ->
        let playlist_id = SkhcDb.Playlist.id playlist in
        let* () =
          Utils.fold_ok'
            (fun () (music, _, _, _) ->
              let music_id = SkhcDb.MusicFile.id music in
              let ply_ms = SkhcDb.PlaylistMusics.init ~playlist_id ~music_id in
              SkhcDb.PlaylistMusics.insert database ply_ms
            )
            () matches
        in
        Ok (playlist, matches)

  let remove (_ : t) database playlist =
    SkhcDb.Playlist.remove database playlist

  let remove_from_name collection database name =
    let ( let* ) = Result.bind in
    let sqlerr e =
      Result.map_error (fun (rc, msg) -> `SqliteError (rc, msg)) e
    in
    let* playlist =
      sqlerr
      @@ SkhcDb.Playlist.find_map database
      @@ fun playlist ->
      if SkhcDb.Playlist.name playlist = name then
        Some playlist
      else
        None
    in
    let* playlist = Option.to_result ~none:`NoMatchingPlaylist playlist in
    sqlerr @@ remove collection database playlist

  let playlists collection database =
    let ( let* ) = Result.bind in
    let stats musics =
      let ( ++ ) lhs rhs = Int64.(add lhs @@ of_int rhs) in
      let music_count, duration, play_count, size, rating, rating_count =
        List.fold_left
          (fun (music_count, duration, play_count, size, rating, rating_count)
               (music, _, _, _) ->
            let music_count = music_count + 1 in
            let duration = duration + SkhcDb.MusicFile.duration music in
            let play_count = play_count + SkhcDb.MusicFile.play_count music in
            let size = size ++ SkhcDb.MusicFile.size music in
            let rating, rating_count =
              match SkhcDb.MusicFile.rating music with
              | None ->
                  (rating, rating_count)
              | Some r ->
                  (rating + r, rating_count + 1)
            in
            (music_count, duration, play_count, size, rating, rating_count)
          )
          (0, 0, 0, Int64.zero, 0, 0)
          musics
      in
      let avg_rating =
        match rating_count with
        | 0 ->
            0.
        | rating_count ->
            Int.to_float rating /. Int.to_float rating_count
      in
      SkhcDb.Playlist.Stats.init ~music_count ~duration ~play_count ~size
        ~avg_rating
    in
    let* playlists = SkhcDb.PlaylistMusics.playlists database in
    let playlists =
      List.map
        (fun ((playlist, _) as ps) ->
          match SkhcDb.Playlist.smart playlist with
          | true ->
              (* Stats of the smart playlist need to be computed. *)
              let squery =
                SkhcQuery.Query.of_sexp (SkhcDb.Playlist.query playlist)
              in
              let stats =
                Option.map
                  (fun query ->
                    let musics =
                      Music.matches collection database query Fun.id
                    in
                    Result.map stats musics
                  )
                  squery
              in
              Option.fold ~none:ps
                ~some:
                  (Result.fold
                     ~ok:(fun stats -> (playlist, stats))
                     ~error:(Fun.const ps)
                  )
                stats
          | false ->
              ps
        )
        playlists
    in
    Ok playlists

  let find_from_name (_ : t) database name =
    SkhcDb.Playlist.find_map database
    @@ fun playlist ->
    match SkhcDb.Playlist.name playlist = name with
    | false ->
        None
    | true ->
        Some playlist

  let musics collection database playlist =
    match SkhcDb.Playlist.smart playlist with
    | true -> (
        let squery = SkhcQuery.Query.of_sexp (SkhcDb.Playlist.query playlist) in
        match squery with
        | None ->
            Ok []
        | Some query ->
            Music.matches collection database query Fun.id
      )
    | false ->
        SkhcDb.PlaylistMusics.musics database playlist

  let query_update ~kind pquery query =
    match kind with
    | `Add ->
        SkhcQuery.Query.union pquery query
    | `Delete ->
        SkhcQuery.Query.diff pquery query
    | `Replace ->
        query

  let update_nosmart ~kind collection database playlist query =
    let ( let* ) = Result.bind in
    let rse e = Result.map_error Error.sql_error' e in
    (* For non smart playlist, we compute a query matching strictly all 
          music in the database since the query used for creating the playlist 
        is maybe obsolete.*)
    let* songs = rse @@ musics collection database playlist in
    let pquery =
      match songs with
      | [] ->
          SkhcQuery.Query.falsum
      | (m, _, _, _) :: q ->
          let query_of_music m =
            let id = SkhcDb.MusicFile.id m in
            SkhcQuery.(Query.node @@ Node.field @@ Field.id @@ Range.value id)
          in
          List.fold_left
            (fun node (m, _, _, _) ->
              SkhcQuery.Query.( lor ) node (query_of_music m)
            )
            (query_of_music m) q
    in
    let query_effective = query_update ~kind pquery query in
    let db_query =
      match SkhcQuery.Query.of_sexp (SkhcDb.Playlist.query playlist) with
      | None ->
          query_effective
      | Some q ->
          query_update ~kind q query
    in
    let playlist =
      SkhcDb.Playlist.set_query (SkhcQuery.Query.to_sexp db_query) playlist
    in
    let* playlist = rse @@ SkhcDb.Playlist.update database playlist in
    let e_playlist =
      SkhcDb.Playlist.set_query
        (SkhcQuery.Query.to_sexp query_effective)
        playlist
    in
    (* Only diff between [playlist] and [e_playlist] should be query. *)
    (* This function tries to update the query as a cumul of all operations 
      applies *)
    let* songs = rse @@ musics collection database e_playlist in
    let playlist_id = SkhcDb.Playlist.id e_playlist in
    let* () =
      SkhcUtil.ListUtil.fold_ok
        (fun () (music, _, _, _) ->
          let music_id = SkhcDb.MusicFile.id music in
          let pm = SkhcDb.PlaylistMusics.init ~playlist_id ~music_id in
          rse @@ SkhcDb.PlaylistMusics.remove database pm
        )
        () songs
    in
    let* musics =
      rse @@ Music.matches collection database query_effective Fun.id
    in
    let* () =
      SkhcUtil.ListUtil.fold_ok
        (fun () (music, _, _, _) ->
          let music_id = SkhcDb.MusicFile.id music in
          let pm = SkhcDb.PlaylistMusics.init ~playlist_id ~music_id in
          rse @@ SkhcDb.PlaylistMusics.insert database pm
        )
        () musics
    in
    Ok (playlist, musics)

  let update kind collection database playlist query =
    let ( let* ) = Result.bind in
    let rse e = Result.map_error Error.sql_error' e in
    SkhcDb.Database.transaction database
    @@ fun database ->
    let name = SkhcDb.Playlist.name playlist in
    match SkhcDb.Playlist.smart playlist with
    | true ->
        let* pquery =
          playlist |> SkhcDb.Playlist.query |> SkhcQuery.Query.of_sexp
          |> Option.to_result
               ~none:(Error.message' "Unable to parse s-exp query of : %s" name)
        in
        let query = query_update ~kind pquery query in
        let playlist =
          SkhcDb.Playlist.set_query (SkhcQuery.Query.to_sexp query) playlist
        in
        let* p = rse @@ SkhcDb.Playlist.update database playlist in
        let* songs = rse @@ Music.matches collection database query Fun.id in
        Ok (p, songs)
    | false ->
        update_nosmart ~kind collection database playlist query

  let add = update `Add
  let delete = update `Delete
  let replace = update `Replace
end

let config t = t.config