wip: start view srot refactor

separates sort criteria from actual order

bin/db_worker/db_worker.ml

@@ -46,7 +46,7 @@ module Worker () = struct
 
   let get_view_keys =
     let view_memo :
-        ( string Db.View.selection * Db.View.Sort.criteria option,
+        ( string Db.View.selection * Db.View.Sort.t,
           IS.Content.Key.t array )
         Hashtbl.t =
       Hashtbl.create 64
@@ -55,14 +55,11 @@ module Worker () = struct
     fun store { Db.View.kind = _; src_views; sort; filters } ->
       (* todo: staged memoization + specialized queries using indexes *)
       let open Fut.Result_syntax in
-      let sort_criteria =
-        match sort with Random -> None | Some (criteria, _) -> Some criteria
-      in
-      let hash = Hashtbl.hash (src_views, sort_criteria, filters) in
+      let hash = Hashtbl.hash (src_views, sort, filters) in
       if Int.equal (fst !last_view) hash then Fut.ok (snd !last_view)
       else
         let+ keys =
-          try Fut.ok @@ Hashtbl.find view_memo (src_views, sort_criteria)
+          try Fut.ok @@ Hashtbl.find view_memo (src_views, sort)
           with Not_found ->
             let+ all_keys =
               let lower = Jv.of_array Jv.of_string [| "Audio" |] in
@@ -82,7 +79,7 @@ module Worker () = struct
                     ~f:(fun { Db.Stores.Items.Key.views; _ } ->
                       List.exists views ~f:(fun v -> List.memq v ~set:src_views))
             in
-            Hashtbl.add view_memo (src_views, sort_criteria) keys;
+            Hashtbl.add view_memo (src_views, sort) keys;
             keys
         in
         let keys =
@@ -97,7 +94,7 @@ module Worker () = struct
         in
         let () =
           match sort with
-          | Some (Name, _) ->
+          | Name ->
               Array.sort keys
                 ~cmp:(fun
                     { Db.Stores.Items.Key.sort_name = sna; _ }
@@ -174,9 +171,8 @@ module Worker () = struct
         let* store = read_only_store () in
         let+ keys = get_view_keys store request in
         let item_count = Array.length keys in
-        let order = Db.View.Order.of_sort ~size:item_count request.sort in
-        { Db.View.uuid; request; order; start_offset = 0; item_count }
-    | Get (view, indexes) ->
+        { Db.View.uuid; request; start_offset = 0; item_count }
+    | Get (view, order, indexes) ->
         (* This request is critical to virtual lists performances and should
            be as fast as possible. *)
         let* store = read_only_store () in
@@ -186,7 +182,7 @@ module Worker () = struct
           Array.map indexes ~f:(fun index ->
               try
                 let index = index + view.start_offset in
-                let index = Db.View.Order.apply view.order index in
+                let index = Db.View.Order.apply order index in
                 (* This could be optimize when access is sequential *)
                 let key = keys.(index) in
                 let open Fut.Syntax in

bin/import.ml

@@ -2,6 +2,7 @@ include Std
 module DS = Data_source.Jellyfin
 module Elwd = Brr_lwd.Elwd
 module Ui_utils = Brr_lwd_ui.Utils
+module View = Db.View
 
 module String = struct
   include String

bin/main.ml

@@ -13,7 +13,8 @@ let _ =
   Data_source.Jellyfin_api.set_session_uuid uuid;
   Worker_client.query (Set_session_uuid (Lwd.peek session_uuid))
 
-let fetch view i = Worker_client.(query (Get (view, i)))
+let fetch ranged_view i =
+  Worker_client.(query (Get (ranged_view.View.view, ranged_view.order, i)))
 
 module P = Player.Playback_controller (struct
   let fetch = fetch
@@ -91,8 +92,18 @@ let app =
           ];
         let open Fut.Result_syntax in
         let sort = Db.View.Sort.of_string s in
-        Worker_client.query
-          (Create_view Db.View.(req Audio ~src_views:(Only l) ~sort ?filters ())))
+        let open Fut.Result_syntax in
+        let+ view =
+          Worker_client.query
+            (Create_view
+               Db.View.(req Audio ~src_views:(Only l) ~sort ?filters ()))
+        in
+        let order =
+          match s with
+          | "random" -> View.Order.random ~size:view.item_count
+          | _ -> View.Order.Initial
+        in
+        { View.view; first = 0; last = view.item_count; order })
   in
 
   let main_list =

bin/player.ml

@@ -3,7 +3,7 @@ open Brr
 open Brr_lwd
 
 type playstate = {
-  playlist : Db.View.t option Lwd.var;
+  playlist : Db.View.ranged option Lwd.var;
   current_index : int Lwd.var;
 }
 
@@ -33,7 +33,7 @@ let audio_url (server : DS.connexion) item_id =
 
 module Playback_controller (P : sig
   val fetch :
-    Db.View.t ->
+    Db.View.ranged ->
     int array ->
     (Db.Stores.Items.t option array, Db.Worker_api.error) Fut.result
 end) =

bin/ui_playlist.ml

@@ -17,7 +17,7 @@ let columns () =
     |]
 
 let make ~reset_playlist ~fetch ?scroll_target
