[OCaml] High Intensity Training Online
feat rework workout logging and show the record to beat
Replace the exercise accordion with a flat, always-visible set table: one row per movement with Load (kg) and Reps columns, completed slots struck through, and a separate ending block below. Show each exercise's most recent prior effort as a neutral "Last: N kg x M reps" line so the trainee knows the load and reps to beat — an observed fact, not a rep target. Reps inputs step by whole numbers. Cover both with end-to-end tests.
Changed files
lib/presenter/pages_workout.ml
@@ -45,62 +45,54 @@
45
45
[ txt "%s" (errors_to_text [ (field, error) ]) ];
46
46
]
47
47
48
Removed:
let input_row ?value:v ?(invalid = false) ?placeholder ~input_id
49
Removed:
(field : string) label =
50
Removed:
let error_attrs =
51
Removed:
if invalid then
48
Added:
(* One movement as a table row: exercise name, load input, reps input. The
49
Added:
surrounding table gives the Load and Reps column headers. A pre-exhaust pair
50
Added:
is simply two rows. *)
51
Added:
let movement_tr ~(errors : (string * string) list) ~name ~load_id ~load_field
52
Added:
~reps_id ~reps_field ?load_value ?reps_value ?previous ~reps_label () =
53
Added:
let number_td ~input_id ~field ~value ~step_ ~label =
54
Added:
tag "td" []
52
55
[
53
Removed:
Dream_html.string_attr "aria-invalid" "true";
54
Removed:
Dream_html.string_attr "aria-describedby" "%s" (error_id input_id);
56
Added:
tag "label"
57
Added:
[ Dream_html.string_attr "for" "%s" input_id; class_ "sr-only" ]
58
Added:
[ txt "%s" label ];
59
Added:
void "input"
60
Added:
([
61
Added:
type_ "number";
62
Added:
Dream_html.string_attr "name" "%s" field;
63
Added:
Dream_html.string_attr "id" "%s" input_id;
64
Added:
step "%s" step_;
65
Added:
required;
66
Added:
]
67
Added:
@ (if List.mem_assoc field errors then
68
Added:
[
69
Added:
Dream_html.string_attr "aria-invalid" "true";
70
Added:
Dream_html.string_attr "aria-describedby" "%s"
71
Added:
(error_id input_id);
72
Added:
]
73
Added:
else [])
74
Added:
@
75
Added:
match value with
76
Added:
| None -> []
77
Added:
| Some v -> [ Dream_html.string_attr "value" "%s" v ]);
55
78
]
56
Removed:
else []
57
79
in
58
Removed:
let placeholder_attr =
59
Removed:
match placeholder with
60
Removed:
| None -> []
61
Removed:
| Some p -> [ Dream_html.string_attr "placeholder" "%s" p ]
62
Removed:
in
63
Removed:
tag "div"
64
Removed:
[ class_ "field" ]
80
Added:
tag "tr" []
65
81
[
66
Removed:
tag "label"
67
Removed:
[ Dream_html.string_attr "for" "%s" input_id; class_ "sr-only" ]
68
Removed:
[ txt "%s" label ];
69
Removed:
void "input"
70
Removed:
([
71
Removed:
type_ "number";
72
Removed:
Dream_html.string_attr "name" "%s" field;
73
Removed:
Dream_html.string_attr "id" "%s" input_id;
74
Removed:
step "0.5";
75
Removed:
required;
76
Removed:
]
77
Removed:
@ placeholder_attr @ error_attrs
78
Removed:
@
79
Removed:
match v with
80
Removed:
| None -> []
81
Removed:
| Some v -> [ Dream_html.string_attr "value" "%s" v ]);
82
Added:
tag "th"
83
Added:
[ Dream_html.string_attr "scope" "row"; class_ "exercise-name" ]
84
Added:
(tag "span" [ class_ "exercise-name-label" ] [ txt "%s" name ]
85
Added:
::
86
Added:
(match previous with
87
Added:
| Some p ->
88
Added:
[ tag "span" [ class_ "exercise-previous" ] [ txt "Last: %s" p ] ]
89
Added:
| None -> []));
90
Added:
number_td ~input_id:load_id ~field:load_field ~value:load_value
91
Added:
~step_:"0.5" ~label:"Load (kg)";
92
Added:
number_td ~input_id:reps_id ~field:reps_field ~value:reps_value ~step_:"1"
93
Added:
~label:reps_label;
82
94
]
83
95
84
Removed:
(* A movement's fields as cells of the fieldset grid: the exercise name, the
85
Removed:
load input, and the reps input. The cells are direct participants of the one
86
Removed:
[.logging-grid] the fieldset wraps them in — a [display: contents] wrapper
87
Removed:
groups a movement without opening a nested grid — so every movement's name,
88
Removed:
load, and reps columns line up across the whole fieldset. The name reads as a
89
Removed:
heading, the inputs as labelled fields. *)
90
Removed:
let movement_row ~(errors : (string * string) list) ~name ~load_id ~load_field
91
Removed:
~reps_id ~reps_field ?load_value ?reps_value ~reps_label () =
92
Removed:
tag "div"
93
Removed:
[ class_ "movement" ]
94
Removed:
[
95
Removed:
tag "p" [ class_ "exercise-name" ] [ txt "%s" name ];
96
Removed:
input_row ?value:load_value ~placeholder:"kg"
97
Removed:
~invalid:(List.mem_assoc load_field errors)
98
Removed:
~input_id:load_id load_field "Load (kg)";
99
Removed:
input_row ?value:reps_value ~placeholder:"reps"
100
Removed:
~invalid:(List.mem_assoc reps_field errors)
101
Removed:
~input_id:reps_id reps_field reps_label;
102
Removed:
]
103
Removed:
104
96
(* [movements] carries the record/correction field spec the controller built
105
97
from the slot's prescription: one row for a single exercise, two for a
106
98
pre-exhaust pair, each already pre-filled when correcting. [submit] names the
@@ -108,16 +100,16 @@
108
100
let form_for_stimulus request ~action_path ~slot
109
101
~(movements : View_model.Workout.movement list) ~selected_extension
110
102
~selected_extension_amount ?(enhanced = false) ?(submit = "Record")
111
Removed:
~(errors : (string * string) list) () =
103
Added:
?(correction = false) ~(errors : (string * string) list) () =
112
104
let field_id field = Printf.sprintf "slot-%d-%s" slot field in
113
105
let selected = selected_extension in
114
106
let movement_of (m : View_model.Workout.movement) =
115
Removed:
movement_row ~errors ~name:m.name ~load_id:(field_id m.load_field)
107
Added:
movement_tr ~errors ~name:m.name ~load_id:(field_id m.load_field)
116
108
~load_field:m.load_field ~reps_id:(field_id m.reps_field)
117
109
~reps_field:m.reps_field ?load_value:m.load_value ?reps_value:m.reps_value
118
Removed:
~reps_label:m.reps_label ()
110
Added:
?previous:m.previous ~reps_label:m.reps_label ()
119
111
in
120
Removed:
let fields = List.map movement_of movements in
112
Added:
let rows = List.map movement_of movements in
121
113
(* The error rows follow the fields present, so a single-exercise slot reports
122
114
load/reps and a pre-exhaust slot reports the iso/comp fields. *)
123
115
let field_names =
@@ -128,82 +120,129 @@
128
120
in
129
121
tag "form"
130
122
([ action_path; post_form ]
131
Removed:
@
132
Removed:
if enhanced then [ Dream_html.attr "data-hito-workout-form" ]
133
Removed:
else [ Dream_html.attr "data-hito-app-form" ])
123
Added:
@ (if enhanced then [ Dream_html.attr "data-hito-workout-form" ]
124
Added:
else [ Dream_html.attr "data-hito-app-form" ])
125
Added:
@ if correction then [ Dream_html.attr "data-hito-correction-form" ] else []
126
Added:
)
134
127
[
135
128
Dream_html.csrf_tag request;
136
129
tag "fieldset"
137
130
[ class_ "logging-fieldset" ]
138
Removed:
(tag "div"
139
Removed:
[ class_ "logging-grid" ]
140
Removed:
(fields
141
Removed:
@ [
142
Removed:
tag "div"
143
Removed:
[ class_ "field field-ending" ]
144
Removed:
[
145
Removed:
tag "label"
146
Removed:
[
147
Removed:
Dream_html.string_attr "for" "%s" (field_id "extension");
148
Removed:
]
149
Removed:
[ txt "Ending" ];
150
Removed:
extension_select ~selected
151
Removed:
~invalid:(List.mem_assoc "extension" errors)
152
Removed:
~input_id:(field_id "extension") ();
153
Removed:
];
154
Removed:
tag "div"
155
Removed:
[ class_ "field field-extension-amount" ]
156
Removed:
[
157
Removed:
tag "label"
158
Removed:
[
159
Removed:
Dream_html.string_attr "for" "%s"
160
Removed:
(field_id "extension_amount");
161
Removed:
]
162
Removed:
[
163
Removed:
tag "span"
164
Removed:
[ class_ "amount-label-reps" ]
165
Removed:
[ txt "Extension reps" ];
166
Removed:
tag "span" [ class_ "amount-label-sep" ] [ txt " / " ];
167
Removed:
tag "span"
168
Removed:
[ class_ "amount-label-seconds" ]
169
Removed:
[ txt "Hold seconds" ];
170
Removed:
];
171
Removed:
void "input"
172
Removed:
[
173
Removed:
type_ "number";
174
Removed:
name "extension_amount";
175
Removed:
Dream_html.string_attr "id" "%s"
176
Removed:
(field_id "extension_amount");
177
Removed:
Dream_html.string_attr "min" "1";
178
Removed:
Dream_html.string_attr "value" "%s"
179
Removed:
selected_extension_amount;
180
Removed:
];
181
Removed:
];
182
Removed:
])
131
Added:
((* The set as a plain table: one row per movement, with Load and Reps
132
Added:
column headers. The Ending block is separate, below the table. *)
133
Added:
tag "table"
134
Added:
[ class_ "logging-table" ]
135
Added:
[
136
Added:
tag "thead" []
137
Added:
[
138
Added:
tag "tr" []
139
Added:
[
140
Added:
(* Empty header over the exercise-name column: the names are
141
Added:
self-describing, so the column needs no label. *)
142
Added:
tag "th" [ Dream_html.string_attr "scope" "col" ] [];
143
Added:
tag "th"
144
Added:
[ Dream_html.string_attr "scope" "col" ]
145
Added:
[ txt "Load (kg)" ];
146
Added:
tag "th"
147
Added:
[ Dream_html.string_attr "scope" "col" ]
148
Added:
[ txt "Reps" ];
149
Added:
];
150
Added:
];
151
Added:
tag "tbody" [] rows;
152
Added:
]
153
Added:
:: tag "div"
154
Added:
[ class_ "ending-block" ]
155
Added:
[
156
Added:
tag "div"
157
Added:
[ class_ "field field-ending" ]
158
Added:
[
159
Added:
tag "label"
160
Added:
[
161
Added:
Dream_html.string_attr "for" "%s" (field_id "extension");
162
Added:
class_ "sr-only";
163
Added:
]
164
Added:
[ txt "Ending" ];
165
Added:
extension_select ~selected
166
Added:
~invalid:(List.mem_assoc "extension" errors)
167
Added:
~input_id:(field_id "extension") ();
168
Added:
];
169
Added:
tag "div"
170
Added:
[ class_ "field field-extension-amount" ]
171
Added:
[
172
Added:
tag "label"
173
Added:
[
174
Added:
Dream_html.string_attr "for" "%s"
175
Added:
(field_id "extension_amount");
176
Added:
class_ "sr-only";
177
Added:
]
178
Added:
[
179
Added:
tag "span"
180
Added:
[ class_ "amount-label-reps" ]
181
Added:
[ txt "Extension reps" ];
182
Added:
tag "span" [ class_ "amount-label-sep" ] [ txt " / " ];
183
Added:
tag "span"
184
Added:
[ class_ "amount-label-seconds" ]
185
Added:
[ txt "Hold seconds" ];
186
Added:
];
187
Added:
void "input"
188
Added:
[
189
Added:
type_ "number";
190
Added:
name "extension_amount";
191
Added:
Dream_html.string_attr "id" "%s"
192
Added:
(field_id "extension_amount");
193
Added:
Dream_html.string_attr "min" "1";
194
Added:
step "1";
195
Added:
Dream_html.string_attr "value" "%s"
196
Added:
selected_extension_amount;
197
Added:
];
198
Added:
tag "span"
199
Added:
[ class_ "field-unit" ]
200
Added:
[
201
Added:
tag "span" [ class_ "amount-label-reps" ] [ txt "reps" ];
202
Added:
tag "span" [ class_ "amount-label-sep" ] [ txt " / " ];
203
Added:
tag "span"
204
Added:
[ class_ "amount-label-seconds" ]
205
Added:
[ txt "seconds" ];
206
Added:
];
207
Added:
];
208
Added:
]
183
209
:: List.concat_map
184
210
(fun field -> error_for ~input_id:(field_id field) field errors)
185
211
field_names
186
Removed:
@ [
212
Added:
@
213
Added:
if correction then
214
Added:
[
215
Added:
tag "div"
216
Added:
[
217
Added:
class_ "button-group correction-actions";
218
Added:
Dream_html.attr "data-hito-correction-actions";
219
Added:
]
220
Added:
[
221
Added:
void "input"
222
Added:
[ type_ "submit"; Dream_html.string_attr "value" "%s" submit ];
223
Added:
tag "button"
224
Added:
[
225
Added:
type_ "reset";
226
Added:
class_ "secondary";
227
Added:
Dream_html.attr "data-hito-correction-reset";
228
Added:
]
229
Added:
[ txt "Reset" ];
230
Added:
];
231
Added:
]
232
Added:
else
233
Added:
[
187
234
void "input"
188
235
[ type_ "submit"; Dream_html.string_attr "value" "%s" submit ];
189
236
]);
190
237
]
191
238
192
239
let workout request ~viewer ?(errors = []) ?editing ?logging ~record_id
193
Removed:
~active_slot (vm : View_model.Workout.t) =
240
Added:
~active_slot:_ (vm : View_model.Workout.t) =
194
241
let enhanced = Option.is_none record_id in
195
242
(* A live workout view is itself the workout in progress, so the middle nav
196
243
action reads "Current workout". A saved-record view defers to the handler,
197
244
which knows whether a separate workout is in progress. *)
198
245
let logging = Option.value logging ~default:enhanced in
199
Removed:
let slot_count = List.length vm.slots in
200
Removed:
let filled_slots =
201
Removed:
List.length
202
Removed:
(List.filter
203
Removed:
(fun (s : View_model.Workout.slot) ->
204
Removed:
Option.is_some s.recorded_summary)
205
Removed:
vm.slots)
206
Removed:
in
207
246
let record_action slot =
208
247
match record_id with
209
248
| None -> action Routes.workout_slot slot
@@ -214,36 +253,25 @@
214
253
| None -> action Routes.workout_slot_edit slot
215
254
| Some record_id -> action Routes.record_slot_edit record_id slot
216
255
in
217
Removed:
(* The early-workout notice. The override was already confirmed in a modal, so
218
Removed:
on the workout screen this is informational only: a toast rather than a
219
Removed:
component in the main content. It is a polite live region. The client shows
220
Removed:
it briefly then dismisses it. Without script it stays visible as a quiet
221
Removed:
fixed notice, so a no-JS visitor is still told. *)
222
Removed:
let override_note =
223
Removed:
if vm.overridden then [ toast "Begun before recovery finished." ] else []
224
Removed:
in
225
Removed:
(* The exercise accordion: one <details> per prescription slot, all sharing a
226
Removed:
[name], which the browser treats as an exclusive group — opening one closes
227
Removed:
the rest, with no script. The active slot is open; the handler still picks
228
Removed:
it from [?slot=], so a record or correction reopens the slot it belongs to.
229
Removed:
A recorded slot shows its summary and a pre-filled correction form (which
230
Removed:
replaces the slot rather than adding volume); an outstanding slot shows the
231
Removed:
record form. Errors render only under the slot being edited. *)
256
Added:
(* Each prescription slot is a flat, always-visible section: a heading (its
257
Added:
number and exercise label, struck through once recorded) followed by the
258
Added:
record form, or — once recorded — a pre-filled correction form (a
259
Added:
correction replaces the slot rather than adding volume). The struck heading
260
Added:
and the pre-filled fields already show what was recorded, so no separate
261
Added:
summary line is repeated. Errors render only under the slot being edited. *)
232
262
let slot_section (slot : View_model.Workout.slot) =
233
263
let index = slot.index in
234
264
let errors = if editing = Some index then errors else [] in
235
265
let done_ = Option.is_some slot.recorded_summary in
236
266
let body =
237
267
match slot.recorded_summary with
238
Removed:
| Some summary ->
268
Added:
| Some _ ->
239
269
[
240
Removed:
tag "p" [ class_ "eyebrow" ] [ txt "Recorded" ];
241
Removed:
tag "p" [ class_ "done" ] [ txt "%s" summary ];
242
270
form_for_stimulus request ~action_path:(edit_action index)
243
271
~slot:index ~movements:slot.movements
244
272
~selected_extension:slot.selected_extension
245
273
~selected_extension_amount:slot.selected_extension_amount
246
Removed:
~enhanced ~submit:"Save correction" ~errors ();
274
Added:
~enhanced ~submit:"Save correction" ~correction:true ~errors ();
247
275
]
248
276
| None ->
249
277
[
@@ -254,29 +282,23 @@
254
282
~enhanced ~errors ();
255
283
]
256
284
in
257
Removed:
tag "details"
258
Removed:
([
259
Removed:
class_ "slot-accordion";
260
Removed:
Dream_html.string_attr "name" "exercise";
261
Removed:
Dream_html.string_attr "id" "slot-%d" index;
262
Removed:
]
263
Removed:
@ (if index = active_slot then [ Dream_html.attr "open" ] else [])
264
Removed:
@ if done_ then [ Dream_html.string_attr "data-done" "true" ] else [])
265
Removed:
[
266
Removed:
tag "summary" []
267
Removed:
[
268
Removed:
tag "span" [ class_ "slot-number" ] [ txt "%d." (index + 1) ];
269
Removed:
tag "span" [ class_ "slot-label" ] [ txt "%s" slot.label ];
270
Removed:
(if done_ then tag "span" [ class_ "slot-done" ] [ txt "done" ]
271
Removed:
else txt "");
272
Removed:
];
273
Removed:
tag "div"
274
Removed:
[ class_ "slot-panel" ]
275
Removed:
[ tag "div" [ class_ "slot-panel-body" ] body ];
276
Removed:
]
285
Added:
tag "section"
286
Added:
[ class_ "slot-section"; Dream_html.string_attr "id" "slot-%d" index ]
287
Added:
(tag "h2"
288
Added:
[ class_ "slot-heading" ]
289
Added:
[
290
Added:
tag "span" [ class_ "slot-number" ] [ txt "%d." (index + 1) ];
291
Added:
tag "span"
292
Added:
[
293
Added:
Dream_html.string_attr "class" "slot-label%s"
294
Added:
(if done_ then " slot-label-done" else "");
295
Added:
]
296
Added:
[ txt "%s" slot.label ];
297
Added:
]
298
Added:
:: body)
277
299
in
278
Removed:
let accordion =
279
Removed:
[ tag "div" [ class_ "slot-accordions" ] (List.map slot_section vm.slots) ]
300
Added:
let slots =
301
Added:
[ tag "div" [ class_ "slot-sections" ] (List.map slot_section vm.slots) ]
280
302
in
281
303
let complete_note =
282
304
if vm.all_recorded then
@@ -300,9 +322,10 @@
300
322
class_ "workout-timer";
301
323
Dream_html.attr "data-hito-workout-timer";
302
324
Dream_html.string_attr "data-started" "%d" started;
325
Added:
Dream_html.string_attr "role" "timer";
326
Added:
Dream_html.string_attr "aria-label" "Elapsed workout time";
303
327
]
304
328
[
305
Removed:
tag "span" [ class_ "workout-timer-label" ] [ txt "Elapsed" ];
306
329
tag "span"
307
330
[
308
331
class_ "workout-timer-value";
@@ -397,14 +420,9 @@
397
420
Dream_html.attr "data-hito-workout-content";
398
421
]
399
422
else [])
400
Removed:
(timer_bar @ override_note
401
Removed:
@ [
402
Removed:
tag "h1" [] [ txt "%s" vm.name ];
403
Removed:
tag "p"
404
Removed:
[ class_ "ledger-meta" ]
405
Removed:
[ txt "%d of %d recorded." filled_slots slot_count ];
406
Removed:
]
407
Removed:
@ accordion @ complete_note @ finish_section
423
Added:
(timer_bar
424
Added:
@ [ tag "h1" [] [ txt "%s" vm.name ] ]
425
Added:
@ slots @ complete_note @ finish_section
408
426
@
409
427
if enhanced then
410
428
[
lib/presenter/view_model.ml
@@ -85,6 +85,11 @@
85
85
load_value : string option;
86
86
(** Pre-fill when correcting a recorded slot. *)
87
87
reps_value : string option;
88
Added:
previous : string option;
89
Added:
(** The most recent prior effort for this exercise, pre-formatted as the
90
Added:
record to beat (for example ["60 kg × 12 reps"]). [None] when the
91
Added:
exercise has no earlier observation. It is an observed fact, not a
92
Added:
target — the set still ends at failure. *)
88
93
}
89
94
(** One input row of a slot's record/correction form. The controller emits one
90
95
movement for a single-exercise slot and two for a pre-exhaust pair, so the
lib/web/handlers_kit.ml
@@ -270,7 +270,7 @@
270
270
(Format.asprintf "%a" Evidence.Stimulus.pp_extension)
271
271
extensions)
272
272
273
Removed:
let workout_view ~active_slot workout : View_model.Workout.t =
273
Added:
let workout_view ~active_slot ~log workout : View_model.Workout.t =
274
274
let prescription = Evidence.Workout.prescription workout in
275
275
let prescribed_slots = Prescription.Workout.stimuli prescription in
276
276
(* One entry per filled slot, the first fill in performance order — the fill
@@ -284,6 +284,19 @@
284
284
in
285
285
let load_string load = Printf.sprintf "%g" load in
286
286
let reps_string reps = string_of_int reps in
287
Added:
(* The most recent prior effort for [exercise], pre-formatted as the record
288
Added:
to beat. The log holds finished history only, so the in-progress workout
289
Added:
is never compared against itself. An observed fact, not a target. *)
290
Added:
let previous_of exercise =
291
Added:
match List.rev (Evidence.Log.observations log exercise) with
292
Added:
| latest :: _ ->
293
Added:
let e = Evidence.Observation.effort latest in
294
Added:
Some
295
Added:
(Printf.sprintf "%s kg × %d reps"
296
Added:
(load_string (Evidence.Stimulus.Effort.load e))
297
Added:
(Evidence.Stimulus.Effort.reps e))
298
Added:
| [] -> None
299
Added:
in
287
300
let label p =
288
301
match Prescription.Stimulus.delivery p with
289
302
| Prescription.Stimulus.Single e -> Exercise.name e
@@ -316,6 +329,7 @@
316
329
reps_label = "Reps to failure";
317
330
load_value = load_of 0;
318
331
reps_value = reps_of 0;
332
Added:
previous = previous_of exercise;
319
333
};
320
334
]
321
335
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
@@ -327,6 +341,7 @@
327
341
reps_label = "Reps";
328
342
load_value = load_of 0;
329
343
reps_value = reps_of 0;
344
Added:
previous = previous_of isolation;
330
345
};
331
346
{
332
347
name = Exercise.name compound;
@@ -335,6 +350,7 @@
335
350
reps_label = "Reps";
336
351
load_value = load_of 1;
337
352
reps_value = reps_of 1;
353
Added:
previous = previous_of compound;
338
354
};
339
355
]
340
356
in
lib/web/handlers_logbook.ml
@@ -30,8 +30,6 @@
30
30
leveled "difficulty" (fun l -> Feedback.Difficulty l);
31
31
]
32
32
33
Removed:
let describe_signal = Present.feedback_signal
34
Removed:
35
33
let date_of_unix seconds =
36
34
let tm = Unix.gmtime (float_of_int seconds) in
37
35
Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900)
@@ -246,12 +244,6 @@
246
244
}
247
245
: View_model.Logbook_entry.t)
248
246
249
Removed:
let feedback_view (report : Feedback.t) : View_model.Feedback.report =
250
Removed:
{
251
Removed:
at_unix = Recovery.timestamp_to_unix_seconds (Feedback.reported_at report);
252
Removed:
signals = List.map describe_signal (Feedback.signals report);
253
Removed:
}
254
Removed:
255
247
let index t trainee request =
256
248
let viewer =
257
249
{
@@ -263,12 +255,8 @@
263
255
Service.history t.service trainee.Trainee.id >>= fun records ->
264
256
Service.workout_log t.service trainee.Trainee.id >>= fun log ->
265
257
Service.imported_records t.service trainee.Trainee.id >>= fun imported ->
266
Removed:
Service.feedback t.service trainee.Trainee.id >>= fun feedback ->
267
258
Lwt_list.map_s (imported_entry_view t trainee.Trainee.id) imported
268
259
>>= fun imported_entries ->
269
Removed:
let feedback = List.map feedback_view feedback in
270
Removed:
(* Native prescribed records and read-only imports, interleaved by start
271
Removed:
date, most recent first. *)
272
260
let all_records =
273
261
List.map (entry_view log) records @ imported_entries
274
262
|> List.stable_sort (fun a b ->
@@ -319,7 +307,7 @@
319
307
html
320
308
(Pages.logbook request
321
309
~logging:(Option.is_some in_progress)
322
Removed:
~viewer ~feedback ~calendar
310
Added:
~viewer ~calendar
323
311
~suggest_feedback:
324
312
(match Dream.query request "prompt" with
325
313
| Some "feedback" -> true
@@ -351,6 +339,7 @@
351
339
}
352
340
in
353
341
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
342
Added:
Service.workout_log t.service trainee.Trainee.id >>= fun log ->
354
343
record_target t trainee.Trainee.id id >>= function
355
344
| None -> not_found Present.unknown_record
356
345
| Some (_, workout) ->
@@ -359,7 +348,7 @@
359
348
(Pages.workout request ~viewer
360
349
~logging:(Option.is_some in_progress)
361
350
~record_id:(Some id) ~active_slot
362
Removed:
(workout_view ~active_slot workout))
351
Added:
(workout_view ~active_slot ~log workout))
363
352
364
353
let log t trainee request id slot =
365
354
record_target t trainee.Trainee.id id >>= function
test/web/workout.ml
@@ -181,7 +181,33 @@
181
181
Alcotest.(check int) "corrected" 303 (status corrected);
182
182
(* A correction replaces the slot; it does not add volume. *)
183
183
Alcotest.(check int)
184
Removed:
"still one filled slot, not two" 1 (filled_after_record ()) );
184
Added:
"still one filled slot, not two" 1 (filled_after_record ());
185
Added:
(* The stored slot now holds the corrected values, not the originals. *)
186
Added:
let slot1_effort () =
187
Added:
match
188
Added:
Lwt_main.run (Memory_repo.in_progress repo trainee.Trainee.id)
189
Added:
with
190
Added:
| Some w -> (
191
Added:
match List.assoc_opt 1 (Evidence.Workout.performed w) with
192
Added:
| Some s -> List.hd (Evidence.Stimulus.efforts s)
193
Added:
| None -> Alcotest.failf "expected slot 1 to be filled")
194
Added:
| None -> Alcotest.failf "expected a workout in progress"
195
Added:
in
196
Added:
let effort = slot1_effort () in
197
Added:
Alcotest.(check (float 0.001))
198
Added:
"load updated to the corrected value" 16.
199
Added:
(Evidence.Stimulus.Effort.load effort);
200
Added:
Alcotest.(check int)
201
Added:
"reps updated to the corrected value" 6
202
Added:
(Evidence.Stimulus.Effort.reps effort);
203
Added:
(* The rendered workout form pre-fills the corrected values. *)
204
Added:
let page = body (get c "/workout?slot=1") in
205
Added:
Alcotest.(check bool)
206
Added:
"the form shows the corrected load" true
207
Added:
(Option.is_some (index_from ~needle:"value=\"16\"" page 0));
208
Added:
Alcotest.(check bool)
209
Added:
"the form shows the corrected reps" true
210
Added:
(Option.is_some (index_from ~needle:"value=\"6\"" page 0)) );
185
211
( "an invalid workout field is rejected and records nothing",
186
212
`Quick,
187
213
fun () ->
@@ -498,5 +524,168 @@
498
524
(match Recovery.basis (Evidence.Workout.clearance workout) with
499
525
| Recovery.Recovered -> true
500
526
| Recovery.Overridden _ -> false) );
527
Added:
( "recording a slot crosses it off in the flat slot list",
528
Added:
`Quick,
529
Added:
fun () ->
530
Added:
let c = client () in
531
Added:
let _ = sign_in_new c in
532
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
533
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
534
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
535
Added:
let _ =
536
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
537
Added:
in
538
Added:
(* Record slot 0 (the pre-exhaust pair), then reload the workout. *)
539
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
540
Added:
let recorded =
541
Added:
post c "/workout/slots/0"
542
Added:
[
543
Added:
("dream.csrf", token);
544
Added:
("iso_load", "10");
545
Added:
("iso_reps", "8");
546
Added:
("comp_load", "40");
547
Added:
("comp_reps", "6");
548
Added:
("extension", "");
549
Added:
]
550
Added:
in
551
Added:
Alcotest.(check int) "slot 0 recorded" 303 (status recorded);
552
Added:
let page = body (get c "/workout") in
553
Added:
(* The completed slot's label is struck through. *)
554
Added:
Alcotest.(check bool)
555
Added:
"the recorded slot label is crossed off" true
556
Added:
(Option.is_some (index_from ~needle:"slot-label-done" page 0));
557
Added:
(* The slots are a flat list, not an accordion: no <details>. *)
558
Added:
Alcotest.(check bool)
559
Added:
"no accordion details element remains" true
560
Added:
(Option.is_none (index_from ~needle:"slot-accordion" page 0));
561
Added:
Alcotest.(check bool)
562
Added:
"the slots render as flat sections" true
563
Added:
(Option.is_some (index_from ~needle:"slot-section" page 0));
564
Added:
(* Every slot is present at once, including a later one. *)
565
Added:
Alcotest.(check bool)
566
Added:
"a later slot is visible without interaction" true
567
Added:
(Option.is_some (index_from ~needle:"id=\"slot-1\"" page 0));
568
Added:
(* The recorded slot offers a correction form with paired Save and
569
Added:
Reset actions, shown only once a field changes (via the client). *)
570
Added:
Alcotest.(check bool)
571
Added:
"the correction form is marked for change tracking" true
572
Added:
(Option.is_some
573
Added:
(index_from ~needle:"data-hito-correction-form" page 0));
574
Added:
Alcotest.(check bool)
575
Added:
"the correction actions pair Save and Reset" true
576
Added:
(Option.is_some
577
Added:
(index_from ~needle:"data-hito-correction-actions" page 0));
578
Added:
Alcotest.(check bool)
579
Added:
"a Reset control is present" true
580
Added:
(Option.is_some
581
Added:
(index_from ~needle:"data-hito-correction-reset" page 0));
582
Added:
Alcotest.(check bool)
583
Added:
"a Save correction control is present" true
584
Added:
(Option.is_some (index_from ~needle:"Save correction" page 0)) );
585
Added:
( "a record and a correction each redirect, and the reloaded page \
586
Added:
shows the saved values",
587
Added:
`Quick,
588
Added:
fun () ->
589
Added:
let c = client () in
590
Added:
let _ = sign_in_new c in
591
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
592
Added:
let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in
593
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
594
Added:
let _ =
595
Added:
post c "/workout" [ ("dream.csrf", token); ("override", "false") ]
596
Added:
in
597
Added:
(* Record slot 1, then correct it. Both submit natively (full page),
598
Added:
so each answers a 303 redirect and the followed GET reflects the
599
Added:
saved value — the behaviour that guarantees accuracy. *)
600
Added:
let token =
601
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
602
Added:
in
603
Added:
let recorded =
604
Added:
post c "/workout/slots/1"
605
Added:
[
606
Added:
("dream.csrf", token);
607
Added:
("load", "12");
608
Added:
("reps", "8");
609
Added:
("extension", "");
610
Added:
]
611
Added:
in
612
Added:
Alcotest.(check int) "record redirects" 303 (status recorded);
613
Added:
let token =
614
Added:
Option.get (csrf_token (body (get c "/workout?slot=1")))
615
Added:
in
616
Added:
let corrected =
617
Added:
post c "/workout/slots/1/edit"
618
Added:
[
619
Added:
("dream.csrf", token);
620
Added:
("load", "16");
621
Added:
("reps", "6");
622
Added:
("extension", "");
623
Added:
]
624
Added:
in
625
Added:
Alcotest.(check int) "correction redirects" 303 (status corrected);
626
Added:
let page = body (get c "/workout?slot=1") in
627
Added:
Alcotest.(check bool)
628
Added:
"the reloaded form shows the corrected load" true
629
Added:
(Option.is_some (index_from ~needle:"value=\"16\"" page 0));
630
Added:
Alcotest.(check bool)
631
Added:
"the reloaded form shows the corrected reps" true
632
Added:
(Option.is_some (index_from ~needle:"value=\"6\"" page 0));
633
Added:
Alcotest.(check bool)
634
Added:
"the stale load is gone" true
635
Added:
(Option.is_none (index_from ~needle:"value=\"12\"" page 0)) );
636
Added:
( "the logging form shows the prior effort as the record to beat",
637
Added:
`Quick,
638
Added:
fun () ->
639
Added:
(* An empty log offers no record to beat; once an exercise has a
640
Added:
finished effort, its next appearance shows that prior effort. *)
641
Added:
let c, now, _repo = clocked_client () in
642
Added:
now := day 10;
643
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
644
Added:
let _ = start_day_one c in
645
Added:
(* The first-ever Day 1 has no history: no record-to-beat line. *)
646
Added:
Alcotest.(check bool)
647
Added:
"no prior effort on the first workout" true
648
Added:
(Option.is_none
649
Added:
(index_from ~needle:"exercise-previous"
650
Added:
(body (get c "/workout"))
651
Added:
0));
652
Added:
record_all_day_one_slots c;
653
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
654
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
655
Added:
(* Advance through the cycle until Day 1 comes round again, resting
656
Added:
past the 48-hour gate before each begin. *)
657
Added:
let rec reach_day_one attempts d =
658
Added:
if attempts = 0 then Alcotest.failf "Day 1 did not recur"
659
Added:
else begin
660
Added:
now := day d;
661
Added:
let token = Option.get (csrf_token (body (get c "/"))) in
662
Added:
let _ =
663
Added:
post c "/workout"
664
Added:
[ ("dream.csrf", token); ("override", "false") ]
665
Added:
in
666
Added:
let page = body (get c "/workout") in
667
Added:
if Option.is_some (index_from ~needle:">Day 1<" page 0) then
668
Added:
page
669
Added:
else begin
670
Added:
record_all_day_one_slots c;
671
Added:
let token =
672
Added:
Option.get (csrf_token (body (get c "/workout")))
673
Added:
in
674
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
675
Added:
reach_day_one (attempts - 1) (d + 3)
676
Added:
end
677
Added:
end
678
Added:
in
679
Added:
let day_one_again = reach_day_one 6 13 in
680
Added:
(* Slot 1 (Laterals) was recorded at 12 kg × 8 reps; its next Day 1
681
Added:
appearance states that as the record to beat. *)
682
Added:
Alcotest.(check bool)
683
Added:
"the prior effort line is shown" true
684
Added:
(Option.is_some
685
Added:
(index_from ~needle:"exercise-previous" day_one_again 0));
686
Added:
Alcotest.(check bool)
687
Added:
"the prior load and reps are stated" true
688
Added:
(Option.is_some
689
Added:
(index_from ~needle:"Last: 12 kg × 8 reps" day_one_again 0)) );
501
690
] );
502
691
]