[OCaml] High Intensity Training Online
fix record and correction submits navigate natively
The XHR-and-swap submit path raced when two submits landed in a short span, so a second record or correction was dropped until a manual refresh. Workout forms now submit as a full-page POST-redirect-GET, which guarantees the reloaded view reflects the saved value. Also removes the toast client code and keeps the correction dirty-tracking that toggles the Save/Reset actions.
Changed files
lib/web/handlers_current_workout.ml
@@ -34,7 +34,9 @@
34
34
| Error Service.Unknown_routine -> not_found Present.unknown_routine
35
35
))
36
36
37
Removed:
let show t trainee request =
37
Added:
(* Render the workout-in-progress page, or redirect Home when nothing is in
38
Added:
progress. Shared by the GET view and the partial responses below. *)
39
Added:
let render_workout t trainee request =
38
40
let viewer =
39
41
{
40
42
View_model.Viewer.username =
@@ -43,12 +45,24 @@
43
45
in
44
46
Service.in_progress t.service trainee.Trainee.id >>= function
45
47
| Some workout ->
48
Added:
Service.workout_log t.service trainee.Trainee.id >>= fun log ->
46
49
let active_slot = active_slot request workout in
47
50
html
48
51
(Pages.workout request ~viewer ~record_id:None ~active_slot
49
Removed:
(workout_view ~active_slot workout))
52
Added:
(workout_view ~active_slot ~log workout))
50
53
| None -> redirect_to request Routes.home
51
54
55
Added:
let show t trainee request = render_workout t trainee request
56
Added:
57
Added:
(* The response after a successful record or correction: a POST-redirect-GET
58
Added:
that flashes [message] and reloads the workout. Record and correction
59
Added:
submits navigate natively (full page), which guarantees the reloaded view
60
Added:
reflects exactly what was saved — no client swap that could race. *)
61
Added:
let saved _t _trainee request message =
62
Added:
redirect_with_flash request
63
Added:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
64
Added:
message
65
Added:
52
66
let log t trainee request slot =
53
67
Service.in_progress t.service trainee.Trainee.id >>= function
54
68
| None -> not_found Present.no_workout
@@ -67,10 +81,7 @@
67
81
Present.form_invalid
68
82
| Ok stimulus -> (
69
83
save_current t trainee.Trainee.id stimulus >>= function
70
Removed:
| Ok () ->
71
Removed:
redirect_with_flash request
72
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
73
Removed:
"Record saved."
84
Added:
| Ok () -> saved t trainee request "Record saved."
74
85
| Error detail ->
75
86
redirect_with_flash request
76
87
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
@@ -97,10 +108,7 @@
97
108
Present.form_invalid
98
109
| Ok stimulus -> (
99
110
replace_current t trainee.Trainee.id ~slot stimulus >>= function
100
Removed:
| Ok () ->
101
Removed:
redirect_with_flash request
102
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
103
Removed:
"Record saved."
111
Added:
| Ok () -> saved t trainee request "Record saved."
104
112
| Error detail ->
105
113
redirect_with_flash request
106
114
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
lib/web/workout_client.ml
@@ -30,62 +30,6 @@
30
30
| Some status -> status##.textContent := Js.some (Js.string message)
31
31
| None -> ()
32
32
33
Removed:
(* The transient notice. Without script it stays, so a no-JS visitor still
34
Removed:
reads it. With script it slides away after five seconds (WCAG 2.2.1 gives
35
Removed:
users time to read a brief status) or when its Dismiss button is pressed.
36
Removed:
Marking it done starts the slide-out; the node is removed once that has
37
Removed:
played. Idempotent: a toast already marked done is left alone, so a content
38
Removed:
swap never re-arms the same notice, and the pending timer is cancelled on a
39
Removed:
manual dismiss so it cannot act on a later toast. *)
40
Removed:
let toast_timer = ref None
41
Removed:
42
Removed:
let finish_toast toast =
43
Removed:
match
44
Removed:
Js.Opt.to_option (toast##getAttribute (Js.string "data-hito-toast-done"))
45
Removed:
with
46
Removed:
| Some _ -> ()
47
Removed:
| None ->
48
Removed:
toast##setAttribute (Js.string "data-hito-toast-done") (Js.string "");
49
Removed:
ignore
50
Removed:
(Dom_html.window##setTimeout
51
Removed:
(Js.wrap_callback (fun () ->
52
Removed:
match Js.Opt.to_option toast##.parentNode with
53
Removed:
| Some parent -> Dom.removeChild parent toast
54
Removed:
| None -> ()))
55
Removed:
(Js.number_of_float 400.))
56
Removed:
57
Removed:
let dismiss_toast () =
58
Removed:
(match !toast_timer with
59
Removed:
| Some id ->
60
Removed:
Dom_html.window##clearTimeout id;
61
Removed:
toast_timer := None
62
Removed:
| None -> ());
63
Removed:
match query_one document "[data-hito-toast]:not([data-hito-toast-done])" with
64
Removed:
| None -> ()
65
Removed:
| Some toast ->
66
Removed:
toast_timer :=
67
Removed:
Some
68
Removed:
(Dom_html.window##setTimeout
69
Removed:
(Js.wrap_callback (fun () ->
70
Removed:
toast_timer := None;
71
Removed:
finish_toast toast))
72
Removed:
(Js.number_of_float 5000.))
73
Removed:
74
Removed:
let toast_click event =
75
Removed:
match closest "[data-hito-toast-dismiss]" (Dom_html.eventTarget event) with
76
Removed:
| None -> Js._true
77
Removed:
| Some button -> (
78
Removed:
match closest "[data-hito-toast]" button with
79
Removed:
| None -> Js._true
80
Removed:
| Some toast ->
81
Removed:
(match !toast_timer with
82
Removed:
| Some id ->
83
Removed:
Dom_html.window##clearTimeout id;
84
Removed:
toast_timer := None
85
Removed:
| None -> ());
86
Removed:
finish_toast toast;
87
Removed:
Js._false)
88
Removed:
89
33
(* The workout timer. The sticky bar carries the workout's start time as an
90
34
epoch in [data-started]. The elapsed time is computed from it, so a content
91
35
swap that re-renders the bar never resets the count. A single interval runs
@@ -227,7 +171,6 @@
227
171
would be redundant noise. Transient "Loading"/"Saving" still clear when
228
172
the swap lands, because the fresh status node starts empty. *)
229
173
start_timer ();
230
Removed:
dismiss_toast ();
231
174
open_marked_feedback_modal ();
232
175
open_marked_confirm_modal ();
233
176
true
@@ -290,11 +233,6 @@
290
233
Lwt.async (fun () -> get ~push:true ~workout url);
291
234
Js._false)
292
235
293
Removed:
let slot_from_action action =
294
Removed:
match List.rev (String.split_on_char '/' action) with
295
Removed:
| "edit" :: slot :: _ | slot :: _ -> slot
296
Removed:
| [] -> ""
297
Removed:
298
236
let form_submit event =
299
237
match
300
238
closest "form[data-hito-app-form], form[data-hito-workout-form]"
@@ -305,6 +243,15 @@
305
243
match Js.Opt.to_option (Dom_html.CoerceTo.form element) with
306
244
| None -> Js._true
307
245
| Some form when not (Js.to_bool form##checkValidity) -> Js._true
246
Added:
(* Workout record and correction submits navigate natively: a full-page
247
Added:
POST-redirect-GET. The in-place swap raced when two submits landed in a
248
Added:
short span, so a second record or correction could be dropped until a
249
Added:
manual refresh. A real navigation guarantees the saved value is always
250
Added:
what the next page shows — correctness over the partial-swap feel. *)
251
Added:
| Some form
252
Added:
when Js.to_bool
253
Added:
(form##hasAttribute (Js.string "data-hito-workout-form")) ->
254
Added:
Js._true
308
255
| Some form ->
309
256
let action =
310
257
match
@@ -315,9 +262,6 @@
315
262
in
316
263
incr request_number;
317
264
let request = !request_number in
318
Removed:
let workout =
319
Removed:
Js.to_bool (form##hasAttribute (Js.string "data-hito-workout-form"))
320
Removed:
in
321
265
let feedback =
322
266
Js.to_bool
323
267
(form##hasAttribute (Js.string "data-hito-feedback-form"))
@@ -361,15 +305,12 @@
361
305
else (
362
306
set_busy false;
363
307
Option.iter (fun set -> set false) submit;
364
Removed:
let replace =
365
Removed:
if workout then replace_workout else replace_app
366
Removed:
in
367
Removed:
if response.code = 400 && replace response.content then
308
Added:
(* App forms swap in place: a 400 re-renders with errors; a 2xx
309
Added:
swaps and pushes the new URL. Workout record/correction forms
310
Added:
do not reach here — they submit natively for correctness. *)
311
Added:
if response.code = 400 && replace_app response.content then
368
312
Lwt.return_unit
369
Removed:
else if workout && response.code >= 200 && response.code < 300
370
Removed:
then
371
Removed:
get ~workout:true ("/workout?slot=" ^ slot_from_action action)
372
Removed:
else if response.code < 500 && replace response.content then (
313
Added:
else if response.code < 500 && replace_app response.content then (
373
314
if response.code >= 200 && response.code < 300 then
374
315
push_url response.url;
375
316
Lwt.return_unit)
@@ -441,6 +382,68 @@
441
382
| None -> Js._false)
442
383
| None -> Js._true))
443
384
385
Added:
(* Correction forms show their Save/Reset actions only once a field differs from
386
Added:
its recorded value. A form is "dirty" when any control no longer matches its
387
Added:
default (the server-rendered initial value, which a native reset restores
388
Added:
to). The dirty flag is a [data-hito-dirty] attribute the CSS keys off;
389
Added:
recomputing it on every input keeps it correct both ways, so returning the
390
Added:
last field to its recorded value hides the actions again. *)
391
Added:
let control_changed node =
392
Added:
match Js.Opt.to_option (Dom_html.CoerceTo.input node) with
393
Added:
| Some input ->
394
Added:
not (Js.to_string input##.value = Js.to_string input##.defaultValue)
395
Added:
| None -> (
396
Added:
match Js.Opt.to_option (Dom_html.CoerceTo.select node) with
397
Added:
| Some select ->
398
Added:
let options = select##.options in
399
Added:
let changed = ref false in
400
Added:
for i = 0 to options##.length - 1 do
401
Added:
match Js.Opt.to_option (options##item i) with
402
Added:
| Some opt ->
403
Added:
if Js.to_bool opt##.selected <> Js.to_bool opt##.defaultSelected
404
Added:
then changed := true
405
Added:
| None -> ()
406
Added:
done;
407
Added:
!changed
408
Added:
| None -> false)
409
Added:
410
Added:
let refresh_correction_dirty form =
411
Added:
let controls = form##querySelectorAll (Js.string "input, select") in
412
Added:
let dirty = ref false in
413
Added:
for i = 0 to controls##.length - 1 do
414
Added:
match Js.Opt.to_option (controls##item i) with
415
Added:
| Some node -> if control_changed node then dirty := true
416
Added:
| None -> ()
417
Added:
done;
418
Added:
if !dirty then form##setAttribute (Js.string "data-hito-dirty") (Js.string "")
419
Added:
else form##removeAttribute (Js.string "data-hito-dirty")
420
Added:
421
Added:
let correction_input event =
422
Added:
match
423
Added:
closest "form[data-hito-correction-form]" (Dom_html.eventTarget event)
424
Added:
with
425
Added:
| None -> Js._true
426
Added:
| Some form ->
427
Added:
Js.Opt.iter (Dom_html.CoerceTo.form form) refresh_correction_dirty;
428
Added:
Js._true
429
Added:
430
Added:
(* A native reset restores defaults synchronously after this handler returns, so
431
Added:
the dirty flag is recomputed a tick later, once values are back. *)
432
Added:
let correction_reset event =
433
Added:
match
434
Added:
closest "form[data-hito-correction-form]" (Dom_html.eventTarget event)
435
Added:
with
436
Added:
| None -> Js._true
437
Added:
| Some form ->
438
Added:
ignore
439
Added:
(Dom_html.window##setTimeout
440
Added:
(Js.wrap_callback (fun () ->
441
Added:
Js.Opt.iter
442
Added:
(Dom_html.CoerceTo.form form)
443
Added:
refresh_correction_dirty))
444
Added:
(Js.number_of_float 0.));
445
Added:
Js._true
446
Added:
444
447
(* The feedback modal uses the same native dialog behavior as workout
445
448
cancellation. The trigger remains a normal link, so no-script clients open
446
449
the server-rendered modal page instead, and Close is a link back to the
@@ -476,6 +479,15 @@
476
479
(Dom_html.handler form_submit)
477
480
Js._false
478
481
|> ignore;
482
Added:
Dom_html.addEventListener document Dom_html.Event.input
483
Added:
(Dom_html.handler correction_input)
484
Added:
Js._false
485
Added:
|> ignore;
486
Added:
Dom_html.addEventListener document
487
Added:
(Dom_html.Event.make "reset")
488
Added:
(Dom_html.handler correction_reset)
489
Added:
Js._false
490
Added:
|> ignore;
479
491
Dom_html.addEventListener document Dom_html.Event.click
480
492
(Dom_html.handler feedback_click)
481
493
Js._false
@@ -485,10 +497,6 @@
485
497
Js._false
486
498
|> ignore;
487
499
Dom_html.addEventListener document Dom_html.Event.click
488
Removed:
(Dom_html.handler toast_click)
489
Removed:
Js._false
490
Removed:
|> ignore;
491
Removed:
Dom_html.addEventListener document Dom_html.Event.click
492
500
(Dom_html.handler confirm_click)
493
501
Js._false
494
502
|> ignore;
@@ -520,5 +528,4 @@
520
528
Js._false
521
529
|> ignore;
522
530
start_timer ();
523
Removed:
dismiss_toast ();
524
531
open_marked_confirm_modal ()