Feature/2138 improve filter statistics

pool/app/experiment/experiment.mli

@@ -433,10 +433,15 @@ module Statistics : sig
     type statistics =
       { total_sent : int
       ; total_match_filter : int
+      ; total_uninvited_matching : int
       ; sent_by_count : sent_by_count list
       }
 
-    val create : Database.Label.t -> t -> (statistics, Pool_message.Error.t) Lwt_result.t
+    val create
+      :  ?query:Filter.query
+      -> Database.Label.t
+      -> t
+      -> (statistics, Pool_message.Error.t) Lwt_result.t
   end
 
   module RegistrationPossible : sig

pool/app/experiment/repo/repo_statistics.ml

@@ -35,7 +35,7 @@ module SentInvitations = struct
       (Id.value experiment_id)
   ;;
 
-  let by_experiment pool ({ id; _ } as experiment) =
+  let by_experiment ?query pool ({ id; _ } as experiment) =
     let open Utils.Lwt_result.Infix in
     let%lwt counts = Database.collect pool find_unique_counts_request (Id.value id) in
     let base_dyn = Dynparam.(empty |> add Caqti_type.string (Id.value id)) in
@@ -51,17 +51,19 @@ module SentInvitations = struct
         in
         Database.find pool request pv |> Lwt.map (fun count -> send_count, count))
     in
-    let* total_match_filter =
-      let query = experiment.filter |> CCOption.map (fun { Filter.query; _ } -> query) in
+    let query =
+      let open CCOption.Infix in
+      query <+> (experiment.filter |> CCOption.map (fun { Filter.query; _ } -> query))
+    in
+    let count_filtered_contacts ~include_invited =
       Filter.(
-        count_filtered_contacts
-          ~include_invited:true
-          pool
-          (Matcher (Id.to_common id))
-          query)
+        count_filtered_contacts ~include_invited pool (Matcher (Id.to_common id)) query)
     in
+    let* total_match_filter = count_filtered_contacts ~include_invited:true in
+    let* total_uninvited_matching = count_filtered_contacts ~include_invited:false in
     Lwt.return_ok
-      Statistics.SentInvitations.{ total_sent; total_match_filter; sent_by_count }
+      Statistics.SentInvitations.
+        { total_sent; total_match_filter; total_uninvited_matching; sent_by_count }
   ;;
 end
 

pool/app/experiment/statistics.ml

@@ -7,6 +7,7 @@ module SentInvitations = struct
   type statistics =
     { total_sent : int
     ; total_match_filter : int
+    ; total_uninvited_matching : int
     ; sent_by_count : sent_by_count list
     }
   [@@deriving eq, show]

pool/app/pool_common/entity_i18n.ml

@@ -46,6 +46,7 @@ type t =
   | FilterNrOfContacts
   | FilterNrOfSentInvitations
   | FilterNrOfUnsuitableAssignments
+  | FilterNuberMatchingUninvited
   | FollowUpSessionFor
   | Help
   | ImportConfirmationNote

pool/app/pool_common/locales/i18n_de.ml

@@ -89,6 +89,7 @@ let to_string = function
   | FilterNrOfSentInvitations -> "Anzahl bereits eingeladener Kontakte:"
   | FilterNrOfUnsuitableAssignments ->
     "Anzahl angemeldeter Kontakte, die nicht den Kriterien entsprechen:"
+  | FilterNuberMatchingUninvited -> "Anzahl mögliche neue Einladungen:"
   | FollowUpSessionFor -> "Folgesession für:"
   | Help -> "Hilfe"
   | ImportConfirmationNote ->

pool/app/pool_common/locales/i18n_en.ml

@@ -87,6 +87,7 @@ let to_string = function
   | FilterNrOfSentInvitations -> "Number of contacts already invited:"
   | FilterNrOfUnsuitableAssignments ->
     "Number of assigned contacts not meeting the criteria of this filter:"
+  | FilterNuberMatchingUninvited -> "Possible new invitations:"
   | FollowUpSessionFor -> "Follow-up for:"
   | Help -> "Help"
   | ImportConfirmationNote ->

pool/app/statistics/entity.ml

@@ -137,14 +137,12 @@ type t =
 
 module ExperimentFilter = struct
   type t =
