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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
(*****************************************************************************)
(*                                                                           *)
(*  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 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

  let column_query ~music_album_key ~album_key ~id ~play_count ~duration ~size
      ~rating =
    let music_table, album_id = music_album_key in
    let album_table, album_tid = album_key in
    let from_where =
      Printf.sprintf "FROM %s WHERE %s.%s = %s.%s" music_table music_table
        album_id album_table album_tid
    in
    Printf.sprintf
      {|
  COUNT(DISTINCT %s),
	(SELECT sum(%s) %s),
	(SELECT sum(%s) %s),
	(SELECT sum(%s) %s),
	(SELECT avg(%s) %s),
	(SELECT avg(%s) %s),
	(SELECT avg(%s) %s)
  |}
      id play_count from_where duration from_where size from_where duration
      from_where rating from_where size from_where
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