[OCaml] High Intensity Training Online
feat Add tabbed workout logging
Show one exercise at a time with slot progress, side-by-side inputs, and correction controls.
Changed files
lib/web/assets/hito.css
@@ -263,6 +263,74 @@
263
263
264
264
.row { display: grid; grid-template-columns: repeat(2, minmax(0, 1fr)); gap: 0.8rem; }
265
265
266
Added:
/* The exercise tab strip. Server-rendered links, one per prescription slot,
267
Added:
carrying the slot in a query parameter. The active tab reads as pressed; a
268
Added:
recorded slot is marked with a check. On a narrow screen the strip scrolls
269
Added:
horizontally rather than wrapping, so one slot's panel stays in view. */
270
Added:
.slot-tabs {
271
Added:
display: flex;
272
Added:
flex-wrap: wrap;
273
Added:
gap: 0.35rem;
274
Added:
margin: 1.25rem 0 0;
275
Added:
border-bottom: 2px solid var(--ink);
276
Added:
padding-bottom: 0.4rem;
277
Added:
}
278
Added:
279
Added:
.slot-tab {
280
Added:
display: inline-flex;
281
Added:
align-items: center;
282
Added:
gap: 0.5rem;
283
Added:
min-height: 2.75rem;
284
Added:
padding: 0.5rem 0.85rem;
285
Added:
border: 1px solid var(--rule-strong);
286
Added:
border-bottom: none;
287
Added:
border-radius: 0.3rem 0.3rem 0 0;
288
Added:
color: var(--ink);
289
Added:
background: var(--paper);
290
Added:
font-size: 0.9rem;
291
Added:
font-weight: 600;
292
Added:
text-decoration: none;
293
Added:
}
294
Added:
295
Added:
.slot-tab:hover {
296
Added:
color: var(--oxblood-dark);
297
Added:
background: #ece4d5;
298
Added:
}
299
Added:
300
Added:
.slot-tab.is-active {
301
Added:
color: var(--paper-raised);
302
Added:
background: var(--oxblood);
303
Added:
border-color: var(--oxblood-dark);
304
Added:
}
305
Added:
306
Added:
.slot-tab-index {
307
Added:
display: grid;
308
Added:
width: 1.5rem;
309
Added:
height: 1.5rem;
310
Added:
place-items: center;
311
Added:
border: 1px solid currentColor;
312
Added:
border-radius: 50%;
313
Added:
font: 700 0.72rem/1 var(--mono);
314
Added:
font-variant-numeric: tabular-nums;
315
Added:
}
316
Added:
317
Added:
.slot-tab.is-done .slot-tab-index {
318
Added:
border-color: var(--evergreen);
319
Added:
color: var(--paper-raised);
320
Added:
background: var(--evergreen);
321
Added:
}
322
Added:
323
Added:
.slot-tab.is-active.is-done .slot-tab-index {
324
Added:
border-color: var(--paper-raised);
325
Added:
color: var(--oxblood);
326
Added:
background: var(--paper-raised);
327
Added:
}
328
Added:
329
Added:
.slot-panel { margin-top: 1.25rem; }
330
Added:
331
Added:
.recorded-slot { margin: 1rem 0; }
332
Added:
.recorded-slot .done { margin-bottom: 0.35rem; }
333
Added:
266
334
.warn {
267
335
max-width: 47rem;
268
336
margin: 1rem 0;
@@ -346,6 +414,18 @@
346
414
}
347
415
348
416
.page-surface { min-height: calc(100vh - 9rem); padding: 1.25rem; }
417
Added:
418
Added:
.slot-tabs {
419
Added:
flex-wrap: nowrap;
420
Added:
overflow-x: auto;
421
Added:
scrollbar-width: thin;
422
Added:
-webkit-overflow-scrolling: touch;
423
Added:
}
424
Added:
425
Added:
.slot-tab {
426
Added:
flex: 0 0 auto;
427
Added:
white-space: nowrap;
428
Added:
}
349
429
}
350
430
351
431
@media (max-width: 26rem) {
lib/web/handlers.ml
@@ -160,21 +160,57 @@
160
160
let outstanding workout slot =
161
161
List.assoc_opt slot (Evidence.Workout.outstanding workout)
162
162
163
Added:
(* The prescription at any valid slot, filled or not — the edit handlers
164
Added:
correct filled slots, which [outstanding] does not list. *)
165
Added:
let prescription_at workout slot =
166
Added:
List.nth_opt
167
Added:
(Prescription.Workout.stimuli (Evidence.Workout.prescription workout))
168
Added:
slot
169
Added:
170
Added:
(* The tab a tabbed workout view should open on. An explicit [?slot=] query
171
Added:
wins when it names a real slot; otherwise the view defaults to the first
172
Added:
incomplete slot. A [?slot=] out of range, or absent, falls back to the
173
Added:
default, so a bookmarked or hand-edited URL never renders an empty view. *)
174
Added:
let active_slot request workout =
175
Added:
let slot_count =
176
Added:
List.length
177
Added:
(Prescription.Workout.stimuli (Evidence.Workout.prescription workout))
178
Added:
in
179
Added:
match Dream.query request "slot" with
180
Added:
| Some raw -> (
181
Added:
match int_of_string_opt raw with
182
Added:
| Some slot when slot >= 0 && slot < slot_count -> slot
183
Added:
| _ -> Pages.default_slot workout)
184
Added:
| None -> Pages.default_slot workout
185
Added:
163
186
let save_current t trainee stimulus =
164
187
Service.log t.service trainee stimulus >|= function
165
188
| Ok _ -> Ok ()
166
189
| Error e -> Error (Present.log_error e)
167
190
191
Added:
let replace_current t trainee ~slot stimulus =
192
Added:
Service.replace_current t.service trainee ~slot stimulus >|= function
193
Added:
| Ok _ -> Ok ()
194
Added:
| Error e -> Error (Present.log_error e)
195
Added:
168
196
let save_record t trainee id stimulus =
169
197
Service.add_to_record t.service trainee id stimulus >|= function
170
198
| Ok _ -> Ok ()
171
199
| Error e -> Error (Present.edit_error e)
172
200
201
Added:
let replace_record t trainee id ~slot stimulus =
202
Added:
Service.replace_in_record t.service trainee id ~slot stimulus >|= function
203
Added:
| Ok _ -> Ok ()
204
Added:
| Error e -> Error (Present.edit_error e)
205
Added:
173
206
module Overview = struct
174
207
let page t trainee request =
175
208
Service.in_progress t.service trainee.Trainee.id >>= function
176
209
| Some workout ->
177
Removed:
Lwt.return (Pages.workout request ~trainee ~record_id:None workout)
210
Added:
Lwt.return
211
Added:
(Pages.workout request ~trainee ~record_id:None
212
Added:
~active_slot:(active_slot request workout)
213
Added:
workout)
178
214
| None -> (
179
215
Service.active_routine t.service trainee.Trainee.id >>= function
180
216
| None ->
@@ -253,7 +289,10 @@
253
289
let show t trainee request =
254
290
Service.in_progress t.service trainee.Trainee.id >>= function
255
291
| Some workout ->
256
Removed:
html (Pages.workout request ~trainee ~record_id:None workout)
292
Added:
html
293
Added:
(Pages.workout request ~trainee ~record_id:None
294
Added:
~active_slot:(active_slot request workout)
295
Added:
workout)
257
296
| None -> redirect_to request Routes.home
258
297
259
298
let log t trainee request slot =
@@ -266,14 +305,36 @@
266
305
decode_form (Decode.stimulus prescription) request >>= function
267
306
| Error (`Invalid errors) ->
268
307
html ~status:`Bad_Request
269
Removed:
(Pages.workout request ~trainee ~errors ~record_id:None
270
Removed:
workout)
308
Added:
(Pages.workout request ~trainee ~errors ~editing:slot
309
Added:
~record_id:None ~active_slot:slot workout)
271
310
| Error `Bad_request -> bad_request Present.form_invalid
272
311
| Ok stimulus -> (
273
312
save_current t trainee.Trainee.id stimulus >>= function
274
313
| Ok () -> redirect_to request Routes.workout
275
314
| Error detail -> bad_request detail)))
276
315
316
Added:
(* Correct a recorded slot of the workout in progress. The slot may be
317
Added:
filled, so its prescription comes from the workout, not [outstanding].
318
Added:
[replace_current] targets the slot and never adds volume. *)
319
Added:
let edit t trainee request slot =
320
Added:
Service.in_progress t.service trainee.Trainee.id >>= function
321
Added:
| None -> not_found Present.no_workout
322
Added:
| Some workout -> (
323
Added:
match prescription_at workout slot with
324
Added:
| None -> not_found Present.slot_not_awaiting
325
Added:
| Some prescription -> (
326
Added:
decode_form (Decode.stimulus prescription) request >>= function
327
Added:
| Error (`Invalid errors) ->
328
Added:
html ~status:`Bad_Request
329
Added:
(Pages.workout request ~trainee ~errors ~editing:slot
330
Added:
~record_id:None ~active_slot:slot workout)
331
Added:
| Error `Bad_request -> bad_request Present.form_invalid
332
Added:
| Ok stimulus -> (
333
Added:
replace_current t trainee.Trainee.id ~slot stimulus
334
Added:
>>= function
335
Added:
| Ok () -> redirect_to request Routes.workout
336
Added:
| Error detail -> bad_request detail)))
337
Added:
277
338
let finish t trainee request =
278
339
guard_csrf request >>= function
279
340
| Error _ -> bad_request Present.form_invalid
@@ -292,6 +353,8 @@
292
353
begin_workout t trainee request));
293
354
Dream_html.post Routes.workout_slot (fun request slot ->
294
355
authenticated t request (fun trainee -> log t trainee request slot));
356
Added:
Dream_html.post Routes.workout_slot_edit (fun request slot ->
357
Added:
authenticated t request (fun trainee -> edit t trainee request slot));
295
358
Dream_html.post Routes.finish_workout (fun request ->
296
359
authenticated t request (fun trainee -> finish t trainee request));
297
360
]
@@ -306,7 +369,10 @@
306
369
record_target t trainee.Trainee.id id >>= function
307
370
| None -> not_found Present.unknown_record
308
371
| Some (_, workout) ->
309
Removed:
html (Pages.workout request ~trainee ~record_id:(Some id) workout)
372
Added:
html
373
Added:
(Pages.workout request ~trainee ~record_id:(Some id)
374
Added:
~active_slot:(active_slot request workout)
375
Added:
workout)
310
376
311
377
let log t trainee request id slot =
312
378
record_target t trainee.Trainee.id id >>= function
@@ -318,8 +384,8 @@
318
384
decode_form (Decode.stimulus prescription) request >>= function
319
385
| Error (`Invalid errors) ->
320
386
html ~status:`Bad_Request
321
Removed:
(Pages.workout request ~trainee ~errors ~record_id:(Some id)
322
Removed:
workout)
387
Added:
(Pages.workout request ~trainee ~errors ~editing:slot
388
Added:
~record_id:(Some id) ~active_slot:slot workout)
323
389
| Error `Bad_request -> bad_request Present.form_invalid
324
390
| Ok stimulus -> (
325
391
save_record t trainee.Trainee.id record_id stimulus
@@ -330,6 +396,30 @@
330
396
id)
331
397
| Error detail -> bad_request detail)))
332
398
399
Added:
(* Correct a recorded slot of a saved workout. [replace_record] targets the
400
Added:
slot, replacing its record rather than appending volume. *)
401
Added:
let edit t trainee request id slot =
402
Added:
record_target t trainee.Trainee.id id >>= function
403
Added:
| None -> not_found Present.unknown_record
404
Added:
| Some (record_id, workout) -> (
405
Added:
match prescription_at workout slot with
406
Added:
| None -> not_found Present.slot_not_awaiting
407
Added:
| Some prescription -> (
408
Added:
decode_form (Decode.stimulus prescription) request >>= function
409
Added:
| Error (`Invalid errors) ->
410
Added:
html ~status:`Bad_Request
411
Added:
(Pages.workout request ~trainee ~errors ~editing:slot
412
Added:
~record_id:(Some id) ~active_slot:slot workout)
413
Added:
| Error `Bad_request -> bad_request Present.form_invalid
414
Added:
| Ok stimulus -> (
415
Added:
replace_record t trainee.Trainee.id record_id ~slot stimulus
416
Added:
>>= function
417
Added:
| Ok () ->
418
Added:
redirect request
419
Added:
(Dream_html.path_attr Dream_html.HTML.href Routes.record
420
Added:
id)
421
Added:
| Error detail -> bad_request detail)))
422
Added:
333
423
let routes t =
334
424
[
335
425
Dream_html.get Routes.history (fun request ->
@@ -339,6 +429,9 @@
339
429
Dream_html.post Routes.record_slot (fun request id slot ->
340
430
authenticated t request (fun trainee ->
341
431
log t trainee request id slot));
432
Added:
Dream_html.post Routes.record_slot_edit (fun request id slot ->
433
Added:
authenticated t request (fun trainee ->
434
Added:
edit t trainee request id slot));
342
435
]
343
436
end
344
437
lib/web/pages.ml
@@ -214,15 +214,23 @@
214
214
Printf.sprintf "%s into %s, no pause — %s" (Exercise.name isolation)
215
215
(Exercise.name compound) window
216
216
217
Removed:
let extension_select ~input_id =
217
Added:
let extension_select ?(selected = "") ~input_id () =
218
Added:
let option (code : string) label =
219
Added:
let attrs = [ Dream_html.string_attr "value" "%s" code ] in
220
Added:
let attrs =
221
Added:
if String.equal code selected then Dream_html.attr "selected" :: attrs
222
Added:
else attrs
223
Added:
in
224
Added:
tag "option" attrs [ txt "%s" label ]
225
Added:
in
218
226
tag "select"
219
227
[ name "extension"; Dream_html.string_attr "id" "%s" input_id ]
220
228
[
221
Removed:
tag "option" [ value "" ] [ txt "to positive failure" ];
222
Removed:
tag "option" [ value "forced" ] [ txt "then forced reps" ];
223
Removed:
tag "option" [ value "negatives" ] [ txt "then negatives" ];
224
Removed:
tag "option" [ value "rest-pause" ] [ txt "then rest-pause" ];
225
Removed:
tag "option" [ value "static" ] [ txt "then a static hold" ];
229
Added:
option "" "to positive failure";
230
Added:
option "forced" "then forced reps";
231
Added:
option "negatives" "then negatives";
232
Added:
option "rest-pause" "then rest-pause";
233
Added:
option "static" "then a static hold";
226
234
]
227
235
228
236
let choose_routine request ~trainee ~routines =
@@ -355,7 +363,7 @@
355
363
[ txt "%s" (Decode.errors_to_text [ (field, error) ]) ];
356
364
]
357
365
358
Removed:
let input_row ~input_id field label =
366
Added:
let input_row ?value:v ~input_id field label =
359
367
tag "div"
360
368
[ class_ "field" ]
361
369
[
@@ -363,32 +371,90 @@
363
371
[ Dream_html.string_attr "for" "%s" input_id ]
364
372
[ txt "%s" label ];
365
373
void "input"
366
Removed:
[
367
Removed:
type_ "number";
368
Removed:
name field;
369
Removed:
Dream_html.string_attr "id" "%s" input_id;
370
Removed:
step "0.5";
371
Removed:
required;
372
Removed:
];
374
Added:
([
375
Added:
type_ "number";
376
Added:
name field;
377
Added:
Dream_html.string_attr "id" "%s" input_id;
378
Added:
step "0.5";
379
Added:
required;
380
Added:
]
381
Added:
@
382
Added:
match v with
383
Added:
| None -> []
384
Added:
| Some v -> [ Dream_html.string_attr "value" "%s" v ]);
373
385
]
374
386
375
Removed:
let form_for_stimulus request ~action_path ~slot ~prescription ~errors =
387
Added:
(* Load and reps sit side by side. The [.row] class is a two-column grid that
388
Added:
collapses to one column on a narrow screen. Each movement of a pre-exhaust
389
Added:
pair gets its own row, so both stay paired. *)
390
Added:
let load_reps_row ~load_id ~load_field ~reps_id ~reps_field ?load_value
391
Added:
?reps_value ~reps_label () =
392
Added:
tag "div"
393
Added:
[ class_ "row" ]
394
Added:
[
395
Added:
input_row ?value:load_value ~input_id:load_id load_field "Load (kg)";
396
Added:
input_row ?value:reps_value ~input_id:reps_id reps_field reps_label;
397
Added:
]
398
Added:
399
Added:
(* A recorded number, rendered the way a numeric input expects. *)
400
Added:
let load_string load = Printf.sprintf "%g" load
401
Added:
let reps_string reps = string_of_int reps
402
Added:
403
Added:
(* The extension code the single-choice form uses, taken from an effort's
404
Added:
outcome. The form offers one ending, so the first extension stands for it. *)
405
Added:
let extension_code_of_effort effort =
406
Added:
match Evidence.Stimulus.Effort.outcome effort with
407
Added:
| Evidence.Stimulus.Positive_failure -> ""
408
Added:
| Evidence.Stimulus.Beyond_failure (first, _) -> (
409
Added:
match first with
410
Added:
| Evidence.Stimulus.Forced_reps -> "forced"
411
Added:
| Evidence.Stimulus.Negatives -> "negatives"
412
Added:
| Evidence.Stimulus.Rest_pause -> "rest-pause"
413
Added:
| Evidence.Stimulus.Static_hold -> "static")
414
Added:
415
Added:
(* [recorded] pre-fills the form when correcting a slot; [submit] names the
416
Added:
action. Load and reps of each movement are laid out side by side. *)
417
Added:
let form_for_stimulus request ~action_path ~slot ~prescription ?recorded
418
Added:
?(submit = "Record") ~errors () =
376
419
let field_id field = Printf.sprintf "slot-%d-%s" slot field in
420
Added:
let efforts = Option.map Evidence.Stimulus.efforts recorded in
421
Added:
let nth n = Option.bind efforts (fun es -> List.nth_opt es n) in
422
Added:
let load_of n =
423
Added:
Option.map (fun e -> load_string (Evidence.Stimulus.Effort.load e)) (nth n)
424
Added:
in
425
Added:
let reps_of n =
426
Added:
Option.map (fun e -> reps_string (Evidence.Stimulus.Effort.reps e)) (nth n)
427
Added:
in
428
Added:
let selected =
429
Added:
match recorded with
430
Added:
| None -> ""
431
Added:
| Some s -> (
432
Added:
(* The ending lives on the last effort (the compound of a pair). *)
433
Added:
match List.rev (Evidence.Stimulus.efforts s) with
434
Added:
| last :: _ -> extension_code_of_effort last
435
Added:
| [] -> "")
436
Added:
in
377
437
let fields =
378
438
match Prescription.Stimulus.delivery prescription with
379
439
| Prescription.Stimulus.Single _ ->
380
440
[
381
Removed:
input_row ~input_id:(field_id "load") "load" "Load (kg)";
382
Removed:
input_row ~input_id:(field_id "reps") "reps" "Reps to failure";
441
Added:
load_reps_row ~load_id:(field_id "load") ~load_field:"load"
442
Added:
~reps_id:(field_id "reps") ~reps_field:"reps"
443
Added:
?load_value:(load_of 0) ?reps_value:(reps_of 0)
444
Added:
~reps_label:"Reps to failure" ();
383
445
]
384
446
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
385
447
[
386
448
tag "p" [ class_ "done" ] [ txt "%s" (Exercise.name isolation) ];
387
Removed:
input_row ~input_id:(field_id "iso_load") "iso_load" "Load (kg)";
388
Removed:
input_row ~input_id:(field_id "iso_reps") "iso_reps" "Reps";
449
Added:
load_reps_row ~load_id:(field_id "iso_load") ~load_field:"iso_load"
450
Added:
~reps_id:(field_id "iso_reps") ~reps_field:"iso_reps"
451
Added:
?load_value:(load_of 0) ?reps_value:(reps_of 0) ~reps_label:"Reps"
452
Added:
();
389
453
tag "p" [ class_ "done" ] [ txt "%s" (Exercise.name compound) ];
390
Removed:
input_row ~input_id:(field_id "comp_load") "comp_load" "Load (kg)";
391
Removed:
input_row ~input_id:(field_id "comp_reps") "comp_reps" "Reps";
454
Added:
load_reps_row ~load_id:(field_id "comp_load") ~load_field:"comp_load"
455
Added:
~reps_id:(field_id "comp_reps") ~reps_field:"comp_reps"
456
Added:
?load_value:(load_of 1) ?reps_value:(reps_of 1) ~reps_label:"Reps"
457
Added:
();
392
458
]
393
459
in
394
460
tag "form" [ action_path; post_form ]
@@ -401,7 +467,7 @@
401
467
tag "label"
402
468
[ Dream_html.string_attr "for" "%s" (field_id "extension") ]
403
469
[ txt "Ending" ];
404
Removed:
extension_select ~input_id:(field_id "extension");
470
Added:
extension_select ~selected ~input_id:(field_id "extension") ();
405
471
]
406
472
@ List.concat_map
407
473
(fun field -> error_for field errors)
@@ -414,7 +480,10 @@
414
480
"comp_reps";
415
481
"extension";
416
482
]
417
Removed:
@ [ void "input" [ type_ "submit"; value "Record" ] ]);
483
Added:
@ [
484
Added:
void "input"
485
Added:
[ type_ "submit"; Dream_html.string_attr "value" "%s" submit ];
486
Added:
]);
418
487
]
419
488
420
489
let describe_stimulus stimulus =
@@ -437,15 +506,44 @@
437
506
(Format.asprintf "%a" Evidence.Stimulus.pp_extension)
438
507
extensions)
439
508
440
Removed:
let workout request ~trainee ?(errors = []) ~record_id workout =
509
Added:
(* A short tab label for a slot, drawn from its prescription. A pre-exhaust
510
Added:
slot names both movements so the tab stays legible. *)
511
Added:
let tab_label prescription =
512
Added:
match Prescription.Stimulus.delivery prescription with
513
Added:
| Prescription.Stimulus.Single exercise -> Exercise.name exercise
514
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
515
Added:
Printf.sprintf "%s + %s" (Exercise.name isolation)
516
Added:
(Exercise.name compound)
517
Added:
518
Added:
(* The base path a slot's tab links to, without the [?slot=] the tab strip
519
Added:
appends. Current-workout tabs return to [/workout]; a saved record's tabs
520
Added:
return to [/history/<id>]. The URL is built directly so the [slot] query can
521
Added:
be appended. *)
522
Added:
let tab_href ~record_id slot =
523
Added:
let base =
524
Added:
match record_id with
525
Added:
| None -> "/workout"
526
Added:
| Some record_id -> "/history/" ^ record_id
527
Added:
in
528
Added:
Printf.sprintf "%s?slot=%d" base slot
529
Added:
530
Added:
let workout request ~trainee ?(errors = []) ?editing ~record_id ~active_slot
531
Added:
workout =
441
532
let prescription = Evidence.Workout.prescription workout in
442
Removed:
let performed = Evidence.Workout.stimuli workout in
533
Added:
let performed = Evidence.Workout.performed workout in
534
Added:
let prescribed_slots = Prescription.Workout.stimuli prescription in
535
Added:
let slot_count = List.length prescribed_slots in
443
536
let outstanding = Evidence.Workout.outstanding workout in
444
Removed:
let form_action slot =
537
Added:
let record_action slot =
445
538
match record_id with
446
539
| None -> action Routes.workout_slot slot
447
540
| Some record_id -> action Routes.record_slot record_id slot
448
541
in
542
Added:
let edit_action slot =
543
Added:
match record_id with
544
Added:
| None -> action Routes.workout_slot_edit slot
545
Added:
| Some record_id -> action Routes.record_slot_edit record_id slot
546
Added:
in
449
547
let override_note =
450
548
match Recovery.basis (Evidence.Workout.clearance workout) with
451
549
| Recovery.Recovered -> []
@@ -454,19 +552,105 @@
454
552
tag "div" [ class_ "warn" ] [ txt "Begun before recovery finished." ];
455
553
]
456
554
in
457
Removed:
let recorded_section =
458
Removed:
if performed = [] then []
459
Removed:
else
460
Removed:
[
461
Removed:
tag "h2" [] [ txt "Recorded" ];
462
Removed:
tag "ul" []
463
Removed:
(List.map
464
Removed:
(fun stimulus ->
465
Removed:
tag "li" [] [ txt "%s" (describe_stimulus stimulus) ])
466
Removed:
performed);
467
Removed:
]
555
Added:
(* One entry per filled slot, the first fill in performance order — the fill
556
Added:
[replace_stimulus] keeps in place when a correction lands. *)
557
Added:
let filled =
558
Added:
List.fold_left
559
Added:
(fun acc (slot, stimulus) ->
560
Added:
if List.mem_assoc slot acc then acc else acc @ [ (slot, stimulus) ])
561
Added:
[] performed
468
562
in
469
Removed:
let outstanding_section =
563
Added:
let recorded_at slot = List.assoc_opt slot filled in
564
Added:
let is_recorded slot = Option.is_some (recorded_at slot) in
565
Added:
(* The tab strip: one tab per prescription slot, a server-rendered link
566
Added:
carrying the slot as a query parameter. The active tab is the panel below;
567
Added:
a recorded slot is marked done. This is link navigation, not an ARIA
568
Added:
widget: a labelled [nav] with [aria-current="page"] on the active link is
569
Added:
the accessible, deterministic pattern — no client script, no focus state to
570
Added:
manage. *)
571
Added:
let tab_strip =
572
Added:
tag "nav"
573
Added:
[ class_ "slot-tabs"; Dream_html.string_attr "aria-label" "Exercises" ]
574
Added:
(List.mapi
575
Added:
(fun slot p ->
576
Added:
let current = slot = active_slot in
577
Added:
let done_ = is_recorded slot in
578
Added:
let state =
579
Added:
match (current, done_) with
580
Added:
| true, true -> "slot-tab is-active is-done"
581
Added:
| true, false -> "slot-tab is-active"
582
Added:
| false, true -> "slot-tab is-done"
583
Added:
| false, false -> "slot-tab"
584
Added:
in
585
Added:
let attrs =
586
Added:
[
587
Added:
Dream_html.string_attr "class" "%s" state;
588
Added:
Dream_html.string_attr "href" "%s" (tab_href ~record_id slot);
589
Added:
]
590
Added:
in
591
Added:
let attrs =
592
Added:
if current then
593
Added:
Dream_html.string_attr "aria-current" "page" :: attrs
594
Added:
else attrs
595
Added:
in
596
Added:
tag "a" attrs
597
Added:
[
598
Added:
tag "span" [ class_ "slot-tab-index" ] [ txt "%d" (slot + 1) ];
599
Added:
tag "span" [ class_ "slot-tab-name" ] [ txt "%s" (tab_label p) ];
600
Added:
])
601
Added:
prescribed_slots)
602
Added:
in
603
Added:
(* The panel for the active slot. It shows one exercise at a time: a recorded
604
Added:
slot renders its read-only summary and a pre-filled correction form (which
605
Added:
replaces the slot rather than adding volume); an outstanding slot renders
606
Added:
the record form. *)
607
Added:
let active_panel =
608
Added:
match List.nth_opt prescribed_slots active_slot with
609
Added:
| None ->
610
Added:
[
611
Added:
tag "p"
612
Added:
[ class_ "warn" ]
613
Added:
[ txt "That exercise is not part of this workout." ];
614
Added:
]
615
Added:
| Some prescription ->
616
Added:
let errors = if editing = Some active_slot then errors else [] in
617
Added:
let heading = tag "h2" [] [ txt "%s" (tab_label prescription) ] in
618
Added:
let body =
619
Added:
match recorded_at active_slot with
620
Added:
| Some stimulus ->
621
Added:
[
622
Added:
tag "p" [ class_ "eyebrow" ] [ txt "Recorded" ];
623
Added:
tag "p"
624
Added:
[ class_ "done" ]
625
Added:
[ txt "%s" (describe_stimulus stimulus) ];
626
Added:
tag "p"
627
Added:
[ class_ "doctrine-note" ]
628
Added:
[
629
Added:
txt
630
Added:
"A correction replaces the recorded set. It does not add \
631
Added:
volume; the logbook states one fact per slot.";
632
Added:
];
633
Added:
form_for_stimulus request ~action_path:(edit_action active_slot)
634
Added:
~slot:active_slot ~prescription ~recorded:stimulus
635
Added:
~submit:"Save correction" ~errors ();
636
Added:
]
637
Added:
| None ->
638
Added:
[
639
Added:
tag "p"
640
Added:
[ class_ "doctrine-note" ]
641
Added:
[
642
Added:
txt
643
Added:
"Record the effort as it occurred. The logbook does not \
644
Added:
revise the fact.";
645
Added:
];
646
Added:
form_for_stimulus request
647
Added:
~action_path:(record_action active_slot)
648
Added:
~slot:active_slot ~prescription ~errors ();
649
Added:
]
650
Added:
in
651
Added:
[ tag "section" [ class_ "slot-panel" ] (heading :: body) ]
652
Added:
in
653
Added:
let complete_note =
470
654
if outstanding = [] then
471
655
[
472
656
tag "p"
@@ -480,20 +664,7 @@
480
664
conclusions from it.";
481
665
];
482
666
]
483
Removed:
else
484
Removed:
tag "h2" [] [ txt "Still to do" ]
485
Removed:
:: tag "p"
486
Removed:
[ class_ "doctrine-note" ]
487
Removed:
[
488
Removed:
txt
489
Removed:
"Record each effort as it occurred. The logbook does not revise \
490
Removed:
the fact.";
491
Removed:
]
492
Removed:
:: List.map
493
Removed:
(fun (slot, prescription) ->
494
Removed:
form_for_stimulus request ~action_path:(form_action slot) ~slot
495
Removed:
~prescription ~errors)
496
Removed:
outstanding
667
Added:
else []
497
668
in
498
669
let finish_section =
499
670
match record_id with
@@ -513,14 +684,27 @@
513
684
(Prescription.Workout.name prescription)
514
685
(override_note
515
686
@ [
516
Removed:
tag "h2" [] [ txt "%s" (Prescription.Workout.name prescription) ];
517
Removed:
tag "p" []
687
Added:
tag "p"
688
Added:
[ class_ "eyebrow" ]
689
Added:
[ txt "%s" (Prescription.Workout.name prescription) ];
690
Added:
tag "p"
691
Added:
[ class_ "ledger-meta" ]
518
692
[
519
Removed:
txt "%d of %d recorded." (List.length performed)
520
Removed:
(List.length (Prescription.Workout.stimuli prescription));
693
Added:
txt "%d of %d recorded."
694
Added:
(Evidence.Workout.filled_slots workout)
695
Added:
slot_count;
521
696
];
697
Added:
tab_strip;
522
698
]
523
Removed:
@ recorded_section @ outstanding_section @ finish_section)
699
Added:
@ active_panel @ complete_note @ finish_section)
700
Added:
701
Added:
(* The slot a tabbed workout view should open on: the first slot still awaiting
702
Added:
a record, or the first slot when every slot is filled. A caller clamps a
703
Added:
requested slot against the prescription; this supplies the default. *)
704
Added:
let default_slot workout =
705
Added:
match Evidence.Workout.outstanding workout with
706
Added:
| (slot, _) :: _ -> slot
707
Added:
| [] -> 0
524
708
525
709
let history ~trainee records =
526
710
html_page ~trainee ~active:"history" "History"
lib/web/pages.mli
@@ -26,9 +26,19 @@
26
26
Dream.request ->
27
27
trainee:Trainee.t ->
28
28
?errors:(string * string) list ->
29
Added:
?editing:int ->
29
30
record_id:string option ->
31
Added:
active_slot:int ->
30
32
Evidence.Workout.t ->
31
33
page
34
Added:
(** Renders one prescribed slot at a time under a strip of named tabs.
35
Added:
[active_slot] selects the visible tab; a handler clamps a requested slot and
36
Added:
falls back to {!default_slot}. [record_id] is [None] for the workout in
37
Added:
progress and [Some id] for a saved history record. *)
38
Added:
39
Added:
val default_slot : Evidence.Workout.t -> int
40
Added:
(** The slot a tabbed view opens on: the first slot still awaiting a record, or
41
Added:
the first slot when every slot is filled. *)
32
42
33
43
val history : trainee:Trainee.t -> Repository.record list -> page
34
44
val problem : title:string -> detail:string -> page
lib/web/routes.ml
@@ -10,8 +10,10 @@
10
10
let%path routine = "/routine"
11
11
let%path workout = "/workout"
12
12
let%path workout_slot = "/workout/slots/%d"
13
Added:
let%path workout_slot_edit = "/workout/slots/%d/edit"
13
14
let%path finish_workout = "/workout/finish"
14
15
let%path history = "/history"
15
16
let%path record = "/history/%s"
16
17
let%path record_slot = "/history/%s/slots/%d"
18
Added:
let%path record_slot_edit = "/history/%s/slots/%d/edit"
17
19
let%path stylesheet = "/assets/hito.css"
test/test_web.ml
@@ -224,7 +224,7 @@
224
224
] );
225
225
( "web.flow",
226
226
[
227
Removed:
( "a signed-in trainee starts a workout and sees the effort forms",
227
Added:
( "a signed-in trainee starts a workout and sees the tabbed slots",
228
228
`Quick,
229
229
fun () ->
230
230
let c = client () in
@@ -243,10 +243,19 @@
243
243
Alcotest.(check int) "workout started" 303 (status started);
244
244
let workout_page = body (get c "/workout") in
245
245
Alcotest.(check bool)
246
Removed:
"outstanding heading" true
247
Removed:
(contains ~substring:"Still to do" workout_page);
246
Added:
"renders a tab strip" true
247
Added:
(contains ~substring:"slot-tabs" workout_page);
248
248
Alcotest.(check bool)
249
Removed:
"first effort form" true
249
Added:
"labels the tab strip for assistive tech" true
250
Added:
(contains ~substring:"aria-label=\"Exercises\"" workout_page);
251
Added:
Alcotest.(check bool)
252
Added:
"marks the active tab with aria-current" true
253
Added:
(contains ~substring:"aria-current=\"page\"" workout_page);
254
Added:
Alcotest.(check bool)
255
Added:
"links a later slot by query parameter" true
256
Added:
(contains ~substring:"?slot=1" workout_page);
257
Added:
Alcotest.(check bool)
258
Added:
"opens on the first slot's record form" true
250
259
(contains ~substring:"/workout/slots/0" workout_page) );
251
260
( "the routine page uses workout description accordions",
252
261
`Quick,
@@ -273,6 +282,174 @@
273
282
"includes prescription" true
274
283
(contains ~substring:"Dumbbell Flyes into Incline Presses" page)
275
284
);
285
Added:
( "effort forms lay load and reps out side by side",
286
Added:
`Quick,
287
Added:
fun () ->
288
Added:
let c = client () in
289
Added:
let _ = sign_in_new c in
290
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
291
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
292
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
293
Added:
let _ =
294
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
295
Added:
in
296
Added:
let page = body (get c "/workout") in
297
Added:
Alcotest.(check bool)
298
Added:
"uses the two-column row class" true
299
Added:
(contains ~substring:"class=\"row\"" page);
300
Added:
Alcotest.(check bool)
301
Added:
"still labels load" true
302
Added:
(contains ~substring:"Load (kg)" page) );
303
Added:
( "a recorded slot can be corrected, replacing it rather than adding \
304
Added:
volume",
305
Added:
`Quick,
306
Added:
fun () ->
307
Added:
let c = client () in
308
Added:
let _ = sign_in_new c in
309
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
310
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
311
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
312
Added:
let _ =
313
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
314
Added:
in
315
Added:
(* Slot 1 is the single Laterals set. Open its tab, record it, then
316
Added:
correct it — one slot at a time, addressed by [?slot=]. *)
317
Added:
let page = body (get c "/workout?slot=1") in
318
Added:
let token = Option.get (csrf_token page) in
319
Added:
let recorded =
320
Added:
post c "/workout/slots/1"
321
Added:
[
322
Added:
("dream.csrf", token);
323
Added:
("load", "12");
324
Added:
("reps", "8");
325
Added:
("extension", "");
326
Added:
]
327
Added:
in
328
Added:
Alcotest.(check int) "recorded" 303 (status recorded);
329
Added:
(* The default view now opens on slot 0, not the recorded slot. *)
330
Added:
let default_page = body (get c "/workout") in
331
Added:
Alcotest.(check bool)
332
Added:
"the default view does not show the recorded slot's edit form"
333
Added:
false
334
Added:
(contains ~substring:"/workout/slots/1/edit" default_page);
335
Added:
Alcotest.(check bool)
336
Added:
"counts one filled slot" true
337
Added:
(contains ~substring:"1 of 4 recorded" default_page);
338
Added:
(* The recorded slot's tab shows its correction form. *)
339
Added:
let page = body (get c "/workout?slot=1") in
340
Added:
Alcotest.(check bool)
341
Added:
"shows a correction form for the slot" true
342
Added:
(contains ~substring:"/workout/slots/1/edit" page);
343
Added:
let token = Option.get (csrf_token page) in
344
Added:
let corrected =
345
Added:
post c "/workout/slots/1/edit"
346
Added:
[
347
Added:
("dream.csrf", token);
348
Added:
("load", "16");
349
Added:
("reps", "6");
350
Added:
("extension", "");
351
Added:
]
352
Added:
in
353
Added:
Alcotest.(check int) "corrected" 303 (status corrected);
354
Added:
let page = body (get c "/workout?slot=1") in
355
Added:
Alcotest.(check bool)
356
Added:
"still one filled slot, not two" true
357
Added:
(contains ~substring:"1 of 4 recorded" page);
358
Added:
Alcotest.(check bool)
359
Added:
"shows the corrected load" true
360
Added:
(contains ~substring:"16" page) );
361
Added:
( "a saved workout's slot can be corrected from the history view",
362
Added:
`Quick,
363
Added:
fun () ->
364
Added:
let c = client () in
365
Added:
let _ = sign_in_new c in
366
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
367
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
368
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
369
Added:
let _ =
370
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
371
Added:
in
372
Added:
let token =
373
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
374
Added:
in
375
Added:
let _ =
376
Added:
post c "/workout/slots/1"
377
Added:
[
378
Added:
("dream.csrf", token);
379
Added:
("load", "12");
380
Added:
("reps", "8");
381
Added:
("extension", "");
382
Added:
]
383
Added:
in
384
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
385
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
386
Added:
(* The one saved workout is w1 for this trainee. Its recorded slot is
387
Added:
reached through the same [?slot=] tab state. *)
388
Added:
let record_page = body (get c "/history/w1?slot=1") in
389
Added:
Alcotest.(check bool)
390
Added:
"renders a tab strip for the saved workout" true
391
Added:
(contains ~substring:"slot-tabs" record_page);
392
Added:
Alcotest.(check bool)
393
Added:
"offers a saved-slot correction form" true
394
Added:
(contains ~substring:"/history/w1/slots/1/edit" record_page);
395
Added:
let token = Option.get (csrf_token record_page) in
396
Added:
let corrected =
397
Added:
post c "/history/w1/slots/1/edit"
398
Added:
[
399
Added:
("dream.csrf", token);
400
Added:
("load", "20");
401
Added:
("reps", "7");
402
Added:
("extension", "");
403
Added:
]
404
Added:
in
405
Added:
Alcotest.(check int) "corrected" 303 (status corrected);
406
Added:
let record_page = body (get c "/history/w1?slot=1") in
407
Added:
Alcotest.(check bool)
408
Added:
"still one filled slot" true
409
Added:
(contains ~substring:"1 of 4 recorded" record_page);
410
Added:
Alcotest.(check bool)
411
Added:
"shows the corrected load" true
412
Added:
(contains ~substring:"20" record_page) );
413
Added:
( "the workout view shows one slot at a time and defaults to the first \
414
Added:
incomplete slot",
415
Added:
`Quick,
416
Added:
fun () ->
417
Added:
let c = client () in
418
Added:
let _ = sign_in_new c in
419
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
420
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
421
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
422
Added:
let _ =
423
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
424
Added:
in
425
Added:
(* Nothing recorded yet: the default view opens on slot 0 and shows
426
Added:
only slot 0's record form, not slot 1's. *)
427
Added:
let page = body (get c "/workout") in
428
Added:
Alcotest.(check bool)
429
Added:
"shows the first slot's form" true
430
Added:
(contains ~substring:"action=\"/workout/slots/0\"" page);
431
Added:
Alcotest.(check bool)
432
Added:
"does not also show a later slot's form" false
433
Added:
(contains ~substring:"action=\"/workout/slots/1\"" page);
434
Added:
(* Record slot 0. The default now moves to the next incomplete slot,
435
Added:
slot 1. *)
436
Added:
let token = Option.get (csrf_token page) in
437
Added:
let recorded =
438
Added:
post c "/workout/slots/0"
439
Added:
[
440
Added:
("dream.csrf", token);
441
Added:
("iso_load", "10");
442
Added:
("iso_reps", "8");
443
Added:
("comp_load", "40");
444
Added:
("comp_reps", "6");
445
Added:
("extension", "");
446
Added:
]
447
Added:
in
448
Added:
Alcotest.(check int) "recorded slot 0" 303 (status recorded);
449
Added:
let page = body (get c "/workout") in
450
Added:
Alcotest.(check bool)
451
Added:
"default now opens on slot 1's record form" true
452
Added:
(contains ~substring:"action=\"/workout/slots/1\"" page) );
276
453
( "signing out returns the trainee to the sign-in page",
277
454
`Quick,
278
455
fun () ->