[OCaml] High Intensity Training Online
fix Suggest prior in-range workout load
Changed files
lib/web/handlers_kit.ml
@@ -386,10 +386,21 @@
386
386
match List.rev (Evidence.Log.observations log exercise) with
387
387
| latest :: _ ->
388
388
let e = Evidence.Observation.effort latest in
389
Added:
let reps = Evidence.Stimulus.Effort.reps e in
389
390
( Some (load_string (Evidence.Stimulus.Effort.load e)),
390
Removed:
Some (reps_string (Evidence.Stimulus.Effort.reps e)) )
391
Removed:
| [] -> (None, None)
391
Added:
Some (reps_string reps),
392
Added:
Some reps )
393
Added:
| [] -> (None, None, None)
392
394
in
395
Added:
let suggested_load p ~previous_load ~previous_reps =
396
Added:
match (previous_load, previous_reps) with
397
Added:
| Some load, Some reps ->
398
Added:
let minimum, maximum =
399
Added:
Prescription.Rep_range.bounds (Prescription.Stimulus.rep_range p)
400
Added:
in
401
Added:
if reps >= minimum && reps <= maximum then Some load else None
402
Added:
| _ -> None
403
Added:
in
393
404
let label p =
394
405
match Prescription.Stimulus.delivery p with
395
406
| Prescription.Stimulus.Single e -> Exercise.name e
@@ -411,32 +422,48 @@
411
422
(fun e -> reps_string (Evidence.Stimulus.Effort.reps e))
412
423
(nth n)
413
424
in
425
Added:
let suggested_or_recorded_load n ~previous_load ~previous_reps =
426
Added:
match load_of n with
427
Added:
| Some load -> Some load
428
Added:
| None -> suggested_load p ~previous_load ~previous_reps
429
Added:
in
414
430
let movements : View_model.Workout.movement list =
415
431
match Prescription.Stimulus.delivery p with
416
432
| Prescription.Stimulus.Single exercise ->
417
Removed:
let previous_load, previous_reps = previous_of exercise in
433
Added:
let previous_load, previous_reps, previous_rep_count =
434
Added:
previous_of exercise
435
Added:
in
418
436
[
419
437
{
420
438
name = Exercise.name exercise;
421
439
load_field = "load";
422
440
reps_field = "reps";
423
441
reps_label = "Reps to failure";
424
Removed:
load_value = load_of 0;
442
Added:
load_value =
443
Added:
suggested_or_recorded_load 0 ~previous_load
444
Added:
~previous_reps:previous_rep_count;
425
445
reps_value = reps_of 0;
426
446
previous_load;
427
447
previous_reps;
428
448
};
429
449
]
430
450
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
431
Removed:
let iso_previous_load, iso_previous_reps = previous_of isolation in
432
Removed:
let comp_previous_load, comp_previous_reps = previous_of compound in
451
Added:
let iso_previous_load, iso_previous_reps, iso_previous_rep_count =
452
Added:
previous_of isolation
453
Added:
in
454
Added:
let comp_previous_load, comp_previous_reps, comp_previous_rep_count
455
Added:
=
456
Added:
previous_of compound
457
Added:
in
433
458
[
434
459
{
435
460
name = Exercise.name isolation;
436
461
load_field = "iso_load";
437
462
reps_field = "iso_reps";
438
463
reps_label = "Reps";
439
Removed:
load_value = load_of 0;
464
Added:
load_value =
465
Added:
suggested_or_recorded_load 0 ~previous_load:iso_previous_load
466
Added:
~previous_reps:iso_previous_rep_count;
440
467
reps_value = reps_of 0;
441
468
previous_load = iso_previous_load;
442
469
previous_reps = iso_previous_reps;
@@ -446,7 +473,9 @@
446
473
load_field = "comp_load";
447
474
reps_field = "comp_reps";
448
475
reps_label = "Reps";
449
Removed:
load_value = load_of 1;
476
Added:
load_value =
477
Added:
suggested_or_recorded_load 1 ~previous_load:comp_previous_load
478
Added:
~previous_reps:comp_previous_rep_count;
450
479
reps_value = reps_of 1;
451
480
previous_load = comp_previous_load;
452
481
previous_reps = comp_previous_reps;
test/web/workout.ml
@@ -216,10 +216,26 @@
216
216
| Some w -> Evidence.Workout.filled_slots w
217
217
| None -> Alcotest.failf "expected a workout in progress"
218
218
in
219
Removed:
Alcotest.(check int) "one filled slot" 1 (filled_after_record ());
220
Removed:
let token =
221
Removed:
Option.get (csrf_token (body (get c "/workout?slot=1")))
219
Added:
let slot1_effort () =
220
Added:
match
221
Added:
Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id)
222
Added:
with
223
Added:
| Some w -> (
224
Added:
match List.assoc_opt 1 (Evidence.Workout.performed w) with
225
Added:
| Some s -> List.hd (Evidence.Stimulus.efforts s)
226
Added:
| None -> Alcotest.failf "expected slot 1 to be filled")
227
Added:
| None -> Alcotest.failf "expected a workout in progress"
222
228
in
229
Added:
Alcotest.(check int) "one filled slot" 1 (filled_after_record ());
230
Added:
let edit_page = body (get c "/workout?slot=1") in
231
Added:
let before_edit = slot1_effort () in
232
Added:
Alcotest.(check (float 0.001))
233
Added:
"opening correction keeps the saved load" 12.
234
Added:
(Evidence.Stimulus.Effort.load before_edit);
235
Added:
Alcotest.(check int)
236
Added:
"opening correction keeps the saved reps" 8
237
Added:
(Evidence.Stimulus.Effort.reps before_edit);
238
Added:
let token = Option.get (csrf_token edit_page) in
223
239
let corrected =
224
240
post c "/workout/slots/1/edit"
225
241
[
@@ -234,16 +250,6 @@
234
250
Alcotest.(check int)
235
251
"still one filled slot, not two" 1 (filled_after_record ());
236
252
(* The stored slot now holds the corrected values, not the originals. *)
237
Removed:
let slot1_effort () =
238
Removed:
match
239
Removed:
Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id)
240
Removed:
with
241
Removed:
| Some w -> (
242
Removed:
match List.assoc_opt 1 (Evidence.Workout.performed w) with
243
Removed:
| Some s -> List.hd (Evidence.Stimulus.efforts s)
244
Removed:
| None -> Alcotest.failf "expected slot 1 to be filled")
245
Removed:
| None -> Alcotest.failf "expected a workout in progress"
246
Removed:
in
247
253
let effort = slot1_effort () in
248
254
Alcotest.(check (float 0.001))
249
255
"load updated to the corrected value" 16.
@@ -612,5 +618,84 @@
612
618
(List.length
613
619
(Lwt_main.run (Test_repo.history repo trainee.Trainee.id))
614
620
>= 1) );
621
Added:
( "an in-range previous effort suggests its load",
622
Added:
`Quick,
623
Added:
fun () ->
624
Added:
let c, now, _repo = clocked_client () in
625
Added:
now := day 10;
626
Added:
let _ = sign_in_new c in
627
Added:
let _ = start_day_one c in
628
Added:
let record slot fields =
629
Added:
let token =
630
Added:
Option.get (csrf_token (body (get c ("/workout?slot=" ^ slot))))
631
Added:
in
632
Added:
let _ =
633
Added:
post c ("/workout/slots/" ^ slot)
634
Added:
(("dream.csrf", token) :: fields)
635
Added:
in
636
Added:
()
637
Added:
in
638
Added:
record "0"
639
Added:
[
640
Added:
("iso_load", "20");
641
Added:
("iso_reps", "9");
642
Added:
("comp_load", "60");
643
Added:
("comp_reps", "7");
644
Added:
("extension", "");
645
Added:
];
646
Added:
(* Laterals failed above the 6-10 guideline. Its prior load remains
647
Added:
visible but is not suggested. Rear deltoid laterals failed inside
648
Added:
the range, so its prior load is suggested on the next Day 1. *)
649
Added:
record "1" [ ("load", "12"); ("reps", "11"); ("extension", "") ];
650
Added:
record "2" [ ("load", "10"); ("reps", "8"); ("extension", "") ];
651
Added:
record "3"
652
Added:
[
653
Added:
("iso_load", "20");
654
Added:
("iso_reps", "9");
655
Added:
("comp_load", "0");
656
Added:
("comp_reps", "7");
657
Added:
("extension", "");
658
Added:
];
659
Added:
let finish () =
660
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
661
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
662
Added:
()
663
Added:
in
664
Added:
finish ();
665
Added:
let rec reach_day_one attempts d =
666
Added:
if attempts = 0 then Alcotest.failf "Day 1 did not recur"
667
Added:
else begin
668
Added:
now := day d;
669
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
670
Added:
let _ =
671
Added:
post c "/workout"
672
Added:
[ ("dream.csrf", token); ("override", "false") ]
673
Added:
in
674
Added:
let page = body (get c "/workout") in
675
Added:
if Option.is_some (index_from ~needle:"Day 1" page 0) then page
676
Added:
else begin
677
Added:
record_all_day_one_slots c;
678
Added:
finish ();
679
Added:
reach_day_one (attempts - 1) (d + 3)
680
Added:
end
681
Added:
end
682
Added:
in
683
Added:
let page = reach_day_one 6 13 in
684
Added:
Alcotest.(check bool)
685
Added:
"an in-range prior load is pre-filled" true
686
Added:
(Option.is_some
687
Added:
(index_from
688
Added:
~needle:
689
Added:
"name=\"load\" id=\"slot-2-load\" step=\"0.5\" required \
690
Added:
value=\"10\""
691
Added:
page 0));
692
Added:
Alcotest.(check bool)
693
Added:
"an out-of-range prior load is not pre-filled" true
694
Added:
(Option.is_none
695
Added:
(index_from
696
Added:
~needle:
697
Added:
"name=\"load\" id=\"slot-1-load\" step=\"0.5\" required \
698
Added:
value=\"12\""
699
Added:
page 0)) );
615
700
] );
616
701
]