[OCaml] High Intensity Training Online
feat implement make with whitelist validation
make rejects the first candidate not on the exercise's catalog whitelist, so a prescription can only narrow it, never widen it — Exercise.substitute already encodes that rule; this just applies it to every candidate. Authored test_prescription.ml (extraction from Routine.Prescription left it without a suite). Exercise.id is private, so tests locate catalog fixtures by name rather than constructing an id directly.
lib/core/prescription.ml
@@ -1,9 +1,23 @@
1
Removed:
(* Minimal stubs only; implementation deferred until after the review gate. *)
1
Added:
type t = {
2
Added:
exercise : Exercise.t;
3
Added:
target_reps : Units.Rep_range.t;
4
Added:
allowed_substitutes : Exercise.t list;
5
Added:
}
2
6
3
Removed:
type t = unit
7
Added:
let make ~exercise ~target_reps ~allowed_substitutes =
8
Added:
let rec check = function
9
Added:
| [] -> Ok { exercise; target_reps; allowed_substitutes }
10
Added:
| candidate :: rest -> (
11
Added:
match Exercise.substitute ~original:exercise ~candidate with
12
Added:
| Ok _ -> check rest
13
Added:
| Error e -> Error e)
14
Added:
in
15
Added:
check allowed_substitutes
4
16
5
Removed:
let make ~exercise:_ ~target_reps:_ ~allowed_substitutes:_ = failwith "TODO"
6
Removed:
let exercise _ = failwith "TODO"
7
Removed:
let target_reps _ = failwith "TODO"
8
Removed:
let allowed_substitutes _ = failwith "TODO"
9
Removed:
let pp _ _ = failwith "TODO"
17
Added:
let exercise t = t.exercise
18
Added:
let target_reps t = t.target_reps
19
Added:
let allowed_substitutes t = t.allowed_substitutes
20
Added:
21
Added:
let pp fmt t =
22
Added:
Format.fprintf fmt "%a (%a)" Exercise.pp t.exercise Units.Rep_range.pp
23
Added:
t.target_reps
test/test_hito.ml
@@ -4,4 +4,4 @@
4
4
let () =
5
5
Alcotest.run "hito"
6
6
(Test_units.suite @ Test_exercise.suite @ Test_set.suite
7
Removed:
@ Test_set_group.suite)
7
Added:
@ Test_set_group.suite @ Test_prescription.suite)
test/test_prescription.ml
@@ -0,0 +1,80 @@
1
Added:
(** Unit tests for {!Hito_core.Prescription}, authored against prescription.mli.
2
Added:
3
Added:
Under test: a prescription may only narrow the exercise's catalog whitelist,
4
Added:
never widen it. *)
5
Added:
6
Added:
open Hito_core
7
Added:
8
Added:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
9
Added:
10
Added:
let by_name n =
11
Added:
match
12
Added:
List.find_opt (fun ex -> String.equal (Exercise.name ex) n) Exercise.catalog
13
Added:
with
14
Added:
| Some ex -> ex
15
Added:
| None -> Alcotest.failf "no exercise named %s" n
16
Added:
17
Added:
let target_reps () =
18
Added:
ok
19
Added:
(Units.Rep_range.make
20
Added:
~min:(ok (Units.Reps.of_int 6))
21
Added:
~max:(ok (Units.Reps.of_int 8)))
22
Added:
23
Added:
let bench = by_name "Barbell Bench Press"
24
Added:
and dumbbell_bench = by_name "Dumbbell Bench Press"
25
Added:
and squat = by_name "Back Squat"
26
Added:
27
Added:
let make_tests =
28
Added:
[
29
Added:
( "catalog substitute is accepted",
30
Added:
`Quick,
31
Added:
fun () ->
32
Added:
Alcotest.(check bool)
33
Added:
"accepted" true
34
Added:
(Result.is_ok
35
Added:
(Prescription.make ~exercise:bench ~target_reps:(target_reps ())
36
Added:
~allowed_substitutes:[ dumbbell_bench ])) );
37
Added:
( "non-whitelisted exercise is rejected",
38
Added:
`Quick,
39
Added:
fun () ->
40
Added:
Alcotest.(check bool)
41
Added:
"rejected" true
42
Added:
(Result.is_error
43
Added:
(Prescription.make ~exercise:bench ~target_reps:(target_reps ())
44
Added:
~allowed_substitutes:[ squat ])) );
45
Added:
( "empty substitutes is always accepted",
46
Added:
`Quick,
47
Added:
fun () ->
48
Added:
Alcotest.(check bool)
49
Added:
"accepted" true
50
Added:
(Result.is_ok
51
Added:
(Prescription.make ~exercise:bench ~target_reps:(target_reps ())
52
Added:
~allowed_substitutes:[])) );
53
Added:
]
54
Added:
55
Added:
let accessor_tests =
56
Added:
[
57
Added:
( "accessors round-trip",
58
Added:
`Quick,
59
Added:
fun () ->
60
Added:
let reps = target_reps () in
61
Added:
let p =
62
Added:
ok
63
Added:
(Prescription.make ~exercise:bench ~target_reps:reps
64
Added:
~allowed_substitutes:[ dumbbell_bench ])
65
Added:
in
66
Added:
Alcotest.(check bool)
67
Added:
"exercise" true
68
Added:
(Exercise.equal (Prescription.exercise p) bench);
69
Added:
Alcotest.(check bool)
70
Added:
"target_reps" true
71
Added:
(Units.Rep_range.equal (Prescription.target_reps p) reps);
72
Added:
Alcotest.(check int)
73
Added:
"substitutes" 1
74
Added:
(List.length (Prescription.allowed_substitutes p)) );
75
Added:
]
76
Added:
77
Added:
let suite =
78
Added:
[
79
Added:
("prescription.make", make_tests); ("prescription.accessors", accessor_tests);
80
Added:
]