[OCaml] High Intensity Training Online
feat implement straight, superset, and pre_exhaust
t = view directly: the type already IS the shape after the strict- adherence paring (no extra_volume to validate), so there is no representation to hide behind an opaque type. Authored test_set_group.ml, since no suite existed for this shape — it postdates the extra_volume removal and the routine-as-split correction. Covers all three constructors, warm-up ramp retention and its empty default, and that view exposes the right constructor.
Changed files
lib/core/set_group.ml
@@ -1,11 +1,3 @@
1
Removed:
(* Minimal stubs only; implementation deferred until after the review gate. *)
2
Removed:
3
Removed:
type t = unit
4
Removed:
5
Removed:
let straight ?warm_ups:_ ~working:_ () = failwith "TODO"
6
Removed:
let superset ?warm_ups:_ ~first:_ ~second:_ () = failwith "TODO"
7
Removed:
let pre_exhaust ?warm_ups:_ ~isolation:_ ~compound:_ () = failwith "TODO"
8
Removed:
9
1
type view =
10
2
| Straight of { warm_ups : Set.Warm_up.t list; working : Set.Working.t }
11
3
| Superset of {
@@ -19,7 +11,45 @@
19
11
compound : Set.Working.t;
20
12
}
21
13
22
Removed:
let view _ = failwith "TODO"
23
Removed:
let working_sets _ = failwith "TODO"
24
Removed:
let warm_ups _ = failwith "TODO"
25
Removed:
let pp _ _ = failwith "TODO"
14
Added:
type t = view
15
Added:
16
Added:
let straight ?(warm_ups = []) ~working () = Straight { warm_ups; working }
17
Added:
18
Added:
let superset ?(warm_ups = []) ~first ~second () =
19
Added:
Superset { warm_ups; first; second }
20
Added:
21
Added:
let pre_exhaust ?(warm_ups = []) ~isolation ~compound () =
22
Added:
Pre_exhaust { warm_ups; isolation; compound }
23
Added:
24
Added:
let view t = t
25
Added:
26
Added:
let working_sets = function
27
Added:
| Straight { working; _ } -> [ working ]
28
Added:
| Superset { first; second; _ } -> [ first; second ]
29
Added:
| Pre_exhaust { isolation; compound; _ } -> [ isolation; compound ]
30
Added:
31
Added:
let warm_ups = function
32
Added:
| Straight { warm_ups; _ }
33
Added:
| Superset { warm_ups; _ }
34
Added:
| Pre_exhaust { warm_ups; _ } ->
35
Added:
warm_ups
36
Added:
37
Added:
let pp fmt t =
38
Added:
let pp_warm_ups fmt = function
39
Added:
| [] -> ()
40
Added:
| ws ->
41
Added:
Format.fprintf fmt "warm-up: %a; "
42
Added:
(Format.pp_print_list
43
Added:
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
44
Added:
Set.Warm_up.pp)
45
Added:
ws
46
Added:
in
47
Added:
match t with
48
Added:
| Straight { warm_ups; working } ->
49
Added:
Format.fprintf fmt "%a%a" pp_warm_ups warm_ups Set.Working.pp working
50
Added:
| Superset { warm_ups; first; second } ->
51
Added:
Format.fprintf fmt "%asuperset: %a + %a" pp_warm_ups warm_ups
52
Added:
Set.Working.pp first Set.Working.pp second
53
Added:
| Pre_exhaust { warm_ups; isolation; compound } ->
54
Added:
Format.fprintf fmt "%apre-exhaust: %a -> %a" pp_warm_ups warm_ups
55
Added:
Set.Working.pp isolation Set.Working.pp compound
test/test_hito.ml
@@ -2,4 +2,6 @@
2
2
implementations land. *)
3
3
4
4
let () =
5
Removed:
Alcotest.run "hito" (Test_units.suite @ Test_exercise.suite @ Test_set.suite)
5
Added:
Alcotest.run "hito"
6
Added:
(Test_units.suite @ Test_exercise.suite @ Test_set.suite
7
Added:
@ Test_set_group.suite)
test/test_set_group.ml
@@ -0,0 +1,112 @@
1
Added:
(** Unit tests for {!Hito_core.Set_group}, authored against set_group.mli.
2
Added:
3
Added:
Under test: each shape retains its working sets and warm-ups; the shape
4
Added:
admits no more or fewer working sets than Heavy Duty prescribes. *)
5
Added:
6
Added:
open Hito_core
7
Added:
8
Added:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
9
Added:
let mk_w kg = ok (Units.Weight.of_kg kg)
10
Added:
let mk_r n = ok (Units.Reps.of_int n)
11
Added:
12
Added:
let exercises =
13
Added:
match Exercise.catalog with
14
Added:
| a :: b :: _ -> (a, b)
15
Added:
| _ -> Alcotest.fail "catalog needs at least two exercises"
16
Added:
17
Added:
let working exercise load reps =
18
Added:
Set.Working.make ~exercise ~load:(mk_w load) ~reps:(mk_r reps)
19
Added:
~outcome:Set.Working.Positive_failure
20
Added:
21
Added:
let warm_up exercise load reps =
22
Added:
Set.Warm_up.make ~exercise ~load:(mk_w load) ~reps:(mk_r reps)
23
Added:
24
Added:
let straight_tests =
25
Added:
[
26
Added:
( "straight retains exactly one working set",
27
Added:
`Quick,
28
Added:
fun () ->
29
Added:
let ex, _ = exercises in
30
Added:
let g = Set_group.straight ~working:(working ex 80.0 6) () in
31
Added:
Alcotest.(check int)
32
Added:
"one working set" 1
33
Added:
(List.length (Set_group.working_sets g)) );
34
Added:
( "straight retains its warm-up ramp",
35
Added:
`Quick,
36
Added:
fun () ->
37
Added:
let ex, _ = exercises in
38
Added:
let ramp = [ warm_up ex 40.0 10; warm_up ex 60.0 5 ] in
39
Added:
let g =
40
Added:
Set_group.straight ~warm_ups:ramp ~working:(working ex 80.0 6) ()
41
Added:
in
42
Added:
Alcotest.(check int)
43
Added:
"two warm-ups" 2
44
Added:
(List.length (Set_group.warm_ups g)) );
45
Added:
( "straight defaults to no warm-up",
46
Added:
`Quick,
47
Added:
fun () ->
48
Added:
let ex, _ = exercises in
49
Added:
let g = Set_group.straight ~working:(working ex 80.0 6) () in
50
Added:
Alcotest.(check int)
51
Added:
"no warm-ups" 0
52
Added:
(List.length (Set_group.warm_ups g)) );
53
Added:
]
54
Added:
55
Added:
let superset_tests =
56
Added:
[
57
Added:
( "superset retains both working sets in order",
58
Added:
`Quick,
59
Added:
fun () ->
60
Added:
let a, b = exercises in
61
Added:
let first = working a 80.0 6 and second = working b 20.0 12 in
62
Added:
let g = Set_group.superset ~first ~second () in
63
Added:
match Set_group.working_sets g with
64
Added:
| [ s1; s2 ] ->
65
Added:
Alcotest.(check bool)
66
Added:
"first matches" true
67
Added:
(Exercise.equal (Set.Working.exercise s1) a);
68
Added:
Alcotest.(check bool)
69
Added:
"second matches" true
70
Added:
(Exercise.equal (Set.Working.exercise s2) b)
71
Added:
| _ -> Alcotest.fail "expected exactly two working sets" );
72
Added:
]
73
Added:
74
Added:
let pre_exhaust_tests =
75
Added:
[
76
Added:
( "pre-exhaust orders isolation before compound",
77
Added:
`Quick,
78
Added:
fun () ->
79
Added:
let isolation_ex, compound_ex = exercises in
80
Added:
let isolation = working isolation_ex 20.0 12 in
81
Added:
let compound = working compound_ex 80.0 6 in
82
Added:
let g = Set_group.pre_exhaust ~isolation ~compound () in
83
Added:
match Set_group.working_sets g with
84
Added:
| [ s1; s2 ] ->
85
Added:
Alcotest.(check bool)
86
Added:
"isolation first" true
87
Added:
(Exercise.equal (Set.Working.exercise s1) isolation_ex);
88
Added:
Alcotest.(check bool)
89
Added:
"compound second" true
90
Added:
(Exercise.equal (Set.Working.exercise s2) compound_ex)
91
Added:
| _ -> Alcotest.fail "expected exactly two working sets" );
92
Added:
]
93
Added:
94
Added:
let view_tests =
95
Added:
[
96
Added:
( "view exposes the straight shape",
97
Added:
`Quick,
98
Added:
fun () ->
99
Added:
let ex, _ = exercises in
100
Added:
let g = Set_group.straight ~working:(working ex 80.0 6) () in
101
Added:
match Set_group.view g with
102
Added:
| Set_group.Straight _ -> ()
103
Added:
| _ -> Alcotest.fail "expected Straight" );
104
Added:
]
105
Added:
106
Added:
let suite =
107
Added:
[
108
Added:
("set_group.straight", straight_tests);
109
Added:
("set_group.superset", superset_tests);
110
Added:
("set_group.pre_exhaust", pre_exhaust_tests);
111
Added:
("set_group.view", view_tests);
112
Added:
]