-    (view : (Db.View.t, 'a) Fut.result Lwd.t) =
+    (view : (Db.View.ranged, 'a) Fut.result Lwd.t) =
   let img_url server_id item_id =
     let servers =
       (* should this be reactive ? *)
@@ -41,9 +41,16 @@ let make ~reset_playlist ~fetch ?scroll_target
     let play_from _ =
       ignore
         (let open Fut.Result_syntax in
-         let+ (view : Db.View.t) = view in
+         let+ (view : Db.View.ranged) = view in
          reset_playlist
-           { view with start_offset = view.start_offset + start_index })
+           {
+             view with
+             view =
+               {
+                 view.view with
+                 start_offset = view.view.start_offset + start_index;
+               };
+           })
     in
     let play_on_click = Elwd.handler Ev.click play_from in
     let img_url =
@@ -73,7 +80,11 @@ let make ~reset_playlist ~fetch ?scroll_target
   in
   let data_source =
     Lwd.map view ~f:(fun view ->
-        let total_items = Fut.map (Result.map Db.View.item_count) view in
+        let total_items =
+          Fut.map
+            (Result.map (fun view -> Db.View.item_count view.View.view))
+            view
+        in
         let fetch i =
           let open Fut.Result_syntax in
           let* view = view in
@@ -85,6 +96,6 @@ let make ~reset_playlist ~fetch ?scroll_target
   Table.Virtual.make ~ui_table ~placeholder ?scroll_target data_source
 
 let make_now_playing ~reset_playlist ~fetch
-    (view : (Db.View.t, 'a) Fut.result Lwd.t) =
+    (view : (Db.View.ranged, 'a) Fut.result Lwd.t) =
   let scroll_target = Lwd.get Player.playstate.current_index in
   make ~scroll_target ~reset_playlist ~fetch view

lib/db/db_worker_api.ml

@@ -12,7 +12,9 @@ module Queries = struct
     | Get_libraries : unit -> Stores.Items.t list query
     | Get_server_libraries : string -> Stores.Items.t list query
     | Create_view : View.req -> View.t query
-    | Get : View.t * int array -> Stores.Items.t option array query
+    | Get :
+        View.t * View.Order.t * int array
+        -> Stores.Items.t option array query
 
   type 'a event = Servers_status_update : (string * Sync.report) event
 end

lib/db/view.ml

@@ -1,30 +1,27 @@
 open Std
 
-module Sort = struct
-  type criteria = Date_added | Name
-  type direction = Asc | Desc
-  type t = Some of criteria * direction | Random
-
-  let of_string ?(direction = Asc) = function
-    | "date_added" -> Some (Date_added, direction)
-    | "name" -> Some (Name, direction)
-    | "random" -> Random
-    | _ -> failwith "wrong sort of sort"
-end
-
 (** Some sorts require a custom ordering which is done using a table of indexes. For example, to get a random sort we simple shuffle an array which size is the one of the result. *)
 module Order = struct
-  type t = Initial | Custom of int array
+  type t = Initial | Asc | Desc | Custom of int array
 
-  let of_sort ~size = function
-    | Sort.Random ->
-        let tbl = Array.init size ~f:Fun.id in
-        let () = Array.shuffle tbl in
-        Custom tbl
-    | _ -> Initial
+  let random ~size =
+    let tbl = Array.init size ~f:Fun.id in
+    let () = Array.shuffle tbl in
+    Custom tbl
 
   let apply t i =
-    match t with Initial -> i | Custom a -> (* todo check bounds *) a.(i)
+    match t with
+    | Initial | Asc | Desc -> i
+    | Custom a -> (* todo check bounds *) a.(i)
+end
+
+module Sort = struct
+  type t = Date_added | Name
+
+  let of_string = function
+    | "date_added" -> Date_added
+    | "name" -> Name
+    | _ -> Date_added
 end
 
 type 'a selection = All | Only of 'a list
@@ -38,18 +35,12 @@ type req = {
   filters : filter list;
 }
 
-type t = {
-  uuid : Uuidm.t;
-  request : req;
-  order : Order.t;
-  start_offset : int;
-  item_count : int;
-}
+type t = { uuid : Uuidm.t; request : req; start_offset : int; item_count : int }
+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.(Some (Date_added, Desc)))
-    ?(filters = []) () =
+let req kind ?(src_views = All) ?(sort = Sort.Date_added) ?(filters = []) () =
   { kind; src_views; sort; filters }
 
 let hash req = Hashtbl.hash (req.src_views, req.filters)