package shakuhachi

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

Source file util.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
(**********************************************************************************************)
(*                                                                                            *)
(* This file is part of shakuhachi: a music collection manager                                *)
(* Copyright (C) 2025 Yves Ndiaye                                                             *)
(*                                                                                            *)
(* shakuhachi is free software: you can redistribute it and/or modify it under the terms      *)
(* of the GNU General Public License as published by the Free Software Foundation,            *)
(* either version 3 of the License, or (at your option) any later version.                    *)
(*                                                                                            *)
(* shakuhachi is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;    *)
(* without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR           *)
(* PURPOSE.  See the GNU General Public License for more details.                             *)
(* You should have received a copy of the GNU General Public License along with shakuhachi.   *)
(* If not, see <http://www.gnu.org/licenses/>.                                                *)
(*                                                                                            *)
(**********************************************************************************************)

module Metadata = SkhcMetadata.Metadata

module Parser = struct
  open Angstrom

  let is_digit = function '0' .. '9' -> true | _ -> false
  let number = map ~f:int_of_string (take_while1 is_digit)
  let number64 = map ~f:Int64.of_string (take_while1 is_digit)
  let string_all k = map (take_while (Fun.const true)) ~f:k
end

module Stats = struct
  let init ~init' ~music_count ~duration ~play_count ~size ~avg_rating =
    let avg what =
      if music_count = 0 then
        Float.zero
      else
        Int.to_float what /. Int.to_float music_count
    in
    let avg_duration = avg duration in
    let avg_size = Int64.to_float size /. Int.to_float music_count in
    init' ~music_count ~duration ~play_count ~size ~avg_duration ~avg_rating
      ~avg_size
end

let bind_ok database rc f =
  match rc with
  | Sqlite3.Rc.OK | Sqlite3.Rc.DONE ->
      f ()
  | rc ->
      let message = Sqlite3.errmsg database in
      Error (rc, message)

let bind_constraint_ok database rc f =
  match rc with
  | Sqlite3.Rc.OK | Sqlite3.Rc.DONE | Sqlite3.Rc.CONSTRAINT ->
      f ()
  | rc ->
      let message = Sqlite3.errmsg database in
      Error (rc, message)

let bind_option fbind statement n value =
  match value with
  | None ->
      Sqlite3.Rc.OK
  | Some value ->
      fbind statement n value

let sql_participants_format ~ss ~id ~role ~name =
  Printf.sprintf "group_concat(%s || ':' || %s || '_' || %s, '%c')" id role name
    ss

(*
    ss like split string
    sv like split value
*)
let sql_participants ~ss s =
  let participant_parse s =
    let open Angstrom in
    let parser =
      map2 ~f:(fun id d -> (id, d)) (Parser.number64 <* char ':')
      @@ choice
           [
             map2 Parser.number
               (char '_' *> Parser.string_all Fun.id)
               ~f:(fun role name ->
                 let role = Role.of_int role in
                 (name, role)
               );
             map (Parser.string_all Fun.id) ~f:(fun s -> (s, Role.Unknown));
           ]
    in
    match parse_string ~consume:All parser s with
    | Ok e ->
        Some e
    | Error _ ->
        None
  in
  s |> String.split_on_char ss
  |> List.fold_left
       (fun ids s ->
         match participant_parse s with
         | None ->
             ids
         | Some (id, (name, role)) ->
             Ids.Map.update id
               (function
                 | None ->
                     Some (name, Roles.singleton role)
                 | Some (_, roles) ->
                     Some (name, Roles.add role roles)
                 )
               ids
       )
       Ids.Map.empty

let sql_properties ~ss ~sv s =
  s |> String.split_on_char ss
  |> List.fold_left
       (fun properties s ->
         let key_vals = String.split_on_char sv s in
         match key_vals with
         | [] | _ :: [] ->
             properties
         | key :: values ->
             let values = String.concat " " values in
             Metadata.Properties.update key
               (function
                 | None ->
                     Some (Metadata.Values.singleton values)
                 | Some v ->
                     Some (Metadata.Values.add values v)
                 )
               properties
       )
       Metadata.Properties.empty