[OCaml] High Intensity Training Online
refactor Pass a Viewer view model, not the Trainee entity
Every page took the Trainee entity only to show its username. Add a Viewer DTO { username } to view_model.ml, thread ~viewer through the presenter and the html_page shell, and map Trainee -> Viewer once per handler. The presenter now names no Trainee entity, removing the most widespread entity crossing at the web boundary. Behavior-preserving: the same username reaches the shell; 243 tests pass.
lib/web/handlers.ml
@@ -252,17 +252,23 @@
252
252
253
253
module Overview = struct
254
254
let page t trainee request =
255
Added:
let viewer =
256
Added:
{
257
Added:
View_model.Viewer.username =
258
Added:
Trainee.username_to_string trainee.Trainee.username;
259
Added:
}
260
Added:
in
255
261
Service.in_progress t.service trainee.Trainee.id >>= function
256
262
| Some workout ->
257
263
let workout_name =
258
264
Prescription.Workout.name (Evidence.Workout.prescription workout)
259
265
in
260
Removed:
Lwt.return (Pages.workout_in_progress request ~trainee ~workout_name)
266
Added:
Lwt.return (Pages.workout_in_progress request ~viewer ~workout_name)
261
267
| None -> (
262
268
Service.active_routine t.service trainee.Trainee.id >>= function
263
269
| None ->
264
270
Lwt.return
265
Removed:
(Pages.choose_routine request ~logging:false ~trainee
271
Added:
(Pages.choose_routine request ~logging:false ~viewer
266
272
~routines:(Service.list_routines t.service))
267
273
| Some (routine, selected) -> (
268
274
Service.next_workout t.service trainee.Trainee.id ~routine
@@ -272,7 +278,7 @@
272
278
>|= fun readiness ->
273
279
match (next, readiness) with
274
280
| Ok next, Ok readiness ->
275
Removed:
Pages.home request ~trainee ~routine
281
Added:
Pages.home request ~viewer ~routine
276
282
~routine_name:(Prescription.Routine.name selected)
277
283
~next ~readiness
278
284
| Error error, _ | _, Error error ->
@@ -282,11 +288,17 @@
282
288
let home t trainee request = page t trainee request >>= html
283
289
284
290
let routines t trainee request =
291
Added:
let viewer =
292
Added:
{
293
Added:
View_model.Viewer.username =
294
Added:
Trainee.username_to_string trainee.Trainee.username;
295
Added:
}
296
Added:
in
285
297
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
286
298
html
287
299
(Pages.choose_routine request
288
300
~logging:(Option.is_some in_progress)
289
Removed:
~trainee
301
Added:
~viewer
290
302
~routines:(Service.list_routines t.service))
291
303
292
304
let select_routine t trainee request id =
@@ -300,13 +312,19 @@
300
312
| Error _ -> not_found Present.unknown_routine)
301
313
302
314
let routine t trainee request =
315
Added:
let viewer =
316
Added:
{
317
Added:
View_model.Viewer.username =
318
Added:
Trainee.username_to_string trainee.Trainee.username;
319
Added:
}
320
Added:
in
303
321
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
304
322
Service.active_routine t.service trainee.Trainee.id >>= function
305
323
| Some (_, routine) ->
306
324
html
307
325
(Pages.routine request
308
326
~logging:(Option.is_some in_progress)
309
Removed:
~trainee routine)
327
Added:
~viewer routine)
310
328
| None -> redirect_to request Routes.routines
311
329
312
330
let routes t =
@@ -344,10 +362,16 @@
344
362
not_found Present.unknown_routine))
345
363
346
364
let show t trainee request =
365
Added:
let viewer =
366
Added:
{
367
Added:
View_model.Viewer.username =
368
Added:
Trainee.username_to_string trainee.Trainee.username;
369
Added:
}
370
Added:
in
347
371
Service.in_progress t.service trainee.Trainee.id >>= function
348
372
| Some workout ->
349
373
html
350
Removed:
(Pages.workout request ~trainee ~record_id:None
374
Added:
(Pages.workout request ~viewer ~record_id:None
351
375
~active_slot:(active_slot request workout)
352
376
workout)
353
377
| None -> redirect_to request Routes.home
@@ -525,6 +549,12 @@
525
549
]
526
550
527
551
let index t trainee request =
552
Added:
let viewer =
553
Added:
{
554
Added:
View_model.Viewer.username =
555
Added:
Trainee.username_to_string trainee.Trainee.username;
556
Added:
}
557
Added:
in
528
558
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
529
559
Service.history t.service trainee.Trainee.id >>= fun records ->
530
560
Service.feedback t.service trainee.Trainee.id >>= fun feedback ->
@@ -539,7 +569,7 @@
539
569
html
540
570
(Pages.logbook request
541
571
~logging:(Option.is_some in_progress)
542
Removed:
~trainee ~feedback
572
Added:
~viewer ~feedback
543
573
~suggest_feedback:
544
574
(match Dream.query request "prompt" with
545
575
| Some "feedback" -> true
@@ -630,12 +660,18 @@
630
660
redirect_with_flash request Routes.logbook "Feedback skipped."
631
661
632
662
let show t trainee request id =
663
Added:
let viewer =
664
Added:
{
665
Added:
View_model.Viewer.username =
666
Added:
Trainee.username_to_string trainee.Trainee.username;
667
Added:
}
668
Added:
in
633
669
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
634
670
record_target t trainee.Trainee.id id >>= function
635
671
| None -> not_found Present.unknown_record
636
672
| Some (_, workout) ->
637
673
html
638
Removed:
(Pages.workout request ~trainee
674
Added:
(Pages.workout request ~viewer
639
675
~logging:(Option.is_some in_progress)
640
676
~record_id:(Some id)
641
677
~active_slot:(active_slot request workout)
@@ -753,12 +789,18 @@
753
789
}
754
790
755
791
let show t trainee request =
792
Added:
let viewer =
793
Added:
{
794
Added:
View_model.Viewer.username =
795
Added:
Trainee.username_to_string trainee.Trainee.username;
796
Added:
}
797
Added:
in
756
798
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
757
799
Service.app_feedback t.service trainee.Trainee.id >>= fun reports ->
758
800
html
759
801
(Pages.app_feedback request
760
802
~logging:(Option.is_some in_progress)
761
Removed:
~trainee ~tab:(tab request) (List.map view_of reports))
803
Added:
~viewer ~tab:(tab request) (List.map view_of reports))
762
804
763
805
let submit t trainee request =
764
806
decode_form Decode.app_feedback request >>= function
@@ -843,6 +885,12 @@
843
885
(* The profile page. A [?changed=] query set by a successful redirect shows
844
886
a confirmation notice, so a refresh never re-posts a change. *)
845
887
let show t trainee request =
888
Added:
let viewer =
889
Added:
{
890
Added:
View_model.Viewer.username =
891
Added:
Trainee.username_to_string trainee.Trainee.username;
892
Added:
}
893
Added:
in
846
894
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
847
895
let notice =
848
896
match Dream.query request "changed" with
@@ -853,14 +901,20 @@
853
901
html
854
902
(Pages.profile request
855
903
~logging:(Option.is_some in_progress)
856
Removed:
~trainee ?notice ())
904
Added:
~viewer ?notice ())
857
905
858
906
let render_error t trainee request ?username_error ?password_error () =
907
Added:
let viewer =
908
Added:
{
909
Added:
View_model.Viewer.username =
910
Added:
Trainee.username_to_string trainee.Trainee.username;
911
Added:
}
912
Added:
in
859
913
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
860
914
html ~status:`Bad_Request
861
915
(Pages.profile request
862
916
~logging:(Option.is_some in_progress)
863
Removed:
~trainee ?username_error ?password_error ())
917
Added:
~viewer ?username_error ?password_error ())
864
918
865
919
let change_username t trainee request =
866
920
decode_form Decode.profile_username request >>= function
lib/web/pages.ml
@@ -20,10 +20,10 @@
20
20
let post_form = Dream_html.string_attr "method" "post"
21
21
let flash_key = "hito.flash"
22
22
23
Removed:
(* The shell. [trainee] and [request] are present on authenticated pages, which
23
Added:
(* The shell. [viewer] and [request] are present on authenticated pages, which
24
24
then show a logout control and the username on the history link. Auth pages
25
25
omit both. *)
26
Removed:
let html_page ?trainee ?request ?(active = "") ?(logging = false)
26
Added:
let html_page ?viewer ?request ?(active = "") ?(logging = false)
27
27
?(show_nav = false) title content =
28
28
let spa_client = true in
29
29
let nav_link page path label =
@@ -59,8 +59,8 @@
59
59
script, so it works before the SPA enhancement loads. The Sign-out form is
60
60
nested inside and keeps its CSRF token. *)
61
61
let profile_area =
62
Removed:
match (trainee, request) with
63
Removed:
| Some (trainee : Trainee.t), Some request ->
62
Added:
match (viewer, request) with
63
Added:
| Some (viewer : View_model.Viewer.t), Some request ->
64
64
let menu_link page path label =
65
65
let attrs = [ class_ "profile-menu-item"; href path ] in
66
66
let attrs =
@@ -94,7 +94,7 @@
94
94
[ class_ "profile-menu" ]
95
95
[
96
96
tag "summary" summary_attrs
97
Removed:
[ txt "%s" (Trainee.username_to_string trainee.username) ];
97
Added:
[ txt "%s" viewer.View_model.Viewer.username ];
98
98
tag "div"
99
99
[ class_ "profile-menu-drawer" ]
100
100
[
@@ -123,16 +123,16 @@
123
123
in
124
124
let account_area = [] in
125
125
let primary_nav =
126
Removed:
match (trainee, request) with
127
Removed:
| Some (_ : Trainee.t), Some _ ->
126
Added:
match (viewer, request) with
127
Added:
| Some (_ : View_model.Viewer.t), Some _ ->
128
128
[ tag "nav" [ class_ "primary-nav" ] (navigation_links ()) ]
129
129
| _ when show_nav ->
130
130
[ tag "nav" [ class_ "primary-nav" ] (navigation_links ()) ]
131
131
| _ -> []
132
132
in
133
133
let bottom_nav =
134
Removed:
match (trainee, request) with
135
Removed:
| Some (_ : Trainee.t), Some _ ->
134
Added:
match (viewer, request) with
135
Added:
| Some (_ : View_model.Viewer.t), Some _ ->
136
136
[
137
137
tag "nav"
138
138
[
@@ -405,8 +405,8 @@
405
405
option "static" "then a static hold";
406
406
]
407
407
408
Removed:
let choose_routine request ~logging ~trainee ~routines =
409
Removed:
html_page ~trainee ~request ~active:"home" ~logging "Choose a routine"
408
Added:
let choose_routine request ~logging ~viewer ~routines =
409
Added:
html_page ~viewer ~request ~active:"home" ~logging "Choose a routine"
410
410
[
411
411
tag "h1" [] [ txt "Routines" ];
412
412
tag "div" []
@@ -518,7 +518,7 @@
518
518
];
519
519
]
520
520
521
Removed:
let home request ~trainee ~routine ~routine_name ~next ~readiness =
521
Added:
let home request ~viewer ~routine ~routine_name ~next ~readiness =
522
522
let status, gate =
523
523
match readiness with
524
524
| Recovery.Ready ->
@@ -540,7 +540,7 @@
540
540
@ override_begin request ~routine);
541
541
] )
542
542
in
543
Removed:
html_page ~trainee ~request ~active:"home" "Home"
543
Added:
html_page ~viewer ~request ~active:"home" "Home"
544
544
([
545
545
tag "h1" [] [ txt "%s" routine_name ];
546
546
tag "p"
@@ -554,8 +554,8 @@
554
554
routine chooser, Home shows a single card: the workout is under way and one
555
555
tap returns to it. The middle navigation action already reads "Current
556
556
workout" here, and this card is the matching Home affordance. *)
557
Removed:
let workout_in_progress request ~trainee ~workout_name =
558
Removed:
html_page ~trainee ~request ~active:"home" ~logging:true "Home"
557
Added:
let workout_in_progress request ~viewer ~workout_name =
558
Added:
html_page ~viewer ~request ~active:"home" ~logging:true "Home"
559
559
[
560
560
tag "a"
561
561
[
@@ -570,8 +570,8 @@
570
570
];
571
571
]
572
572
573
Removed:
let routine request ?(logging = false) ~trainee routine =
574
Removed:
html_page ~trainee ~request ~active:"routine" ~logging "Routine"
573
Added:
let routine request ?(logging = false) ~viewer routine =
574
Added:
html_page ~viewer ~request ~active:"routine" ~logging "Routine"
575
575
[
576
576
tag "h1" [] [ txt "%s" (Prescription.Routine.name routine) ];
577
577
tag "table"
@@ -849,7 +849,7 @@
849
849
Printf.sprintf "%s + %s" (Exercise.name isolation)
850
850
(Exercise.name compound)
851
851
852
Removed:
let workout request ~trainee ?(errors = []) ?editing ?logging ~record_id
852
Added:
let workout request ~viewer ?(errors = []) ?editing ?logging ~record_id
853
853
~active_slot workout =
854
854
let enhanced = Option.is_none record_id in
855
855
(* A live workout view is itself the workout in progress, so the middle nav
@@ -1102,7 +1102,7 @@
1102
1102
];
1103
1103
]
1104
1104
in
1105
Removed:
html_page ~trainee ~request ~active:"workout" ~logging
1105
Added:
html_page ~viewer ~request ~active:"workout" ~logging
1106
1106
(Prescription.Workout.name prescription)
1107
1107
[
1108
1108
tag "div"
@@ -1515,13 +1515,13 @@
1515
1515
reports);
1516
1516
]
1517
1517
1518
Removed:
let logbook request ?(logging = false) ~trainee ?(feedback = [])
1518
Added:
let logbook request ?(logging = false) ~viewer ?(feedback = [])
1519
1519
?(suggest_feedback = false) ?feedback_flow ?(feedback_open = false) records
1520
1520
=
1521
1521
let feedback_flow =
1522
1522
Option.value feedback_flow ~default:{ step = 0; answers = [] }
1523
1523
in
1524
Removed:
html_page ~trainee ~request ~active:"logbook" ~logging "Logbook"
1524
Added:
html_page ~viewer ~request ~active:"logbook" ~logging "Logbook"
1525
1525
[
1526
1526
tag "h1" [] [ txt "Logbook" ];
1527
1527
(if records = [] then tag "p" [] [ txt "Nothing logged yet." ]
@@ -1711,7 +1711,7 @@
1711
1711
[ class_ "app-feedback-actions" ]
1712
1712
[ app_feedback_vote_form request report ]
1713
1713
1714
Removed:
let app_feedback request ?(logging = false) ~trainee ?(tab = `Write) ?error
1714
Added:
let app_feedback request ?(logging = false) ~viewer ?(tab = `Write) ?error
1715
1715
reports =
1716
1716
let panel =
1717
1717
match tab with
@@ -1759,7 +1759,7 @@
1759
1759
reports));
1760
1760
]
1761
1761
in
1762
Removed:
html_page ~trainee ~request ~active:"app-feedback" ~logging "App feedback"
1762
Added:
html_page ~viewer ~request ~active:"app-feedback" ~logging "App feedback"
1763
1763
[
1764
1764
tag "div" []
1765
1765
([
@@ -1784,7 +1784,7 @@
1784
1784
independent forms: rename the account, and change the password. Each form
1785
1785
reports its own error inline; [notice] confirms a successful change. Both are
1786
1786
plain authenticated app-forms, so they work with or without script. *)
1787
Removed:
let profile request ?(logging = false) ~trainee ?username_error ?password_error
1787
Added:
let profile request ?(logging = false) ~viewer ?username_error ?password_error
1788
1788
?notice () =
1789
1789
let notice_block =
1790
1790
match notice with
@@ -1800,7 +1800,7 @@
1800
1800
]
1801
1801
| None -> []
1802
1802
in
1803
Removed:
html_page ~trainee ~request ~active:"profile" ~logging "Profile"
1803
Added:
html_page ~viewer ~request ~active:"profile" ~logging "Profile"
1804
1804
([ tag "h1" [] [ txt "Profile" ] ]
1805
1805
@ notice_block
1806
1806
@ [
@@ -1818,10 +1818,7 @@
1818
1818
tag "span" [ class_ "profile-value-label" ] [ txt "Username" ];
1819
1819
tag "span"
1820
1820
[ class_ "profile-value-text" ]
1821
Removed:
[
1822
Removed:
txt "%s"
1823
Removed:
(Trainee.username_to_string trainee.Trainee.username);
1824
Removed:
];
1821
Added:
[ txt "%s" viewer.View_model.Viewer.username ];
1825
1822
tag "button"
1826
1823
[
1827
1824
type_ "button";
@@ -1865,8 +1862,7 @@
1865
1862
name "username";
1866
1863
Dream_html.string_attr "id" "username";
1867
1864
Dream_html.string_attr "value" "%s"
1868
Removed:
(Trainee.username_to_string
1869
Removed:
trainee.Trainee.username);
1865
Added:
viewer.View_model.Viewer.username;
1870
1866
required;
1871
1867
];
1872
1868
];
lib/web/pages.mli
@@ -11,13 +11,13 @@
11
11
val choose_routine :
12
12
Dream.request ->
13
13
logging:bool ->
14
Removed:
trainee:Trainee.t ->
14
Added:
viewer:View_model.Viewer.t ->
15
15
routines:(Repository.routine_id * Prescription.Routine.t) list ->
16
16
page
17
17
18
18
val home :
19
19
Dream.request ->
20
Removed:
trainee:Trainee.t ->
20
Added:
viewer:View_model.Viewer.t ->
21
21
routine:Repository.routine_id ->
22
22
routine_name:string ->
23
23
next:Prescription.Workout.t ->
@@ -25,20 +25,20 @@
25
25
page
26
26
27
27
val workout_in_progress :
28
Removed:
Dream.request -> trainee:Trainee.t -> workout_name:string -> page
28
Added:
Dream.request -> viewer:View_model.Viewer.t -> workout_name:string -> page
29
29
(** The Home card shown while a workout is in progress. Links to the current
30
30
workout so it stays one tap away. *)
31
31
32
32
val routine :
33
33
Dream.request ->
34
34
?logging:bool ->
35
Removed:
trainee:Trainee.t ->
35
Added:
viewer:View_model.Viewer.t ->
36
36
Prescription.Routine.t ->
37
37
page
38
38
39
39
val workout :
40
40
Dream.request ->
41
Removed:
trainee:Trainee.t ->
41
Added:
viewer:View_model.Viewer.t ->
42
42
?errors:(string * string) list ->
43
43
?editing:int ->
44
44
?logging:bool ->
@@ -67,7 +67,7 @@
67
67
val logbook :
68
68
Dream.request ->
69
69
?logging:bool ->
70
Removed:
trainee:Trainee.t ->
70
Added:
viewer:View_model.Viewer.t ->
71
71
?feedback:Evidence.Feedback.t list ->
72
72
?suggest_feedback:bool ->
73
73
?feedback_flow:feedback_flow ->
@@ -81,7 +81,7 @@
81
81
val profile :
82
82
Dream.request ->
83
83
?logging:bool ->
84
Removed:
trainee:Trainee.t ->
84
Added:
viewer:View_model.Viewer.t ->
85
85
?username_error:string ->
86
86
?password_error:string ->
87
87
?notice:string ->
@@ -101,7 +101,7 @@
101
101
val app_feedback :
102
102
Dream.request ->
103
103
?logging:bool ->
104
Removed:
trainee:Trainee.t ->
104
Added:
viewer:View_model.Viewer.t ->
105
105
?tab:[ `Write | `Submitted ] ->
106
106
?error:string ->
107
107
View_model.App_feedback.t list ->
lib/web/view_model.ml
@@ -9,6 +9,12 @@
9
9
Migrated so far: application feedback. Other pages still take entities
10
10
directly; they move here page by page. *)
11
11
12
Added:
module Viewer = struct
13
Added:
type t = { username : string }
14
Added:
(** The signed-in trainee, as the shell needs them: a name to show, nothing
15
Added:
more. Replaces passing the [Trainee.t] entity into the presenter. *)
16
Added:
end
17
Added:
12
18
module App_feedback = struct
13
19
type t = {
14
20
id : string; (** Opaque feedback identity, already stringified. *)