package shakuhachi

  1. Overview
  2. Docs
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file format.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
(*****************************************************************************)
(*                                                                           *)
(*  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 Ids = SkhcDb.Ids.Map
module Strings = Map.Make (String)
module Roles = SkhcDb.Roles
module Metadata = SkhcMetadata.Metadata

let names s = String.concat ", " s

let participants' participants =
  let a, b, c =
    Ids.fold
      (fun _ (name, roles) ->
        Roles.fold
          (fun role ((artist_names, album_artist, compositors) as aac) ->
            match role with
            | SkhcDb.Role.Artist ->
                (name :: artist_names, album_artist, compositors)
            | AlbumArtist ->
                (artist_names, name :: album_artist, compositors)
            | Composer ->
                (artist_names, album_artist, name :: compositors)
            | Unknown ->
                aac
          )
          roles
      )
      participants ([], [], [])
  in
  (List.rev a, List.rev b, List.rev c)

let substitute map format =
  Strings.fold
    (fun key assoc format ->
      let re = Re.(compile @@ Re.seq [ str key; eow ]) in
      Re.replace_string ~by:assoc re format
    )
    map format

let substitute_safe map format =
  Strings.fold
    (fun key assoc format ->
      let assoc = Util.StringUtil.make_path_safe assoc in
      let re = Re.(compile @@ Re.seq [ str key; eow ]) in
      Re.replace_string ~by:assoc re format
    )
    map format

let filename ~extension config metadata format =
  let title =
    let default = SkhcConfig.Config.default_title config in
    Option.value ~default @@ Metadata.title metadata
  in
  let artist_names =
    match Metadata.artists metadata with
    | [] ->
        SkhcConfig.Config.default_artist config
    | _ :: _ as a ->
        names a
  in
  let album_artists = Metadata.album_artists metadata in
  let album =
    let default = config |> SkhcConfig.Config.default_album in
    Option.value ~default @@ Metadata.album metadata
  in
  let composers = Metadata.composers metadata in
  let title_sort = Metadata.title_sort metadata in
  let year = Metadata.year metadata in
  let track = Metadata.track metadata in
  let disc = Metadata.disc metadata in
  let genre = Option.value ~default:String.empty @@ Metadata.genre metadata in
  let some_f = Printf.sprintf "%02d" in
  let zero = "0" in
  let map =
    Strings.(
      let module Keys = SkhcQuery.Keys in
      empty |> add Keys.title title
      |> add Keys.sort_name (Option.value ~default:String.empty title_sort)
      |> add Keys.artist artist_names
      |> add Keys.album_artist (names album_artists)
      |> add Keys.composer (names composers)
      |> add Keys.album album |> add Keys.genre genre
      |> add Keys.track (Option.fold ~some:some_f ~none:zero track)
      |> add Keys.extension extension
      |> add Keys.year (Option.fold ~some:some_f ~none:zero year)
      |> add Keys.disc (Option.fold ~some:some_f ~none:zero disc)
    )
  in
  substitute_safe map format

let music music album artist_roles properties format =
  (* Cannot open SkhcDb otherwise ocaml/dune treat SkhcDb.Artist like Artist 
    and it causes dependencies cycles
  *)
  let artist_names, album_artists, composers = participants' artist_roles in
  let metadata = Metadata.init None [||] properties in
  let zero = "0" in
  let title = Metadata.title metadata in
  let title_sort = Metadata.title_sort metadata in
  let year = Metadata.year metadata in
  let track = Metadata.track metadata in
  let disc = Metadata.disc metadata in
  let music_path = SkhcDb.MusicFile.path music in
  let extension = Filename.extension music_path in
  let map =
    Strings.(
      let module Keys = SkhcQuery.Keys in
      empty
      (* String *)
      |> add Keys.title (Option.value ~default:String.empty title)
      |> add Keys.sort_name (Option.value ~default:String.empty title_sort)
      |> add Keys.artist (names artist_names)
      |> add Keys.album (SkhcDb.Album.name album)
      |> add Keys.album_artist (names album_artists)
      |> add Keys.composer (names composers)
      |> add Keys.path music_path
      |> add Keys.extension extension
      |> add Keys.genre
           (Option.value ~default:String.empty @@ SkhcDb.Album.genre album)
      (* Int *)
      |> add Keys.id (Printf.sprintf "%Lu" (SkhcDb.MusicFile.id music))
      |> add Keys.size (Printf.sprintf "%u" (SkhcDb.MusicFile.size music))
      |> add Keys.track (Option.fold ~some:string_of_int ~none:zero track)
      |> add Keys.year (Option.fold ~some:string_of_int ~none:zero year)
      |> add Keys.disc (Option.fold ~some:string_of_int ~none:zero disc)
      |> add Keys.plays (string_of_int (SkhcDb.MusicFile.play_count music))
      |> add Keys.length (string_of_int (SkhcDb.MusicFile.duration music))
      |> add Keys.rating
           (Option.fold ~some:string_of_int ~none:String.empty
              (SkhcDb.MusicFile.rating music)
           )
      |> add Keys.album_count (string_of_int 1)
      (* BOOLEAN *)
      |> add Keys.art (Bool.to_string @@ SkhcDb.MusicFile.has_cover music)
      |> add Keys.flag (Bool.to_string @@ SkhcDb.MusicFile.flag music)
      (* FLOAT *)
      |> add Keys.avg_duration (string_of_int (SkhcDb.MusicFile.duration music))
      |> add Keys.avg_rating
           (Option.fold ~some:string_of_int ~none:String.empty
              (SkhcDb.MusicFile.rating music)
           )
      |> add Keys.avg_size (Printf.sprintf "%u" (SkhcDb.MusicFile.size music))
    )
  in
  substitute map format

let album ~safe ~extension album stats participants format =
  let artist_names, album_artists, composers = participants' participants in
  let album_name = SkhcDb.Album.name album in
  let artwork =
    album |> SkhcDb.Album.cover_path |> Option.is_some |> Bool.to_string
  in
  let flag = album |> SkhcDb.Album.flag |> Bool.to_string in
  let bounds =
    match extension with
    | None ->
        Strings.empty
    | Some ext ->
        Strings.singleton SkhcQuery.Keys.extension ext
  in
  let map =
    Strings.(
      let module Keys = SkhcQuery.Keys in
      bounds
      (* String *)
      |> add Keys.title album_name
      |> add Keys.sort_name
           (Option.value ~default:String.empty (SkhcDb.Album.sort_name album))
      |> add Keys.artist (names artist_names)
      |> add Keys.album_artist (names album_artists)
      |> add Keys.composer (names composers)
      |> add Keys.album album_name
      |> add Keys.genre
           (Option.value ~default:String.empty @@ SkhcDb.Album.genre album)
         (* Int *)
      |> add Keys.id (Printf.sprintf "%Lu" (SkhcDb.Album.id album))
      |> add Keys.size (Printf.sprintf "%Lu" (SkhcDb.Album.Stats.size stats))
      |> add Keys.year
           (Option.fold ~some:string_of_int ~none:String.empty
              (SkhcDb.Album.year album)
           )
      |> add Keys.plays (string_of_int (SkhcDb.Album.Stats.play_count stats))
      |> add Keys.length (string_of_int (SkhcDb.Album.Stats.duration stats))
      |> add Keys.rating
           (Option.fold ~some:string_of_int ~none:String.empty
              (SkhcDb.Album.rating album)
           )
      |> add Keys.album_count
           (string_of_int (SkhcDb.Album.Stats.music_count stats))
      (* Bool *)
      |> add Keys.art artwork
      |> add Keys.flag flag
      (* Float *)
      |> add Keys.avg_duration
           (string_of_float (SkhcDb.Album.Stats.avg_duration stats))
      |> add Keys.avg_rating
           (string_of_float (SkhcDb.Album.Stats.avg_rating stats))
      |> add Keys.avg_size (string_of_float (SkhcDb.Album.Stats.avg_size stats))
    )
  in
  match safe with
  | false ->
      substitute map format
  | true ->
      substitute_safe map format

let album_metadata ~safe ~extension metadata format =
  let artist_names = SkhcMetadata.Metadata.artist ~sep:", " metadata in
  let album_artists = SkhcMetadata.Metadata.album_artist ~sep:", " metadata in
  let composers = SkhcMetadata.Metadata.composer ~sep:", " metadata in
  let album_name =
    Option.value ~default:String.empty @@ SkhcMetadata.Metadata.album metadata
  in
  let sort_name = SkhcMetadata.Metadata.album_sort metadata in
  let genre = SkhcMetadata.Metadata.genre metadata in
  let artwork =
    metadata |> SkhcMetadata.Metadata.covers |> Array.length |> ( <> ) 0
    |> Bool.to_string
  in
  let bounds =
    match extension with
    | None ->
        Strings.empty
    | Some ext ->
        Strings.singleton SkhcQuery.Keys.extension ext
  in
  let map =
    Strings.(
      let module Keys = SkhcQuery.Keys in
      bounds
      (* String *)
      |> add Keys.title album_name
      |> add Keys.sort_name (Option.value ~default:String.empty sort_name)
      |> add Keys.artist artist_names
      |> add Keys.album_artist album_artists
      |> add Keys.composer composers
      |> add Keys.album album_name
      |> add Keys.genre (Option.value ~default:String.empty genre)
      (* Int *)
      (* Bool *)
      |> add Keys.art artwork
      (* Float *)
    )
  in
  match safe with
  | false ->
      substitute map format
  | true ->
      substitute_safe map format

let artist ~safe ~extension artist format =
  let artist_name = SkhcDb.Artist.name artist in
  let artwork =
    artist |> SkhcDb.Artist.artwork |> Option.is_some |> Bool.to_string
  in
  let flag = artist |> SkhcDb.Artist.flag |> Bool.to_string in
  let bounds =
    match extension with
    | None ->
        Strings.empty
    | Some ext ->
        Strings.singleton SkhcQuery.Keys.extension ext
  in
  let map =
    Strings.(
      let module Keys = SkhcQuery.Keys in
      bounds
      |> add Keys.id (Printf.sprintf "%Lu" (SkhcDb.Artist.id artist))
      |> add Keys.sort_name
           (Option.value ~default:String.empty (SkhcDb.Artist.sort_name artist))
      |> add Keys.artist artist_name
      |> add Keys.album_artist artist_name
      |> add Keys.composer artist_name
      |> add Keys.rating
           (Option.fold ~some:string_of_int ~none:String.empty
              (SkhcDb.Artist.rating artist)
           )
         (* BOOLEAN *)
      |> add Keys.art artwork |> add Keys.flag flag
      (* Float *)
      |> add Keys.avg_rating
           (Option.fold ~some:string_of_int ~none:String.empty
              (SkhcDb.Artist.rating artist)
           )
    )
  in
  match safe with
  | false ->
      substitute map format
  | true ->
      substitute_safe map format