Feature/1887 session print view

package.json

@@ -22,7 +22,7 @@
   },
   "dependencies": {
     "@ckeditor/ckeditor5-build-classic": "^36.0.0",
-    "@econ/frontend-framework": "^3.1.2",
+    "@econ/frontend-framework": "^3.2.1",
     "@fullcalendar/core": "^6.1.8",
     "@fullcalendar/daygrid": "^6.1.8",
     "@fullcalendar/list": "^6.1.8",

pool/app/pool_common/entity_message.ml

@@ -225,6 +225,7 @@ type control =
   | PromoteContact
   | PublicPage
   | Publish of Field.t option
+  | Print of Field.t option
   | ReactivateAccount
   | Register
   | Remove of Field.t option

pool/app/pool_common/locales/locales_de.ml

@@ -610,6 +610,7 @@ let control_to_string = function
   | PleaseSelect -> "bitte wählen"
   | PreviousPage -> "zurück"
   | PromoteContact -> "Kontakt befördern"
+  | Print field -> format_submit "drucken" field
   | PublicPage -> "Öffne öffentliche Seite"
   | Publish field -> format_submit "veröffentlichen" field
   | ReactivateAccount -> "Account reaktivieren"

pool/app/pool_common/locales/locales_en.ml

@@ -571,6 +571,7 @@ let control_to_string = function
   | PleaseSelect -> format_submit "please select" None
   | PreviousPage -> "previous"
   | PromoteContact -> format_submit "promote contact" None
+  | Print field -> format_submit "print" field
   | PublicPage -> "show public page"
   | Publish field -> format_submit "publish" field
   | ReactivateAccount -> format_submit "reactivate account" None

pool/routes/routes.ml

@@ -402,6 +402,7 @@ module Admin = struct
           ; post "/reschedule" ~middlewares:[ Access.reschedule ] reschedule
           ; get "/close" ~middlewares:[ Access.close ] close
           ; post "/close" ~middlewares:[ Access.close ] close_post
+          ; get "/print" ~middlewares:[ Access.read ] print
           ; post
               "/resend-reminders"
               ~middlewares:[ Access.update ]

pool/web/handler/admin_session.ml

@@ -151,7 +151,7 @@ let create req =
   result |> HttpUtils.extract_happy_path_with_actions ~src req
 ;;
 
-let detail req page =
+let detail page req =
   let open Utils.Lwt_result.Infix in
   let experiment_id = experiment_id req in
   let session_id = session_id req in
@@ -179,6 +179,7 @@ let detail req page =
       Tags.ParticipationTags.(
         find_all database_label (Session (Session.Id.to_common session_id)))
     in
+    let create_layout = create_layout req context in
     (match page with
      | `Detail ->
        let* assignments =
@@ -196,7 +197,7 @@ let detail req page =
          session
          current_tags
          assignments
-       |> Lwt_result.ok
+       >|> create_layout
      | `Edit ->
        let%lwt locations = Pool_location.find_all database_label in
        let%lwt session_reminder_templates =
@@ -235,7 +236,7 @@ let detail req page =
          sys_languages
          (current_tags, available_tags, experiment_participation_tags)
          flash_fetcher
-       |> Lwt_result.ok
+       >|> create_layout
      | `Close ->
        let* assignments =
          Assignment.find_uncanceled_by_session database_label session.Session.id
@@ -257,15 +258,15 @@ let detail req page =
          assignments
          participation_tags
          counters
-       |> Lwt_result.ok
+       >|> create_layout
      | `Reschedule ->
        let* experiment = Experiment.find database_label experiment_id in
        Page.Admin.Session.reschedule_session
          context
          experiment
          session
          flash_fetcher
-       |> Lwt_result.ok
+       >|> create_layout
      | `Cancel ->
        let* follow_ups = Session.find_follow_ups database_label session_id in
        Page.Admin.Session.cancel
@@ -274,18 +275,30 @@ let detail req page =
          session
          follow_ups
          flash_fetcher
-       |> Lwt_result.ok)
-    >>= create_layout req context
+       >|> create_layout
+     | `Print ->
+       let* assignments =
+         Assignment.find_by_session database_label session.Session.id
+       in
+       Page.Admin.Session.print
+         ~view_contact_name
+         ~view_contact_info
+         context
+         experiment
+         session
+         assignments
+       |> Lwt_result.return)
     >|+ Sihl.Web.Response.of_html
   in
   result |> HttpUtils.extract_happy_path ~src req
 ;;
 
-let show req = detail req `Detail
-let edit req = detail req `Edit
-let reschedule_form req = detail req `Reschedule
-let cancel_form req = detail req `Cancel
-let close req = detail req `Close
+let show = detail `Detail
+let edit = detail `Edit
+let reschedule_form = detail `Reschedule
+let cancel_form = detail `Cancel
+let close = detail `Close
+let print = detail `Print
 
 let update_handler action req =
   let experiment_id = experiment_id req in

pool/web/view/component/component_button_group.ml

@@ -1,11 +1,20 @@
 open Tyxml.Html
 
-let dropdown ?(classnames = []) buttons =
+let dropdown ?(classnames = []) ?(orientation = `Right) buttons =
+  let orientation_cls = function
+    | `Left -> "left"
+    | `Right -> "right"
+  in
   div
     ~a:[ a_class ("button-list" :: classnames) ]
