[OCaml] High Intensity Training Online
refactor Group Dream route handlers
Compose focused route groups for overview, current workouts, history, and assets so the application route assembly stays small and clear.
lib/web/handlers.ml
@@ -10,11 +10,6 @@
10
10
let create ?(now = default_now) () =
11
11
{ service = Service.make ~repo:(Memory_repo.create ()); now }
12
12
13
Removed:
let stylesheet =
14
Removed:
match Stylesheet.read "hito.css" with
15
Removed:
| Some stylesheet -> stylesheet
16
Removed:
| None -> failwith "Embedded stylesheet hito.css is missing"
17
Removed:
18
13
let html ?status page = Dream_html.respond ?status page
19
14
let redirect request path = Dream_html.redirect request path
20
15
@@ -24,25 +19,6 @@
24
19
let bad_request detail =
25
20
html (Pages.problem ~title:"Invalid request" ~detail) ~status:`Bad_Request
26
21
27
Removed:
let home_page t =
28
Removed:
match Service.in_progress t.service with
29
Removed:
| Some workout -> Pages.workout ~record_id:None workout
30
Removed:
| None -> (
31
Removed:
match Service.active_routine t.service with
32
Removed:
| None -> Pages.choose_routine ~routines:(Service.list_routines t.service)
33
Removed:
| Some (routine, selected) -> (
34
Removed:
match
35
Removed:
( Service.next_workout t.service ~routine,
36
Removed:
Service.readiness t.service ~routine ~now:(t.now ()) )
37
Removed:
with
38
Removed:
| Ok next, Ok readiness ->
39
Removed:
Pages.home ~routine
40
Removed:
~routine_name:(Prescription.Routine.name selected)
41
Removed:
~next ~readiness
42
Removed:
| Error error, _ | _, Error error ->
43
Removed:
Pages.problem ~title:"Routine unavailable"
44
Removed:
~detail:(Format.asprintf "%a" Service.pp_error error)))
45
Removed:
46
22
let decode_form decoder request =
47
23
Dream_html.form decoder ~csrf:false request >|= function
48
24
| `Ok value -> Ok value
@@ -54,8 +30,8 @@
54
30
|> Option.map (fun record ->
55
31
(record.Repository.id, record.Repository.workout))
56
32
57
Removed:
let outstanding target slot =
58
Removed:
List.assoc_opt slot (Evidence.Workout.outstanding target)
33
Added:
let outstanding workout slot =
34
Added:
List.assoc_opt slot (Evidence.Workout.outstanding workout)
59
35
60
36
let save_current t stimulus =
61
37
match Service.log t.service stimulus with
@@ -72,25 +48,56 @@
72
48
| Error (Service.Rejected_edit error) ->
73
49
Error (Format.asprintf "%a" Evidence.Workout.pp_error error)
74
50
75
Removed:
let routes t =
76
Removed:
let home _request = html (home_page t) in
77
Removed:
let routines _request =
51
Added:
module Overview = struct
52
Added:
let page t =
53
Added:
match Service.in_progress t.service with
54
Added:
| Some workout -> Pages.workout ~record_id:None workout
55
Added:
| None -> (
56
Added:
match Service.active_routine t.service with
57
Added:
| None ->
58
Added:
Pages.choose_routine ~routines:(Service.list_routines t.service)
59
Added:
| Some (routine, selected) -> (
60
Added:
match
61
Added:
( Service.next_workout t.service ~routine,
62
Added:
Service.readiness t.service ~routine ~now:(t.now ()) )
63
Added:
with
64
Added:
| Ok next, Ok readiness ->
65
Added:
Pages.home ~routine
66
Added:
~routine_name:(Prescription.Routine.name selected)
67
Added:
~next ~readiness
68
Added:
| Error error, _ | _, Error error ->
69
Added:
Pages.problem ~title:"Routine unavailable"
70
Added:
~detail:(Format.asprintf "%a" Service.pp_error error)))
71
Added:
72
Added:
let home t _request = html (page t)
73
Added:
74
Added:
let routines t _request =
78
75
html (Pages.choose_routine ~routines:(Service.list_routines t.service))
79
Removed:
in
80
Removed:
let select_routine request id =
76
Added:
77
Added:
let select_routine t request id =
81
78
match Service.select_routine t.service (Repository.routine_id id) with
82
79
| Ok () ->
83
80
redirect request (Dream_html.path_attr Dream_html.HTML.href Routes.home)
84
81
| Error _ -> not_found "That routine is not in the catalogue."
85
Removed:
in
86
Removed:
let routine request =
82
Added:
83
Added:
let routine t request =
87
84
match Service.active_routine t.service with
88
85
| Some (_, routine) -> html (Pages.routine routine)
89
86
| None ->
90
87
redirect request
91
88
(Dream_html.path_attr Dream_html.HTML.href Routes.routines)
92
Removed:
in
93
Removed:
let begin_workout request =
89
Added:
90
Added:
let routes t =
91
Added:
[
92
Added:
Dream_html.get Routes.home (home t);
93
Added:
Dream_html.get Routes.routines (routines t);
94
Added:
Dream_html.post Routes.select_routine (select_routine t);
95
Added:
Dream_html.get Routes.routine (routine t);
96
Added:
]
97
Added:
end
98
Added:
99
Added:
module Current_workout = struct
100
Added:
let begin_workout t request =
94
101
decode_form Decode.override request >>= function
95
102
| Error _ -> bad_request "The submitted form is not valid."
96
103
| Ok override -> (
@@ -112,14 +119,14 @@
112
119
(Dream_html.path_attr Dream_html.HTML.href Routes.home)
113
120
| Error Service.Unknown_routine ->
114
121
not_found "That routine is not in the catalogue."))
115
Removed:
in
116
Removed:
let current_workout request =
122
Added:
123
Added:
let show t request =
117
124
match Service.in_progress t.service with
118
125
| Some workout -> html (Pages.workout ~record_id:None workout)
119
126
| None ->
120
127
redirect request (Dream_html.path_attr Dream_html.HTML.href Routes.home)
121
Removed:
in
122
Removed:
let log_current request slot =
128
Added:
129
Added:
let log t request slot =
123
130
match Service.in_progress t.service with
124
131
| None -> not_found "No workout is in progress."
125
132
| Some workout -> (
@@ -138,21 +145,32 @@
138
145
redirect request
139
146
(Dream_html.path_attr Dream_html.HTML.href Routes.workout)
140
147
| Error detail -> bad_request detail)))
141
Removed:
in
142
Removed:
let finish request =
148
Added:
149
Added:
let finish t request =
143
150
match Service.finish t.service ~ended_at:(t.now ()) with
144
151
| Some _ ->
145
152
redirect request
146
153
(Dream_html.path_attr Dream_html.HTML.href Routes.history)
147
154
| None -> not_found "No workout is in progress."
148
Removed:
in
149
Removed:
let history _request = html (Pages.history (Service.history t.service)) in
150
Removed:
let record _request id =
155
Added:
156
Added:
let routes t =
157
Added:
[
158
Added:
Dream_html.get Routes.workout (show t);
159
Added:
Dream_html.post Routes.workout (begin_workout t);
160
Added:
Dream_html.post Routes.workout_slot (log t);
161
Added:
Dream_html.post Routes.finish_workout (finish t);
162
Added:
]
163
Added:
end
164
Added:
165
Added:
module History = struct
166
Added:
let index t _request = html (Pages.history (Service.history t.service))
167
Added:
168
Added:
let show t _request id =
151
169
match record_target t id with
152
170
| None -> not_found "That saved workout no longer exists."
153
171
| Some (_, workout) -> html (Pages.workout ~record_id:(Some id) workout)
154
Removed:
in
155
Removed:
let log_record request id slot =
172
Added:
173
Added:
let log t request id slot =
156
174
match record_target t id with
157
175
| None -> not_found "That saved workout no longer exists."
158
176
| Some (record_id, workout) -> (
@@ -172,21 +190,30 @@
172
190
(Dream_html.path_attr Dream_html.HTML.href Routes.record
173
191
id)
174
192
| Error detail -> bad_request detail)))
175
Removed:
in
176
Removed:
[
177
Removed:
Dream_html.get Routes.home home;
178
Removed:
Dream_html.get Routes.routines routines;
179
Removed:
Dream_html.post Routes.select_routine select_routine;
180
Removed:
Dream_html.get Routes.routine routine;
181
Removed:
Dream_html.get Routes.workout current_workout;
182
Removed:
Dream_html.post Routes.workout begin_workout;
183
Removed:
Dream_html.post Routes.workout_slot log_current;
184
Removed:
Dream_html.post Routes.finish_workout finish;
185
Removed:
Dream_html.get Routes.history history;
186
Removed:
Dream_html.get Routes.record record;
187
Removed:
Dream_html.post Routes.record_slot log_record;
188
Removed:
Dream_html.get Routes.stylesheet (fun _ ->
189
Removed:
Dream.respond
190
Removed:
~headers:[ ("Content-Type", "text/css; charset=utf-8") ]
191
Removed:
stylesheet);
192
Removed:
]
193
Added:
194
Added:
let routes t =
195
Added:
[
196
Added:
Dream_html.get Routes.history (index t);
197
Added:
Dream_html.get Routes.record (show t);
198
Added:
Dream_html.post Routes.record_slot (log t);
199
Added:
]
200
Added:
end
201
Added:
202
Added:
module Assets = struct
203
Added:
let stylesheet =
204
Added:
match Stylesheet.read "hito.css" with
205
Added:
| Some stylesheet -> stylesheet
206
Added:
| None -> failwith "Embedded stylesheet hito.css is missing"
207
Added:
208
Added:
let routes =
209
Added:
[
210
Added:
Dream_html.get Routes.stylesheet (fun _ ->
211
Added:
Dream.respond
212
Added:
~headers:[ ("Content-Type", "text/css; charset=utf-8") ]
213
Added:
stylesheet);
214
Added:
]
215
Added:
end
216
Added:
217
Added:
let routes t =
218
Added:
Overview.routes t @ Current_workout.routes t @ History.routes t
219
Added:
@ Assets.routes