[OCaml] High Intensity Training Online
refactor Cross the home and routine boundaries with view models
The home, choose_routine, and routine presenters took Prescription routines and workouts, a Recovery readiness, and a routine_id, reading names, rep bands, the workout count, and the recovery gate straight from the entities. Add Home, Routine, and Routine_choice DTOs, decide the gate and phrase the rep bands in the controller, and have Pages render only the DTOs. The three pages now name no Prescription or Recovery entity. The pure formatters they shared moved into the controller (the workout view had its own), removing dead code. 243 tests pass.
lib/web/handlers.ml
@@ -251,6 +251,67 @@
251
251
| Error e -> Error (Present.edit_error e)
252
252
253
253
module Overview = struct
254
Added:
(* Map service entities into the view-model DTOs the presenter renders, so
255
Added:
no Prescription or Recovery type crosses the boundary into Pages. These
256
Added:
replicate the phrasing the shared presenter formatters use. *)
257
Added:
let routine_choice_view
258
Added:
((rid, r) : Repository.routine_id * Prescription.Routine.t) :
259
Added:
View_model.Routine_choice.t =
260
Added:
{
261
Added:
id = (rid :> string);
262
Added:
name = Prescription.Routine.name r;
263
Added:
workout_count = List.length (Prescription.Routine.workouts r);
264
Added:
}
265
Added:
266
Added:
let exercise_string prescription =
267
Added:
match Prescription.Stimulus.delivery prescription with
268
Added:
| Prescription.Stimulus.Single exercise -> Exercise.name exercise
269
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
270
Added:
Printf.sprintf "%s into %s, no pause" (Exercise.name isolation)
271
Added:
(Exercise.name compound)
272
Added:
273
Added:
let reps_string prescription =
274
Added:
let min_reps, max_reps =
275
Added:
Prescription.Rep_range.bounds
276
Added:
(Prescription.Stimulus.rep_range prescription)
277
Added:
in
278
Added:
Printf.sprintf "%d-%d reps" min_reps max_reps
279
Added:
280
Added:
let routine_view r : View_model.Routine.t =
281
Added:
{
282
Added:
name = Prescription.Routine.name r;
283
Added:
workouts =
284
Added:
List.map
285
Added:
(fun w : View_model.Routine.workout ->
286
Added:
{
287
Added:
name = Prescription.Workout.name w;
288
Added:
exercises =
289
Added:
List.map
290
Added:
(fun s : View_model.Routine.exercise ->
291
Added:
{ name = exercise_string s; reps = reps_string s })
292
Added:
(Prescription.Workout.stimuli w);
293
Added:
})
294
Added:
(Prescription.Routine.workouts r);
295
Added:
}
296
Added:
297
Added:
let home_view ~(routine : Repository.routine_id) ~routine_name ~next
298
Added:
~readiness : View_model.Home.t =
299
Added:
{
300
Added:
routine_id = (routine :> string);
301
Added:
routine_name;
302
Added:
next_workout = Prescription.Workout.name next;
303
Added:
gate =
304
Added:
(match readiness with
305
Added:
| Recovery.Ready -> View_model.Home.Ready
306
Added:
| Recovery.Recovering { rested; recommended } ->
307
Added:
View_model.Home.Recovering
308
Added:
{
309
Added:
status =
310
Added:
Format.asprintf "Recovery: %a of %a." Recovery.pp_duration
311
Added:
rested Recovery.pp_duration recommended;
312
Added:
});
313
Added:
}
314
Added:
254
315
let page t trainee request =
255
316
let viewer =
256
317
{
@@ -269,7 +330,9 @@
269
330
| None ->
270
331
Lwt.return
271
332
(Pages.choose_routine request ~logging:false ~viewer
272
Removed:
~routines:(Service.list_routines t.service))
333
Added:
~routines:
334
Added:
(List.map routine_choice_view
335
Added:
(Service.list_routines t.service)))
273
336
| Some (routine, selected) -> (
274
337
Service.next_workout t.service trainee.Trainee.id ~routine
275
338
>>= fun next ->
@@ -278,9 +341,11 @@
278
341
>|= fun readiness ->
279
342
match (next, readiness) with
280
343
| Ok next, Ok readiness ->
281
Removed:
Pages.home request ~viewer ~routine
282
Removed:
~routine_name:(Prescription.Routine.name selected)
283
Removed:
~next ~readiness
344
Added:
Pages.home request ~viewer
345
Added:
~home:
346
Added:
(home_view ~routine
347
Added:
~routine_name:(Prescription.Routine.name selected)
348
Added:
~next ~readiness)
284
349
| Error error, _ | _, Error error ->
285
350
Pages.problem ~title:"Routine unavailable"
286
351
~detail:(Present.routine error)))
@@ -299,7 +364,8 @@
299
364
(Pages.choose_routine request
300
365
~logging:(Option.is_some in_progress)
301
366
~viewer
302
Removed:
~routines:(Service.list_routines t.service))
367
Added:
~routines:
368
Added:
(List.map routine_choice_view (Service.list_routines t.service)))
303
369
304
370
let select_routine t trainee request id =
305
371
guard_csrf request >>= function
@@ -324,7 +390,7 @@
324
390
html
325
391
(Pages.routine request
326
392
~logging:(Option.is_some in_progress)
327
Removed:
~viewer routine)
393
Added:
~viewer (routine_view routine))
328
394
| None -> redirect_to request Routes.routines
329
395
330
396
let routes t =
lib/web/pages.ml
@@ -357,26 +357,8 @@
357
357
358
358
(* --- application pages --- *)
359
359
360
Removed:
let id_string (id : Repository.routine_id) = (id :> string)
361
360
let error_id input_id = input_id ^ "-error"
362
361
363
Removed:
(* The exercise name for one prescribed stimulus, without the rep window. A
364
Removed:
pre-exhaust names both movements. *)
365
Removed:
let prescription_exercise prescription =
366
Removed:
match Prescription.Stimulus.delivery prescription with
367
Removed:
| Prescription.Stimulus.Single exercise -> Exercise.name exercise
368
Removed:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
369
Removed:
Printf.sprintf "%s into %s, no pause" (Exercise.name isolation)
370
Removed:
(Exercise.name compound)
371
Removed:
372
Removed:
(* The prescribed rep window, phrased as a band the load calibrates against.
373
Removed:
Reps are an outcome, never a target (HD1, "Proper Weight Selection"). *)
374
Removed:
let prescription_reps prescription =
375
Removed:
let min_reps, max_reps =
376
Removed:
Prescription.Rep_range.bounds (Prescription.Stimulus.rep_range prescription)
377
Removed:
in
378
Removed:
Printf.sprintf "%d-%d reps" min_reps max_reps
379
Removed:
380
362
let extension_select ?(selected = "") ?(invalid = false) ~input_id () =
381
363
let error_attrs =
382
364
if invalid then
@@ -405,16 +387,17 @@
405
387
option "static" "then a static hold";
406
388
]
407
389
408
Removed:
let choose_routine request ~logging ~viewer ~routines =
390
Added:
let choose_routine request ~logging ~viewer
391
Added:
~(routines : View_model.Routine_choice.t list) =
409
392
html_page ~viewer ~request ~active:"home" ~logging "Choose a routine"
410
393
[
411
394
tag "h1" [] [ txt "Routines" ];
412
395
tag "div" []
413
396
(List.map
414
Removed:
(fun (routine_id, routine) ->
397
Added:
(fun (choice : View_model.Routine_choice.t) ->
415
398
tag "form"
416
399
[
417
Removed:
action Routes.select_routine (id_string routine_id);
400
Added:
action Routes.select_routine choice.id;
418
401
post_form;
419
402
Dream_html.attr "data-hito-app-form";
420
403
]
@@ -422,20 +405,16 @@
422
405
Dream_html.csrf_tag request;
423
406
tag "fieldset" []
424
407
[
425
Removed:
tag "legend" []
426
Removed:
[ txt "%s" (Prescription.Routine.name routine) ];
408
Added:
tag "legend" [] [ txt "%s" choice.name ];
427
409
tag "p" []
428
Removed:
[
429
Removed:
txt "%d workouts in the cycle."
430
Removed:
(List.length (Prescription.Routine.workouts routine));
431
Removed:
];
410
Added:
[ txt "%d workouts in the cycle." choice.workout_count ];
432
411
void "input" [ type_ "submit"; value "Use this routine" ];
433
412
];
434
413
])
435
414
routines);
436
415
]
437
416
438
Removed:
let begin_form request ~routine ~override label =
417
Added:
let begin_form request ~routine_id ~override label =
439
418
tag "form"
440
419
[ action Routes.workout; post_form; Dream_html.attr "data-hito-app-form" ]
441
420
[
@@ -444,7 +423,7 @@
444
423
[
445
424
type_ "hidden";
446
425
name "routine";
447
Removed:
Dream_html.string_attr "value" "%s" (id_string routine);
426
Added:
Dream_html.string_attr "value" "%s" routine_id;
448
427
];
449
428
void "input"
450
429
[
@@ -460,7 +439,7 @@
460
439
the doctrine's deviation stays possible; the modal only makes it deliberate.
461
440
The client reuses the shared confirm machinery: [data-hito-confirm-cancel]
462
441
opens the dialog, [data-hito-confirm-form] is the form its accept submits. *)
463
Removed:
let override_begin request ~routine =
442
Added:
let override_begin request ~routine_id =
464
443
[
465
444
tag "form"
466
445
[
@@ -475,7 +454,7 @@
475
454
[
476
455
type_ "hidden";
477
456
name "routine";
478
Removed:
Dream_html.string_attr "value" "%s" (id_string routine);
457
Added:
Dream_html.string_attr "value" "%s" routine_id;
479
458
];
480
459
void "input"
481
460
[
@@ -518,17 +497,18 @@
518
497
];
519
498
]
520
499
521
Removed:
let home request ~viewer ~routine ~routine_name ~next ~readiness =
500
Added:
let home request ~viewer ~home:(vm : View_model.Home.t) =
522
501
let status, gate =
523
Removed:
match readiness with
524
Removed:
| Recovery.Ready ->
502
Added:
match vm.gate with
503
Added:
| View_model.Home.Ready ->
525
504
( "Recovery is complete.",
526
Removed:
[ begin_form request ~routine ~override:false "Begin next workout" ]
527
Removed:
)
528
Removed:
| Recovery.Recovering { rested; recommended } ->
529
Removed:
( Format.asprintf "Recovery: %a of %a." Recovery.pp_duration rested
530
Removed:
Recovery.pp_duration recommended,
531
505
[
506
Added:
begin_form request ~routine_id:vm.routine_id ~override:false
507
Added:
"Begin next workout";
508
Added:
] )
509
Added:
| View_model.Home.Recovering { status } ->
510
Added:
( status,
511
Added:
[
532
512
tag "div"
533
513
[ class_ "warn" ]
534
514
([
@@ -537,15 +517,13 @@
537
517
txt "Heavy Duty requires recovery before the next workout.";
538
518
];
539
519
]
540
Removed:
@ override_begin request ~routine);
520
Added:
@ override_begin request ~routine_id:vm.routine_id);
541
521
] )
542
522
in
543
523
html_page ~viewer ~request ~active:"home" "Home"
544
524
([
545
Removed:
tag "h1" [] [ txt "%s" routine_name ];
546
Removed:
tag "p"
547
Removed:
[ class_ "ledger-meta" ]
548
Removed:
[ txt "Next: %s" (Prescription.Workout.name next) ];
525
Added:
tag "h1" [] [ txt "%s" vm.routine_name ];
526
Added:
tag "p" [ class_ "ledger-meta" ] [ txt "Next: %s" vm.next_workout ];
549
527
tag "p" [ class_ "ledger-meta" ] [ txt "%s" status ];
550
528
]
551
529
@ gate)
@@ -570,10 +548,10 @@
570
548
];
571
549
]
572
550
573
Removed:
let routine request ?(logging = false) ~viewer routine =
551
Added:
let routine request ?(logging = false) ~viewer (vm : View_model.Routine.t) =
574
552
html_page ~viewer ~request ~active:"routine" ~logging "Routine"
575
553
[
576
Removed:
tag "h1" [] [ txt "%s" (Prescription.Routine.name routine) ];
554
Added:
tag "h1" [] [ txt "%s" vm.name ];
577
555
tag "table"
578
556
[ class_ "routine-table" ]
579
557
[
@@ -597,11 +575,9 @@
597
575
own name and rep-band cells and no stimuli count is shown. *)
598
576
tag "tbody" []
599
577
(List.concat_map
600
Removed:
(fun workout ->
601
Removed:
let stimuli = Prescription.Workout.stimuli workout in
602
Removed:
let name = Prescription.Workout.name workout in
578
Added:
(fun (workout : View_model.Routine.workout) ->
603
579
List.mapi
604
Removed:
(fun index stimulus ->
580
Added:
(fun index (exercise : View_model.Routine.exercise) ->
605
581
let workout_cell =
606
582
if index = 0 then
607
583
[
@@ -609,21 +585,20 @@
609
585
[
610
586
Dream_html.string_attr "scope" "rowgroup";
611
587
Dream_html.string_attr "rowspan" "%d"
612
Removed:
(List.length stimuli);
588
Added:
(List.length workout.exercises);
613
589
]
614
Removed:
[ txt "%s" name ];
590
Added:
[ txt "%s" workout.name ];
615
591
]
616
592
else []
617
593
in
618
594
tag "tr" []
619
595
(workout_cell
620
596
@ [
621
Removed:
tag "td" []
622
Removed:
[ txt "%s" (prescription_exercise stimulus) ];
623
Removed:
tag "td" [] [ txt "%s" (prescription_reps stimulus) ];
597
Added:
tag "td" [] [ txt "%s" exercise.name ];
598
Added:
tag "td" [] [ txt "%s" exercise.reps ];
624
599
]))
625
Removed:
stimuli)
626
Removed:
(Prescription.Routine.workouts routine));
600
Added:
workout.exercises)
601
Added:
vm.workouts);
627
602
];
628
603
]
629
604
lib/web/pages.mli
@@ -12,17 +12,11 @@
12
12
Dream.request ->
13
13
logging:bool ->
14
14
viewer:View_model.Viewer.t ->
15
Removed:
routines:(Repository.routine_id * Prescription.Routine.t) list ->
15
Added:
routines:View_model.Routine_choice.t list ->
16
16
page
17
17
18
18
val home :
19
Removed:
Dream.request ->
20
Removed:
viewer:View_model.Viewer.t ->
21
Removed:
routine:Repository.routine_id ->
22
Removed:
routine_name:string ->
23
Removed:
next:Prescription.Workout.t ->
24
Removed:
readiness:Recovery.readiness ->
25
Removed:
page
19
Added:
Dream.request -> viewer:View_model.Viewer.t -> home:View_model.Home.t -> page
26
20
27
21
val workout_in_progress :
28
22
Dream.request -> viewer:View_model.Viewer.t -> workout_name:string -> page
@@ -33,7 +27,7 @@
33
27
Dream.request ->
34
28
?logging:bool ->
35
29
viewer:View_model.Viewer.t ->
36
Removed:
Prescription.Routine.t ->
30
Added:
View_model.Routine.t ->
37
31
page
38
32
39
33
val workout :
lib/web/view_model.ml
@@ -43,3 +43,37 @@
43
43
(** One subjective-feedback report, ready to render. Carries no
44
44
[Evidence.Feedback] variant and no timestamp type. *)
45
45
end
46
Added:
47
Added:
module Routine = struct
48
Added:
type exercise = { name : string; reps : string }
49
Added:
(** One prescribed exercise line, its name and rep band already phrased. *)
50
Added:
51
Added:
type workout = { name : string; exercises : exercise list }
52
Added:
53
Added:
type t = { name : string; workouts : workout list }
54
Added:
(** A routine as the table renders it: names, rep bands, and grouping only. No
55
Added:
[Prescription] entity. *)
56
Added:
end
57
Added:
58
Added:
module Routine_choice = struct
59
Added:
type t = { id : string; name : string; workout_count : int }
60
Added:
(** One selectable routine on the chooser: its id for the select form, its
61
Added:
name, and how many workouts the cycle holds. *)
62
Added:
end
63
Added:
64
Added:
module Home = struct
65
Added:
type gate =
66
Added:
| Ready
67
Added:
| Recovering of { status : string }
68
Added:
(** Whether the next workout may begin, and the recovery status line to
69
Added:
show while it may not. *)
70
Added:
71
Added:
type t = {
72
Added:
routine_id : string; (** For the begin/override forms. *)
73
Added:
routine_name : string;
74
Added:
next_workout : string;
75
Added:
gate : gate;
76
Added:
}
77
Added:
(** The overview while no workout is in progress. The recovery policy has
78
Added:
already decided [gate] in the use case; the page only renders it. *)
79
Added:
end