[OCaml] High Intensity Training Online

feat Put workout actions in row menus

Remove the two card-level Log feedback and Edit logbook buttons. Every saved-workout row now ends with a native three-dot details menu holding Edit and Delete. Edit opens the saved record. Delete navigates to a confirmation dialog that names the workout and date; only its CSRF-gated confirm form posts deletion. Add delete_workout to the owner-scoped repository port. Its adapter boolean stays an implementation detail; Service.delete_record translates it into (unit, delete_record_error) result Lwt.t, so callers distinguish a completed deletion from Record_not_found explicitly. Deletion removes only saved history and does not touch an in-progress workout. Tests cover row menus, confirmation, deletion through the web route, record absence afterward, and the service's explicit success/not-found result.

Commit
10f49bc5e302c892f3677326078fb00ff3e7c627
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
ARCHITECTURE.org
index f087f48e..140493a9 100644..100644
@@ -465,6 +465,7 @@
465 465 | =/logbook/:id= | GET | A saved workout |
466 466 | =/logbook/:id/slots/:slot= | POST | Add a missing record |
467 467 | =/logbook/:id/slots/:slot/edit= | POST | Correct a saved slot |
468 Added: | =/logbook/:id/delete= | POST | Delete a saved workout after confirmation |
468 469 | =/feedback= | POST | Save a subjective feedback report |
469 470 | =/app-feedback= | GET | Write or review application feedback |
470 471 | =/app-feedback/submit= | POST | Submit application feedback |
lib/app/repository.ml
index 9d00c0b0..b9924b46 100644..100644
@@ -68,6 +68,7 @@
68 68 val finish_workout : t -> Trainee.id -> Evidence.Workout.t -> record Lwt.t
69 69 val find : t -> Trainee.id -> workout_id -> record option Lwt.t
70 70 val replace : t -> Trainee.id -> record -> bool Lwt.t
71 Added: val delete_workout : t -> Trainee.id -> workout_id -> bool Lwt.t
71 72 val log : t -> Trainee.id -> Evidence.Log.t Lwt.t
72 73 val history : t -> Trainee.id -> record list Lwt.t
73 74 val save_feedback : t -> Trainee.id -> Feedback.t -> unit Lwt.t
lib/app/repository.mli
index 253a6a48..49e2c9be 100644..100644
@@ -109,6 +109,10 @@
109 109 val replace : t -> Trainee.id -> record -> bool Lwt.t
110 110 (** Replace an existing record by identity. *)
111 111
112 Added: val delete_workout : t -> Trainee.id -> workout_id -> bool Lwt.t
113 Added: (** Delete one saved workout only when [id] owns it. [false] when it no longer
114 Added: exists. This does not affect an in-progress workout. *)
115 Added:
112 116 val log : t -> Trainee.id -> Evidence.Log.t Lwt.t
113 117 (** Canonical workouts logged through hito. Promoted import observations are
114 118 stored separately in {!imported_records}. *)
lib/app/service.ml
index 0cfd5a29..ecad3383 100644..100644
@@ -31,6 +31,7 @@
31 31 | Rejected e -> Evidence.Workout.pp_error ppf e
32 32
33 33 type edit_error = Unknown_workout | Rejected_edit of Evidence.Workout.error
34 Added: type delete_record_error = Record_not_found
34 35 type app_feedback_error = [ `Empty_message | `Unknown_feedback ]
35 36
36 37 type import_error =
@@ -294,6 +295,12 @@
294 295 with Evidence.Workout.Invalid error -> Error error)
295 296
296 297 let history t trainee = R.history t.repo trainee
298 Added:
299 Added: let delete_record t trainee id =
300 Added: R.delete_workout t.repo trainee id >|= function
301 Added: | true -> Ok ()
302 Added: | false -> Error Record_not_found
303 Added:
297 304 let workout_log t trainee = R.log t.repo trainee
298 305 end
299 306
@@ -506,6 +513,7 @@
506 513 let add_to_record = Records.add_to_record
507 514 let replace_in_record = Records.replace_in_record
508 515 let history = Records.history
516 Added: let delete_record = Records.delete_record
509 517 let workout_log = Records.workout_log
510 518 let progress = Assessment.progress
511 519 let diagnostics = Assessment.diagnostics
lib/app/service.mli
index 04fc7873..4107510c 100644..100644
@@ -170,6 +170,17 @@
170 170
171 171 val history : t -> Trainee.id -> Repository.record list Lwt.t
172 172
173 Added: type delete_record_error = Record_not_found
174 Added:
175 Added: val delete_record :
176 Added: t ->
177 Added: Trainee.id ->
178 Added: Repository.workout_id ->
179 Added: (unit, delete_record_error) result Lwt.t
180 Added: (** Delete one saved workout. [`Unknown_workout] when the record is already
181 Added: absent or belongs to another trainee. The web tier must obtain explicit
182 Added: confirmation before calling this destructive use case. *)
183 Added:
173 184 val workout_log : t -> Trainee.id -> Evidence.Log.t Lwt.t
174 185 (** The trainee's native workout log, for judging progress across history.
175 186 Distinct from imported records, which {!Progress} merges only per
lib/persistence/sqlite_repo.ml
index a9f18927..fdc66fea 100644..100644
@@ -74,6 +74,10 @@
74 74 (t3 string string string ->. unit)
75 75 "UPDATE workout SET encoded = ? WHERE trainee_id = ? AND id = ?"
76 76
77 Added: let delete_workout =
78 Added: (t2 string string ->. unit)
79 Added: "DELETE FROM workout WHERE trainee_id = ? AND id = ?"
80 Added:
77 81 let history =
78 82 (string ->* t2 string string)
79 83 "SELECT id, encoded FROM workout WHERE trainee_id = ? ORDER BY seq DESC"
@@ -367,6 +371,17 @@
367 371 ( encode record.Repository.workout,
368 372 trainee,
369 373 (record.Repository.id :> string) ))
374 Added: >|= fun () -> true
375 Added:
376 Added: let delete_workout t id (wid : Repository.workout_id) =
377 Added: let trainee = Trainee.id_to_string id in
378 Added: run t (fun (module Db : Caqti_lwt.CONNECTION) ->
379 Added: Db.find_opt Q.workout_by_id (trainee, (wid :> string)))
380 Added: >>= function
381 Added: | None -> Lwt.return false
382 Added: | Some _ ->
383 Added: run t (fun (module Db : Caqti_lwt.CONNECTION) ->
384 Added: Db.exec Q.delete_workout (trainee, (wid :> string)))
370 385 >|= fun () -> true
371 386
372 387 let history t id =
lib/presenter/pages.mli
index c8b79921..db20aa10 100644..100644
@@ -60,6 +60,7 @@
60 60 ?feedback:View_model.Feedback.report list ->
61 61 ?suggest_feedback:bool ->
62 62 ?feedback_open:bool ->
63 Added: ?delete_record:View_model.Logbook_entry.t ->
63 64 View_model.Logbook_entry.t list ->
64 65 page
65 66 (** The logbook: recorded workouts and a modal subjective feedback form that
lib/presenter/pages_logbook.ml
index 42f9a1a7..27eb2d10 100644..100644
@@ -106,32 +106,43 @@
106 106 reports);
107 107 ]
108 108
109 Removed: let logbook request ?(logging = false) ~viewer ?(feedback = [])
110 Removed: ?(suggest_feedback = false) ?(feedback_open = false) records =
111 Removed: html_page ~viewer ~request ~active:"logbook" ~logging "Logbook"
109 Added: let delete_record_dialog request (record : View_model.Logbook_entry.t) =
110 Added: tag "dialog"
111 Added: [ class_ "confirm-dialog"; Dream_html.attr "open" ]
112 112 [
113 Removed: tag "h1" [] [ txt "Logbook" ];
113 Added: tag "h2" [] [ txt "Delete this workout log?" ];
114 Added: tag "p" []
115 Added: [
116 Added: txt "Delete %s from %s. This cannot be undone." record.workout_name
117 Added: record.date;
118 Added: ];
114 119 tag "div"
120 Added: [ class_ "button-group" ]
115 121 [
116 Removed: class_ "button-group";
117 Removed: Dream_html.string_attr "role" "group";
118 Removed: Dream_html.string_attr "aria-label" "Logbook actions";
119 Removed: ]
120 Removed: [
121 122 tag "a"
123 Added: [ href Routes.logbook; class_ "button secondary" ]
124 Added: [ txt "Keep workout" ];
125 Added: tag "form"
122 126 [
123 Removed: class_ "button primary";
124 Removed: Dream_html.string_attr "href" "/logbook?feedback=start";
125 Removed: Dream_html.attr "data-hito-feedback-open";
127 Added: action Routes.delete_record record.id;
128 Added: post_form;
129 Added: class_ "delete-record-form";
126 130 ]
127 Removed: [ txt "Log feedback" ];
128 Removed: tag "a"
129 131 [
130 Removed: class_ "button secondary";
131 Removed: Dream_html.string_attr "href" "/logbook?edit=1";
132 Removed: ]
133 Removed: [ txt "Edit logbook" ];
132 Added: Dream_html.csrf_tag request;
133 Added: tag "button"
134 Added: [ type_ "submit"; class_ "danger" ]
135 Added: [ txt "Delete workout" ];
136 Added: ];
134 137 ];
138 Added: ]
139 Added:
140 Added: let logbook request ?(logging = false) ~viewer ?(feedback = [])
141 Added: ?(suggest_feedback = false) ?(feedback_open = false) ?delete_record records
142 Added: =
143 Added: html_page ~viewer ~request ~active:"logbook" ~logging "Logbook"
144 Added: [
145 Added: tag "h1" [] [ txt "Logbook" ];
135 146 (if records = [] then tag "p" [] [ txt "Nothing logged yet." ]
136 147 else
137 148 tag "table"
@@ -150,6 +161,10 @@
150 161 tag "th"
151 162 [ Dream_html.string_attr "scope" "col" ]
152 163 [ txt "Exercises progressed" ];
164 Added: tag "th"
165 Added: ([ class_ "logbook-actions-heading" ]
166 Added: @ [ Dream_html.string_attr "scope" "col" ])
167 Added: [ tag "span" [ class_ "sr-only" ] [ txt "Actions" ] ];
153 168 ];
154 169 ];
155 170 tag "tbody" []
@@ -158,18 +173,49 @@
158 173 tag "tr" []
159 174 [
160 175 tag "td" [] [ txt "%s" entry.date ];
161 Removed: tag "td" []
162 Removed: [
163 Removed: tag "a"
164 Removed: [
165 Removed: href Routes.record entry.id;
166 Removed: Dream_html.attr "data-hito-app-link";
167 Removed: ]
168 Removed: [ txt "%s" entry.workout_name ];
169 Removed: ];
176 Added: tag "td" [] [ txt "%s" entry.workout_name ];
170 177 tag "td"
171 178 [ class_ "logbook-progress" ]
172 179 [ txt "%d" entry.progressed_exercises ];
180 Added: tag "td"
181 Added: [ class_ "logbook-actions" ]
182 Added: [
183 Added: tag "details"
184 Added: [ class_ "logbook-row-menu" ]
185 Added: [
186 Added: tag "summary"
187 Added: [
188 Added: Dream_html.string_attr "aria-label"
189 Added: "Actions for %s on %s" entry.workout_name
190 Added: entry.date;
191 Added: ]
192 Added: [ txt "⋮" ];
193 Added: tag "div"
194 Added: [
195 Added: class_ "logbook-row-menu-drawer";
196 Added: Dream_html.string_attr "role" "menu";
197 Added: Dream_html.string_attr "aria-label"
198 Added: "Workout actions";
199 Added: ]
200 Added: [
201 Added: tag "a"
202 Added: [
203 Added: href Routes.record entry.id;
204 Added: Dream_html.attr "data-hito-app-link";
205 Added: Dream_html.string_attr "role" "menuitem";
206 Added: ]
207 Added: [ txt "Edit" ];
208 Added: tag "a"
209 Added: [
210 Added: Dream_html.string_attr "href"
211 Added: "/logbook?delete=%s" entry.id;
212 Added: Dream_html.string_attr "role" "menuitem";
213 Added: class_ "danger";
214 Added: ]
215 Added: [ txt "Delete" ];
216 Added: ];
217 Added: ];
218 Added: ];
173 219 ])
174 220 records);
175 221 ]);
@@ -197,5 +243,9 @@
197 243 [ txt "Record feedback" ];
198 244 feedback_modal request ~open_:feedback_open;
199 245 ]
200 Removed: @ feedback_list feedback);
246 Added: @ feedback_list feedback
247 Added: @
248 Added: match delete_record with
249 Added: | Some record -> [ delete_record_dialog request record ]
250 Added: | None -> []);
201 251 ]
lib/presenter/routes.ml
index 52605116..f4477c53 100644..100644
@@ -32,6 +32,7 @@
32 32 let%path remove_app_feedback = "/app-feedback/%s/remove"
33 33 let%path feedback = "/feedback"
34 34 let%path record = "/logbook/%s"
35 Added: let%path delete_record = "/logbook/%s/delete"
35 36 let%path record_slot = "/logbook/%s/slots/%d"
36 37 let%path record_slot_edit = "/logbook/%s/slots/%d/edit"
37 38 let%path stylesheet = "/assets/hito.css"
lib/web/assets/hito.css
index ea832cd4..a3f572de 100644..100644
@@ -1308,3 +1308,69 @@
1308 1308 .app-feedback-vote input {
1309 1309 min-height: 2.75rem;
1310 1310 }
1311 Added:
1312 Added: /* One native <details> action menu per logbook row. The dots keep the table
1313 Added: compact; the drawer carries the destructive action out of the data columns. */
1314 Added: .logbook-actions-heading,
1315 Added: .logbook-actions {
1316 Added: width: 2.75rem;
1317 Added: text-align: right;
1318 Added: }
1319 Added: .logbook-row-menu {
1320 Added: position: relative;
1321 Added: display: inline-block;
1322 Added: }
1323 Added: .logbook-row-menu > summary {
1324 Added: display: grid;
1325 Added: place-items: center;
1326 Added: width: 2rem;
1327 Added: height: 2rem;
1328 Added: border-radius: 50%;
1329 Added: color: var(--ink);
1330 Added: cursor: pointer;
1331 Added: list-style: none;
1332 Added: font-size: 1.35rem;
1333 Added: line-height: 1;
1334 Added: }
1335 Added: .logbook-row-menu > summary::-webkit-details-marker { display: none; }
1336 Added: .logbook-row-menu > summary::marker { content: ""; }
1337 Added: .logbook-row-menu > summary:hover,
1338 Added: .logbook-row-menu[open] > summary { background: var(--brass-wash); }
1339 Added: .logbook-row-menu-drawer {
1340 Added: position: absolute;
1341 Added: right: 0;
1342 Added: z-index: 5;
1343 Added: display: flex;
1344 Added: flex-direction: column;
1345 Added: min-width: 8rem;
1346 Added: padding: 0.3rem;
1347 Added: border: 1px solid var(--rule-strong);
1348 Added: border-radius: var(--radius);
1349 Added: background: var(--paper-raised);
1350 Added: box-shadow: 0 0.5rem 1.25rem rgba(0, 0, 0, 0.18);
1351 Added: }
1352 Added: .logbook-row-menu[open] > .logbook-row-menu-drawer {
1353 Added: animation: profile-menu-open 150ms ease both;
1354 Added: }
1355 Added: .logbook-row-menu-drawer a {
1356 Added: min-height: 2.5rem;
1357 Added: padding: 0.5rem 0.7rem;
1358 Added: border-radius: var(--radius);
1359 Added: color: var(--ink);
1360 Added: font: inherit;
1361 Added: font-weight: 700;
1362 Added: text-decoration: none;
1363 Added: }
1364 Added: .logbook-row-menu-drawer a:hover { background: #ece4d5; }
1365 Added: .logbook-row-menu-drawer a.danger { color: var(--oxblood-dark); }
1366 Added: .logbook-row-menu-drawer a.danger:hover {
1367 Added: color: var(--paper-raised);
1368 Added: background: var(--oxblood);
1369 Added: }
1370 Added: .confirm-dialog button.danger {
1371 Added: border-color: var(--oxblood-dark);
1372 Added: background: var(--oxblood-dark);
1373 Added: }
1374 Added: .confirm-dialog button.danger:hover { background: var(--oxblood); }
1375 Added: .confirm-dialog .delete-record-form { flex: 1 1 10rem; margin: 0; }
1376 Added: .confirm-dialog .delete-record-form button { width: 100%; }
lib/web/handlers_logbook.ml
index e04ae637..fa2f8738 100644..100644
@@ -69,6 +69,14 @@
69 69 Service.feedback t.service trainee.Trainee.id >>= fun feedback ->
70 70 let feedback = List.map feedback_view feedback in
71 71 let records = List.map (entry_view log) records in
72 Added: let delete_record =
73 Added: match Dream.query request "delete" with
74 Added: | Some id ->
75 Added: List.find_opt
76 Added: (fun entry -> String.equal entry.View_model.Logbook_entry.id id)
77 Added: records
78 Added: | None -> None
79 Added: in
72 80 let feedback_open =
73 81 match (Dream.query request "feedback", Dream.query request "prompt") with
74 82 | Some "start", _ | _, Some "feedback" -> true
@@ -82,7 +90,7 @@
82 90 (match Dream.query request "prompt" with
83 91 | Some "feedback" -> true
84 92 | _ -> false)
85 Removed: ~feedback_open records)
93 Added: ~feedback_open ?delete_record records)
86 94
87 95 (* One post saves the whole report. Nothing is stored before Submit, so there
88 96 is no partial state to keep or discard. An empty submission is a mistake
@@ -180,6 +188,25 @@
180 188 id)
181 189 detail)))
182 190
191 Added: let delete t trainee request id =
192 Added: guard_csrf request >>= function
193 Added: | Error _ ->
194 Added: redirect_with_flash request
195 Added: (Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
196 Added: Present.form_invalid
197 Added: | Ok () -> (
198 Added: Service.delete_record t.service trainee.Trainee.id
199 Added: (Repository.workout_id id)
200 Added: >>= function
201 Added: | Ok () ->
202 Added: redirect_with_flash request
203 Added: (Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
204 Added: "Workout log deleted."
205 Added: | Error Service.Record_not_found ->
206 Added: redirect_with_flash request
207 Added: (Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
208 Added: "That workout log is no longer available.")
209 Added:
183 210 let routes t =
184 211 [
185 212 Dream_html.get Routes.logbook (fun request ->
@@ -189,6 +216,8 @@
189 216 record_feedback t trainee request));
190 217 Dream_html.get Routes.record (fun request id ->
191 218 authenticated t request (fun trainee -> show t trainee request id));
219 Added: Dream_html.post Routes.delete_record (fun request id ->
220 Added: authenticated t request (fun trainee -> delete t trainee request id));
192 221 Dream_html.post Routes.record_slot (fun request id slot ->
193 222 authenticated t request (fun trainee -> log t trainee request id slot));
194 223 Dream_html.post Routes.record_slot_edit (fun request id slot ->
test/memory_repo.ml
index 90615a71..a80c7d70 100644..100644
@@ -186,6 +186,14 @@
186 186 Lwt.return true
187 187 end
188 188
189 Added: let delete_workout t id wid =
190 Added: let s = state t id in
191 Added: let removed = List.exists (fun r -> equal_id r.Repository.id wid) s.stored in
192 Added: if removed then
193 Added: s.stored <-
194 Added: List.filter (fun r -> not (equal_id r.Repository.id wid)) s.stored;
195 Added: Lwt.return removed
196 Added:
189 197 let log t id =
190 198 let s = state t id in
191 199 Lwt.return
test/test_service.ml
index 90be52f3..31bf3448 100644..100644
@@ -567,6 +567,21 @@
567 567 with
568 568 | Error (S.Rejected_edit (Workout.No_such_slot 99)) -> ()
569 569 | _ -> Alcotest.fail "expected Rejected_edit No_such_slot" );
570 Added: ( "delete_record removes a saved workout and reports an absent one",
571 Added: `Quick,
572 Added: fun () ->
573 Added: let s, t = fixture () in
574 Added: ignore (ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())));
575 Added: let record = Option.get (run (S.finish s t ~ended_at:(at 120))) in
576 Added: (match run (S.delete_record s t record.Repository.id) with
577 Added: | Ok () -> ()
578 Added: | Error _ -> Alcotest.fail "expected saved record deletion");
579 Added: Alcotest.(check int)
580 Added: "history is empty" 0
581 Added: (List.length (run (S.history s t)));
582 Added: match run (S.delete_record s t record.Repository.id) with
583 Added: | Error S.Record_not_found -> ()
584 Added: | Ok () -> Alcotest.fail "expected Record_not_found" );
570 585 ]
571 586
572 587 let assessment_tests =
test/web/logbook.ml
index c3f794e3..a0011024 100644..100644
@@ -5,20 +5,20 @@
5 5 [
6 6 ( "web.logbook",
7 7 [
8 Removed: ( "the logbook shows the action button group and an empty table state",
8 Added: ( "the logbook shows an empty table state without top action buttons",
9 9 `Quick,
10 10 fun () ->
11 11 let c = client () in
12 12 let _ = sign_in_new c in
13 13 let page = body (get c "/logbook") in
14 14 Alcotest.(check bool)
15 Removed: "Log feedback action" true
15 Added: "no Log feedback top action" false
16 16 (Option.is_some (index_from ~needle:"Log feedback" page 0));
17 17 Alcotest.(check bool)
18 Removed: "Edit logbook action" true
18 Added: "no Edit logbook top action" false
19 19 (Option.is_some (index_from ~needle:"Edit logbook" page 0));
20 20 Alcotest.(check bool)
21 Removed: "the button group is present" true
21 Added: "the top action group is absent" false
22 22 (Option.is_some
23 23 (index_from ~needle:"class=\"button-group\"" page 0));
24 24 Alcotest.(check bool)
@@ -44,6 +44,44 @@
44 44 "the progressed-exercises column header" true
45 45 (Option.is_some
46 46 (index_from ~needle:"Exercises progressed" page 0)) );
47 Added: ( "each saved workout row has an edit and confirmation-gated delete menu",
48 Added: `Quick,
49 Added: fun () ->
50 Added: let c, repo = client_with_repo () in
51 Added: let _ = register c ~username:"lifter" ~password:"heavyduty1" in
52 Added: let trainee = the_trainee repo ~username:"lifter" in
53 Added: let _ = start_day_one c in
54 Added: record_all_day_one_slots c;
55 Added: let token = Option.get (csrf_token (body (get c "/workout"))) in
56 Added: let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
57 Added: let page = body (get c "/logbook") in
58 Added: List.iter
59 Added: (fun needle ->
60 Added: Alcotest.(check bool)
61 Added: ("row menu contains " ^ needle)
62 Added: true
63 Added: (Option.is_some (index_from ~needle page 0)))
64 Added: [ "⋮"; "Edit"; "Delete"; "/logbook?delete=w1" ];
65 Added: let confirm = body (get c "/logbook?delete=w1") in
66 Added: Alcotest.(check bool)
67 Added: "delete asks for confirmation" true
68 Added: (Option.is_some
69 Added: (index_from ~needle:"Delete this workout log?" confirm 0));
70 Added: let confirm_token = Option.get (csrf_token confirm) in
71 Added: let deleted =
72 Added: post c "/logbook/w1/delete" [ ("dream.csrf", confirm_token) ]
73 Added: in
74 Added: Alcotest.(check int) "delete redirects" 303 (status deleted);
75 Added: Alcotest.(check int)
76 Added: "record removed from history" 0
77 Added: (List.length
78 Added: (Lwt_main.run (Memory_repo.history repo trainee.Trainee.id)));
79 Added: Alcotest.(check bool)
80 Added: "record cannot be found" true
81 Added: (Option.is_none
82 Added: (Lwt_main.run
83 Added: (Memory_repo.find repo trainee.Trainee.id
84 Added: (Repository.workout_id "w1")))) );
47 85 ( "a saved workout's slot can be corrected from the logbook view",
48 86 `Quick,
49 87 fun () ->