[OCaml] High Intensity Training Online
refactor share redirects alerts and UTC formats
Keep route redirects, accessible alerts, and UTC display formatting consistent without changing controller-owned wording.
Changed files
- lib/presenter/page_kit.ml
- lib/presenter/pages_app_feedback.ml
- lib/presenter/pages_auth.ml
- lib/presenter/pages_profile.ml
- lib/web/handlers_app_feedback.ml
- lib/web/handlers_current_workout.ml
- lib/web/handlers_import.ml
- lib/web/handlers_kit.ml
- lib/web/handlers_logbook.ml
- lib/web/handlers_overview.ml
- lib/web/handlers_settings.ml
lib/presenter/page_kit.ml
@@ -17,6 +17,11 @@
17
17
let post_form = Dream_html.string_attr "method" "post"
18
18
let flash_key = "hito.flash"
19
19
20
Added:
let alert message =
21
Added:
tag "p"
22
Added:
[ class_ "warn"; Dream_html.string_attr "role" "alert" ]
23
Added:
[ Dream_html.txt "%s" message ]
24
Added:
20
25
let error_text = function
21
26
| "error.required" -> "Enter a value."
22
27
| "error.expected.number" -> "Enter a valid number."
lib/presenter/pages_app_feedback.ml
@@ -26,14 +26,7 @@
26
26
27
27
let app_feedback_form request ?error () =
28
28
let error_block =
29
Removed:
match error with
30
Removed:
| None -> []
31
Removed:
| Some message ->
32
Removed:
[
33
Removed:
tag "p"
34
Removed:
[ class_ "warn"; Dream_html.string_attr "role" "alert" ]
35
Removed:
[ txt "%s" message ];
36
Removed:
]
29
Added:
match error with None -> [] | Some message -> [ alert message ]
37
30
in
38
31
tag "form"
39
32
[
lib/presenter/pages_auth.ml
@@ -2,14 +2,7 @@
2
2
open Page_kit
3
3
open Page_shell
4
4
5
Removed:
let auth_error = function
6
Removed:
| None -> []
7
Removed:
| Some message ->
8
Removed:
[
9
Removed:
tag "p"
10
Removed:
[ class_ "warn"; Dream_html.string_attr "role" "alert" ]
11
Removed:
[ txt "%s" message ];
12
Removed:
]
5
Added:
let auth_error = function None -> [] | Some message -> [ alert message ]
13
6
14
7
let credentials_form request ~submit ~action_path =
15
8
tag "form"
lib/presenter/pages_profile.ml
@@ -13,15 +13,7 @@
13
13
| Some message -> [ tag "p" [ class_ "notice" ] [ txt "%s" message ] ]
14
14
| None -> []
15
15
in
16
Removed:
let error_block = function
17
Removed:
| Some message ->
18
Removed:
[
19
Removed:
tag "p"
20
Removed:
[ class_ "warn"; Dream_html.string_attr "role" "alert" ]
21
Removed:
[ txt "%s" message ];
22
Removed:
]
23
Removed:
| None -> []
24
Removed:
in
16
Added:
let error_block = function Some message -> [ alert message ] | None -> [] in
25
17
html_page ~viewer ~request ~active:"profile" ?workout_started "Profile"
26
18
([ tag "h1" [] [ txt "Profile" ] ]
27
19
@ notice_block
lib/web/handlers_app_feedback.ml
@@ -14,21 +14,14 @@
14
14
| Some "submitted" -> `Submitted
15
15
| _ -> `Write
16
16
17
Removed:
let time_to_string timestamp =
18
Removed:
let tm =
19
Removed:
Unix.gmtime (float_of_int (Recovery.timestamp_to_unix_seconds timestamp))
20
Removed:
in
21
Removed:
Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.Unix.tm_year + 1900)
22
Removed:
(tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
23
Removed:
24
Removed:
(* Map a repository record into the view model the presenter renders, so no
25
Removed:
entity or record crosses the boundary into Pages. *)
26
17
let view_of (report : Repository.app_feedback) : View_model.App_feedback.t =
27
18
{
28
19
id = Repository.app_feedback_id_to_string report.Repository.feedback_id;
29
20
author = report.Repository.author;
30
21
contributions = report.Repository.contributions;
31
Removed:
submitted_at = time_to_string report.Repository.submitted_at;
22
Added:
submitted_at =
23
Added:
utc_datetime
24
Added:
(Recovery.timestamp_to_unix_seconds report.Repository.submitted_at);
32
25
message = report.Repository.message;
33
26
upvotes = report.Repository.upvotes;
34
27
viewer_upvoted = report.Repository.viewer_upvoted;
lib/web/handlers_current_workout.ml
@@ -11,10 +11,7 @@
11
11
12
12
let begin_workout t trainee request =
13
13
decode_form Decode.override request >>= function
14
Removed:
| Error _ ->
15
Removed:
redirect_with_flash request
16
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
17
Removed:
Present.form_invalid
14
Added:
| Error _ -> redirect_with_flash_to request Routes.home Present.form_invalid
18
15
| Ok override -> (
19
16
Service.active_routine t.service trainee.Trainee.id >>= function
20
17
| None -> redirect_to request Routes.routines
@@ -24,12 +21,9 @@
24
21
~now:(t.now ()) ?override ()
25
22
>>= function
26
23
| Ok _ ->
27
Removed:
redirect_with_flash request
28
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
29
Removed:
"Workout started."
24
Added:
redirect_with_flash_to request Routes.workout "Workout started."
30
25
| Error (Service.Not_recovered _) ->
31
Removed:
redirect_with_flash request
32
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
26
Added:
redirect_with_flash_to request Routes.home
33
27
"The workout needs an explicit recovery override."
34
28
| Error Service.Unknown_routine -> not_found Present.unknown_routine
35
29
))
@@ -55,9 +49,7 @@
55
49
the reloaded view reflects exactly what the app saved, with no client swap
56
50
that could race. *)
57
51
let saved _t _trainee request message =
58
Removed:
redirect_with_flash request
59
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
60
Removed:
message
52
Added:
redirect_with_flash_to request Routes.workout message
61
53
62
54
let log t trainee request slot =
63
55
Service.in_progress t.service trainee.Trainee.id >>= function
@@ -68,20 +60,16 @@
68
60
| Some prescription -> (
69
61
decode_form (Decode.stimulus prescription) request >>= function
70
62
| Error (`Invalid errors) ->
71
Removed:
redirect_with_flash request
72
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
63
Added:
redirect_with_flash_to request Routes.workout
73
64
(Decode.errors_to_text errors)
74
65
| Error `Bad_request ->
75
Removed:
redirect_with_flash request
76
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
66
Added:
redirect_with_flash_to request Routes.workout
77
67
Present.form_invalid
78
68
| Ok stimulus -> (
79
69
save_current t trainee.Trainee.id stimulus >>= function
80
70
| Ok () -> saved t trainee request "Record saved."
81
71
| Error detail ->
82
Removed:
redirect_with_flash request
83
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
84
Removed:
detail)))
72
Added:
redirect_with_flash_to request Routes.workout detail)))
85
73
86
74
(* Correct a recorded slot of the workout in progress. The slot may be
87
75
filled, so its prescription comes from the workout, not [outstanding].
@@ -95,27 +83,20 @@
95
83
| Some prescription -> (
96
84
decode_form (Decode.stimulus prescription) request >>= function
97
85
| Error (`Invalid errors) ->
98
Removed:
redirect_with_flash request
99
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
86
Added:
redirect_with_flash_to request Routes.workout
100
87
(Decode.errors_to_text errors)
101
88
| Error `Bad_request ->
102
Removed:
redirect_with_flash request
103
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
89
Added:
redirect_with_flash_to request Routes.workout
104
90
Present.form_invalid
105
91
| Ok stimulus -> (
106
92
replace_current t trainee.Trainee.id ~slot stimulus >>= function
107
93
| Ok () -> saved t trainee request "Record saved."
108
94
| Error detail ->
109
Removed:
redirect_with_flash request
110
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
111
Removed:
detail)))
95
Added:
redirect_with_flash_to request Routes.workout detail)))
112
96
113
97
let finish t trainee request =
114
98
guard_csrf request >>= function
115
Removed:
| Error _ ->
116
Removed:
redirect_with_flash request
117
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
118
Removed:
Present.form_invalid
99
Added:
| Error _ -> redirect_with_flash_to request Routes.home Present.form_invalid
119
100
| Ok () -> (
120
101
Service.finish t.service trainee.Trainee.id ~ended_at:(t.now ())
121
102
>>= function
@@ -123,10 +104,7 @@
123
104
redirect_with_flash request
124
105
(Dream_html.string_attr "href" "/logbook?prompt=feedback")
125
106
"Workout finished."
126
Removed:
| None ->
127
Removed:
redirect_with_flash request
128
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
129
Removed:
Present.no_workout)
107
Added:
| None -> redirect_with_flash_to request Routes.home Present.no_workout)
130
108
131
109
(* Cancelling discards the current workout and returns Home. An abandoned
132
110
session is not evidence, so it leaves no record. A forged or missing
@@ -134,14 +112,11 @@
134
112
let cancel t trainee request =
135
113
guard_csrf request >>= function
136
114
| Error _ ->
137
Removed:
redirect_with_flash request
138
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
115
Added:
redirect_with_flash_to request Routes.home
139
116
"Workout cancellation was not confirmed."
140
117
| Ok () ->
141
118
Service.cancel t.service trainee.Trainee.id >>= fun _ ->
142
Removed:
redirect_with_flash request
143
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
144
Removed:
"Workout cancelled."
119
Added:
redirect_with_flash_to request Routes.home "Workout cancelled."
145
120
146
121
let routes t =
147
122
[
lib/web/handlers_import.ml
@@ -110,12 +110,10 @@
110
110
let upload t trainee request =
111
111
read_upload request >>= function
112
112
| Error `Bad_request ->
113
Removed:
redirect_with_flash request
114
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.profile)
113
Added:
redirect_with_flash_to request Routes.profile
115
114
"The import upload is missing its file or offset."
116
115
| Ok (source, _, _) when String.length source > max_source_bytes ->
117
Removed:
redirect_with_flash request
118
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.profile)
116
Added:
redirect_with_flash_to request Routes.profile
119
117
"The import file exceeds the 10 MiB limit."
120
118
| Ok (source, utc_offset_seconds, allow_duplicate) -> (
121
119
let fingerprint = Digest.to_hex (Digest.string source) in
@@ -127,8 +125,7 @@
127
125
I.parse ~batch_id ~fingerprint ~imported_at ~utc_offset_seconds source
128
126
with
129
127
| Error e ->
130
Removed:
redirect_with_flash request
131
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.profile)
128
Added:
redirect_with_flash_to request Routes.profile
132
129
(Format.asprintf "%a" I.pp_error e)
133
130
| Ok batch -> (
134
131
let allow_duplicate = if allow_duplicate then Some () else None in
@@ -142,13 +139,11 @@
142
139
(Workout_import.batch_id_to_string batch_id))
143
140
"Import stored. Review it below."
144
141
| Error Service.Duplicate_source ->
145
Removed:
redirect_with_flash request
146
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.profile)
142
Added:
redirect_with_flash_to request Routes.profile
147
143
"This export was already imported. Re-submit with the \
148
144
duplicate override to import it again."
149
145
| Error _ ->
150
Removed:
redirect_with_flash request
151
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.profile)
146
Added:
redirect_with_flash_to request Routes.profile
152
147
"The import could not be stored."))
153
148
154
149
let review_target t trainee id =
lib/web/handlers_kit.ml
@@ -73,6 +73,21 @@
73
73
Dream.set_session_field request flash_key message >>= fun () ->
74
74
Dream_html.redirect request href
75
75
76
Added:
let redirect_with_flash_to request path message =
77
Added:
redirect_with_flash request
78
Added:
(Dream_html.path_attr Dream_html.HTML.href path)
79
Added:
message
80
Added:
81
Added:
let utc_date seconds =
82
Added:
let tm = Unix.gmtime (float_of_int seconds) in
83
Added:
Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900)
84
Added:
(tm.Unix.tm_mon + 1) tm.Unix.tm_mday
85
Added:
86
Added:
let utc_datetime seconds =
87
Added:
let tm = Unix.gmtime (float_of_int seconds) in
88
Added:
Printf.sprintf "%04d-%02d-%02d %02d:%02d" (tm.Unix.tm_year + 1900)
89
Added:
(tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
90
Added:
76
91
let not_found detail =
77
92
html (Pages.problem ~title:"Not found" ~detail) ~status:`Not_Found
78
93
lib/web/handlers_logbook.ml
@@ -30,11 +30,6 @@
30
30
leveled "difficulty" (fun l -> Feedback.Difficulty l);
31
31
]
32
32
33
Removed:
let date_of_unix seconds =
34
Removed:
let tm = Unix.gmtime (float_of_int seconds) in
35
Removed:
Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900)
36
Removed:
(tm.Unix.tm_mon + 1) tm.Unix.tm_mday
37
Removed:
38
33
(* {1 Calendar} *)
39
34
40
35
let is_leap y = (y mod 4 = 0 && y mod 100 <> 0) || y mod 400 = 0
@@ -168,7 +163,7 @@
168
163
at_unix = started;
169
164
workout_name =
170
165
Prescription.Workout.name (Evidence.Workout.prescription workout);
171
Removed:
date = date_of_unix started;
166
Added:
date = utc_date started;
172
167
duration;
173
168
changes;
174
169
imported_efforts = [];
@@ -238,7 +233,7 @@
238
233
imported = true;
239
234
at_unix = started;
240
235
workout_name = record.Repository.title;
241
Removed:
date = date_of_unix started;
236
Added:
date = utc_date started;
242
237
duration = Printf.sprintf "%d min" ((ended - started) / 60);
243
238
changes = [];
244
239
imported_efforts = efforts;
@@ -405,20 +400,15 @@
405
400
let delete t trainee request id =
406
401
guard_csrf request >>= function
407
402
| Error _ ->
408
Removed:
redirect_with_flash request
409
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
410
Removed:
Present.form_invalid
403
Added:
redirect_with_flash_to request Routes.logbook Present.form_invalid
411
404
| Ok () -> (
412
405
Service.delete_record t.service trainee.Trainee.id
413
406
(Repository.workout_id id)
414
407
>>= function
415
408
| Ok () ->
416
Removed:
redirect_with_flash request
417
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
418
Removed:
"Workout log deleted."
409
Added:
redirect_with_flash_to request Routes.logbook "Workout log deleted."
419
410
| Error Service.Record_not_found ->
420
Removed:
redirect_with_flash request
421
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
411
Added:
redirect_with_flash_to request Routes.logbook
422
412
"That workout log is no longer available.")
423
413
424
414
(* The progress page. One dual-axis line chart per exercise that has at least
@@ -433,7 +423,7 @@
433
423
Recovery.timestamp_to_unix_seconds (Evidence.Observation.performed_at o)
434
424
in
435
425
{
436
Removed:
date = date_of_unix at;
426
Added:
date = utc_date at;
437
427
at_unix = at;
438
428
weight = Evidence.Stimulus.Effort.load effort;
439
429
reps = Evidence.Stimulus.Effort.reps effort;
lib/web/handlers_overview.ml
@@ -153,18 +153,13 @@
153
153
154
154
let select_routine t trainee request id =
155
155
guard_csrf request >>= function
156
Removed:
| Error _ ->
157
Removed:
redirect_with_flash request
158
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
159
Removed:
Present.form_invalid
156
Added:
| Error _ -> redirect_with_flash_to request Routes.home Present.form_invalid
160
157
| Ok () -> (
161
158
Service.select_routine t.service trainee.Trainee.id
162
159
(Repository.routine_id id)
163
160
>>= function
164
161
| Ok () ->
165
Removed:
redirect_with_flash request
166
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
167
Removed:
"Routine selected."
162
Added:
redirect_with_flash_to request Routes.home "Routine selected."
168
163
| Error _ -> not_found Present.unknown_routine)
169
164
170
165
let routine t trainee request =
lib/web/handlers_settings.ml
@@ -27,9 +27,7 @@
27
27
let update _trainee request =
28
28
guard_csrf request >>= function
29
29
| Error _ ->
30
Removed:
redirect_with_flash request
31
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.settings)
32
Removed:
Present.form_invalid
30
Added:
redirect_with_flash_to request Routes.settings Present.form_invalid
33
31
| Ok () -> (
34
32
Dream.form request >>= function
35
33
| `Ok fields -> (
@@ -38,13 +36,10 @@
38
36
Dream.set_session_field request theme_session_key value
39
37
>>= fun () -> Dream.redirect request "/settings"
40
38
| _ ->
41
Removed:
redirect_with_flash request
42
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.settings)
39
Added:
redirect_with_flash_to request Routes.settings
43
40
Present.form_invalid)
44
41
| _ ->
45
Removed:
redirect_with_flash request
46
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.settings)
47
Removed:
Present.form_invalid)
42
Added:
redirect_with_flash_to request Routes.settings Present.form_invalid)
48
43
49
44
let routes t =
50
45
[