[OCaml] High Intensity Training Online
refactor Hide exercise catalog internals
Keep the core focused on lookup and policy decisions by hiding catalog representation and redundant convenience operations. Tests now assert observable domain behavior rather than implementation details.
Changed files
lib/core/exercise.ml
@@ -10,8 +10,6 @@
10
10
11
11
let id t = t.id
12
12
let name t = t.name
13
Removed:
let mechanic t = t.mechanic
14
Removed:
let muscles t = t.muscles
15
13
let equal a b = String.equal a.id b.id
16
14
let pp ppf t = Format.pp_print_string ppf t.name
17
15
@@ -87,23 +85,16 @@
87
85
]
88
86
89
87
let group_of e =
90
Removed:
List.find_opt (fun g -> List.mem e.id g) substitution_groups
88
Added:
List.find_opt (fun group -> List.mem e.id group) substitution_groups
91
89
|> Option.value ~default:[]
92
90
93
91
let permitted_substitutes e =
94
92
group_of e
95
Removed:
|> List.filter (fun i -> not (String.equal i e.id))
93
Added:
|> List.filter (fun id -> not (String.equal id e.id))
96
94
|> List.filter_map find
97
95
98
96
let may_substitute ~original ~candidate =
99
97
List.exists (equal candidate) (permitted_substitutes original)
100
Removed:
101
Removed:
type error = Not_permitted of { original : id; candidate : id }
102
Removed:
103
Removed:
let substitute ~original ~candidate =
104
Removed:
if may_substitute ~original ~candidate then Ok candidate
105
Removed:
else
106
Removed:
Error (Not_permitted { original = original.id; candidate = candidate.id })
107
98
108
99
let may_pre_exhaust ~isolation ~compound =
109
100
match (isolation.mechanic, compound.mechanic, isolation.muscles) with
lib/core/exercise.mli
@@ -1,33 +1,20 @@
1
Removed:
(** Curated exercises, mechanics, and allowed substitutions. *)
1
Added:
(** Curated exercises and their permitted relationships. *)
2
2
3
3
type t
4
Removed:
(** Only obtainable from {!catalog} or {!find}. *)
4
Added:
(** Only obtainable by lookup. *)
5
5
6
6
type id = private string
7
7
8
Added:
val find : string -> t option
9
Added:
(** Looks up an exercise by its identifier. *)
10
Added:
8
11
val id : t -> id
9
12
val name : t -> string
10
13
val equal : t -> t -> bool
11
14
val pp : Format.formatter -> t -> unit
12
Removed:
val catalog : t list
13
15
14
Removed:
val find : string -> t option
15
Removed:
(** By {!id}. *)
16
Removed:
17
Removed:
type mechanic = Isolation | Compound
18
Removed:
19
Removed:
val mechanic : t -> mechanic
20
Removed:
21
Removed:
val muscles : t -> Muscle.t list
22
Removed:
(** One for an isolation; at least two for a compound. *)
23
Removed:
24
16
val may_pre_exhaust : isolation:t -> compound:t -> bool
25
Removed:
(** [isolation] targets a muscle that [compound] also works. *)
17
Added:
(** Whether the pair shares the isolation's target. *)
26
18
27
Removed:
type error = Not_permitted of { original : id; candidate : id }
28
Removed:
29
Removed:
val permitted_substitutes : t -> t list
30
19
val may_substitute : original:t -> candidate:t -> bool
31
Removed:
32
Removed:
val substitute : original:t -> candidate:t -> (t, error) result
33
Removed:
(** [Ok candidate] iff it is whitelisted for [original]. *)
20
Added:
(** Whether [candidate] is author-approved for [original]. *)
lib/core/muscle.ml
@@ -13,23 +13,6 @@
13
13
| Calves
14
14
| Abdominals
15
15
16
Removed:
let all =
17
Removed:
[
18
Removed:
Pecs;
19
Removed:
Delts;
20
Removed:
Triceps;
21
Removed:
Biceps;
22
Removed:
Forearms;
23
Removed:
Lats;
24
Removed:
Traps;
25
Removed:
Erectors;
26
Removed:
Quadriceps;
27
Removed:
Hamstrings;
28
Removed:
Glutes;
29
Removed:
Calves;
30
Removed:
Abdominals;
31
Removed:
]
32
Removed:
33
16
let name = function
34
17
| Pecs -> "pecs"
35
18
| Delts -> "delts"
@@ -46,5 +29,4 @@
46
29
| Abdominals -> "abdominals"
47
30
48
31
let equal = ( = )
49
Removed:
let compare = Stdlib.compare
50
32
let pp ppf t = Format.pp_print_string ppf (name t)
lib/core/muscle.mli
@@ -15,8 +15,6 @@
15
15
| Calves
16
16
| Abdominals
17
17
18
Removed:
val all : t list
19
18
val name : t -> string
20
19
val equal : t -> t -> bool
21
Removed:
val compare : t -> t -> int
22
20
val pp : Format.formatter -> t -> unit
lib/core/units.ml
@@ -12,7 +12,6 @@
12
12
if Float.is_finite kg && kg >= 0. then Ok kg else Error Negative
13
13
14
14
let to_kg t = t
15
Removed:
let zero = 0.
16
15
let compare = Float.compare
17
16
let equal = Float.equal
18
17
let pp ppf t = Format.fprintf ppf "%g kg" t
@@ -40,6 +39,5 @@
40
39
let contains t reps =
41
40
Reps.compare reps t.min >= 0 && Reps.compare reps t.max <= 0
42
41
43
Removed:
let equal a b = Reps.equal a.min b.min && Reps.equal a.max b.max
44
42
let pp ppf t = Format.fprintf ppf "%a-%a" Reps.pp t.min Reps.pp t.max
45
43
end
lib/core/units.mli
@@ -7,13 +7,12 @@
7
7
8
8
val pp_error : Format.formatter -> error -> unit
9
9
10
Removed:
(** Nonnegative kilograms; [zero] is valid for body-weight movements. *)
10
Added:
(** Nonnegative kilograms; zero is valid for body-weight movements. *)
11
11
module Weight : sig
12
12
type t
13
13
14
14
val of_kg : float -> (t, error) result
15
15
val to_kg : t -> float
16
Removed:
val zero : t
17
16
val compare : t -> t -> int
18
17
val equal : t -> t -> bool
19
18
val pp : Format.formatter -> t -> unit
@@ -38,6 +37,5 @@
38
37
val min : t -> Reps.t
39
38
val max : t -> Reps.t
40
39
val contains : t -> Reps.t -> bool
41
Removed:
val equal : t -> t -> bool
42
40
val pp : Format.formatter -> t -> unit
43
41
end
test/test_exercise.ml
@@ -5,41 +5,17 @@
5
5
| Some e -> e
6
6
| None -> Alcotest.failf "catalog is missing %S" id
7
7
8
Removed:
let catalog_tests =
8
Added:
let lookup_tests =
9
9
[
10
Removed:
( "catalog is non-empty and ids are unique",
10
Added:
( "find locates curated entries and rejects unknown ids",
11
11
`Quick,
12
12
fun () ->
13
Removed:
let ids =
14
Removed:
List.map (fun e -> (Exercise.id e :> string)) Exercise.catalog
15
Removed:
in
16
Removed:
Alcotest.(check bool) "non-empty" true (ids <> []);
17
Removed:
Alcotest.(check int)
18
Removed:
"unique" (List.length ids)
19
Removed:
(List.length (List.sort_uniq String.compare ids)) );
20
Removed:
( "find locates a catalog entry and rejects unknown ids",
21
Removed:
`Quick,
22
Removed:
fun () ->
23
13
Alcotest.(check string)
24
14
"name" "Dumbbell Flyes"
25
15
(Exercise.name (get "dumbbell-flyes"));
26
16
Alcotest.(check bool)
27
17
"unknown" true
28
18
(Option.is_none (Exercise.find "jefferson-curl")) );
29
Removed:
( "isolations work exactly one muscle, compounds two or more",
30
Removed:
`Quick,
31
Removed:
fun () ->
32
Removed:
List.iter
33
Removed:
(fun e ->
34
Removed:
let n = List.length (Exercise.muscles e) in
35
Removed:
match Exercise.mechanic e with
36
Removed:
| Exercise.Isolation ->
37
Removed:
Alcotest.(check int) (Exercise.name e ^ " isolates one") 1 n
38
Removed:
| Exercise.Compound ->
39
Removed:
Alcotest.(check bool)
40
Removed:
(Exercise.name e ^ " involves assistors")
41
Removed:
true (n >= 2))
42
Removed:
Exercise.catalog );
43
19
]
44
20
45
21
let pre_exhaust_tests =
@@ -51,15 +27,13 @@
51
27
"flyes then incline press" true
52
28
(Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes")
53
29
~compound:(get "incline-press")) );
54
Removed:
( "accepts HD1's triceps pairing, where Dips serves a second muscle",
30
Added:
( "accepts HD1's triceps pairing, where dips serves a second muscle",
55
31
`Quick,
56
32
fun () ->
57
33
Alcotest.(check bool)
58
34
"french press then dips" true
59
35
(Exercise.may_pre_exhaust ~isolation:(get "lying-french-press")
60
36
~compound:(get "dips"));
61
Removed:
(* The same compound also serves the pecs, which is why a movement
62
Removed:
carries a set of muscles rather than one primary. *)
63
37
Alcotest.(check bool)
64
38
"flyes then dips" true
65
39
(Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes")
@@ -75,25 +49,19 @@
75
49
"leg extensions then leg presses" true
76
50
(Exercise.may_pre_exhaust ~isolation:(get "leg-extensions")
77
51
~compound:(get "leg-presses")) );
78
Removed:
( "rejects a compound paired with a compound",
52
Added:
( "rejects invalid pairings",
79
53
`Quick,
80
54
fun () ->
81
55
Alcotest.(check bool)
82
Removed:
"dips then incline press" false
56
Added:
"compound then compound" false
83
57
(Exercise.may_pre_exhaust ~isolation:(get "dips")
84
Removed:
~compound:(get "incline-press")) );
85
Removed:
( "rejects an isolation paired with an isolation",
86
Removed:
`Quick,
87
Removed:
fun () ->
58
Added:
~compound:(get "incline-press"));
88
59
Alcotest.(check bool)
89
Removed:
"flyes then pec deck" false
60
Added:
"isolation then isolation" false
90
61
(Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes")
91
Removed:
~compound:(get "pec-deck")) );
92
Removed:
( "rejects a pairing that shares no muscle",
93
Removed:
`Quick,
94
Removed:
fun () ->
62
Added:
~compound:(get "pec-deck"));
95
63
Alcotest.(check bool)
96
Removed:
"flyes then squats" false
64
Added:
"unrelated targets" false
97
65
(Exercise.may_pre_exhaust ~isolation:(get "dumbbell-flyes")
98
66
~compound:(get "squats")) );
99
67
]
@@ -111,57 +79,27 @@
111
79
"leg press for squat" true
112
80
(Exercise.may_substitute ~original:(get "leg-presses")
113
81
~candidate:(get "squats")) );
114
Removed:
( "substitution is symmetric",
82
Added:
( "substitution is symmetric but excludes the original and unrelated \
83
Added:
movements",
115
84
`Quick,
116
85
fun () ->
117
Removed:
List.iter
118
Removed:
(fun e ->
119
Removed:
List.iter
120
Removed:
(fun sub ->
121
Removed:
Alcotest.(check bool)
122
Removed:
(Exercise.name e ^ " <-> " ^ Exercise.name sub)
123
Removed:
true
124
Removed:
(Exercise.may_substitute ~original:sub ~candidate:e))
125
Removed:
(Exercise.permitted_substitutes e))
126
Removed:
Exercise.catalog );
127
Removed:
( "an exercise is not its own substitute",
128
Removed:
`Quick,
129
Removed:
fun () ->
130
86
let flyes = get "dumbbell-flyes" in
87
Added:
let pec_deck = get "pec-deck" in
131
88
Alcotest.(check bool)
89
Added:
"pec deck for flyes" true
90
Added:
(Exercise.may_substitute ~original:pec_deck ~candidate:flyes);
91
Added:
Alcotest.(check bool)
132
92
"not self" false
133
Removed:
(List.exists (Exercise.equal flyes)
134
Removed:
(Exercise.permitted_substitutes flyes)) );
135
Removed:
( "unrelated movements are not substitutable",
136
Removed:
`Quick,
137
Removed:
fun () ->
93
Added:
(Exercise.may_substitute ~original:flyes ~candidate:flyes);
138
94
Alcotest.(check bool)
139
95
"curls for squats" false
140
96
(Exercise.may_substitute ~original:(get "curls")
141
97
~candidate:(get "squats")) );
142
Removed:
( "substitute yields the candidate or a typed refusal",
143
Removed:
`Quick,
144
Removed:
fun () ->
145
Removed:
(match
146
Removed:
Exercise.substitute ~original:(get "dumbbell-flyes")
147
Removed:
~candidate:(get "pec-deck")
148
Removed:
with
149
Removed:
| Ok e ->
150
Removed:
Alcotest.(check string) "pec deck" "Pec Deck" (Exercise.name e)
151
Removed:
| Error _ -> Alcotest.fail "expected Ok");
152
Removed:
match
153
Removed:
Exercise.substitute ~original:(get "curls") ~candidate:(get "squats")
154
Removed:
with
155
Removed:
| Ok _ -> Alcotest.fail "expected Error"
156
Removed:
| Error (Exercise.Not_permitted { original; candidate }) ->
157
Removed:
Alcotest.(check string) "original" "curls" (original :> string);
158
Removed:
Alcotest.(check string) "candidate" "squats" (candidate :> string)
159
Removed:
);
160
98
]
161
99
162
100
let suite =
163
101
[
164
Removed:
("exercise.catalog", catalog_tests);
102
Added:
("exercise.lookup", lookup_tests);
165
103
("exercise.pre_exhaust", pre_exhaust_tests);
166
104
("exercise.substitution", substitution_tests);
167
105
]
test/test_muscle.ml
@@ -1,26 +1,21 @@
1
Removed:
(** Unit tests for {!Muscle}. *)
1
Added:
(** Unit tests for {!Muscle}, authored against the muscle.mli contract. *)
2
2
3
3
let muscle_tests =
4
4
[
5
Removed:
( "all lists every constructor exactly once",
5
Added:
( "names identify targets",
6
6
`Quick,
7
7
fun () ->
8
Removed:
let n = List.length Muscle.all in
9
Removed:
let unique = List.sort_uniq Muscle.compare Muscle.all in
10
Removed:
Alcotest.(check int) "no duplicates" n (List.length unique);
11
Removed:
Alcotest.(check int) "thirteen targets" 13 n );
12
Removed:
( "names are distinct",
13
Removed:
`Quick,
14
Removed:
fun () ->
15
Removed:
let names = List.map Muscle.name Muscle.all in
16
Removed:
Alcotest.(check int)
17
Removed:
"distinct" (List.length names)
18
Removed:
(List.length (List.sort_uniq String.compare names)) );
8
Added:
Alcotest.(check string) "pecs" "pecs" (Muscle.name Muscle.Pecs);
9
Added:
Alcotest.(check string) "lats" "lats" (Muscle.name Muscle.Lats) );
19
10
( "equal distinguishes targets",
20
11
`Quick,
21
12
fun () ->
22
Removed:
Alcotest.(check bool) "pecs = pecs" true (Muscle.equal Pecs Pecs);
23
Removed:
Alcotest.(check bool) "pecs <> lats" false (Muscle.equal Pecs Lats) );
13
Added:
Alcotest.(check bool)
14
Added:
"pecs = pecs" true
15
Added:
(Muscle.equal Muscle.Pecs Muscle.Pecs);
16
Added:
Alcotest.(check bool)
17
Added:
"pecs <> lats" false
18
Added:
(Muscle.equal Muscle.Pecs Muscle.Lats) );
24
19
]
25
20
26
21
let suite = [ ("muscle", muscle_tests) ]
test/test_units.ml
@@ -23,18 +23,11 @@
23
23
Alcotest.(check bool)
24
24
"infinity rejected" true
25
25
(Result.is_error (Units.Weight.of_kg Float.infinity)) );
26
Removed:
( "of_kg accepts zero (bodyweight movements)",
26
Added:
( "of_kg accepts zero for body-weight movements",
27
27
`Quick,
28
28
fun () ->
29
Removed:
Alcotest.(check bool)
30
Removed:
"zero accepted" true
31
Removed:
(Result.is_ok (Units.Weight.of_kg 0.0)) );
32
Removed:
( "zero is zero kilograms",
33
Removed:
`Quick,
34
Removed:
fun () ->
35
Removed:
Alcotest.(check (float 0.0001))
36
Removed:
"0kg" 0.0
37
Removed:
(Units.Weight.to_kg Units.Weight.zero) );
29
Added:
let zero = ok (Units.Weight.of_kg 0.0) in
30
Added:
Alcotest.(check (float 0.0001)) "0kg" 0.0 (Units.Weight.to_kg zero) );
38
31
( "round-trips kilograms",
39
32
`Quick,
40
33
fun () ->
@@ -122,18 +115,14 @@
122
115
Alcotest.(check bool)
123
116
"excludes 12" false
124
117
(Units.Rep_range.contains r (reps 12)) );
125
Removed:
( "exposes its bounds and compares structurally",
118
Added:
( "exposes its bounds",
126
119
`Quick,
127
120
fun () ->
128
121
let r = ok (Units.Rep_range.make ~min:(reps 6) ~max:(reps 10)) in
129
122
Alcotest.(check int) "min" 6 (Units.Reps.to_int (Units.Rep_range.min r));
130
123
Alcotest.(check int)
131
124
"max" 10
132
Removed:
(Units.Reps.to_int (Units.Rep_range.max r));
133
Removed:
Alcotest.(check bool)
134
Removed:
"equal to itself" true
135
Removed:
(Units.Rep_range.equal r
136
Removed:
(ok (Units.Rep_range.make ~min:(reps 6) ~max:(reps 10)))) );
125
Added:
(Units.Reps.to_int (Units.Rep_range.max r)) );
137
126
]
138
127
139
128
let suite =