[OCaml] High Intensity Training Online
refactor Cross the workout boundary with a view model
The workout view was the deepest entity crossing: it matched on the prescription's delivery to build load/reps form fields, summarized recorded efforts, and read the clearance basis and start time off the Evidence.Workout entity. Move all of that into the controller, which emits a Workout DTO whose slots carry a movement field-spec, a recorded summary, and the ending code. The presenter now renders movements without naming any Evidence, Prescription, Exercise, or Recovery type. describe_stimulus, exercise_label, extension_code_of_effort, and default_slot moved to the controller. Behavior-preserving; 243 tests pass.
lib/web/handlers.ml
@@ -214,6 +214,14 @@
214
214
(Prescription.Workout.stimuli (Evidence.Workout.prescription workout))
215
215
slot
216
216
217
Added:
(* The slot a workout view should open on: the first slot still awaiting a
218
Added:
record, or the first slot when every slot is filled. A caller clamps a
219
Added:
requested slot against the prescription; this supplies the default. *)
220
Added:
let default_slot workout =
221
Added:
match Evidence.Workout.outstanding workout with
222
Added:
| (slot, _) :: _ -> slot
223
Added:
| [] -> 0
224
Added:
217
225
(* The slot a workout view should open on. An explicit [?slot=] query
218
226
wins when it names a real slot; otherwise the view defaults to the first
219
227
incomplete slot. A [?slot=] out of range, or absent, falls back to the
@@ -227,9 +235,148 @@
227
235
| Some raw -> (
228
236
match int_of_string_opt raw with
229
237
| Some slot when slot >= 0 && slot < slot_count -> slot
230
Removed:
| _ -> Pages.default_slot workout)
231
Removed:
| None -> Pages.default_slot workout
238
Added:
| _ -> default_slot workout)
239
Added:
| None -> default_slot workout
232
240
241
Added:
(* Map an [Evidence.Workout.t] into the view-model DTO the presenter renders,
242
Added:
so no Evidence or Prescription type crosses the boundary into Pages. The
243
Added:
same mapping serves the live workout and a saved-record view; the caller
244
Added:
supplies [record_id]/[editing]/[errors] separately. *)
245
Added:
246
Added:
(* The ending code a single-choice form uses, taken from an effort's outcome.
247
Added:
The form offers one ending, so the first extension stands for it. *)
248
Added:
let extension_code_of_effort effort =
249
Added:
match Evidence.Stimulus.Effort.outcome effort with
250
Added:
| Evidence.Stimulus.Positive_failure -> ""
251
Added:
| Evidence.Stimulus.Beyond_failure (first, _) -> (
252
Added:
match first with
253
Added:
| Evidence.Stimulus.Forced_reps -> "forced"
254
Added:
| Evidence.Stimulus.Negatives -> "negatives"
255
Added:
| Evidence.Stimulus.Rest_pause -> "rest-pause"
256
Added:
| Evidence.Stimulus.Static_hold -> "static")
257
Added:
258
Added:
(* One line describing a recorded stimulus: the efforts joined by "into", then
259
Added:
any extensions appended. *)
260
Added:
let describe_stimulus stimulus =
261
Added:
let effort effort =
262
Added:
Format.asprintf "%s %g kg x %d"
263
Added:
(Exercise.name (Evidence.Stimulus.Effort.exercise effort))
264
Added:
(Evidence.Stimulus.Effort.load effort)
265
Added:
(Evidence.Stimulus.Effort.reps effort)
266
Added:
in
267
Added:
let body =
268
Added:
String.concat " into "
269
Added:
(List.map effort (Evidence.Stimulus.efforts stimulus))
270
Added:
in
271
Added:
match Evidence.Stimulus.extensions stimulus with
272
Added:
| [] -> body
273
Added:
| extensions ->
274
Added:
body ^ ", "
275
Added:
^ String.concat " then "
276
Added:
(List.map
277
Added:
(Format.asprintf "%a" Evidence.Stimulus.pp_extension)
278
Added:
extensions)
279
Added:
280
Added:
let workout_view ~active_slot workout : View_model.Workout.t =
281
Added:
let prescription = Evidence.Workout.prescription workout in
282
Added:
let prescribed_slots = Prescription.Workout.stimuli prescription in
283
Added:
(* One entry per filled slot, the first fill in performance order — the fill
284
Added:
[replace_stimulus] keeps in place when a correction lands. *)
285
Added:
let filled =
286
Added:
List.fold_left
287
Added:
(fun acc (slot, stimulus) ->
288
Added:
if List.mem_assoc slot acc then acc else acc @ [ (slot, stimulus) ])
289
Added:
[]
290
Added:
(Evidence.Workout.performed workout)
291
Added:
in
292
Added:
let load_string load = Printf.sprintf "%g" load in
293
Added:
let reps_string reps = string_of_int reps in
294
Added:
let label p =
295
Added:
match Prescription.Stimulus.delivery p with
296
Added:
| Prescription.Stimulus.Single e -> Exercise.name e
297
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
298
Added:
Printf.sprintf "%s + %s" (Exercise.name isolation)
299
Added:
(Exercise.name compound)
300
Added:
in
301
Added:
let slot_view index p : View_model.Workout.slot =
302
Added:
let recorded = List.assoc_opt index filled in
303
Added:
let efforts = Option.map Evidence.Stimulus.efforts recorded in
304
Added:
let nth n = Option.bind efforts (fun es -> List.nth_opt es n) in
305
Added:
let load_of n =
306
Added:
Option.map
307
Added:
(fun e -> load_string (Evidence.Stimulus.Effort.load e))
308
Added:
(nth n)
309
Added:
in
310
Added:
let reps_of n =
311
Added:
Option.map
312
Added:
(fun e -> reps_string (Evidence.Stimulus.Effort.reps e))
313
Added:
(nth n)
314
Added:
in
315
Added:
let movements : View_model.Workout.movement list =
316
Added:
match Prescription.Stimulus.delivery p with
317
Added:
| Prescription.Stimulus.Single exercise ->
318
Added:
[
319
Added:
{
320
Added:
name = Exercise.name exercise;
321
Added:
load_field = "load";
322
Added:
reps_field = "reps";
323
Added:
reps_label = "Reps to failure";
324
Added:
load_value = load_of 0;
325
Added:
reps_value = reps_of 0;
326
Added:
};
327
Added:
]
328
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
329
Added:
[
330
Added:
{
331
Added:
name = Exercise.name isolation;
332
Added:
load_field = "iso_load";
333
Added:
reps_field = "iso_reps";
334
Added:
reps_label = "Reps";
335
Added:
load_value = load_of 0;
336
Added:
reps_value = reps_of 0;
337
Added:
};
338
Added:
{
339
Added:
name = Exercise.name compound;
340
Added:
load_field = "comp_load";
341
Added:
reps_field = "comp_reps";
342
Added:
reps_label = "Reps";
343
Added:
load_value = load_of 1;
344
Added:
reps_value = reps_of 1;
345
Added:
};
346
Added:
]
347
Added:
in
348
Added:
let selected_extension =
349
Added:
match recorded with
350
Added:
| None -> ""
351
Added:
| Some s -> (
352
Added:
(* The ending lives on the last effort (the compound of a pair). *)
353
Added:
match List.rev (Evidence.Stimulus.efforts s) with
354
Added:
| last :: _ -> extension_code_of_effort last
355
Added:
| [] -> "")
356
Added:
in
357
Added:
{
358
Added:
index;
359
Added:
label = label p;
360
Added:
movements;
361
Added:
recorded_summary = Option.map describe_stimulus recorded;
362
Added:
selected_extension;
363
Added:
}
364
Added:
in
365
Added:
let overridden =
366
Added:
match Recovery.basis (Evidence.Workout.clearance workout) with
367
Added:
| Recovery.Overridden _ -> true
368
Added:
| Recovery.Recovered -> false
369
Added:
in
370
Added:
{
371
Added:
name = Prescription.Workout.name prescription;
372
Added:
slots = List.mapi slot_view prescribed_slots;
373
Added:
active_slot;
374
Added:
started_at_unix =
375
Added:
Recovery.timestamp_to_unix_seconds (Evidence.Workout.started_at workout);
376
Added:
overridden;
377
Added:
all_recorded = Evidence.Workout.outstanding workout = [];
378
Added:
}
379
Added:
233
380
let save_current t trainee stimulus =
234
381
Service.log t.service trainee stimulus >|= function
235
382
| Ok _ -> Ok ()
@@ -436,10 +583,10 @@
436
583
in
437
584
Service.in_progress t.service trainee.Trainee.id >>= function
438
585
| Some workout ->
586
Added:
let active_slot = active_slot request workout in
439
587
html
440
Removed:
(Pages.workout request ~viewer ~record_id:None
441
Removed:
~active_slot:(active_slot request workout)
442
Removed:
workout)
588
Added:
(Pages.workout request ~viewer ~record_id:None ~active_slot
589
Added:
(workout_view ~active_slot workout))
443
590
| None -> redirect_to request Routes.home
444
591
445
592
let log t trainee request slot =
@@ -785,12 +932,12 @@
785
932
record_target t trainee.Trainee.id id >>= function
786
933
| None -> not_found Present.unknown_record
787
934
| Some (_, workout) ->
935
Added:
let active_slot = active_slot request workout in
788
936
html
789
937
(Pages.workout request ~viewer
790
938
~logging:(Option.is_some in_progress)
791
Removed:
~record_id:(Some id)
792
Removed:
~active_slot:(active_slot request workout)
793
Removed:
workout)
939
Added:
~record_id:(Some id) ~active_slot
940
Added:
(workout_view ~active_slot workout))
794
941
795
942
let log t trainee request id slot =
796
943
record_target t trainee.Trainee.id id >>= function
lib/web/pages.ml
@@ -688,70 +688,44 @@
688
688
tag "span" [ class_ "col-heading" ] [ txt "%s" reps_label ];
689
689
]
690
690
691
Removed:
(* A recorded number, rendered the way a numeric input expects. *)
692
Removed:
let load_string load = Printf.sprintf "%g" load
693
Removed:
let reps_string reps = string_of_int reps
694
Removed:
695
Removed:
(* The extension code the single-choice form uses, taken from an effort's
696
Removed:
outcome. The form offers one ending, so the first extension stands for it. *)
697
Removed:
let extension_code_of_effort effort =
698
Removed:
match Evidence.Stimulus.Effort.outcome effort with
699
Removed:
| Evidence.Stimulus.Positive_failure -> ""
700
Removed:
| Evidence.Stimulus.Beyond_failure (first, _) -> (
701
Removed:
match first with
702
Removed:
| Evidence.Stimulus.Forced_reps -> "forced"
703
Removed:
| Evidence.Stimulus.Negatives -> "negatives"
704
Removed:
| Evidence.Stimulus.Rest_pause -> "rest-pause"
705
Removed:
| Evidence.Stimulus.Static_hold -> "static")
706
Removed:
707
Removed:
(* [recorded] pre-fills the form when correcting a slot; [submit] names the
691
Added:
(* [movements] carries the record/correction field spec the controller built
692
Added:
from the slot's prescription: one row for a single exercise, two for a
693
Added:
pre-exhaust pair, each already pre-filled when correcting. [submit] names the
708
694
action. Load and reps of each movement are laid out side by side. *)
709
Removed:
let form_for_stimulus request ~action_path ~slot ~prescription ?recorded
695
Added:
let form_for_stimulus request ~action_path ~slot
696
Added:
~(movements : View_model.Workout.movement list) ~selected_extension
710
697
?(enhanced = false) ?(submit = "Record") ~(errors : (string * string) list)
711
698
() =
712
699
let field_id field = Printf.sprintf "slot-%d-%s" slot field in
713
Removed:
let efforts = Option.map Evidence.Stimulus.efforts recorded in
714
Removed:
let nth n = Option.bind efforts (fun es -> List.nth_opt es n) in
715
Removed:
let load_of n =
716
Removed:
Option.map (fun e -> load_string (Evidence.Stimulus.Effort.load e)) (nth n)
717
Removed:
in
718
Removed:
let reps_of n =
719
Removed:
Option.map (fun e -> reps_string (Evidence.Stimulus.Effort.reps e)) (nth n)
720
Removed:
in
721
Removed:
let selected =
722
Removed:
match recorded with
723
Removed:
| None -> ""
724
Removed:
| Some s -> (
725
Removed:
(* The ending lives on the last effort (the compound of a pair). *)
726
Removed:
match List.rev (Evidence.Stimulus.efforts s) with
727
Removed:
| last :: _ -> extension_code_of_effort last
728
Removed:
| [] -> "")
729
Removed:
in
730
Removed:
let fields =
731
Removed:
match Prescription.Stimulus.delivery prescription with
732
Removed:
| Prescription.Stimulus.Single exercise ->
700
Added:
let selected = selected_extension in
701
Added:
(* A single-exercise slot shows one row with a visible "Reps to failure"
702
Added:
label; a pre-exhaust pair shows a shared column heading and hides the
703
Added:
per-row labels. *)
704
Added:
let hide_labels = List.length movements > 1 in
705
Added:
let head =
706
Added:
match movements with
707
Added:
| first :: _ :: _ ->
733
708
[
734
Removed:
movement_row ~errors ~name:(Exercise.name exercise)
735
Removed:
~load_id:(field_id "load") ~load_field:"load"
736
Removed:
~reps_id:(field_id "reps") ~reps_field:"reps"
737
Removed:
?load_value:(load_of 0) ?reps_value:(reps_of 0)
738
Removed:
~reps_label:"Reps to failure" ();
709
Added:
exercise_fields_head ~reps_label:first.View_model.Workout.reps_label
710
Added:
();
739
711
]
740
Removed:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
741
Removed:
[
742
Removed:
exercise_fields_head ~reps_label:"Reps" ();
743
Removed:
movement_row ~errors ~name:(Exercise.name isolation)
744
Removed:
~load_id:(field_id "iso_load") ~load_field:"iso_load"
745
Removed:
~reps_id:(field_id "iso_reps") ~reps_field:"iso_reps"
746
Removed:
?load_value:(load_of 0) ?reps_value:(reps_of 0) ~reps_label:"Reps"
747
Removed:
~hide_labels:true ();
748
Removed:
movement_row ~errors ~name:(Exercise.name compound)
749
Removed:
~load_id:(field_id "comp_load") ~load_field:"comp_load"
750
Removed:
~reps_id:(field_id "comp_reps") ~reps_field:"comp_reps"
751
Removed:
?load_value:(load_of 1) ?reps_value:(reps_of 1) ~reps_label:"Reps"
752
Removed:
~hide_labels:true ();
753
Removed:
]
712
Added:
| _ -> []
754
713
in
714
Added:
let movement_of (m : View_model.Workout.movement) =
715
Added:
movement_row ~errors ~name:m.name ~load_id:(field_id m.load_field)
716
Added:
~load_field:m.load_field ~reps_id:(field_id m.reps_field)
717
Added:
~reps_field:m.reps_field ?load_value:m.load_value ?reps_value:m.reps_value
718
Added:
~reps_label:m.reps_label ~hide_labels ()
719
Added:
in
720
Added:
let fields = head @ List.map movement_of movements in
721
Added:
(* The error rows follow the fields present, so a single-exercise slot reports
722
Added:
load/reps and a pre-exhaust slot reports the iso/comp fields. *)
723
Added:
let field_names =
724
Added:
List.concat_map
725
Added:
(fun (m : View_model.Workout.movement) -> [ m.load_field; m.reps_field ])
726
Added:
movements
727
Added:
@ [ "extension" ]
728
Added:
in
755
729
tag "form"
756
730
([ action_path; post_form ]
757
731
@
@@ -780,62 +754,28 @@
780
754
])
781
755
:: List.concat_map
782
756
(fun field -> error_for ~input_id:(field_id field) field errors)
783
Removed:
[
784
Removed:
"load";
785
Removed:
"reps";
786
Removed:
"iso_load";
787
Removed:
"iso_reps";
788
Removed:
"comp_load";
789
Removed:
"comp_reps";
790
Removed:
"extension";
791
Removed:
]
757
Added:
field_names
792
758
@ [
793
759
void "input"
794
760
[ type_ "submit"; Dream_html.string_attr "value" "%s" submit ];
795
761
]);
796
762
]
797
763
798
Removed:
let describe_stimulus stimulus =
799
Removed:
let effort effort =
800
Removed:
Format.asprintf "%s %g kg x %d"
801
Removed:
(Exercise.name (Evidence.Stimulus.Effort.exercise effort))
802
Removed:
(Evidence.Stimulus.Effort.load effort)
803
Removed:
(Evidence.Stimulus.Effort.reps effort)
804
Removed:
in
805
Removed:
let body =
806
Removed:
String.concat " into "
807
Removed:
(List.map effort (Evidence.Stimulus.efforts stimulus))
808
Removed:
in
809
Removed:
match Evidence.Stimulus.extensions stimulus with
810
Removed:
| [] -> body
811
Removed:
| extensions ->
812
Removed:
body ^ ", "
813
Removed:
^ String.concat " then "
814
Removed:
(List.map
815
Removed:
(Format.asprintf "%a" Evidence.Stimulus.pp_extension)
816
Removed:
extensions)
817
Removed:
818
Removed:
(* A short label for a slot's exercise button, drawn from its prescription. A
819
Removed:
pre-exhaust slot names both movements so the button stays legible. *)
820
Removed:
let exercise_label prescription =
821
Removed:
match Prescription.Stimulus.delivery prescription with
822
Removed:
| Prescription.Stimulus.Single exercise -> Exercise.name exercise
823
Removed:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
824
Removed:
Printf.sprintf "%s + %s" (Exercise.name isolation)
825
Removed:
(Exercise.name compound)
826
Removed:
827
764
let workout request ~viewer ?(errors = []) ?editing ?logging ~record_id
828
Removed:
~active_slot workout =
765
Added:
~active_slot (vm : View_model.Workout.t) =
829
766
let enhanced = Option.is_none record_id in
830
767
(* A live workout view is itself the workout in progress, so the middle nav
831
768
action reads "Current workout". A saved-record view defers to the handler,
832
769
which knows whether a separate workout is in progress. *)
833
770
let logging = Option.value logging ~default:enhanced in
834
Removed:
let prescription = Evidence.Workout.prescription workout in
835
Removed:
let performed = Evidence.Workout.performed workout in
836
Removed:
let prescribed_slots = Prescription.Workout.stimuli prescription in
837
Removed:
let slot_count = List.length prescribed_slots in
838
Removed:
let outstanding = Evidence.Workout.outstanding workout in
771
Added:
let slot_count = List.length vm.slots in
772
Added:
let filled_slots =
773
Added:
List.length
774
Added:
(List.filter
775
Added:
(fun (s : View_model.Workout.slot) ->
776
Added:
Option.is_some s.recorded_summary)
777
Added:
vm.slots)
778
Added:
in
839
779
let record_action slot =
840
780
match record_id with
841
781
| None -> action Routes.workout_slot slot
@@ -852,30 +792,19 @@
852
792
it briefly then dismisses it. Without script it stays visible as a quiet
853
793
fixed notice, so a no-JS visitor is still told. *)
854
794
let override_note =
855
Removed:
match Recovery.basis (Evidence.Workout.clearance workout) with
856
Removed:
| Recovery.Recovered -> []
857
Removed:
| Recovery.Overridden _ ->
858
Removed:
[
859
Removed:
tag "div"
860
Removed:
[
861
Removed:
class_ "toast";
862
Removed:
Dream_html.attr "data-hito-toast";
863
Removed:
Dream_html.string_attr "role" "status";
864
Removed:
Dream_html.string_attr "aria-live" "polite";
865
Removed:
]
866
Removed:
[ txt "Begun before recovery finished." ];
867
Removed:
]
795
Added:
if vm.overridden then
796
Added:
[
797
Added:
tag "div"
798
Added:
[
799
Added:
class_ "toast";
800
Added:
Dream_html.attr "data-hito-toast";
801
Added:
Dream_html.string_attr "role" "status";
802
Added:
Dream_html.string_attr "aria-live" "polite";
803
Added:
]
804
Added:
[ txt "Begun before recovery finished." ];
805
Added:
]
806
Added:
else []
868
807
in
869
Removed:
(* One entry per filled slot, the first fill in performance order — the fill
870
Removed:
[replace_stimulus] keeps in place when a correction lands. *)
871
Removed:
let filled =
872
Removed:
List.fold_left
873
Removed:
(fun acc (slot, stimulus) ->
874
Removed:
if List.mem_assoc slot acc then acc else acc @ [ (slot, stimulus) ])
875
Removed:
[] performed
876
Removed:
in
877
Removed:
let recorded_at slot = List.assoc_opt slot filled in
878
Removed:
let is_recorded slot = Option.is_some (recorded_at slot) in
879
808
(* The exercise selector: a dropdown naming every prescription slot. Choosing
880
809
an option opens that exercise below. The selector is a GET form so it works
881
810
without script — submitting navigates to the slot via a [?slot=] query, the
@@ -886,16 +815,15 @@
886
815
match record_id with None -> "/workout" | Some id -> "/logbook/" ^ id
887
816
in
888
817
let exercise_group =
889
Removed:
let option_for slot p =
890
Removed:
let done_ = is_recorded slot in
818
Added:
let option_for (slot : View_model.Workout.slot) =
819
Added:
let done_ = Option.is_some slot.recorded_summary in
891
820
let label =
892
Removed:
if done_ then
893
Removed:
Printf.sprintf "%d. %s (done)" (slot + 1) (exercise_label p)
894
Removed:
else Printf.sprintf "%d. %s" (slot + 1) (exercise_label p)
821
Added:
if done_ then Printf.sprintf "%d. %s (done)" (slot.index + 1) slot.label
822
Added:
else Printf.sprintf "%d. %s" (slot.index + 1) slot.label
895
823
in
896
Removed:
let attrs = [ Dream_html.string_attr "value" "%d" slot ] in
824
Added:
let attrs = [ Dream_html.string_attr "value" "%d" slot.index ] in
897
825
let attrs =
898
Removed:
if slot = active_slot then Dream_html.attr "selected" :: attrs
826
Added:
if slot.index = active_slot then Dream_html.attr "selected" :: attrs
899
827
else attrs
900
828
in
901
829
tag "option" attrs [ txt "%s" label ]
@@ -922,7 +850,7 @@
922
850
id "exercise-choice";
923
851
Dream_html.attr "data-hito-exercise-select";
924
852
]
925
Removed:
(List.mapi option_for prescribed_slots);
853
Added:
(List.map option_for vm.slots);
926
854
void "input"
927
855
[
928
856
type_ "submit"; class_ "secondary exercise-select-go"; value "Open";
@@ -934,39 +862,40 @@
934
862
replaces the slot rather than adding volume); an outstanding slot renders
935
863
the record form. *)
936
864
let active_panel =
937
Removed:
match List.nth_opt prescribed_slots active_slot with
865
Added:
match List.nth_opt vm.slots active_slot with
938
866
| None ->
939
867
[
940
868
tag "p"
941
869
[ class_ "warn" ]
942
870
[ txt "That exercise is not part of this workout." ];
943
871
]
944
Removed:
| Some prescription ->
872
Added:
| Some (slot : View_model.Workout.slot) ->
945
873
let errors = if editing = Some active_slot then errors else [] in
946
Removed:
let heading = tag "h2" [] [ txt "%s" (exercise_label prescription) ] in
874
Added:
let heading = tag "h2" [] [ txt "%s" slot.label ] in
947
875
let body =
948
Removed:
match recorded_at active_slot with
949
Removed:
| Some stimulus ->
876
Added:
match slot.recorded_summary with
877
Added:
| Some summary ->
950
878
[
951
879
tag "p" [ class_ "eyebrow" ] [ txt "Recorded" ];
952
Removed:
tag "p"
953
Removed:
[ class_ "done" ]
954
Removed:
[ txt "%s" (describe_stimulus stimulus) ];
880
Added:
tag "p" [ class_ "done" ] [ txt "%s" summary ];
955
881
form_for_stimulus request ~action_path:(edit_action active_slot)
956
Removed:
~slot:active_slot ~prescription ~enhanced ~recorded:stimulus
882
Added:
~slot:active_slot ~movements:slot.movements
883
Added:
~selected_extension:slot.selected_extension ~enhanced
957
884
~submit:"Save correction" ~errors ();
958
885
]
959
886
| None ->
960
887
[
961
888
form_for_stimulus request
962
889
~action_path:(record_action active_slot)
963
Removed:
~slot:active_slot ~prescription ~enhanced ~errors ();
890
Added:
~slot:active_slot ~movements:slot.movements
891
Added:
~selected_extension:slot.selected_extension ~enhanced ~errors
892
Added:
();
964
893
]
965
894
in
966
895
[ tag "section" [ class_ "slot-panel" ] (heading :: body) ]
967
896
in
968
897
let complete_note =
969
Removed:
if outstanding = [] then
898
Added:
if vm.all_recorded then
970
899
[
971
900
tag "p"
972
901
[ class_ "done" ]
@@ -980,9 +909,7 @@
980
909
resets the count. Only the live workout shows it. *)
981
910
let timer_bar =
982
911
if enhanced then
983
Removed:
let started =
984
Removed:
Recovery.timestamp_to_unix_seconds (Evidence.Workout.started_at workout)
985
Removed:
in
912
Added:
let started = vm.started_at_unix in
986
913
[
987
914
tag "div"
988
915
[
@@ -1077,8 +1004,7 @@
1077
1004
];
1078
1005
]
1079
1006
in
1080
Removed:
html_page ~viewer ~request ~active:"workout" ~logging
1081
Removed:
(Prescription.Workout.name prescription)
1007
Added:
html_page ~viewer ~request ~active:"workout" ~logging vm.name
1082
1008
[
1083
1009
tag "div"
1084
1010
(if enhanced then
@@ -1089,14 +1015,10 @@
1089
1015
else [])
1090
1016
(timer_bar @ override_note
1091
1017
@ [
1092
Removed:
tag "h1" [] [ txt "%s" (Prescription.Workout.name prescription) ];
1018
Added:
tag "h1" [] [ txt "%s" vm.name ];
1093
1019
tag "p"
1094
1020
[ class_ "ledger-meta" ]
1095
Removed:
[
1096
Removed:
txt "%d of %d recorded."
1097
Removed:
(Evidence.Workout.filled_slots workout)
1098
Removed:
slot_count;
1099
Removed:
];
1021
Added:
[ txt "%d of %d recorded." filled_slots slot_count ];
1100
1022
exercise_group;
1101
1023
]
1102
1024
@ active_panel @ complete_note @ finish_section
@@ -1112,14 +1034,6 @@
1112
1034
]
1113
1035
else []);
1114
1036
]
1115
Removed:
1116
Removed:
(* The slot a workout view should open on: the first slot still awaiting
1117
Removed:
a record, or the first slot when every slot is filled. A caller clamps a
1118
Removed:
requested slot against the prescription; this supplies the default. *)
1119
Removed:
let default_slot workout =
1120
Removed:
match Evidence.Workout.outstanding workout with
1121
Removed:
| (slot, _) :: _ -> slot
1122
Removed:
| [] -> 0
1123
1037
1124
1038
(* The subjective feedback form. Leveled selects report sleep, appetite,
1125
1039
readiness, motivation, and difficulty against a personal baseline; flags
lib/web/pages.mli
@@ -38,20 +38,17 @@
38
38
?logging:bool ->
39
39
record_id:string option ->
40
40
active_slot:int ->
41
Removed:
Evidence.Workout.t ->
41
Added:
View_model.Workout.t ->
42
42
page
43
43
(** Renders one prescribed slot at a time under a vertical group of named
44
44
exercise buttons. Authenticated pages carry generic progressive-enhancement
45
45
markers; current workouts additionally mark slot links and forms, while
46
46
saved-record edits use the generic authenticated form path. [active_slot]
47
Removed:
button; a handler clamps a requested slot and falls back to {!default_slot}.
48
Removed:
[record_id] is [None] for the workout in progress and [Some id] for a saved
49
Removed:
history record. [logging] sets the middle navigation action; it defaults to
50
Removed:
a live workout view (true when [record_id] is [None]). *)
51
Removed:
52
Removed:
val default_slot : Evidence.Workout.t -> int
53
Removed:
(** The slot a workout view opens on: the first slot still awaiting a record, or
54
Removed:
the first slot when every slot is filled. *)
47
Added:
button; a handler clamps a requested slot and falls back to the first
48
Added:
outstanding slot. [record_id] is [None] for the workout in progress and
49
Added:
[Some id] for a saved history record. [logging] sets the middle navigation
50
Added:
action; it defaults to a live workout view (true when [record_id] is
51
Added:
[None]). *)
55
52
56
53
type feedback_flow = { step : int; answers : (string * string) list }
57
54
lib/web/view_model.ml
@@ -101,6 +101,10 @@
101
101
(** [Some description] once the slot is filled; [None] while
102
102
outstanding. Drives the recorded/outstanding branch without an
103
103
entity. *)
104
Added:
selected_extension : string;
105
Added:
(** The ending code to pre-select when correcting a recorded slot ("",
106
Added:
"forced", "negatives", "rest-pause", "static"). "" for an
107
Added:
outstanding slot. *)
104
108
}
105
109
106
110
type t = {