hide external data id if not required

uzh · Aug 7, 2023 · 1b184e3 · 1b184e3
1 parent 1ea37c3
commit 1b184e3
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 30 deletions.
diff --git a/pool/test/test_utils.ml b/pool/test/test_utils.ml
@@ -222,7 +222,7 @@ module Model = struct
           false |> DirectRegistrationDisabled.create
       ; registration_disabled = false |> RegistrationDisabled.create
       ; allow_uninvited_signup = false |> AllowUninvitedSignup.create
-      ; external_data_required = false |> ExternalDataRequired.create
+      ; external_data_required = true |> ExternalDataRequired.create
       ; experiment_type = Some Pool_common.ExperimentType.Lab
       ; created_at = Ptime_clock.now ()
       ; updated_at = Ptime_clock.now ()

diff --git a/pool/web/view/page/page_admin_assignments.ml b/pool/web/view/page/page_admin_assignments.ml
@@ -1,6 +1,7 @@
 open CCFun.Infix
 open Tyxml.Html
 open Component.Input
+module Field = Pool_common.Message.Field
 
 let assignments_path experiment_id =
   Format.asprintf
@@ -94,6 +95,7 @@ module Partials = struct
     ?(view_contact_name = false)
     ?(view_contact_email = false)
     ?(view_contact_cellphone = false)
+    ?(external_data_required = false)
     redirect
     Pool_context.{ language; csrf; _ }
     experiment_id
@@ -112,7 +114,6 @@ module Partials = struct
     in
     let button_form suffix confirmable control icon assignment =
       let hidden_redirect_input =
-        let open Pool_common.Message in
         input_element
           ~value:(show_assignment_redirect redirect)
           language
@@ -159,7 +160,6 @@ module Partials = struct
     | false ->
       let add_field_if check values = if check then values else [] in
       let contact_information =
-        let open Pool_common.Message in
         add_field_if
           view_contact_name
           [ Field.Lastname, contact_lastname
@@ -173,10 +173,15 @@ module Partials = struct
         | [] -> [ Field.Id, assignment_id ]
         | fields -> fields
       in
+      let external_data_field =
+        add_field_if
+          external_data_required
+          [ Field.ExternalDataId, assignment_external_data_id ]
+      in
       let thead =
         ((CCList.map fst contact_information
-          @ Pool_common.Message.Field.
-              [ Participated; NoShow; ExternalDataId; CanceledAt ])
+          @ CCList.map fst external_data_field
+          @ Field.[ Participated; NoShow; CanceledAt ])
          |> Component.Table.fields_to_txt language)
         @ [ default ]
       in
@@ -186,11 +191,8 @@ module Partials = struct
           (fun (assignment : Assignment.t) ->
             let base =
               CCList.map snd contact_information
-              @ [ assignment_participated
-                ; assignment_no_show
-                ; assignment_external_data_id
-                ; canceled_at
-                ]
+              @ CCList.map snd external_data_field
+              @ [ assignment_participated; assignment_no_show; canceled_at ]
               |> CCList.map (fun fcn -> fcn assignment)
             in
             let buttons =
@@ -214,7 +216,7 @@ module Partials = struct
     ?view_contact_cellphone
     redirect
     (Pool_context.{ language; _ } as context)
-    experiment
+    { Experiment.id; external_data_required; _ }
     assignments
     =
     CCList.map
@@ -239,9 +241,11 @@ module Partials = struct
               ?view_contact_name
               ?view_contact_email
               ?view_contact_cellphone
+              ~external_data_required:
+                (Experiment.ExternalDataRequired.value external_data_required)
               redirect
               context
-              experiment.Experiment.id
+              id
               session
               assignments
           ])
@@ -254,7 +258,7 @@ let list
   ?view_contact_name
   ?view_contact_email
   ?view_contact_cellphone
-  experiment
+  ({ Experiment.id; _ } as experiment)
   ({ Pool_context.language; _ } as context)
   assignments
   =
@@ -263,7 +267,7 @@ let list
           [ a
               ~a:
                 [ a_href
-                    (assignments_path experiment.Experiment.id
+                    (assignments_path id
                      |> Format.asprintf "%s/deleted"
                      |> Sihl.Web.externalize_path)
                 ]

diff --git a/pool/web/view/page/page_admin_session.ml b/pool/web/view/page/page_admin_session.ml
@@ -591,13 +591,15 @@ let detail
   ?view_contact_email
   ?view_contact_cellphone
   (Pool_context.{ language; _ } as context)
-  experiment
+  ({ Experiment.id; external_data_required; _ } as experiment)
   (session : Session.t)
   participation_tags
   assignments
   =
   let open Pool_common in
   let open Session in
+  let experiment_id = Experiment.Id.value id in
+  let session_id = Session.Id.value session.id in
   let session_link ?style (show, url, control) =
     let style, icon =
       style |> CCOption.map_or ~default:(`Primary, None) CCFun.id
@@ -612,8 +614,8 @@ let detail
         ?icon
         (Format.asprintf
            "/admin/experiments/%s/sessions/%s/%s"
-           (Experiment.Id.value experiment.Experiment.id)
-           (Id.value session.id)
+           experiment_id
+           session_id
            url)
       |> CCOption.pure
   in
@@ -629,7 +631,7 @@ let detail
                   [ a_href
                       (Format.asprintf
                          "/admin/experiments/%s/sessions/%s"
-                         (Experiment.Id.value experiment.Experiment.id)
+                         experiment_id
                          (Id.value follow_up_to)
                        |> Sihl.Web.externalize_path)
                   ]
@@ -683,9 +685,7 @@ let detail
     let links =
       let duplicate =
         let base =
-          Format.asprintf
-            "/admin/experiments/%s/sessions"
-            (Experiment.Id.value experiment.Experiment.id)
+          Format.asprintf "/admin/experiments/%s/sessions" experiment_id
         in
         let link =
           match session.follow_up_to with
@@ -694,12 +694,8 @@ let detail
               "%s/%s/follow-up?duplicate_id=%s"
               base
               (Id.value parent_session)
-              (Id.value session.id)
-          | None ->
-            Format.asprintf
-              "%s/create/?duplicate_id=%s"
-              base
-              (Id.value session.id)
+              session_id
+          | None -> Format.asprintf "%s/create/?duplicate_id=%s" base session_id
         in
         link_as_button
           ~control:(language, Message.Duplicate (Some Field.Session))
@@ -757,9 +753,11 @@ let detail
           ?view_contact_name
           ?view_contact_email
           ?view_contact_cellphone
+          ~external_data_required:
+            (Experiment.ExternalDataRequired.value external_data_required)
           Session
           context
-          experiment.Experiment.id
+          id
           session
           assignments)
     in
@@ -777,8 +775,8 @@ let detail
       ~control:(language, Message.(Edit (Some Field.Session)))
       (Format.asprintf
          "/admin/experiments/%s/sessions/%s/edit"
-         (Experiment.Id.value experiment.Experiment.id)
-         (Id.value session.id))
+         experiment_id
+         session_id)
   in
   div
     ~a:[ a_class [ "stack-lg" ] ]