feat Allow workout logging cancellation

Discard only the in-progress workout so abandoned logging never enters history.

Commit
425507d88e866de3864180ebdad1d767ed3401b4
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
lib/app/service.ml
index 2e69aa9d..0190fa44 100644..100644
@@ -160,6 +160,14 @@
160 160 | Some workout ->
161 161 let finished = Evidence.Workout.finish workout ~ended_at in
162 162 R.finish_workout t.repo trainee finished >|= fun record -> Some record
163 Added:
164 Added: (* Discard the workout in progress. This clears the slot only; it never
165 Added: writes to history, so a cancelled workout leaves no record. The doctrine
166 Added: keeps plan and record distinct — an abandoned session is not evidence. *)
167 Added: let cancel t trainee =
168 Added: R.in_progress t.repo trainee >>= function
169 Added: | None -> Lwt.return false
170 Added: | Some _ -> R.set_in_progress t.repo trainee None >|= fun () -> true
163 171 end
164 172
165 173 (* --- saved records --- *)
@@ -227,6 +235,7 @@
227 235 let log = Workouts.log
228 236 let replace_current = Workouts.replace_current
229 237 let finish = Workouts.finish
238 Added: let cancel = Workouts.cancel
230 239 let find_record = Records.find_record
231 240 let add_to_record = Records.add_to_record
232 241 let replace_in_record = Records.replace_in_record
lib/app/service.mli
index a0c1c468..1f3d4eb9 100644..100644
@@ -115,6 +115,11 @@
115 115 (** Complete and persist the workout in progress, clearing the slot. [None] if
116 116 nothing was in progress. *)
117 117
118 Added: val cancel : t -> Trainee.id -> bool Lwt.t
119 Added: (** Discard the workout in progress, clearing the slot without saving it to
120 Added: history. Saved records are untouched. [true] if a workout was discarded,
121 Added: [false] if nothing was in progress. *)
122 Added:
118 123 type edit_error = Unknown_workout | Rejected_edit of Evidence.Workout.error
119 124
120 125 val find_record :
test/test_service.ml
index 1ab627f7..5efed883 100644..100644
@@ -329,6 +329,42 @@
329 329 let _ = run (S.finish s t ~ended_at:(at 3600)) in
330 330 Alcotest.(check int) "one workout" 1 (List.length (run (S.history s t)))
331 331 );
332 Added: ( "cancelling after recording a set discards it and saves no history",
333 Added: `Quick,
334 Added: fun () ->
335 Added: let s, t = fixture () in
336 Added: let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
337 Added: let _ = ok (run (S.log s t (single "laterals" 12. 8))) in
338 Added: Alcotest.(check bool)
339 Added: "a workout was discarded" true
340 Added: (run (S.cancel s t));
341 Added: Alcotest.(check bool)
342 Added: "no workout in progress" true
343 Added: (Option.is_none (run (S.in_progress s t)));
344 Added: Alcotest.(check int)
345 Added: "no history record" 0
346 Added: (List.length (run (S.history s t))) );
347 Added: ( "cancelling preserves saved history",
348 Added: `Quick,
349 Added: fun () ->
350 Added: let s, t = fixture () in
351 Added: (* Finish one workout so history is non-empty. *)
352 Added: let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in
353 Added: let _ = run (S.finish s t ~ended_at:(day 1)) in
354 Added: (* Begin and cancel a second. The saved first workout must remain. *)
355 Added: let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 3) ())) in
356 Added: Alcotest.(check bool) "discarded" true (run (S.cancel s t));
357 Added: Alcotest.(check int)
358 Added: "saved history kept" 1
359 Added: (List.length (run (S.history s t)));
360 Added: Alcotest.(check bool)
361 Added: "no workout in progress" true
362 Added: (Option.is_none (run (S.in_progress s t))) );
363 Added: ( "cancelling with nothing in progress is a no-op",
364 Added: `Quick,
365 Added: fun () ->
366 Added: let s, t = fixture () in
367 Added: Alcotest.(check bool) "nothing to discard" false (run (S.cancel s t)) );
332 368 ]
333 369
334 370 let active_and_edit_tests =