-    [ div [ Component_icon.(to_html EllipsisVertical) ]
-    ; ul
-        ~a:[ a_class [ "dropdown" ] ]
-        (buttons |> CCList.map CCFun.(CCList.return %> li))
+    [ div
+        ~a:[ a_class [ "has-dropdown"; orientation_cls orientation ] ]
+        [ button
+            ~a:[ a_class [ "btn"; "small"; "is-text" ] ]
+            [ Component_icon.(to_html EllipsisVertical) ]
+        ; ul
+            ~a:[ a_class [ "dropdown" ] ]
+            (buttons |> CCList.map CCFun.(CCList.return %> li))
+        ]
     ]
 ;;

pool/web/view/component/component_icon.ml

@@ -22,6 +22,8 @@ type t =
   | CloseCircle [@name "close-circle"] [@printer prt "close-circle"]
   | Create [@name "create"] [@printer prt "create"]
   | CreateOutline [@name "create-outline"] [@printer prt "create-outline"]
+  | Download [@name "download"] [@printer prt "download"]
+  | DownloadOutline [@name "download-outline"] [@printer prt "download-outline"]
   | Earth [@name "earth"] [@printer prt "earth"]
   | EarthOutline [@name "earth-outline"] [@printer prt "earth-outline"]
   | EllipsisVertical [@name "ellipsis-vertical"]
@@ -55,13 +57,17 @@ type t =
   | PrevCircleOutline [@name "prev-circle-outline"]
   [@printer prt "prev-circle-outline"]
   | PrevOutline [@name "prev-outline"] [@printer prt "prev-outline"]
+  | Print [@name "print"] [@printer prt "print"]
+  | PrintOutline [@name "print-outline"] [@printer prt "print-outline"]
   | RefreshOutline [@name "refresh-outline"] [@printer prt "refresh-outline"]
   | ReorderThree [@name "reorder-three"] [@printer prt "reorder-three"]
   | ReorderTwo [@name "reorder-two"] [@printer prt "reorder-two"]
   | Save [@name "save"] [@printer prt "save"]
   | SaveOutline [@name "save-outline"] [@printer prt "save-outline"]
   | School [@name "school"] [@printer prt "school"]
   | SchoolOutline [@name "school-outline"] [@printer prt "school-outline"]
+  | Settings [@name "settings"] [@printer prt "settings"]
+  | SettingsOutline [@name "settings-outline"] [@printer prt "settings-outline"]
   | SwapHorizonal [@name "swap-horizonal"] [@printer prt "swap-horizonal"]
   | Trash [@name "trash"] [@printer prt "trash"]
   | TrashOutline [@name "trash-outline"] [@printer prt "trash-outline"]

pool/web/view/layout/layout.ml

@@ -5,6 +5,7 @@ module Language = Pool_common.Language
 module Message = Message
 module Navigation = Navigation
 module Experiment = Navigation_experiment
+module Print = Layout_print
 
 module Tenant = struct
   let create

pool/web/view/layout/layout_print.ml

@@ -0,0 +1,6 @@
+open Tyxml.Html
+
+let create ~document_title content =
+  let stylesheet = `GlobalStylesheet |> Layout_utils.css_link_tag in
+  html (head (title (txt document_title)) [ stylesheet ]) (body content)
+;;

pool/web/view/page/page_admin_assignments.ml

@@ -284,6 +284,7 @@ module Partials = struct
     ?(view_contact_name = false)
     ?(view_contact_info = false)
     ?(allow_session_swap = false)
+    ?(is_print = false)
     redirect
     (Pool_context.{ language; csrf; _ } as context)
     experiment
@@ -457,7 +458,10 @@ module Partials = struct
               external_data_field
         in
         let checkboxes = [ txt "P"; txt "NS" ] in
-        let right = [ Field.CanceledAt |> field_to_text; default ] in
+        let right =
+          let base = [ Field.CanceledAt |> field_to_text ] in
+          if is_print then base else base @ [ default ]
+        in
         left @ checkboxes @ right
       in
       let rows, modals =
@@ -503,7 +507,8 @@ module Partials = struct
                 :: modals
               | false -> modals
             in
-            (base @ buttons) :: rows, modals)
+            let columns = if is_print then base else base @ buttons in
+            columns :: rows, modals)
           ([], [])
           assignments
       in

pool/web/view/page/page_admin_session.ml

@@ -897,9 +897,34 @@ let detail
           assignments)
     in
     div
-      [ h2
-          ~a:[ a_class [ "heading-2" ] ]
-          [ txt (Utils.nav_link_to_string language I18n.Assignments) ]
+      ~a:[ a_class [ "stack" ] ]
+      [ div
+          ~a:
+            [ a_class
+                [ "flexrow"
+                ; "flex-gap"
+                ; "justify-between"
+                ; "flexcolumn-mobile"
+                ]
+            ]
+          [ div
+              [ h2
+                  ~a:[ a_class [ "heading-2" ] ]
+                  [ txt (Utils.nav_link_to_string language I18n.Assignments) ]
+              ]
+          ; button
+              ~a:
+                [ a_class [ "btn"; "primary"; "has-icon"; "small" ]
+                ; a_user_data "print" "assignments"
+                ]
+              [ Icon.(to_html PrintOutline)
+              ; txt
+                  Pool_common.(
+                    Utils.control_to_string
+                      language
+                      Message.(Print (Some Field.Assignments)))
+              ]
+          ]
       ; assignment_list
       ]
   in
@@ -925,6 +950,34 @@ let detail
          experiment)
 ;;
 
+let print
+  ?view_contact_name
+  ?view_contact_info
+  (Pool_context.{ language; _ } as context)
+  experiment
+  (session : Session.t)
+  assignments
+  =
+  let assignment_list =
+    Page_admin_assignments.(
+      Partials.overview_list
+        ?view_contact_name
+        ?view_contact_info
+        ~is_print:true
+        Session
+        context
+        experiment
+        session
+        assignments)
+  in
+  let title =
+    Pool_common.(Utils.text_to_string language (session_title session))
+  in
+  [ div ~a:[ a_class [ "safety-margin" ] ] [ h1 [ txt title ]; assignment_list ]
+  ]
+  |> Layout.Print.create ~document_title:title
+;;
+
 let edit
   ({ Pool_context.language; csrf; _ } as context)
   experiment

resources/admin.js

@@ -3,12 +3,14 @@ import { initFilterForm } from "./admin/filter.js"
 import { initRichTextEditor } from "./admin/richTextEditor.js"
 import { initCopyClipboard } from "./admin/copyClipboard.js";
 import { initCalendar } from './admin/calendar'
+import { initPrint } from "./admin/print"
 
 initRoleSearchForm();
 initFilterForm();
 initRichTextEditor();
 initCopyClipboard();
 initCalendar();
+initPrint();
 
 window['pool-tool'] = {
     initRichTextEditor

resources/admin/print.js

@@ -0,0 +1,29 @@
+const frameClass = "print-frame";
+
+export const initPrint = () => {
+    document.querySelectorAll("[data-print]").forEach((element) => {
+        element.addEventListener("click", (ev) => {
+            ev.preventDefault();
+
+            const body = document.querySelector("body");
+            const currentUrl = window.location.href;
+            const printUrl = `${currentUrl}/print`
+            const printFrame = document.createElement("iframe");
+
+            printFrame.src = printUrl;
+            printFrame.style.visibility = "hidden";
+            printFrame.style.height = "0";
+            printFrame.style.overflow = "hidden";
+            printFrame.classList.add(frameClass);
+
+            body.appendChild(printFrame);
+            printFrame.contentWindow.print();
+        })
+    })
+
+    window.addEventListener("afterprint", () => {
+        document.querySelectorAll(`.${frameClass}`).forEach(frame => {
+            frame.remove();
+        })
+    });
+}