diff --git a/pool/app/experiment/experiment.mli b/pool/app/experiment/experiment.mli index 3ce4b0a9e..b6ffae9a3 100644 --- a/pool/app/experiment/experiment.mli +++ b/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 diff --git a/pool/app/experiment/repo/repo_statistics.ml b/pool/app/experiment/repo/repo_statistics.ml index 1293e5079..13a934a36 100644 --- a/pool/app/experiment/repo/repo_statistics.ml +++ b/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 diff --git a/pool/app/experiment/statistics.ml b/pool/app/experiment/statistics.ml index 0793f45fd..e595d789c 100644 --- a/pool/app/experiment/statistics.ml +++ b/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] diff --git a/pool/app/pool_common/entity_i18n.ml b/pool/app/pool_common/entity_i18n.ml index 0bac0fa04..b74435896 100644 --- a/pool/app/pool_common/entity_i18n.ml +++ b/pool/app/pool_common/entity_i18n.ml @@ -46,6 +46,7 @@ type t = | FilterNrOfContacts | FilterNrOfSentInvitations | FilterNrOfUnsuitableAssignments + | FilterNuberMatchingUninvited | FollowUpSessionFor | Help | ImportConfirmationNote diff --git a/pool/app/pool_common/locales/i18n_de.ml b/pool/app/pool_common/locales/i18n_de.ml index 016eb12cd..54a1172d8 100644 --- a/pool/app/pool_common/locales/i18n_de.ml +++ b/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 -> diff --git a/pool/app/pool_common/locales/i18n_en.ml b/pool/app/pool_common/locales/i18n_en.ml index ff1fe486f..6d8af7f6f 100644 --- a/pool/app/pool_common/locales/i18n_en.ml +++ b/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 -> diff --git a/pool/app/statistics/entity.ml b/pool/app/statistics/entity.ml index dfc94ca02..982a82314 100644 --- a/pool/app/statistics/entity.ml +++ b/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 diff --git a/pool/app/statistics/statistics.mli b/pool/app/statistics/statistics.mli index 364ef265c..392500a00 100644 --- a/pool/app/statistics/statistics.mli +++ b/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 } diff --git a/pool/web/view/component/component_statistics.ml b/pool/web/view/component/component_statistics.ml index 8dd9e4d5e..5a69f891a 100644 --- a/pool/web/view/component/component_statistics.ml +++ b/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 diff --git a/pool/web/view/page/page_admin_invitations.ml b/pool/web/view/page/page_admin_invitations.ml index 1d82d1c1f..2242d6901 100644 --- a/pool/web/view/page/page_admin_invitations.ml +++ b/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 diff --git a/resources/admin/filter.js b/resources/admin/filter.js index 3ba6860a4..27509a51c 100644 --- a/resources/admin/filter.js +++ b/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) }