Filter by genres

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

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,42 +22,91 @@ let view =
         request =
           {
             kind = Audio;
-            src_views = Only [];
+            src_views = Selection.init [];
             sort = Sort.Date_added;
             filters = [];
           };
         start_offset = 0;
         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
   let open Fut.Result_syntax in
   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

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 }

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

vendor/brr_lwd_ui/lib/forms/field_textinput.ml

@@ -13,19 +13,20 @@ 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 =
       let open Attrs in
       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