[OCaml] High Intensity Training Online
refactor make warm-ups workout preparation
Preparation precedes working stimuli rather than belonging to an arbitrary recorded set. Keep the HD1 ordering invariant in the core and expose a dedicated preparation flow in the application.
Changed files
lib/app/service.ml
@@ -88,6 +88,16 @@
88
88
Format.pp_print_string ppf "no workout in progress"
89
89
| Rejected e -> Evidence.Workout.pp_error ppf e
90
90
91
Added:
let add_warm_up t warm_up =
92
Added:
match t.current with
93
Added:
| None -> Error No_workout_in_progress
94
Added:
| Some workout -> (
95
Added:
match Evidence.Workout.add_warm_up workout warm_up with
96
Added:
| Error error -> Error (Rejected error)
97
Added:
| Ok updated ->
98
Added:
t.current <- Some updated;
99
Added:
Ok updated)
100
Added:
91
101
let log t stimulus =
92
102
match t.current with
93
103
| None -> Error No_workout_in_progress
lib/app/service.mli
@@ -60,6 +60,10 @@
60
60
61
61
val pp_log_error : Format.formatter -> log_error -> unit
62
62
63
Added:
val add_warm_up :
64
Added:
t -> Evidence.Stimulus.Warm_up.t -> (Evidence.Workout.t, log_error) result
65
Added:
(** Record preparation before the first working stimulus. *)
66
Added:
63
67
val log : t -> Evidence.Stimulus.t -> (Evidence.Workout.t, log_error) result
64
68
(** Record a stimulus against the workout in progress. *)
65
69
lib/core/evidence.ml
@@ -66,15 +66,10 @@
66
66
| Single of Movement.t
67
67
| Pair of { first : Movement.t; second : Movement.t }
68
68
69
Removed:
type t = {
70
Removed:
delivery : delivery;
71
Removed:
warm_ups : Warm_up.t list;
72
Removed:
note : string option;
73
Removed:
}
69
Added:
type t = { delivery : delivery; note : string option }
74
70
75
Removed:
let make ?(warm_ups = []) ?note delivery = { delivery; warm_ups; note }
71
Added:
let make ?note delivery = { delivery; note }
76
72
let delivery t = t.delivery
77
Removed:
let warm_ups t = t.warm_ups
78
73
let note t = t.note
79
74
80
75
let movements t =
@@ -159,7 +154,7 @@
159
154
prescribed : shape;
160
155
logged : shape;
161
156
}
162
Removed:
| Warm_ups_after_first_stimulus
157
Added:
| Warm_ups_after_working_stimulus
163
158
| Not_finished
164
159
165
160
type t = {
@@ -168,6 +163,7 @@
168
163
started_at : Recovery.timestamp;
169
164
ended_at : Recovery.timestamp option;
170
165
feedback : Feedback.t option;
166
Added:
warm_ups : Stimulus.Warm_up.t list;
171
167
performed : (int * Stimulus.t) list;
172
168
}
173
169
@@ -183,9 +179,8 @@
183
179
Format.fprintf ppf "%s is prescribed as %a but was logged as %a"
184
180
(exercise :> string)
185
181
pp_shape prescribed pp_shape logged
186
Removed:
| Warm_ups_after_first_stimulus ->
187
Removed:
Format.pp_print_string ppf
188
Removed:
"warm-ups belong only before the first stimulus"
182
Added:
| Warm_ups_after_working_stimulus ->
183
Added:
Format.pp_print_string ppf "warm-ups belong only before working stimuli"
189
184
| Not_finished -> Format.pp_print_string ppf "this workout is not finished"
190
185
191
186
let start prescription ~clearance ~started_at =
@@ -195,6 +190,7 @@
195
190
started_at;
196
191
ended_at = None;
197
192
feedback = None;
193
Added:
warm_ups = [];
198
194
performed = [];
199
195
}
200
196
@@ -204,6 +200,7 @@
204
200
let ended_at t = t.ended_at
205
201
let is_finished t = Option.is_some t.ended_at
206
202
let feedback t = t.feedback
203
Added:
let warm_ups t = List.rev t.warm_ups
207
204
let stimuli t = List.map snd (List.rev t.performed)
208
205
209
206
let duration t =
@@ -251,35 +248,32 @@
251
248
let unperformed t = List.map snd (outstanding t)
252
249
let completeness t = if outstanding t = [] then Complete else Incomplete
253
250
251
Added:
let add_warm_up t warm_up =
252
Added:
if t.performed <> [] then Error Warm_ups_after_working_stimulus
253
Added:
else Ok { t with warm_ups = warm_up :: t.warm_ups }
254
Added:
254
255
let add_stimulus t s =
255
Removed:
if t.performed <> [] && Stimulus.warm_ups s <> [] then
256
Removed:
Error Warm_ups_after_first_stimulus
257
Removed:
else
258
Removed:
let candidates = List.filter (fun (_, p) -> mentions p s) (indexed t) in
259
Removed:
let matching = List.filter (fun (_, p) -> conforms p s) candidates in
260
Removed:
let leading = Exercise.id (List.hd (Stimulus.exercises s)) in
261
Removed:
match (candidates, matching) with
262
Removed:
| [], _ -> Error (Not_prescribed leading)
263
Removed:
| (_, p) :: _, [] ->
264
Removed:
Error
265
Removed:
(Delivery_mismatch
266
Removed:
{
267
Removed:
exercise = leading;
268
Removed:
prescribed = prescribed_shape p;
269
Removed:
logged = logged_shape s;
270
Removed:
})
271
Removed:
| _, matching ->
272
Removed:
let unanswered =
273
Removed:
List.filter (fun (i, _) -> not (List.mem i (answered t))) matching
274
Removed:
in
275
Removed:
let i, _ =
276
Removed:
match unanswered with
277
Removed:
| chosen :: _ -> chosen
278
Removed:
| [] -> List.hd matching
279
Removed:
in
280
Removed:
if Stimulus.warm_ups s <> [] && i <> 0 then
281
Removed:
Error Warm_ups_after_first_stimulus
282
Removed:
else Ok { t with performed = (i, s) :: t.performed }
256
Added:
let candidates = List.filter (fun (_, p) -> mentions p s) (indexed t) in
257
Added:
let matching = List.filter (fun (_, p) -> conforms p s) candidates in
258
Added:
let leading = Exercise.id (List.hd (Stimulus.exercises s)) in
259
Added:
match (candidates, matching) with
260
Added:
| [], _ -> Error (Not_prescribed leading)
261
Added:
| (_, p) :: _, [] ->
262
Added:
Error
263
Added:
(Delivery_mismatch
264
Added:
{
265
Added:
exercise = leading;
266
Added:
prescribed = prescribed_shape p;
267
Added:
logged = logged_shape s;
268
Added:
})
269
Added:
| _, matching ->
270
Added:
let unanswered =
271
Added:
List.filter (fun (i, _) -> not (List.mem i (answered t))) matching
272
Added:
in
273
Added:
let i, _ =
274
Added:
match unanswered with chosen :: _ -> chosen | [] -> List.hd matching
275
Added:
in
276
Added:
Ok { t with performed = (i, s) :: t.performed }
283
277
284
278
let finish t ~ended_at =
285
279
match t.ended_at with
lib/core/evidence.mli
@@ -49,7 +49,7 @@
49
49
50
50
type t
51
51
52
Removed:
val make : ?warm_ups:Warm_up.t list -> ?note:string -> delivery -> t
52
Added:
val make : ?note:string -> delivery -> t
53
53
(** Records the delivery as performed. *)
54
54
55
55
val delivery : t -> delivery
@@ -57,7 +57,6 @@
57
57
val movements : t -> Movement.t list
58
58
(** Performance order. *)
59
59
60
Removed:
val warm_ups : t -> Warm_up.t list
61
60
val note : t -> string option
62
61
val exercises : t -> Exercise.t list
63
62
val extensions : t -> extension list
@@ -122,7 +121,7 @@
122
121
prescribed : shape;
123
122
logged : shape;
124
123
}
125
Removed:
| Warm_ups_after_first_stimulus
124
Added:
| Warm_ups_after_working_stimulus
126
125
| Not_finished
127
126
128
127
val pp_error : Format.formatter -> error -> unit
@@ -133,6 +132,9 @@
133
132
started_at:Recovery.timestamp ->
134
133
t
135
134
135
Added:
val add_warm_up : t -> Stimulus.Warm_up.t -> (t, error) result
136
Added:
(** Preparation is allowed only before working stimuli. *)
137
Added:
136
138
val add_stimulus : t -> Stimulus.t -> (t, error) result
137
139
(** Warm-ups are allowed only on the first recorded stimulus. *)
138
140
@@ -150,6 +152,7 @@
150
152
val duration : t -> Recovery.duration option
151
153
val completeness : t -> completeness
152
154
val feedback : t -> Feedback.t option
155
Added:
val warm_ups : t -> Stimulus.Warm_up.t list
153
156
154
157
val stimuli : t -> Stimulus.t list
155
158
(** Performance order. *)
lib/web/pages.ml
@@ -211,25 +211,49 @@
211
211
();
212
212
]
213
213
214
Removed:
let warm_up_fields ~allow ~exercise ~warm_ups_name =
215
Removed:
if not allow then []
216
Removed:
else
217
Removed:
[
218
Removed:
label [ txt "Warm-ups (optional: one load,reps pair per line)" ];
219
Removed:
Form.input
220
Removed:
~a:[ a_placeholder "40,10\n60,6" ]
221
Removed:
~input_type:`Text ~name:warm_ups_name Form.string;
222
Removed:
p
223
Removed:
~a:[ a_class [ "done" ] ]
224
Removed:
[ txt ("All warm-ups use " ^ Exercise.name exercise ^ ".") ];
225
Removed:
]
214
Added:
let preparation_form exercise =
215
Added:
Form.post_form ~service:Routes.warm_up
216
Added:
(fun (exercise_name, (load_name, reps_name)) ->
217
Added:
[
218
Added:
fieldset
219
Added:
~legend:(legend [ txt "Preparation" ])
220
Added:
[
221
Added:
p
222
Added:
[
223
Added:
txt
224
Added:
("Warm up for the workout with " ^ Exercise.name exercise
225
Added:
^ ".");
226
Added:
];
227
Added:
Form.input ~input_type:`Hidden ~name:exercise_name
228
Added:
~value:(Exercise.id exercise :> string)
229
Added:
Form.string;
230
Added:
div
231
Added:
~a:[ a_class [ "row" ] ]
232
Added:
[
233
Added:
div
234
Added:
[
235
Added:
label [ txt "Load (kg)" ];
236
Added:
Form.input
237
Added:
~a:[ a_step (Some 0.5); a_required () ]
238
Added:
~input_type:`Number ~name:load_name Form.float;
239
Added:
];
240
Added:
div
241
Added:
[
242
Added:
label [ txt "Reps" ];
243
Added:
Form.input
244
Added:
~a:[ a_required () ]
245
Added:
~input_type:`Number ~name:reps_name Form.int;
246
Added:
];
247
Added:
];
248
Added:
Form.input ~input_type:`Submit ~value:"Record warm-up" Form.string;
249
Added:
];
250
Added:
])
251
Added:
()
226
252
227
Removed:
let single_form ~workout_id ~allow_warm_ups ~slot ~prescription =
253
Added:
let single_form ~workout_id ~slot ~prescription =
228
254
Form.post_form ~service:Routes.log_single
229
255
(fun ( workout_name,
230
Removed:
( slot_name,
231
Removed:
(load_name, (reps_name, (ext_name, (note_name, warm_ups_name)))) )
232
Removed:
) ->
256
Added:
(slot_name, (load_name, (reps_name, (ext_name, note_name)))) ) ->
233
257
[
234
258
fieldset
235
259
~legend:(legend [ txt (describe_prescription prescription) ])
@@ -260,25 +284,17 @@
260
284
label [ txt "Note (optional)" ];
261
285
Form.input ~input_type:`Text ~name:note_name Form.string;
262
286
]
263
Removed:
@ warm_up_fields ~allow:allow_warm_ups
264
Removed:
~exercise:
265
Removed:
(match Prescription.Stimulus.delivery prescription with
266
Removed:
| Prescription.Stimulus.Single e -> e
267
Removed:
| Prescription.Stimulus.Pre_exhaust _ -> assert false)
268
Removed:
~warm_ups_name
269
287
@ [ Form.input ~input_type:`Submit ~value:"Record" Form.string ]);
270
288
])
271
289
()
272
290
273
Removed:
let pair_form ~workout_id ~allow_warm_ups ~slot ~prescription ~isolation
274
Removed:
~compound =
291
Added:
let pair_form ~workout_id ~slot ~prescription ~isolation ~compound =
275
292
Form.post_form ~service:Routes.log_pair
276
293
(fun ( workout_name,
277
294
( slot_name,
278
295
( iso_load,
279
Removed:
( iso_reps,
280
Removed:
(comp_load, (comp_reps, (ext_name, (note_name, warm_ups_name))))
281
Removed:
) ) ) ) ->
296
Added:
(iso_reps, (comp_load, (comp_reps, (ext_name, note_name)))) ) )
297
Added:
) ->
282
298
[
283
299
fieldset
284
300
~legend:(legend [ txt (describe_prescription prescription) ])
@@ -329,8 +345,6 @@
329
345
label [ txt "Note (optional)" ];
330
346
Form.input ~input_type:`Text ~name:note_name Form.string;
331
347
]
332
Removed:
@ warm_up_fields ~allow:allow_warm_ups ~exercise:isolation
333
Removed:
~warm_ups_name
334
348
@ [ Form.input ~input_type:`Submit ~value:"Record" Form.string ]);
335
349
])
336
350
()
@@ -358,7 +372,19 @@
358
372
let prescription = Evidence.Workout.prescription workout in
359
373
let workout_id = Option.value ~default:"" record_id in
360
374
let performed = Evidence.Workout.stimuli workout in
375
Added:
let warm_ups = Evidence.Workout.warm_ups workout in
361
376
let outstanding = Evidence.Workout.outstanding workout in
377
Added:
let preparation =
378
Added:
match (record_id, performed, Prescription.Workout.stimuli prescription) with
379
Added:
| None, [], first :: _ ->
380
Added:
let exercise =
381
Added:
match Prescription.Stimulus.delivery first with
382
Added:
| Prescription.Stimulus.Single exercise -> exercise
383
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; _ } -> isolation
384
Added:
in
385
Added:
[ preparation_form exercise ]
386
Added:
| _ -> []
387
Added:
in
362
388
let override_note =
363
389
match Recovery.basis (Evidence.Workout.clearance workout) with
364
390
| Recovery.Recovered -> []
@@ -381,6 +407,22 @@
381
407
(List.length (Prescription.Workout.stimuli prescription)));
382
408
];
383
409
]
410
Added:
@ preparation
411
Added:
@ (if warm_ups = [] then []
412
Added:
else
413
Added:
[
414
Added:
h2 [ txt "Preparation recorded" ];
415
Added:
ul
416
Added:
(List.map
417
Added:
(fun warm_up ->
418
Added:
li
419
Added:
[
420
Added:
txt
421
Added:
(Format.asprintf "%a" Evidence.Stimulus.Warm_up.pp
422
Added:
warm_up);
423
Added:
])
424
Added:
warm_ups);
425
Added:
])
384
426
@ (if performed = [] then []
385
427
else
386
428
[
@@ -393,14 +435,12 @@
393
435
h2 [ txt "Still to do" ]
394
436
:: List.map
395
437
(fun (slot, p) ->
396
Removed:
let allow_warm_ups = slot = 0 && performed = [] in
397
438
match Prescription.Stimulus.delivery p with
398
439
| Prescription.Stimulus.Single _ ->
399
Removed:
single_form ~workout_id ~allow_warm_ups ~slot
400
Removed:
~prescription:p
440
Added:
single_form ~workout_id ~slot ~prescription:p
401
441
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
402
Removed:
pair_form ~workout_id ~allow_warm_ups ~slot ~prescription:p
403
Removed:
~isolation ~compound)
442
Added:
pair_form ~workout_id ~slot ~prescription:p ~isolation
443
Added:
~compound)
404
444
outstanding)
405
445
@
406
446
match record_id with
lib/web/routes.ml
@@ -61,9 +61,18 @@
61
61
( Eliom_parameter.unit,
62
62
Eliom_parameter.(
63
63
string "workout" ** int "slot" ** float "load" ** int "reps"
64
Removed:
** string "extension" ** string "note" ** string "warm_ups") ))
64
Added:
** string "extension" ** string "note") ))
65
65
()
66
66
67
Added:
(* POST /warm-up — one preparatory movement before working stimuli. *)
68
Added:
let warm_up =
69
Added:
Eliom_service.create ~path:(Eliom_service.Path [ "warm-up" ])
70
Added:
~meth:
71
Added:
(Eliom_service.Post
72
Added:
( Eliom_parameter.unit,
73
Added:
Eliom_parameter.(string "exercise" ** float "load" ** int "reps") ))
74
Added:
()
75
Added:
67
76
(* POST /log-pair — an isolation carried into a compound, no pause between. *)
68
77
let log_pair =
69
78
Eliom_service.create ~path:(Eliom_service.Path [ "log-pair" ])
@@ -73,7 +82,7 @@
73
82
Eliom_parameter.(
74
83
string "workout" ** int "slot" ** float "iso_load"
75
84
** int "iso_reps" ** float "comp_load" ** int "comp_reps"
76
Removed:
** string "extension" ** string "note" ** string "warm_ups") ))
85
Added:
** string "extension" ** string "note") ))
77
86
()
78
87
79
88
(* POST /finish — complete and persist. *)
lib/web/services.ml
@@ -231,9 +231,34 @@
231
231
~detail:(Format.asprintf "%a" Evidence.Workout.pp_error error))
232
232
in
233
233
234
Added:
Eliom_registration.Html.register ~service:Routes.warm_up
235
Added:
(fun () (exercise_id, (load, reps)) ->
236
Added:
match Exercise.find exercise_id with
237
Added:
| None ->
238
Added:
Lwt.return
239
Added:
(Pages.problem ~title:"Unknown warm-up exercise"
240
Added:
~detail:"Choose an exercise from the workout.")
241
Added:
| Some exercise -> (
242
Added:
match
243
Added:
warm_ups_of_text ~exercise (Printf.sprintf "%g,%d" load reps)
244
Added:
with
245
Added:
| Error detail ->
246
Added:
Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
247
Added:
| Ok [ warm_up ] ->
248
Added:
Lwt.return
249
Added:
(match Service.add_warm_up service warm_up with
250
Added:
| Ok workout -> Pages.log_workout ~record_id:None ~workout
251
Added:
| Error Service.No_workout_in_progress ->
252
Added:
Pages.problem ~title:"No workout in progress"
253
Added:
~detail:"Choose a routine to begin one."
254
Added:
| Error (Service.Rejected error) ->
255
Added:
Pages.problem ~title:"Preparation is closed"
256
Added:
~detail:
257
Added:
(Format.asprintf "%a" Evidence.Workout.pp_error error))
258
Added:
| Ok _ -> assert false));
259
Added:
234
260
Eliom_registration.Html.register ~service:Routes.log_single
235
Removed:
(fun
236
Removed:
() (workout_id, (slot, (load, (reps, (extension, (note, warm_ups)))))) ->
261
Added:
(fun () (workout_id, (slot, (load, (reps, (extension, note))))) ->
237
262
match
238
263
(Routes.extension_of_string extension, prescribed_at workout_id slot)
239
264
with
@@ -254,15 +279,12 @@
254
279
~detail:
255
280
"A pre-exhaust pair cannot be recorded as a single set.")
256
281
| Prescription.Stimulus.Single exercise -> (
257
Removed:
match
258
Removed:
( build_movement ~exercise ~load ~reps ~extension,
259
Removed:
warm_ups_of_text ~exercise warm_ups )
260
Removed:
with
261
Removed:
| Error detail, _ | _, Error detail ->
282
Added:
match build_movement ~exercise ~load ~reps ~extension with
283
Added:
| Error detail ->
262
284
Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
263
Removed:
| Ok movement, Ok warm_ups ->
285
Added:
| Ok movement ->
264
286
save_stimulus record_id
265
Removed:
(Evidence.Stimulus.make ?note:(optional_text note) ~warm_ups
287
Added:
(Evidence.Stimulus.make ?note:(optional_text note)
266
288
(Evidence.Stimulus.Single movement)))));
267
289
268
290
Eliom_registration.Html.register ~service:Routes.log_pair
@@ -270,9 +292,8 @@
270
292
()
271
293
( workout_id,
272
294
( slot,
273
Removed:
( iso_load,
274
Removed:
(iso_reps, (comp_load, (comp_reps, (extension, (note, warm_ups)))))
275
Removed:
) ) )
295
Added:
(iso_load, (iso_reps, (comp_load, (comp_reps, (extension, note))))) )
296
Added:
)
276
297
->
277
298
match
278
299
(Routes.extension_of_string extension, prescribed_at workout_id slot)
@@ -297,14 +318,13 @@
297
318
( build_movement ~exercise:isolation ~load:iso_load
298
319
~reps:iso_reps ~extension:None,
299
320
build_movement ~exercise:compound ~load:comp_load
300
Removed:
~reps:comp_reps ~extension,
301
Removed:
warm_ups_of_text ~exercise:isolation warm_ups )
321
Added:
~reps:comp_reps ~extension )
302
322
with
303
Removed:
| Error detail, _, _ | _, Error detail, _ | _, _, Error detail ->
323
Added:
| Error detail, _ | _, Error detail ->
304
324
Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
305
Removed:
| Ok first, Ok second, Ok warm_ups ->
325
Added:
| Ok first, Ok second ->
306
326
save_stimulus record_id
307
Removed:
(Evidence.Stimulus.make ?note:(optional_text note) ~warm_ups
327
Added:
(Evidence.Stimulus.make ?note:(optional_text note)
308
328
(Evidence.Stimulus.Pair { first; second })))));
309
329
310
330
Eliom_registration.Html.register ~service:Routes.edit (fun workout_id () ->
test/test_evidence.ml
@@ -105,30 +105,6 @@
105
105
(List.length (Stimulus.extensions s)) );
106
106
]
107
107
108
Removed:
let warm_up_tests =
109
Removed:
[
110
Removed:
( "warm-ups sit alongside the stimulus, not inside it",
111
Removed:
`Quick,
112
Removed:
fun () ->
113
Removed:
let w =
114
Removed:
Stimulus.Warm_up.make ~exercise:(get "squats") ~load:(kg 40.)
115
Removed:
~reps:(reps 10)
116
Removed:
in
117
Removed:
let s =
118
Removed:
Stimulus.make ~warm_ups:[ w ] (Stimulus.Single (move "squats" 100. 8))
119
Removed:
in
120
Removed:
Alcotest.(check int) "one warm-up" 1 (List.length (Stimulus.warm_ups s));
121
Removed:
Alcotest.(check int)
122
Removed:
"still one drive to failure" 1
123
Removed:
(List.length (Stimulus.movements s)) );
124
Removed:
( "a stimulus needs no warm-up",
125
Removed:
`Quick,
126
Removed:
fun () ->
127
Removed:
Alcotest.(check int)
128
Removed:
"none" 0
129
Removed:
(List.length (Stimulus.warm_ups (single "sit-ups" 0. 12))) );
130
Removed:
]
131
Removed:
132
108
(* {1 One performed workout} *)
133
109
134
110
let routine = Prescription.Routine.ideal
@@ -474,16 +450,32 @@
474
450
475
451
let completion_feedback_tests =
476
452
[
477
Removed:
( "notes and multiple warm-ups are retained on the first stimulus",
453
Added:
( "warm-ups belong to the workout and precede working stimuli",
478
454
`Quick,
479
455
fun () ->
480
456
let warm_up load count =
481
457
Stimulus.Warm_up.make ~exercise:(get "dumbbell-flyes") ~load:(kg load)
482
458
~reps:(reps count)
483
459
in
460
Added:
let workout =
461
Added:
fresh () |> fun workout ->
462
Added:
ok (Workout.add_warm_up workout (warm_up 10. 12)) |> fun workout ->
463
Added:
ok (Workout.add_warm_up workout (warm_up 15. 8))
464
Added:
in
465
Added:
Alcotest.(check int)
466
Added:
"two workout warm-ups" 2
467
Added:
(List.length (Workout.warm_ups workout));
468
Added:
let workout =
469
Added:
ok (Workout.add_stimulus workout (List.hd day_one_stimuli))
470
Added:
in
471
Added:
match Workout.add_warm_up workout (warm_up 20. 6) with
472
Added:
| Error Workout.Warm_ups_after_working_stimulus -> ()
473
Added:
| _ -> Alcotest.fail "expected preparation ordering rejection" );
474
Added:
( "notes are retained on working stimuli",
475
Added:
`Quick,
476
Added:
fun () ->
484
477
let stimulus =
485
478
Stimulus.make ~note:"controlled negative"
486
Removed:
~warm_ups:[ warm_up 10. 12; warm_up 15. 8 ]
487
479
(Stimulus.Pair
488
480
{
489
481
first = move "dumbbell-flyes" 20. 9;
@@ -491,27 +483,9 @@
491
483
})
492
484
in
493
485
let workout = ok (Workout.add_stimulus (fresh ()) stimulus) in
494
Removed:
let recorded = List.hd (Workout.stimuli workout) in
495
Removed:
Alcotest.(check int)
496
Removed:
"two warm-ups" 2
497
Removed:
(List.length (Stimulus.warm_ups recorded));
498
486
Alcotest.(check (option string))
499
Removed:
"note" (Some "controlled negative") (Stimulus.note recorded) );
500
Removed:
( "warm-ups on a later prescribed stimulus are refused",
501
Removed:
`Quick,
502
Removed:
fun () ->
503
Removed:
let workout = fresh () in
504
Removed:
let warm_up =
505
Removed:
Stimulus.Warm_up.make ~exercise:(get "laterals") ~load:(kg 5.)
506
Removed:
~reps:(reps 10)
507
Removed:
in
508
Removed:
match
509
Removed:
Workout.add_stimulus workout
510
Removed:
(Stimulus.make ~warm_ups:[ warm_up ]
511
Removed:
(Stimulus.Single (move "laterals" 12. 8)))
512
Removed:
with
513
Removed:
| Error Workout.Warm_ups_after_first_stimulus -> ()
514
Removed:
| _ -> Alcotest.fail "expected warm-up placement rejection" );
487
Added:
"note" (Some "controlled negative")
488
Added:
(Stimulus.note (List.hd (Workout.stimuli workout))) );
515
489
( "feedback requires finish and completeness updates after later edits",
516
490
`Quick,
517
491
fun () ->
@@ -553,7 +527,6 @@
553
527
[
554
528
("evidence.stimulus.outcome", outcome_tests);
555
529
("evidence.stimulus.delivery", stimulus_delivery_tests);
556
Removed:
("evidence.stimulus.warm_up", warm_up_tests);
557
530
("evidence.workout.lifecycle", lifecycle_tests);
558
531
("evidence.workout.conformance", conformance_tests);
559
532
("evidence.workout.volume", volume_tests);
test/test_service.ml
@@ -162,6 +162,23 @@
162
162
Alcotest.(check bool)
163
163
"slot cleared" true
164
164
(Option.is_none (S.in_progress s)) );
165
Added:
( "preparation is recorded before, but refused after, a working stimulus",
166
Added:
`Quick,
167
Added:
fun () ->
168
Added:
let s = service () in
169
Added:
ignore (ok (S.begin_workout s ~routine:ideal ~now:(day 1) ()));
170
Added:
let warm_up =
171
Added:
Stimulus.Warm_up.make ~exercise:(get "dumbbell-flyes") ~load:(kg 10.)
172
Added:
~reps:(reps 12)
173
Added:
in
174
Added:
let workout = ok (S.add_warm_up s warm_up) in
175
Added:
Alcotest.(check int)
176
Added:
"one warm-up" 1
177
Added:
(List.length (Workout.warm_ups workout));
178
Added:
ignore (ok (S.log s (List.hd day_one_stimuli)));
179
Added:
match S.add_warm_up s warm_up with
180
Added:
| Error (S.Rejected Workout.Warm_ups_after_working_stimulus) -> ()
181
Added:
| _ -> Alcotest.fail "expected preparation ordering rejection" );
165
182
( "history returns the finished workout",
166
183
`Quick,
167
184
fun () ->