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
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
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