WIP

pool/app/admin/admin.mli

@@ -1,4 +1,8 @@
-module Id : module type of Pool_common.Id
+module Id : sig
+  include module type of Pool_common.Id
+
+  val to_common : t -> Pool_common.Id.t
+end
 
 type t =
   { user : Sihl_user.t

pool/app/pool_context/pool_context.ml

@@ -12,6 +12,12 @@ let get_admin_user = function
   | Admin admin -> Ok admin
 ;;
 
+let get_user_id : user -> Pool_common.Id.t option = function
+  | Guest -> None
+  | Admin admin -> Admin.(id admin |> Id.to_common |> CCOption.return)
+  | Contact contact -> Contact.(id contact |> CCOption.return)
+;;
+
 module Utils = struct
   let find_authorizable_opt ?(admin_only = false) database_label user =
     let open Utils.Lwt_result.Infix in

pool/app/pool_context/pool_context.mli

@@ -70,6 +70,7 @@ val sexp_of_t : t -> Sexplib.Sexp.t
 val is_from_root : t -> bool
 val user_is_admin : user -> bool
 val get_admin_user : user -> (Admin.t, Pool_common.Message.error) result
+val get_user_id : user -> Pool_common.Id.t option
 
 module Utils : sig
   val find_authorizable_opt

pool/app/query/query.ml

@@ -1,6 +1,25 @@
 include Entity
 
+module Cache = struct
+  open Hashtbl
+
+  (* TODO: How to determine when to clear the cache? Add param to reset button?
+     Clear after some time without reading? *)
+  type key = Pool_common.Id.t * string [@@deriving show]
+
+  let tbl : (key, Entity.t) t = create 50
+  let find = find_opt tbl
+  let add = add tbl
+  let clear = remove tbl
+
+  let should_reset req =
+    Sihl.Web.Request.query "reset" req
+    |> CCOption.map_or ~default:false Utils.Bool.of_string
+  ;;
+end
+
 let from_request
+  ?(cached_key : Cache.key option)
   ?(filterable_by : Filter.human option)
   ?(searchable_by : Column.t list option)
   ?(sortable_by : Column.t list option)
@@ -38,12 +57,9 @@ let from_request
     | [] -> None
     | conditions -> Some conditions
   in
-  let pagination =
-    let open Pagination in
-    let limit = find Limit.field >>= CCInt.of_string in
-    let page = find Page.field >>= CCInt.of_string in
-    create ?limit ?page ()
-  in
+  let limit = find Pagination.Limit.field >>= CCInt.of_string in
+  let page = find Pagination.Page.field >>= CCInt.of_string in
+  let pagination () = Pagination.create ?limit ?page () in
   let search =
     let open Search in
     searchable_by
@@ -64,7 +80,25 @@ let from_request
     >>= fun columns ->
     find Field.Order >|= Field.read >>= Sort.create ?order columns
   in
-  create ~pagination ?filter ?search ?sort () |> apply_default ~default
+  let anything_set =
+    match filter, limit, page, search, sort with
+    | None, None, None, None, None -> false
+    | _ -> true
+  in
+  let from_request = create ~pagination:(pagination ()) ?filter ?search ?sort in
+  apply_default ~default
+  @@
+  match anything_set with
+  | true ->
+    let query = from_request () in
+    let () = cached_key |> map_or ~default:() (CCFun.flip Cache.add query) in
+    query
+  | false ->
+    (match Cache.should_reset req with
+     | false -> cached_key >>= Cache.find |> value ~default:(from_request ())
+     | true ->
+       let () = cached_key |> map_or ~default:() Cache.clear in
+       from_request ())
 ;;
 
 let empty () = create ()

pool/app/query/query.mli

@@ -144,6 +144,15 @@ val to_uri_query
 val with_sort_order : Sort.SortOrder.t -> t -> t
 val with_sort_column : Column.t -> t -> t
 
+module Cache : sig
+  type key = Pool_common.Id.t * string
+
+  val show_key : key -> string
+  val find : key -> t option
+  val add : key -> t -> unit
+  val clear : key -> unit
+end
+
 val create
   :  ?filter:Filter.t
   -> ?pagination:Pagination.t
@@ -153,7 +162,8 @@ val create
   -> t
 
 val from_request
-  :  ?filterable_by:Filter.human
+  :  ?cached_key:Cache.key
+  -> ?filterable_by:Filter.human
   -> ?searchable_by:Column.t list
   -> ?sortable_by:Column.t list
   -> ?default:t

pool/web/handler/admin_experiments.ml

@@ -112,10 +112,9 @@ let index req =
     req
   @@ fun ({ Pool_context.database_label; user; _ } as context) query ->
   let open Utils.Lwt_result.Infix in
-  let find_actor =
+  let* actor =
     Pool_context.Utils.find_authorizable ~admin_only:true database_label user
   in
-  let* actor = find_actor in
   let%lwt experiments, query =
     Experiment.find_all
       ~query

pool/web/utils/http_utils.ml

@@ -427,9 +427,15 @@ module Htmx = struct
     fun ?active_navigation ~error_path ~query:(module Q) ~create_layout req run ->
     let open Utils.Lwt_result.Infix in
     extract_happy_path ~src req
-    @@ fun context ->
+    @@ fun ({ Pool_context.user; _ } as context) ->
+    let cached_key =
+      (* TODO: Use something else then active naviation as key *)
+      let user_id = user |> Pool_context.get_user_id in
+      CCOption.( and* ) user_id active_navigation
+    in
     let query =
       Query.from_request
+        ?cached_key
         ?filterable_by:Q.filterable_by
         ~searchable_by:Q.searchable_by
         ~sortable_by:Q.sortable_by

pool/web/view/component/data_table.ml

@@ -339,7 +339,10 @@ let resetbar language =
   div
     ~a:[ a_class [ "flexrow"; "justify-end"; "filter-bar-reset" ] ]
     [ a
-        ~a:[ a_class [ "has-icon"; "undecorated"; "color-dark" ]; a_href "?" ]
+        ~a:
+          [ a_class [ "has-icon"; "undecorated"; "color-dark" ]
+          ; a_href "?reset=true"
+          ]
         [ Component_icon.(to_html RefreshOutline)
         ; txt
             (Utils.control_to_string