-    { contacts_meeting_criteria : int
-    ; invitation_count : int
+    { invitations : Experiment.Statistics.SentInvitations.statistics
     ; assigned_contacts_not_matching : int
     }
 
   let create pool experiment query =
     let open Utils.Lwt_result.Infix in
-    let open Filter in
     let contacts_not_matching query =
       let%lwt contacts =
         Assignment.find_assigned_contacts_by_experiment pool experiment.Experiment.id
@@ -155,19 +153,12 @@ module ExperimentFilter = struct
       in
       Lwt.return CCList.(length contacts - matching)
     in
-    let* contacts_meeting_criteria =
-      count_filtered_contacts
-        pool
-        (Matcher Experiment.(experiment |> id |> Id.to_common))
-        query
-    in
-    let%lwt invitation_count =
-      experiment |> Experiment.id |> Experiment.invitation_count pool
+    let* invitations =
+      Experiment.Statistics.SentInvitations.create ?query pool experiment
     in
     let%lwt assigned_contacts_not_matching =
       query |> CCOption.map_or ~default:(Lwt.return 0) contacts_not_matching
     in
-    Lwt_result.return
-      { contacts_meeting_criteria; invitation_count; assigned_contacts_not_matching }
+    Lwt_result.return { invitations; assigned_contacts_not_matching }
   ;;
 end

pool/app/statistics/statistics.mli

@@ -82,8 +82,7 @@ val yojson_of_t : t -> Yojson.Safe.t
 
 module ExperimentFilter : sig
   type t =
-    { contacts_meeting_criteria : int
-    ; invitation_count : int
+    { invitations : Experiment.Statistics.SentInvitations.statistics
     ; assigned_contacts_not_matching : int
     }
 

pool/web/view/component/component_statistics.ml

@@ -121,26 +121,39 @@ let create
 module ExperimentFilter = struct
   open ExperimentFilter
 
-  let create
-        language
-        { contacts_meeting_criteria; invitation_count; assigned_contacts_not_matching }
-    =
+  let create language { invitations; assigned_contacts_not_matching } =
     let open Pool_common in
+    let Experiment.Statistics.SentInvitations.
+          { total_sent; total_match_filter; total_uninvited_matching; sent_by_count }
+      =
+      invitations
+    in
+    let sent_by_count =
+      match sent_by_count with
+      | [] -> []
+      | sent_by_count ->
+        sent_by_count
+        |> CCList.map (fun (count, nr_invitations) ->
+          tr
+            ~a:[ a_class [ "font-italic" ] ]
+            [ td
+                [ span ~a:[ a_class [ "inset"; "left" ] ] [ txt (CCInt.to_string count) ]
+                ]
+            ; td [ txt (CCInt.to_string nr_invitations) ]
+            ])
+    in
     let to_string = Utils.text_to_string language in
+    let make_row i18n num =
+      tr [ th [ txt (to_string i18n) ]; td [ span [ txt (CCInt.to_string num) ] ] ]
+    in
     table
       ~a:[ a_class [ "table"; "simple"; "width-auto" ] ]
-      [ tr
-          [ th [ txt (to_string I18n.FilterNrOfContacts) ]
-          ; td [ span [ txt (CCInt.to_string contacts_meeting_criteria) ] ]
-          ]
-      ; tr
-          [ th [ txt (to_string I18n.FilterNrOfSentInvitations) ]
-          ; td [ txt (CCInt.to_string invitation_count) ]
-          ]
-      ; tr
-          [ th [ txt (to_string I18n.FilterNrOfUnsuitableAssignments) ]
-          ; td [ txt (CCInt.to_string assigned_contacts_not_matching) ]
-          ]
-      ]
+      ([ make_row I18n.FilterNrOfContacts total_match_filter
+       ; make_row I18n.FilterNrOfSentInvitations total_sent
+       ]
+       @ sent_by_count
+       @ [ make_row I18n.FilterNuberMatchingUninvited total_uninvited_matching
+         ; make_row I18n.FilterNrOfUnsuitableAssignments assigned_contacts_not_matching
+         ])
   ;;
 end

pool/web/view/page/page_admin_invitations.ml

@@ -155,6 +155,7 @@ module Partials = struct
         { Experiment.Statistics.SentInvitations.total_sent
         ; sent_by_count
         ; total_match_filter
+        ; _
         }
     =
     let open Pool_common in

resources/admin/filter.js

@@ -232,9 +232,6 @@ const updateStatistics = async (form) => {
 
     if (target) {
         const action = target.dataset.action;
-        const spinner = icon(["icon-spinner-outline", "rotate"])
-        target.innerHTML = "";
-        target.appendChild(spinner);
         try {
             const query = parseQuery();
             const body = { query: JSON.stringify(query), _csrf: csrfToken(form) }