Add initial support for name filtering

bin/db_worker/db_worker.ml

@@ -49,33 +49,47 @@ module Worker () = struct
         =
       Hashtbl.create 64
     in
-    fun store { Db.View.kind = _; src_views; sort = _; _ } ->
+    let last_view : (int * IS.Content.Key.t array) ref = ref (-1, [||]) in
+    fun store { Db.View.kind = _; src_views; sort = _; filters } ->
       (* todo: staged memoization + specialized queries using indexes *)
       let open Fut.Result_syntax in
-      try Fut.ok @@ Hashtbl.find view_memo src_views
-      with Not_found ->
-        Console.debug [ "View not found" ];
-        let f = Performance.now_ms G.performance in
+      let hash = Hashtbl.hash (src_views, filters) in
+      if Int.equal (fst !last_view) hash then Fut.ok (snd !last_view)
+      else
         let idx = IS.index (module IS.Index.Kind_View) store in
-        let+ all_keys =
-          let lower = Jv.of_array Jv.of_string [| "Audio" |] in
-          let upper = Jv.of_array Jv.of_string [| "Audio\u{0}" |] in
-          let query =
-            IDB.Key_range.bound ~lower ~upper ~lower_open:true ~upper_open:false
-              ()
-          in
-          IS.Index.Kind_View.get_all_keys ~query idx |> as_fut
+        let+ keys =
+          try Fut.ok @@ Hashtbl.find view_memo src_views
+          with Not_found ->
+            let+ all_keys =
+              let lower = Jv.of_array Jv.of_string [| "Audio" |] in
+              let upper = Jv.of_array Jv.of_string [| "Audio\u{0}" |] in
+              let query =
+                IDB.Key_range.bound ~lower ~upper ~lower_open:true
+                  ~upper_open:false ()
+              in
+              IS.Index.Kind_View.get_all_keys ~query idx |> as_fut
+            in
+            let keys =
+              match src_views with
+              | All -> all_keys
+              | Only src_views ->
+                  Array.filter all_keys ~f:(fun (_, _sn, views) ->
+                      List.exists views ~f:(fun v -> List.memq v ~set:src_views))
+            in
+            Hashtbl.add view_memo src_views keys;
+            keys
         in
         let keys =
-          match src_views with
-          | All -> all_keys
-          | Only src_views ->
-              Array.filter all_keys ~f:(fun (_, _sn, views) ->
-                  List.exists views ~f:(fun v -> List.memq v ~set:src_views))
+          match filters with
+          | [ Search sub ] when not (String.is_empty sub) ->
+              let sub = String.lowercase_ascii sub in
+              Array.filter keys ~f:(fun (_, sort_name, _) ->
+                  let sort_name = String.lowercase_ascii sort_name in
+                  let pattern = String.Find.compile (Printf.sprintf "%s" sub) in
+                  String.Find.find ~pattern sort_name >= 0)
+          | _ -> keys
         in
-        let f' = Performance.now_ms G.performance in
-        Console.log [ "Uncached view creation took:"; f' -. f; "ms" ];
-        Hashtbl.add view_memo src_views keys;
+        last_view := (hash, keys);
         keys
 
   let on_query (type a) (q : a query) : (a, error) Fut.result =

bin/main.ml

@@ -31,14 +31,22 @@ let app _idb =
   let player_ui =
     Elwd.div ~at:[ `P (At.style (Jstr.v "grid-column:1/-1")) ] [ `R player ]
   in
+  let f_search =
+    let open Brr_lwd_ui.Field_textinput in
+    make
+      {
+        name = "pouet";
+        default = None;
+        desc = { placeholder = Lwd.pure None; label = [] };
+      }
+  in
 
   let filters, f_value =
     let f_libraries =
       let open Brr_lwd_ui.Field_checkboxes in
       let choices =
         Lwd_seq.fold_monoid
           (fun (_, l) ->
-            Console.log [ "Libraries:"; l ];
             let l : Db.Stores.Items.t list Lwd.t = l in
             Lwd.map l ~f:(fun l ->
                 Lwd_seq.transform_list l (fun l ->
@@ -49,12 +57,16 @@ let app _idb =
       in
       make { name = "pouet"; desc = Lwd.join choices }
     in
-    (f_libraries.field, f_libraries.value)
+    let filters = Elwd.div [ `R f_search.field; `R f_libraries.field ] in
+    (filters, f_libraries.value)
   in
   let main_view =
-    Lwd.map f_value ~f:(fun l ->
+    Lwd.map2 f_value f_search.value ~f:(fun l t ->
+        let filters = Option.map (fun s -> [ Db.View.Search s ]) t in
+        let open Fut.Result_syntax in
         Worker_client.query
-          (Create_view Db.View.(req Audio ~src_views:(Only l) ~sort:Random ())))
+          (Create_view
+             Db.View.(req Audio ~src_views:(Only l) ~sort:Random ?filters ())))
   in
 
   let main_list =

lib/db/view.ml

@@ -23,12 +23,13 @@ end
 
 type 'a selection = All | Only of 'a list
 type kind = Audio
+type filter = Search of string
 
 type req = {
   kind : kind;
   src_views : string selection;
   sort : Sort.t;
-  filters : unit list;
+  filters : filter list;
 }
 
 type t = {
@@ -44,3 +45,5 @@ let item_count t = t.item_count - t.start_offset
 let req kind ?(src_views = All) ?(sort = Sort.(Some (Date_added, Desc)))
     ?(filters = []) () =
   { kind; src_views; sort; filters }
+
+let hash req = Hashtbl.hash (req.src_views, req.filters)