diff --git a/bin/db_worker/db_worker.ml b/bin/db_worker/db_worker.ml index 2613ec2..c7311d4 100644 --- a/bin/db_worker/db_worker.ml +++ b/bin/db_worker/db_worker.ml @@ -23,19 +23,12 @@ let fut_of_array (fs : 'a Fut.t array) : 'a array Fut.t = Obj.magic @@ fut @@ Jv.Promise.bind all to_array module Worker () = struct - let view_memo : - ( int Db.View.selection * Db.View.Sort.t, - Db.Generic_schema.Track.Key.t array ) - Hashtbl.t = - Hashtbl.create 64 - let last_view : (int * Db.Generic_schema.Track.Key.t array) ref = ref (-1, [||]) let check_db idb source = let server_id, source = source in let report status = - Hashtbl.clear view_memo; last_view := (-1, [||]); dispatch_event Servers_status_update (server_id, status) in @@ -72,8 +65,8 @@ module Worker () = struct let n = Performance.now_ms G.performance in let keys = match src_views with - | All -> all_keys - | Only src_views -> + | { only = []; none_of = _ } -> [||] + | { only = src_views; none_of = _ } -> Array.filter all_keys ~f:(fun { Db.Generic_schema.Track.Key.collections; _ } -> List.exists collections ~f:(fun v -> List.memq v ~set:src_views)) @@ -87,11 +80,17 @@ module Worker () = struct ~f:(fun { Db.Generic_schema.Track.Key.name; _ } -> let name = String.lowercase_ascii name in String.Find.find ~pattern name >= 0) - | Genres (Only ids) -> + | Genres { only; none_of } -> Array.filter keys ~f:(fun { Db.Generic_schema.Track.Key.genres; _ } -> let genres = Int.Set.of_list genres in - Int.Set.subset genres ids) + let b_only = + Int.Set.is_empty only || not (Int.Set.disjoint genres only) + in + let b_noneof = + Int.Set.is_empty none_of || Int.Set.disjoint genres none_of + in + b_only && b_noneof) | _ -> keys) in Console.log diff --git a/bin/ui_filters.ml b/bin/ui_filters.ml index c096ac1..7536973 100644 --- a/bin/ui_filters.ml +++ b/bin/ui_filters.ml @@ -3,10 +3,14 @@ open Brr open Brr_lwd_ui.Forms open Db.Generic_schema +(* TODO this module has already seen multiple experimental reworks, it's due for + a cleanup and refactor... *) + let selected_libraries = Lwd.var Lwd_seq.empty let view0 = Lwd.var None -let view0_genres = Lwd.var Lwd_seq.empty +let view0_genres : (int * (int * Genre.t)) list Lwd.var = Lwd.var [] let selected_genres = Lwd.var Int.Set.empty +let genre_formula = Lwd.var "" let selected_sort = Lwd.var "date_added" let selected_order = Lwd.var "desc" let name_filter = Lwd.var "" @@ -18,7 +22,7 @@ let view = request = { kind = Audio; - src_views = Only []; + src_views = Selection.init []; sort = Sort.Date_added; filters = []; }; @@ -26,27 +30,50 @@ let view = item_count = 0; } -let filter0_changed () = - let open View in - let src_views = Only (Lwd.peek selected_libraries |> Lwd_seq.to_list) in - let req = { kind = Audio; src_views; sort = Sort.Date_added; filters = [] } in - let open Fut.Result_syntax in - let* view = Worker_client.query (Create_view req) in - let+ genres = Worker_client.query (Get_view_albums view) in - let sorted_genres = - Int.Map.to_list genres - |> List.sort ~cmp:(fun (_, (c1, _)) (_, (c2, _)) -> Int.compare c2 c1) +let genre_filter_of_formula ~genres formula = + let open View.Selection in + let string_of_chars chars = String.of_list (List.rev chars) in + let matching_genres ~name = + let canon_name = canonicalize_string name in + List.filter_map genres ~f:(fun (key, name) -> + if String.find ~sub:canon_name name >= 0 then Some key else None) in - Lwd.set view0 (Some view); - Lwd.set view0_genres (Lwd_seq.of_list sorted_genres) + String.fold_left formula ~init:[] ~f:(fun acc char -> + match (char, acc) with + | '+', _ -> `Only [] :: acc + | '-', _ -> `None_of [] :: acc + | c, `Only l :: tl -> `Only (c :: l) :: tl + | c, `None_of l :: tl -> `None_of (c :: l) :: tl + | _, _ -> acc) + |> List.fold_left ~init:(init [ [] ]) ~f:(fun ({ only; none_of } as s) -> + function + | `Only chars -> + let name = string_of_chars chars in + if String.is_empty name then s + else { s with only = matching_genres ~name :: only } + | `None_of chars -> + let name = string_of_chars chars in + if String.is_empty name then s + else { s with none_of = matching_genres ~name :: none_of }) + |> map ~f:(fun ll -> Int.Set.of_list (List.flatten ll)) let filter1_changed () = let open View in - let src_views = Only (Lwd.peek selected_libraries |> Lwd_seq.to_list) in + let src_views = + { + (Selection.init []) with + only = Lwd.peek selected_libraries |> Lwd_seq.to_list; + } + in let sort = Sort.of_string @@ Lwd.peek selected_sort in let genres = (* TODO that's not efficient *) - Only (Lwd.peek selected_genres) + (* Only (Lwd.peek selected_genres) *) + let genres = + Lwd.peek view0_genres + |> List.map ~f:(fun (k, (_, g)) -> (k, g.Genre.canon)) + in + genre_filter_of_formula ~genres (Lwd.peek genre_formula) in let filters = [ Search (Lwd.peek name_filter); Genres genres ] in let req = { kind = Audio; src_views; sort; filters } in @@ -54,6 +81,32 @@ let filter1_changed () = let+ view' = Worker_client.query (Create_view req) in Lwd.set view view' +let filter0_changed () = + let open View in + let src_views = + { + (Selection.init []) with + only = Lwd.peek selected_libraries |> Lwd_seq.to_list; + } + in + let req = { kind = Audio; src_views; sort = Sort.Date_added; filters = [] } in + let open Fut.Result_syntax in + let+ view = Worker_client.query (Create_view req) in + let+ genres = Worker_client.query (Get_view_albums view) in + let sorted_genres = + Int.Map.to_list genres + |> List.sort ~cmp:(fun (_, (c1, _)) (_, (c2, _)) -> Int.compare c2 c1) + in + Lwd.set view0 (Some view); + Lwd.set view0_genres sorted_genres; + filter1_changed () + +let request_refresh = + let timer = ref (-1) in + fun ?(delay = 250) () -> + if !timer >= 0 then G.stop_timer !timer; + timer := G.set_timeout ~ms:delay (fun () -> filter1_changed () |> ignore) + let libraries_choices = let open Field_checkboxes in let choices = @@ -73,11 +126,10 @@ let libraries_choices = Lwd.map value ~f:(fun v -> Lwd.set selected_libraries v; ignore @@ filter0_changed (); - ignore @@ filter1_changed (); v) in Lwd.map2 field value ~f:(fun field _ -> field) - +(* let genres_choices = let open Field_checkboxes in let at = Attrs.O.(`P (C "vertical-picker") @:: v (`P (C ""))) in @@ -86,7 +138,7 @@ let genres_choices = (fun (key, (count, { Genre.name; _ })) -> let text = Printf.sprintf "%s (%i)" name count in Check (key, [ `P (El.txt' text) ], true)) - (Lwd.get view0_genres) + (Lwd.map (Lwd.get view0_genres) ~f:Lwd_seq.of_list) in let { field; value } = make ~at { name = "genre-selection"; desc = choices } @@ -98,14 +150,25 @@ let genres_choices = ignore @@ filter1_changed (); v) in - Lwd.map2 field value ~f:(fun field _ -> field) + Lwd.map2 field value ~f:(fun field _ -> field) *) + +let genre_formula = + let open Field_textinput in + let on_change ~init v = + Lwd.set genre_formula v; + if not init then ignore @@ request_refresh () + in + let placeholder = "+classi -opera" in + (make ~on_change ~placeholder + { name = "genre-formula"; default = None; label = [] }) + .field let search_and_sort = let f_search = let open Field_textinput in - let on_change v = + let on_change ~init v = Lwd.set name_filter v; - ignore @@ filter1_changed () + if not init then ignore @@ request_refresh () in make ~on_change { name = "pouet"; default = None; label = [] } in @@ -115,9 +178,9 @@ let search_and_sort = Lwd.pure (Lwd_seq.of_list [ ("date_added", "Date added"); ("name", "Name") ]) in - let on_change v = + let on_change ~init v = Lwd.set selected_sort v; - ignore @@ filter1_changed () + if not init then ignore @@ request_refresh ~delay:25 () in make ~on_change { name = "view-sort"; default = "date_added"; label = [] } @@ -130,9 +193,9 @@ let search_and_sort = (Lwd_seq.of_list [ ("asc", "Asc"); ("desc", "Desc"); ("random", "Random") ]) in - let on_change v = + let on_change ~init v = Lwd.set selected_order v; - ignore @@ filter1_changed () + if not init then ignore @@ request_refresh ~delay:25 () in make ~on_change { name = "view-order"; default = "desc"; label = [] } @@ -146,7 +209,7 @@ let library_chooser = let genre_chooser = let at = Attrs.O.(v (`P (C "genres-picker"))) in - Elwd.div ~at [ `R genres_choices ] + Elwd.div ~at [ `P (El.txt' "Filter by genre: "); `R genre_formula ] let bar = let at = Attrs.O.(v (`P (C "filters-row"))) in diff --git a/lib/db/view.ml b/lib/db/view.ml index d858205..3ea654f 100644 --- a/lib/db/view.ml +++ b/lib/db/view.ml @@ -33,13 +33,21 @@ module Sort = struct | _ -> Date_added end -type 'a selection = All | Only of 'a +module Selection = struct + type 'a t = { only : 'a; none_of : 'a } + + let map ~f s = { only = f s.only; none_of = f s.none_of } + let init v = { only = v; none_of = v } +end + +open Selection + type kind = Audio -type filter = Search of string | Genres of Int.Set.t selection +type filter = Search of string | Genres of Int.Set.t Selection.t type req = { kind : kind; - src_views : int list selection; + src_views : int list Selection.t; sort : Sort.t; filters : filter list; } @@ -49,10 +57,14 @@ let hash { kind; src_views; sort; filters } = List.map filters ~f:(fun f -> match f with | Search s -> s - | Genres (Only s) -> - Int.Set.to_list s |> List.map ~f:string_of_int - |> String.concat ~sep:";" - | Genres All -> "allgenres") + | Genres { only; none_of } -> + String.concat ~sep:";" + @@ List.concat + [ + Int.Set.to_list only |> List.map ~f:string_of_int; + [ "not" ]; + Int.Set.to_list none_of |> List.map ~f:string_of_int; + ]) in Hash.poly (kind, src_views, sort, filters) @@ -61,5 +73,6 @@ type ranged = { view : t; first : int; last : int; order : Order.t } let item_count t = t.item_count - t.start_offset -let req kind ?(src_views = All) ?(sort = Sort.Date_added) ?(filters = []) () = +let req kind ?(src_views = init []) ?(sort = Sort.Date_added) ?(filters = []) () + = { kind; src_views; sort; filters } diff --git a/vendor/brr_lwd_ui/lib/forms/field_select.ml b/vendor/brr_lwd_ui/lib/forms/field_select.ml index f599110..0b5cbce 100644 --- a/vendor/brr_lwd_ui/lib/forms/field_select.ml +++ b/vendor/brr_lwd_ui/lib/forms/field_select.ml @@ -12,15 +12,15 @@ type 'a reactive_field = { let name ~id base_name = if id then Printf.sprintf "%s--id" base_name else base_name -let make ?(persist = true) ?(at = []) ?(ev = []) ?(on_change = ignore) - (desc : string Field.desc) options = +let make ?(persist = true) ?(at = []) ?(ev = []) + ?(on_change = fun ~init:_ -> ignore) (desc : string Field.desc) options = let id = name ~id:true desc.name in let name = name ~id:false desc.name in let value = if persist then Persistent.var ~key:id desc.default else Lwd.var desc.default in - let () = on_change @@ Lwd.peek value in + let () = on_change ~init:true @@ Lwd.peek value in let label = Elwd.label ~at:[ `P (At.for' (Jstr.v id)) ] desc.label in let field = let at = @@ -33,7 +33,7 @@ let make ?(persist = true) ?(at = []) ?(ev = []) ?(on_change = ignore) Elwd.handler Ev.change (fun ev -> let t = Ev.target ev |> Ev.target_to_jv in let value' = Jv.get t "value" |> Jv.to_string in - on_change value'; + on_change ~init:false value'; Lwd.set value value') in let ev = `P on_change :: ev in diff --git a/vendor/brr_lwd_ui/lib/forms/field_textinput.ml b/vendor/brr_lwd_ui/lib/forms/field_textinput.ml index 5b7f67f..9ddb239 100644 --- a/vendor/brr_lwd_ui/lib/forms/field_textinput.ml +++ b/vendor/brr_lwd_ui/lib/forms/field_textinput.ml @@ -13,12 +13,12 @@ let name ~id base_name = if id then Printf.sprintf "%s--id" base_name else Printf.sprintf "%s" base_name -let make ?(at = []) ?(ev = []) ?(on_change = ignore) +let make ?(at = []) ?(ev = []) ?placeholder ?(on_change = fun ~init:_ -> ignore) (desc : string option Field.desc) = let id = name ~id:true desc.name in let name = name ~id:false desc.name in let value = Persistent.var ~key:id desc.default in - let () = Lwd.peek value |> Option.iter on_change in + let () = Lwd.peek value |> Option.iter (on_change ~init:true) in let label = Elwd.label ~at:[ `P (At.for' (Jstr.v id)) ] desc.label in let field = let at = @@ -26,6 +26,7 @@ let make ?(at = []) ?(ev = []) ?(on_change = ignore) add At.Name.id (`P id) at |> add At.Name.name (`P name) |> add At.Name.type' (`P "text") + |> add_opt At.Name.placeholder placeholder in let at = match Lwd.peek value with @@ -36,7 +37,7 @@ let make ?(at = []) ?(ev = []) ?(on_change = ignore) Elwd.handler Ev.keyup (fun ev -> let t = Ev.target ev |> Ev.target_to_jv in let value' = Jv.get t "value" |> Jv.to_string in - on_change value'; + on_change ~init:false value'; Lwd.set value (Some value')) in let ev = `P on_change :: ev in