[OCaml] High Intensity Training Online
refactor Tighten evidence interfaces
Remove unstructured constructor inputs and isolate progression\njudgment behind the logbook interface.
Changed files
- lib/app/service.ml
- lib/app/service.mli
- lib/core/evidence.ml
- lib/core/evidence.mli
- lib/core/progression.ml
- lib/core/progression.mli
- lib/core/recovery.ml
- lib/core/recovery.mli
- lib/web/pages.ml
- lib/web/routes.ml
- lib/web/services.ml
- test/test_evidence.ml
- test/test_progression.ml
- test/test_recovery.ml
- test/test_service.ml
lib/app/service.ml
@@ -67,7 +67,7 @@
67
67
let clearance =
68
68
match (Recovery.clear readiness, override) with
69
69
| Some c, _ -> Some c
70
Removed:
| None, Some reason -> Some (Recovery.override readiness ~reason)
70
Added:
| None, Some () -> Some (Recovery.override readiness)
71
71
| None, None -> None
72
72
in
73
73
match clearance with
@@ -129,6 +129,5 @@
129
129
let progress t exercise =
130
130
Progression.assess (Evidence.Log.observations (R.log t.repo) exercise)
131
131
132
Removed:
let diagnostics t =
133
Removed:
Progression.diagnose (Evidence.Log.workouts (R.log t.repo))
132
Added:
let diagnostics t = Progression.diagnose (R.log t.repo)
134
133
end
lib/app/service.mli
@@ -4,9 +4,9 @@
4
4
Recovery gating lives here, not in the client. {!Evidence.Workout.start}
5
5
demands a {!Recovery.clearance}, and this module is the only thing that
6
6
decides how one is obtained: earned by having rested, or taken deliberately
7
Removed:
through {!begin_workout}'s [?override] with a stated reason. Putting that
8
Removed:
policy here means a native client cannot quietly adopt looser rules than the
9
Removed:
web one. *)
7
Added:
through {!begin_workout}'s [override] acknowledgment. Putting that policy
8
Added:
here means a native client cannot quietly adopt looser rules than the web
9
Added:
one. *)
10
10
11
11
module Make (R : Repository.S) : sig
12
12
type t
@@ -19,8 +19,8 @@
19
19
type error =
20
20
| Unknown_routine
21
21
| Not_recovered of Recovery.readiness
22
Removed:
(** Refused: recovery is incomplete and no reason was given. Carries the
23
Removed:
reading so a client can say how much longer. *)
22
Added:
(** Refused: recovery is incomplete and no override was given. Carries
23
Added:
the reading so a client can say how much longer. *)
24
24
25
25
val pp_error : Format.formatter -> error -> unit
26
26
val select_routine : t -> Repository.routine_id -> (unit, error) result
@@ -42,12 +42,11 @@
42
42
t ->
43
43
routine:Repository.routine_id ->
44
44
now:Recovery.timestamp ->
45
Removed:
?override:string ->
45
Added:
?override:unit ->
46
46
unit ->
47
47
(Evidence.Workout.t, error) result
48
48
(** Start the next workout. [Error (Not_recovered _)] unless recovery is
49
Removed:
complete or [?override] states why you are training anyway; the reason is
50
Removed:
kept with the workout and reaches {!Progression.diagnose}. *)
49
Added:
complete or [override] explicitly acknowledges early training. *)
51
50
52
51
val in_progress : t -> Evidence.Workout.t option
53
52
(** The workout being logged, if any. Single-user: one slot for the whole
lib/core/evidence.ml
@@ -49,11 +49,10 @@
49
49
| Single of Movement.t
50
50
| Pair of { first : Movement.t; second : Movement.t }
51
51
52
Removed:
type t = { delivery : delivery; note : string option }
52
Added:
type t = { delivery : delivery }
53
53
54
Removed:
let make ?note delivery = { delivery; note }
54
Added:
let make delivery = { delivery }
55
55
let delivery t = t.delivery
56
Removed:
let note t = t.note
57
56
58
57
let movements t =
59
58
match t.delivery with
@@ -125,7 +124,6 @@
125
124
prescribed : shape;
126
125
logged : shape;
127
126
}
128
Removed:
| Not_finished
129
127
130
128
type t = {
131
129
prescription : Prescription.Workout.t;
@@ -147,7 +145,6 @@
147
145
Format.fprintf ppf "%s is prescribed as %a but was logged as %a"
148
146
(exercise :> string)
149
147
pp_shape prescribed pp_shape logged
150
Removed:
| Not_finished -> Format.pp_print_string ppf "this workout is not finished"
151
148
152
149
let start prescription ~clearance ~started_at =
153
150
{ prescription; clearance; started_at; ended_at = None; performed = [] }
lib/core/evidence.mli
@@ -36,7 +36,7 @@
36
36
37
37
type t
38
38
39
Removed:
val make : ?note:string -> delivery -> t
39
Added:
val make : delivery -> t
40
40
(** Records the delivery as performed. *)
41
41
42
42
val delivery : t -> delivery
@@ -44,7 +44,6 @@
44
44
val movements : t -> Movement.t list
45
45
(** Performance order. *)
46
46
47
Removed:
val note : t -> string option
48
47
val exercises : t -> Exercise.t list
49
48
val extensions : t -> extension list
50
49
val is_extended : t -> bool
@@ -86,7 +85,6 @@
86
85
prescribed : shape;
87
86
logged : shape;
88
87
}
89
Removed:
| Not_finished
90
88
91
89
val pp_error : Format.formatter -> error -> unit
92
90
lib/core/progression.ml
@@ -128,7 +128,8 @@
128
128
| Recovery.Recovered -> false
129
129
| Recovery.Overridden _ -> true
130
130
131
Removed:
let diagnose workouts =
131
Added:
let diagnose log =
132
Added:
let workouts = Evidence.Log.workouts log in
132
133
let count predicate = List.length (List.filter predicate workouts) in
133
134
let extended = count all_extended in
134
135
let overridden = count under_recovered in
lib/core/progression.mli
@@ -1,11 +1,5 @@
1
1
(** Interprets recorded training against Heavy Duty rules. *)
2
2
3
Removed:
val beats :
4
Removed:
previous:Evidence.Stimulus.Movement.t ->
5
Removed:
current:Evidence.Stimulus.Movement.t ->
6
Removed:
bool
7
Removed:
(** More load, or equal load and more reps. *)
8
Removed:
9
3
type assessment = Progressing | Stalled
10
4
type error = Insufficient_data
11
5
@@ -52,5 +46,5 @@
52
46
| Extensions_on_every_stimulus of int
53
47
| Trained_under_recovered of int
54
48
55
Removed:
val diagnose : Evidence.Workout.t list -> diagnostic list
49
Added:
val diagnose : Evidence.Log.t -> diagnostic list
56
50
val pp_diagnostic : Format.formatter -> diagnostic -> unit
lib/core/recovery.ml
@@ -33,16 +33,15 @@
33
33
34
34
type basis =
35
35
| Recovered
36
Removed:
| Overridden of { rested : duration; recommended : duration; reason : string }
36
Added:
| Overridden of { rested : duration; recommended : duration }
37
37
38
38
type clearance = basis
39
39
40
40
let clear = function Ready -> Some Recovered | Recovering _ -> None
41
41
42
Removed:
let override readiness ~reason =
42
Added:
let override readiness =
43
43
match readiness with
44
44
| Ready -> Recovered
45
Removed:
| Recovering { rested; recommended } ->
46
Removed:
Overridden { rested; recommended; reason }
45
Added:
| Recovering { rested; recommended } -> Overridden { rested; recommended }
47
46
48
47
let basis c = c
lib/core/recovery.mli
@@ -29,12 +29,12 @@
29
29
30
30
type basis =
31
31
| Recovered
32
Removed:
| Overridden of { rested : duration; recommended : duration; reason : string }
32
Added:
| Overridden of { rested : duration; recommended : duration }
33
33
34
34
val clear : readiness -> clearance option
35
35
(** [Some] iff recovery is complete. *)
36
36
37
Removed:
val override : readiness -> reason:string -> clearance
38
Removed:
(** Records training before recovery completes. *)
37
Added:
val override : readiness -> clearance
38
Added:
(** Records explicit training before recovery completes. *)
39
39
40
40
val basis : clearance -> basis
lib/web/pages.ml
@@ -162,11 +162,11 @@
162
162
p [ txt ("Next: " ^ Prescription.Workout.name next) ];
163
163
p [ txt status ];
164
164
Form.post_form ~service:Routes.begin_workout
165
Removed:
(fun (routine_name, reason) ->
165
Added:
(fun (routine_name, override) ->
166
166
[
167
167
Form.input ~input_type:`Hidden ~name:routine_name
168
168
~value:(id_string routine) Form.string;
169
Removed:
Form.input ~input_type:`Hidden ~name:reason ~value:"" Form.string;
169
Added:
Form.input ~input_type:`Hidden ~name:override ~value:false Form.bool;
170
170
Form.input ~input_type:`Submit ~value:"Begin next workout"
171
171
Form.string;
172
172
])
@@ -212,29 +212,21 @@
212
212
txt
213
213
"Heavy Duty treats training before recovery finishes as the \
214
214
main way progress is lost — growth happens while you rest, \
215
Removed:
not while you lift. Train anyway only with a reason, which is \
216
Removed:
kept with the workout so a later stall can be explained.";
215
Added:
not while you lift. Train anyway only by explicitly\n\
216
Added:
\ acknowledging the override; a later \
217
Added:
diagnostic retains it.";
217
218
];
218
219
];
219
220
Form.post_form ~service:Routes.begin_workout
220
Removed:
(fun (routine_name, reason) ->
221
Added:
(fun (routine_name, override) ->
221
222
[
222
223
fieldset
223
224
~legend:(legend [ txt "Train anyway" ])
224
225
[
225
226
Form.input ~input_type:`Hidden ~name:routine_name
226
227
~value:(id_string routine) Form.string;
227
Removed:
label
228
Removed:
~a:[ a_label_for "reason" ]
229
Removed:
[ txt "Why are you training early?" ];
230
Removed:
Form.input
231
Removed:
~a:
232
Removed:
[
233
Removed:
a_id "reason";
234
Removed:
a_required ();
235
Removed:
a_placeholder "travelling tomorrow";
236
Removed:
]
237
Removed:
~input_type:`Text ~name:reason Form.string;
228
Added:
Form.input ~input_type:`Hidden ~name:override ~value:true
229
Added:
Form.bool;
238
230
Form.input ~input_type:`Submit ~value:"Begin under override"
239
231
Form.string;
240
232
];
@@ -244,8 +236,7 @@
244
236
245
237
let single_form ~workout_id ~slot ~prescription =
246
238
Form.post_form ~service:Routes.log_single
247
Removed:
(fun ( workout_name,
248
Removed:
(slot_name, (load_name, (reps_name, (ext_name, note_name)))) ) ->
239
Added:
(fun (workout_name, (slot_name, (load_name, (reps_name, ext_name)))) ->
249
240
[
250
241
fieldset
251
242
~legend:(legend [ txt (describe_prescription prescription) ])
@@ -273,8 +264,6 @@
273
264
];
274
265
label [ txt "Ending" ];
275
266
extension_select ext_name;
276
Removed:
label [ txt "Note (optional)" ];
277
Removed:
Form.input ~input_type:`Text ~name:note_name Form.string;
278
267
]
279
268
@ [ Form.input ~input_type:`Submit ~value:"Record" Form.string ]);
280
269
])
@@ -284,9 +273,7 @@
284
273
Form.post_form ~service:Routes.log_pair
285
274
(fun ( workout_name,
286
275
( slot_name,
287
Removed:
( iso_load,
288
Removed:
(iso_reps, (comp_load, (comp_reps, (ext_name, note_name)))) ) )
289
Removed:
) ->
276
Added:
(iso_load, (iso_reps, (comp_load, (comp_reps, ext_name)))) ) ) ->
290
277
[
291
278
fieldset
292
279
~legend:(legend [ txt (describe_prescription prescription) ])
@@ -334,8 +321,6 @@
334
321
];
335
322
label [ txt "Ending" ];
336
323
extension_select ext_name;
337
Removed:
label [ txt "Note (optional)" ];
338
Removed:
Form.input ~input_type:`Text ~name:note_name Form.string;
339
324
]
340
325
@ [ Form.input ~input_type:`Submit ~value:"Record" Form.string ]);
341
326
])
@@ -368,11 +353,11 @@
368
353
let override_note =
369
354
match Recovery.basis (Evidence.Workout.clearance workout) with
370
355
| Recovery.Recovered -> []
371
Removed:
| Recovery.Overridden { reason; _ } ->
356
Added:
| Recovery.Overridden _ ->
372
357
[
373
358
div
374
359
~a:[ a_class [ "warn" ] ]
375
Removed:
[ txt ("Begun before recovery finished: " ^ reason) ];
360
Added:
[ txt "Begun before recovery finished." ];
376
361
]
377
362
in
378
363
shell
lib/web/routes.ml
@@ -46,14 +46,13 @@
46
46
Eliom_service.create ~path:(Eliom_service.Path [ "history" ])
47
47
~meth:(Eliom_service.Get Eliom_parameter.unit) ()
48
48
49
Removed:
(* POST /begin — start the next workout. An empty reason means "no override
50
Removed:
offered", which is how the two-step gate refuses the first attempt. *)
49
Added:
(* POST /begin — the override flag explicitly acknowledges early training. *)
51
50
let begin_workout =
52
51
Eliom_service.create ~path:(Eliom_service.Path [ "begin" ])
53
52
~meth:
54
53
(Eliom_service.Post
55
54
( Eliom_parameter.unit,
56
Removed:
Eliom_parameter.(string "routine" ** string "reason") ))
55
Added:
Eliom_parameter.(string "routine" ** bool "override") ))
57
56
()
58
57
59
58
(* POST /log-single — one movement driven to failure.
@@ -67,7 +66,7 @@
67
66
( Eliom_parameter.unit,
68
67
Eliom_parameter.(
69
68
string "workout" ** int "slot" ** float "load" ** int "reps"
70
Removed:
** string "extension" ** string "note") ))
69
Added:
** string "extension") ))
71
70
()
72
71
73
72
(* POST /log-pair — an isolation carried into a compound, no pause between. *)
@@ -79,7 +78,7 @@
79
78
Eliom_parameter.(
80
79
string "workout" ** int "slot" ** float "iso_load"
81
80
** int "iso_reps" ** float "comp_load" ** int "comp_reps"
82
Removed:
** string "extension" ** string "note") ))
81
Added:
** string "extension") ))
83
82
()
84
83
85
84
(* POST /finish — complete and persist. *)
lib/web/services.ml
@@ -68,12 +68,11 @@
68
68
Eliom_registration.Html.register ~service:Routes.history (fun () () ->
69
69
Lwt.return (Pages.history ~records:(Service.history service)));
70
70
71
Removed:
(* Begin. An empty reason means none was offered, which is what makes the
72
Removed:
recovery gate a deliberate second step rather than one click. *)
71
Added:
(* The recovery gate requires a separate explicit override action. *)
73
72
Eliom_registration.Html.register ~service:Routes.begin_workout
74
Removed:
(fun () (routine, reason) ->
73
Added:
(fun () (routine, override) ->
75
74
let routine = Repository.routine_id routine in
76
Removed:
let override = if String.trim reason = "" then None else Some reason in
75
Added:
let override = if override then Some () else None in
77
76
Lwt.return
78
77
(match
79
78
Service.begin_workout service ~routine ~now:(now ()) ?override ()
@@ -101,11 +100,6 @@
101
100
| Error e, _ | _, Error e -> Error (Format.asprintf "%a" Units.pp_error e)
102
101
in
103
102
104
Removed:
let optional_text text =
105
Removed:
let text = String.trim text in
106
Removed:
if text = "" then None else Some text
107
Removed:
in
108
Removed:
109
103
(* The slot names which prescribed stimulus is being answered. *)
110
104
let target_workout workout_id =
111
105
if workout_id = "" then
@@ -150,7 +144,7 @@
150
144
in
151
145
152
146
Eliom_registration.Html.register ~service:Routes.log_single
153
Removed:
(fun () (workout_id, (slot, (load, (reps, (extension, note))))) ->
147
Added:
(fun () (workout_id, (slot, (load, (reps, extension)))) ->
154
148
match
155
149
(Routes.extension_of_string extension, prescribed_at workout_id slot)
156
150
with
@@ -176,16 +170,14 @@
176
170
Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
177
171
| Ok movement ->
178
172
save_stimulus record_id
179
Removed:
(Evidence.Stimulus.make ?note:(optional_text note)
180
Removed:
(Evidence.Stimulus.Single movement)))));
173
Added:
(Evidence.Stimulus.make (Evidence.Stimulus.Single movement))
174
Added:
)));
181
175
182
176
Eliom_registration.Html.register ~service:Routes.log_pair
183
177
(fun
184
178
()
185
179
( workout_id,
186
Removed:
( slot,
187
Removed:
(iso_load, (iso_reps, (comp_load, (comp_reps, (extension, note))))) )
188
Removed:
)
180
Added:
(slot, (iso_load, (iso_reps, (comp_load, (comp_reps, extension))))) )
189
181
->
190
182
match
191
183
(Routes.extension_of_string extension, prescribed_at workout_id slot)
@@ -216,7 +208,7 @@
216
208
Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
217
209
| Ok first, Ok second ->
218
210
save_stimulus record_id
219
Removed:
(Evidence.Stimulus.make ?note:(optional_text note)
211
Added:
(Evidence.Stimulus.make
220
212
(Evidence.Stimulus.Pair { first; second })))));
221
213
222
214
Eliom_registration.Html.register ~service:Routes.edit (fun workout_id () ->
test/test_evidence.ml
@@ -275,12 +275,11 @@
275
275
in
276
276
let w =
277
277
Workout.start day_one
278
Removed:
~clearance:(Recovery.override recovering ~reason:"away next week")
278
Added:
~clearance:(Recovery.override recovering)
279
279
~started_at:(at 0)
280
280
in
281
281
match Recovery.basis (Workout.clearance w) with
282
Removed:
| Recovery.Overridden { reason; _ } ->
283
Removed:
Alcotest.(check string) "reason" "away next week" reason
282
Added:
| Recovery.Overridden _ -> ()
284
283
| Recovery.Recovered -> Alcotest.fail "expected Overridden" );
285
284
]
286
285
@@ -450,21 +449,6 @@
450
449
451
450
let completion_feedback_tests =
452
451
[
453
Removed:
( "notes are retained on working stimuli",
454
Removed:
`Quick,
455
Removed:
fun () ->
456
Removed:
let stimulus =
457
Removed:
Stimulus.make ~note:"controlled negative"
458
Removed:
(Stimulus.Pair
459
Removed:
{
460
Removed:
first = move "dumbbell-flyes" 20. 9;
461
Removed:
second = move "incline-press" 60. 7;
462
Removed:
})
463
Removed:
in
464
Removed:
let workout = ok (Workout.add_stimulus (fresh ()) stimulus) in
465
Removed:
Alcotest.(check (option string))
466
Removed:
"note" (Some "controlled negative")
467
Removed:
(Stimulus.note (List.hd (Workout.stimuli workout))) );
468
452
( "feedback rejects duplicate signal categories",
469
453
`Quick,
470
454
fun () ->
test/test_progression.ml
@@ -26,44 +26,6 @@
26
26
let seen ~on load r : Evidence.Log.observation =
27
27
{ exercise = get "laterals"; movement = move load r; performed_at = day on }
28
28
29
Removed:
let beats_tests =
30
Removed:
[
31
Removed:
( "one more rep at the same load is progress",
32
Removed:
`Quick,
33
Removed:
fun () ->
34
Removed:
Alcotest.(check bool)
35
Removed:
"8 -> 9" true
36
Removed:
(Progression.beats ~previous:(move 12. 8) ~current:(move 12. 9)) );
37
Removed:
( "more load is progress",
38
Removed:
`Quick,
39
Removed:
fun () ->
40
Removed:
Alcotest.(check bool)
41
Removed:
"12 -> 14kg" true
42
Removed:
(Progression.beats ~previous:(move 12. 8) ~current:(move 14. 8)) );
43
Removed:
( "more load at fewer reps is still progress",
44
Removed:
`Quick,
45
Removed:
fun () ->
46
Removed:
(* Raising the load is meant to force you back down the rep range. *)
47
Removed:
Alcotest.(check bool)
48
Removed:
"12kg x 12 -> 14kg x 7" true
49
Removed:
(Progression.beats ~previous:(move 12. 12) ~current:(move 14. 7)) );
50
Removed:
( "repeating a performance is not progress",
51
Removed:
`Quick,
52
Removed:
fun () ->
53
Removed:
Alcotest.(check bool)
54
Removed:
"identical" false
55
Removed:
(Progression.beats ~previous:(move 12. 8) ~current:(move 12. 8)) );
56
Removed:
( "going backwards is not progress",
57
Removed:
`Quick,
58
Removed:
fun () ->
59
Removed:
Alcotest.(check bool)
60
Removed:
"fewer reps" false
61
Removed:
(Progression.beats ~previous:(move 12. 8) ~current:(move 12. 7));
62
Removed:
Alcotest.(check bool)
63
Removed:
"more reps at a lighter load" false
64
Removed:
(Progression.beats ~previous:(move 12. 8) ~current:(move 10. 12)) );
65
Removed:
]
66
Removed:
67
29
let assess_tests =
68
30
[
69
31
( "the stall window is two weeks",
@@ -248,8 +210,10 @@
248
210
`Quick,
249
211
fun () ->
250
212
let w = performed ~clearance:cleared ~stimuli:[ laterals 12. 8 ] in
251
Removed:
Alcotest.(check int) "none" 0 (List.length (Progression.diagnose [ w ]))
252
Removed:
);
213
Added:
Alcotest.(check int)
214
Added:
"none" 0
215
Added:
(List.length
216
Added:
(Progression.diagnose (Evidence.Log.add Evidence.Log.empty w))) );
253
217
( "extending every stimulus is flagged",
254
218
`Quick,
255
219
fun () ->
@@ -257,7 +221,7 @@
257
221
performed ~clearance:cleared
258
222
~stimuli:[ laterals ~outcome:extended 12. 8 ]
259
223
in
260
Removed:
match Progression.diagnose [ w ] with
224
Added:
match Progression.diagnose (Evidence.Log.add Evidence.Log.empty w) with
261
225
| [ Progression.Extensions_on_every_stimulus n ] ->
262
226
Alcotest.(check int) "one workout" 1 n
263
227
| _ -> Alcotest.fail "expected the extension diagnostic" );
@@ -268,8 +232,10 @@
268
232
performed ~clearance:cleared
269
233
~stimuli:[ laterals ~outcome:extended 12. 8; laterals 10. 9 ]
270
234
in
271
Removed:
Alcotest.(check int) "none" 0 (List.length (Progression.diagnose [ w ]))
272
Removed:
);
235
Added:
Alcotest.(check int)
236
Added:
"none" 0
237
Added:
(List.length
238
Added:
(Progression.diagnose (Evidence.Log.add Evidence.Log.empty w))) );
273
239
( "training on an override is flagged",
274
240
`Quick,
275
241
fun () ->
@@ -279,10 +245,10 @@
279
245
in
280
246
let w =
281
247
performed
282
Removed:
~clearance:(Recovery.override recovering ~reason:"impatient")
248
Added:
~clearance:(Recovery.override recovering)
283
249
~stimuli:[ laterals 12. 8 ]
284
250
in
285
Removed:
match Progression.diagnose [ w ] with
251
Added:
match Progression.diagnose (Evidence.Log.add Evidence.Log.empty w) with
286
252
| [ Progression.Trained_under_recovered n ] ->
287
253
Alcotest.(check int) "one workout" 1 n
288
254
| _ -> Alcotest.fail "expected the under-recovery diagnostic" );
@@ -295,10 +261,13 @@
295
261
in
296
262
let w =
297
263
performed
298
Removed:
~clearance:(Recovery.override recovering ~reason:"impatient")
264
Added:
~clearance:(Recovery.override recovering)
299
265
~stimuli:[ laterals ~outcome:extended 12. 8 ]
300
266
in
301
Removed:
Alcotest.(check int) "both" 2 (List.length (Progression.diagnose [ w ]));
267
Added:
Alcotest.(check int)
268
Added:
"both" 2
269
Added:
(List.length
270
Added:
(Progression.diagnose (Evidence.Log.add Evidence.Log.empty w)));
302
271
Alcotest.(check bool)
303
272
"and the routine is stalled" true
304
273
(Progression.assess
@@ -308,7 +277,6 @@
308
277
309
278
let suite =
310
279
[
311
Removed:
("progression.beats", beats_tests);
312
280
("progression.assess", assess_tests);
313
281
("progression.remedy", remedy_tests);
314
282
("progression.load", load_tests);
test/test_recovery.ml
@@ -74,26 +74,23 @@
74
74
Alcotest.(check bool)
75
75
"refused" true
76
76
(Option.is_none (Recovery.clear recovering)) );
77
Removed:
( "an override is granted but leaves its reason on the record",
77
Added:
( "an override is granted and records the recovery shortfall",
78
78
`Quick,
79
79
fun () ->
80
80
let recovering =
81
81
Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12)
82
82
~recommended:(Recovery.hours 48)
83
83
in
84
Removed:
let c = Recovery.override recovering ~reason:"travelling tomorrow" in
84
Added:
let c = Recovery.override recovering in
85
85
match Recovery.basis c with
86
Removed:
| Recovery.Overridden { rested; recommended; reason } ->
86
Added:
| Recovery.Overridden { rested; recommended } ->
87
87
Alcotest.(check int) "rested" 43_200 (secs rested);
88
Removed:
Alcotest.(check int) "recommended" 172_800 (secs recommended);
89
Removed:
Alcotest.(check string) "reason" "travelling tomorrow" reason
88
Added:
Alcotest.(check int) "recommended" 172_800 (secs recommended)
90
89
| Recovery.Recovered -> Alcotest.fail "expected Overridden" );
91
90
( "overriding when already recovered is simply recovered",
92
91
`Quick,
93
92
fun () ->
94
Removed:
match
95
Removed:
Recovery.basis (Recovery.override Recovery.Ready ~reason:"impatient")
96
Removed:
with
93
Added:
match Recovery.basis (Recovery.override Recovery.Ready) with
97
94
| Recovery.Recovered -> ()
98
95
| Recovery.Overridden _ ->
99
96
Alcotest.fail "no recovery was outstanding to override" );
test/test_service.ml
@@ -98,29 +98,24 @@
98
98
Alcotest.(check string)
99
99
"Day 2" "Day 2"
100
100
(Prescription.Workout.name (Workout.prescription w)) );
101
Removed:
( "an override is accepted and keeps its reason on the record",
101
Added:
( "an override is accepted and recorded",
102
102
`Quick,
103
103
fun () ->
104
104
let s = service () in
105
105
let _ = ok (S.begin_workout s ~routine:ideal ~now:(day 1) ()) in
106
106
let _ = S.finish s ~ended_at:(day 1) in
107
107
let w =
108
Removed:
ok
109
Removed:
(S.begin_workout s ~routine:ideal ~now:(day 2)
110
Removed:
~override:"travelling tomorrow" ())
108
Added:
ok (S.begin_workout s ~routine:ideal ~now:(day 2) ~override:() ())
111
109
in
112
110
match Recovery.basis (Workout.clearance w) with
113
Removed:
| Recovery.Overridden { reason; _ } ->
114
Removed:
Alcotest.(check string) "reason" "travelling tomorrow" reason
111
Added:
| Recovery.Overridden _ -> ()
115
112
| Recovery.Recovered -> Alcotest.fail "expected Overridden" );
116
113
( "an override while genuinely rested is not recorded as one",
117
114
`Quick,
118
115
fun () ->
119
116
let s = service () in
120
117
let w =
121
Removed:
ok
122
Removed:
(S.begin_workout s ~routine:ideal ~now:(day 1)
123
Removed:
~override:"just in case" ())
118
Added:
ok (S.begin_workout s ~routine:ideal ~now:(day 1) ~override:() ())
124
119
in
125
120
match Recovery.basis (Workout.clearance w) with
126
121
| Recovery.Recovered -> ()
@@ -222,7 +217,7 @@
222
217
Day 1 comes round, at an unchanging load. *)
223
218
let run ~on ~load =
224
219
let w =
225
Removed:
ok (S.begin_workout s ~routine:ideal ~now:on ~override:"fixture" ())
220
Added:
ok (S.begin_workout s ~routine:ideal ~now:on ~override:() ())
226
221
in
227
222
if
228
223
String.equal "Day 1"
@@ -248,9 +243,7 @@
248
243
let _ = ok (S.begin_workout s ~routine:ideal ~now:(day 1) ()) in
249
244
let _ = S.finish s ~ended_at:(day 1) in
250
245
let _ =
251
Removed:
ok
252
Removed:
(S.begin_workout s ~routine:ideal ~now:(day 2) ~override:"impatient"
253
Removed:
())
246
Added:
ok (S.begin_workout s ~routine:ideal ~now:(day 2) ~override:() ())
254
247
in
255
248
let _ = S.finish s ~ended_at:(day 2) in
256
249
match