[OCaml] High Intensity Training Online
refactor share workout conformance helpers
Keep generic and slot-targeted conformance checks identical while preserving observed extra volume and corrective replacements.
Changed files
lib/core/evidence.ml
@@ -195,28 +195,30 @@
195
195
(* Distinct answered slots, so recorded extra volume never inflates the
196
196
count past the prescription length. *)
197
197
let filled_slots t = List.length (List.sort_uniq Int.compare (answered t))
198
Added:
let leading_exercise_id s = Exercise.id (List.hd (Stimulus.exercises s))
198
199
200
Added:
let delivery_mismatch p s =
201
Added:
Delivery_mismatch
202
Added:
{
203
Added:
exercise = leading_exercise_id s;
204
Added:
prescribed = prescribed_shape p;
205
Added:
logged = logged_shape s;
206
Added:
}
207
Added:
208
Added:
let unanswered t candidates =
209
Added:
List.filter (fun (i, _) -> not (List.mem i (answered t))) candidates
210
Added:
199
211
let add_stimulus t s =
200
212
let candidates = List.filter (fun (_, p) -> mentions p s) (indexed t) in
201
213
let matching = List.filter (fun (_, p) -> conforms p s) candidates in
202
Removed:
let leading = Exercise.id (List.hd (Stimulus.exercises s)) in
203
214
match (candidates, matching) with
204
Removed:
| [], _ -> raise (Invalid (Not_prescribed leading))
205
Removed:
| (_, p) :: _, [] ->
206
Removed:
raise
207
Removed:
(Invalid
208
Removed:
(Delivery_mismatch
209
Removed:
{
210
Removed:
exercise = leading;
211
Removed:
prescribed = prescribed_shape p;
212
Removed:
logged = logged_shape s;
213
Removed:
}))
215
Added:
| [], _ -> raise (Invalid (Not_prescribed (leading_exercise_id s)))
216
Added:
| (_, p) :: _, [] -> raise (Invalid (delivery_mismatch p s))
214
217
| _, matching ->
215
Removed:
let unanswered =
216
Removed:
List.filter (fun (i, _) -> not (List.mem i (answered t))) matching
217
Removed:
in
218
218
let i, _ =
219
Removed:
match unanswered with chosen :: _ -> chosen | [] -> List.hd matching
219
Added:
match unanswered t matching with
220
Added:
| chosen :: _ -> chosen
221
Added:
| [] -> List.hd matching
220
222
in
221
223
{ t with performed = (i, s) :: t.performed }
222
224
@@ -229,17 +231,8 @@
229
231
230
232
let check_against p s =
231
233
if not (mentions p s) then
232
Removed:
raise
233
Removed:
(Invalid (Not_prescribed (Exercise.id (List.hd (Stimulus.exercises s)))))
234
Removed:
else if not (conforms p s) then
235
Removed:
raise
236
Removed:
(Invalid
237
Removed:
(Delivery_mismatch
238
Removed:
{
239
Removed:
exercise = Exercise.id (List.hd (Stimulus.exercises s));
240
Removed:
prescribed = prescribed_shape p;
241
Removed:
logged = logged_shape s;
242
Removed:
}))
234
Added:
raise (Invalid (Not_prescribed (leading_exercise_id s)))
235
Added:
else if not (conforms p s) then raise (Invalid (delivery_mismatch p s))
243
236
244
237
let record_at t ~slot s =
245
238
check_against (prescription_at t slot) s;
test/test_evidence.ml
@@ -31,6 +31,9 @@
31
31
None
32
32
with Workout.Invalid error -> Some error
33
33
34
Added:
let invalid_message f =
35
Added:
invalid_error f |> Option.map (Format.asprintf "%a" Workout.pp_error)
36
Added:
34
37
(* {1 One stimulus} *)
35
38
36
39
let outcome_tests =
@@ -213,6 +216,23 @@
213
216
->
214
217
()
215
218
| _ -> Alcotest.fail "expected Delivery_mismatch" );
219
Added:
( "slot-targeted operations phrase a mismatch like generic logging",
220
Added:
`Quick,
221
Added:
fun () ->
222
Added:
let stimulus = single "dumbbell-flyes" 20. 9 in
223
Added:
let expected =
224
Added:
invalid_message (fun () -> Workout.add_stimulus (fresh ()) stimulus)
225
Added:
in
226
Added:
List.iter
227
Added:
(fun (name, attempt) ->
228
Added:
Alcotest.(check (option string))
229
Added:
name expected (invalid_message attempt))
230
Added:
[
231
Added:
( "record_at",
232
Added:
fun () -> Workout.record_at (fresh ()) ~slot:0 stimulus );
233
Added:
( "replace_stimulus",
234
Added:
fun () -> Workout.replace_stimulus (fresh ()) ~slot:0 stimulus );
235
Added:
] );
216
236
( "the prescribed pair, delivered as prescribed, is accepted",
217
237
`Quick,
218
238
fun () ->