Feature/2251 signoff on contact page (#480)

* fix modal table head

* allow assignments to be deleted on contact page

* add cancel btn

* fix button title

pool/web/handler/admin_experiments_assignments.ml

@@ -71,8 +71,8 @@ let cancel req =
 
 let mark_as_deleted req =
   let open Utils.Lwt_result.Infix in
-  let experiment_id, session_id, assignment_id = ids_from_request req in
-  let redirect_path = Url.session_path ~id:session_id experiment_id in
+  let experiment_id, _, assignment_id = ids_from_request req in
+  let redirect_path = HttpUtils.find_referer req |> CCOption.value ~default:"/" in
   let result { Pool_context.database_label; user; _ } =
     Utils.Lwt_result.map_error (fun err -> err, redirect_path)
     @@

pool/web/utils/http_utils.ml

@@ -96,6 +96,11 @@ let find_query_param req field decode =
   >>= decode
 ;;
 
+let find_referer req =
+  let open CCOption.Infix in
+  Httpaf.Headers.get req.Opium.Request.headers "referer" >|= Uri.of_string >|= Uri.path
+;;
+
 let redirect_to_with_actions ?(skip_externalize = false) path actions =
   let externalize_path path =
     if skip_externalize then path else Sihl.Web.externalize_path path
@@ -107,6 +112,11 @@ let redirect_to_with_actions ?(skip_externalize = false) path actions =
   |> Lwt.return
 ;;
 
+let redirect_back ~fallback req actions =
+  let redirect = find_referer req |> CCOption.value ~default:fallback in
+  redirect_to_with_actions redirect actions
+;;
+
 let redirect_to path = redirect_to_with_actions path []
 
 let set_no_cache_headers ?(enable_cache = false) res =

pool/web/view/page/page_admin_contact.ml

@@ -396,33 +396,80 @@ let experiment_history Pool_context.{ language; _ } contact experiments query =
 ;;
 
 let experiment_history_modal
-      { Pool_context.language; _ }
+      { Pool_context.csrf; language; _ }
       (experiment : Experiment.t)
       assignments
   =
   let open Pool_common in
   let title (_ : Language.t) = Experiment.(Title.value experiment.title) in
   let html =
     let thead =
-      Pool_message.Field.[ Start; NoShow; Participant ]
+      Pool_message.Field.[ Start; NoShow; Participated ]
       |> CCList.map CCFun.(Utils.field_to_string_capitalized language %> txt)
     in
+    let thead = thead @ [ txt "" ] in
     let to_icon value =
       CCOption.map_or ~default:(txt "") CCFun.(value %> Component.Icon.bool_to_icon)
     in
     let rows =
       let open Assignment in
+      let open Session in
       assignments
-      |> CCList.map (fun (session, { no_show; participated; _ }) ->
-        let start = Session.start_end_with_duration_human session |> txt in
+      |> CCList.map (fun (session, { id; no_show; participated; _ }) ->
+        let start = start_end_with_duration_human session |> txt in
         let start =
-          if CCOption.is_some session.Session.follow_up_to
+          if CCOption.is_some session.follow_up_to
           then div ~a:[ a_class [ "inset"; "left" ] ] [ start ]
           else start
         in
-        [ start; to_icon NoShow.value no_show; to_icon Participated.value participated ])
+        let forms =
+          match session.closed_at with
+          | Some _ -> txt ""
+          | None ->
+            let action suffix =
+              Http_utils.Url.Admin.assignment_path
+                experiment.Experiment.id
+                session.id
+                ~id
+                ~suffix
+                ()
+              |> Sihl.Web.externalize_path
+            in
+            Pool_message.
+              [ ( "cancel"
+                , Pool_common.I18n.CancelAssignment
+                , Control.(Cancel (Some Field.Assignment))
+                , Icon.Close )
+              ; ( "mark-as-deleted"
+                , Pool_common.I18n.MarkAssignmentWithFollowUpsAsDeleted
+                , Control.MarkAsDeleted
+                , Icon.TrashOutline )
+              ]
+            |> CCList.map (fun (suffix, confirmable, control, icon) ->
+              form
+                ~a:
+                  [ a_method `Post
+                  ; a_action (action suffix)
+                  ; a_user_data
+                      "confirmable"
+                      (Utils.confirmable_to_string language confirmable)
+                  ]
+                Component.Input.
+                  [ csrf_element csrf ()
+                  ; submit_icon
+                      ~attributes:[ a_title (Utils.control_to_string language control) ]
+                      ~classnames:[ "error" ]
+                      icon
+                  ])
+            |> div ~a:[ a_class [ "flexrow"; "flex-gap-sm"; "justify-end" ] ]
+        in
+        [ start
+        ; to_icon NoShow.value no_show
+        ; to_icon Participated.value participated
+        ; forms
+        ])
     in
-    Component.Table.horizontal_table ~thead `Striped rows
+    Component.Table.horizontal_table ~align_last_end:true ~thead `Striped rows
   in
   Modal.create ~active:true language title experiment_history_modal_id html
 ;;

resources/htmx.js

@@ -1,6 +1,6 @@
 import { csrfToken } from "./admin/utils.js";
 import { initSearch } from "./search.js";
-import { initNotification, initModal } from '../node_modules/@econ/frontend-framework/dist/main'
+import { initNotification, initModal, initConfirmable } from '../node_modules/@econ/frontend-framework/dist/main'
 import { initRichTextEditor } from "./admin/richTextEditor.js";
 
 const configRequest = (e, form) => {
@@ -15,6 +15,7 @@ export const initHTMX = () => {
         initSearch(e.detail.elt)
         initRichTextEditor(e.detail.elt)
         initModal(e.detail.elt)
+        initConfirmable(e.detail.elt)
         initNotification()
 
         const modalClose = [...e.detail.elt.querySelectorAll(".modal-close")];