[OCaml] High Intensity Training Online

refactor raise invalid plan construction

Authored prescriptions are built after the app validates input, so invalid pairings, ranges, substitutions, and empty plans now raise scoped exceptions rather than burdening trusted callers with result plumbing. Raw unit conversion and recoverable domain feedback remain results. Evidence records a factual Pair rather than asserting every recorded pair is a pre-exhaustion. This keeps history honest while Prescription remains strict. Align steering with those boundaries, the local-only HD1 source, and the concrete validation command.

Commit
854f6dade2c76503031a735c9d80e5b8283a6384
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
.kiro/steering/domain.md
index a0131072..d547009a 100644..100644
@@ -4,6 +4,7 @@
4 4
5 5 - Source of doctrine: `doc/Mike_Mentzer_Heavy_Duty_I.md` (HD1). Every domain
6 6 decision must be justified against it.
7 Added: - It is copyrighted local reference material, gitignored, and never committed.
7 8 - On conflict between a design choice and the doctrine:
8 9 1. The doctrine wins, or
9 10 2. The conflict is raised explicitly.
.kiro/steering/ocaml.md
index f341660d..0a64d826 100644..100644
@@ -15,11 +15,15 @@
15 15 substantial noise — typically chained `result` plumbing.
16 16 - A single `match` is clearer than a monad; don't reach for one reflexively.
17 17 - Abstract types with smart constructors for anything carrying an invariant.
18 Removed: - Return `result` with a module-specific error type.
19 Removed: - Each module defines its own errors.
20 Removed: - No shared catch-all error type, no `string` errors.
18 Added: - Use `result` for expected, recoverable failure.
19 Added: - This includes converting untrusted external data and domain feedback a caller
20 Added: can present or recover from.
21 Added: - Each module defines its own errors; no shared catch-all error type or
22 Added: `string` errors.
23 Added: - Raise a module-specific exception for a violated authored-plan precondition
24 Added: after validation.
25 Added: - Do not use exceptions for normal domain outcomes or recorded deviations.
21 26 - Prefer closed variants — they keep `match` exhaustiveness working for you.
22 Removed: - Reserve exceptions for genuine programmer error, never for control flow.
23 27 - Total functions where practical; make partiality visible in the type.
24 28
25 29 ## Layering
.kiro/steering/workflow.md
index 249b3444..8212e659 100644..100644
@@ -14,7 +14,7 @@
14 14
15 15 - Commit — but only when asked.
16 16 - Never commit unformatted or failing code.
17 Removed: - Use `direnv exec <repo> dune ...` if the local opam switch is not active.
17 Added: - Use `direnv exec . dune ...` if the local opam switch is not active.
18 18
19 19 ## Commits
20 20
@@ -43,4 +43,5 @@
43 43 - Interface docs state **intention**, not implementation. One line where one
44 44 line will do.
45 45 - A module header says what the module is for and which invariant it upholds.
46 Added: - No Markdown files unless asked.
46 47 - Don't restate the signature in prose. Document the *why* and the edge cases.
lib/core/evidence.ml
index a5086520..a72d9594 100644..100644
@@ -64,40 +64,18 @@
64 64
65 65 type delivery =
66 66 | Single of Movement.t
67 Removed: | Pre_exhaust of { isolation : Movement.t; compound : Movement.t }
67 Added: | Pair of { first : Movement.t; second : Movement.t }
68 68
69 69 type t = { delivery : delivery; warm_ups : Warm_up.t list }
70 70
71 Removed: type error =
72 Removed: | Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
73 Removed:
74 Removed: let pp_error ppf (Not_a_pre_exhaust { isolation; compound }) =
75 Removed: Format.fprintf ppf "%s cannot pre-exhaust for %s"
76 Removed: (isolation :> string)
77 Removed: (compound :> string)
78 Removed:
79 Removed: let make ?(warm_ups = []) delivery =
80 Removed: match delivery with
81 Removed: | Pre_exhaust { isolation; compound }
82 Removed: when not
83 Removed: (Exercise.may_pre_exhaust
84 Removed: ~isolation:(Movement.exercise isolation)
85 Removed: ~compound:(Movement.exercise compound)) ->
86 Removed: Error
87 Removed: (Not_a_pre_exhaust
88 Removed: {
89 Removed: isolation = Exercise.id (Movement.exercise isolation);
90 Removed: compound = Exercise.id (Movement.exercise compound);
91 Removed: })
92 Removed: | _ -> Ok { delivery; warm_ups }
93 Removed:
71 Added: let make ?(warm_ups = []) delivery = { delivery; warm_ups }
94 72 let delivery t = t.delivery
95 73 let warm_ups t = t.warm_ups
96 74
97 75 let movements t =
98 76 match t.delivery with
99 77 | Single m -> [ m ]
100 Removed: | Pre_exhaust { isolation; compound } -> [ isolation; compound ]
78 Added: | Pair { first; second } -> [ first; second ]
101 79
102 80 let exercises t = List.map Movement.exercise (movements t)
103 81 let extensions t = List.concat_map Movement.extensions (movements t)
@@ -106,13 +84,12 @@
106 84 let pp ppf t =
107 85 match t.delivery with
108 86 | Single m -> Movement.pp ppf m
109 Removed: | Pre_exhaust { isolation; compound } ->
110 Removed: Format.fprintf ppf "%a into %a" Movement.pp isolation Movement.pp
111 Removed: compound
87 Added: | Pair { first; second } ->
88 Added: Format.fprintf ppf "%a then %a" Movement.pp first Movement.pp second
112 89 end
113 90
114 91 module Workout = struct
115 Removed: type shape = As_single | As_pre_exhaust
92 Added: type shape = As_single | As_pair
116 93
117 94 type error =
118 95 | Not_prescribed of Exercise.id
@@ -135,7 +112,7 @@
135 112
136 113 let pp_shape ppf = function
137 114 | As_single -> Format.pp_print_string ppf "a single set"
138 Removed: | As_pre_exhaust -> Format.pp_print_string ppf "a pre-exhaust pair"
115 Added: | As_pair -> Format.pp_print_string ppf "a pair"
139 116
140 117 let pp_error ppf = function
141 118 | Not_prescribed id ->
@@ -165,12 +142,12 @@
165 142 let prescribed_shape p =
166 143 match Prescription.Stimulus.delivery p with
167 144 | Prescription.Stimulus.Single _ -> As_single
168 Removed: | Prescription.Stimulus.Pre_exhaust _ -> As_pre_exhaust
145 Added: | Prescription.Stimulus.Pre_exhaust _ -> As_pair
169 146
170 147 let logged_shape s =
171 148 match Stimulus.delivery s with
172 149 | Stimulus.Single _ -> As_single
173 Removed: | Stimulus.Pre_exhaust _ -> As_pre_exhaust
150 Added: | Stimulus.Pair _ -> As_pair
174 151
175 152 (* A logged movement answers a prescribed one when it is that movement, or a
176 153 substitute the prescription allows *for that movement*. *)
lib/core/evidence.mli
index c6ce4735..1cb1015c 100644..100644
@@ -45,18 +45,13 @@
45 45
46 46 type delivery =
47 47 | Single of Movement.t
48 Removed: | Pre_exhaust of { isolation : Movement.t; compound : Movement.t }
48 Added: | Pair of { first : Movement.t; second : Movement.t }
49 49
50 50 type t
51 51
52 Removed: type error =
53 Removed: | Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
52 Added: val make : ?warm_ups:Warm_up.t list -> delivery -> t
53 Added: (** Records the delivery as performed. *)
54 54
55 Removed: val pp_error : Format.formatter -> error -> unit
56 Removed:
57 Removed: val make : ?warm_ups:Warm_up.t list -> delivery -> (t, error) result
58 Removed: (** Rejects a mislabelled pre-exhaust pairing. *)
59 Removed:
60 55 val delivery : t -> delivery
61 56
62 57 val movements : t -> Movement.t list
@@ -72,7 +67,7 @@
72 67 (** A performed or in-progress prescribed workout. *)
73 68 module Workout : sig
74 69 type t
75 Removed: type shape = As_single | As_pre_exhaust
70 Added: type shape = As_single | As_pair
76 71
77 72 type error =
78 73 | Not_prescribed of Exercise.id
lib/core/prescription.ml
index c64bb537..f8bca3c4 100644..100644
@@ -48,6 +48,8 @@
48 48 Units.Rep_range.contains rep_limits (Units.Rep_range.min range)
49 49 && Units.Rep_range.contains rep_limits (Units.Rep_range.max range)
50 50
51 Added: exception Invalid of error
52 Added:
51 53 let make ~delivery ~rep_range ~allowed_substitutes =
52 54 let movements = delivery_exercises delivery in
53 55 let unpermitted =
@@ -62,16 +64,17 @@
62 64 match (delivery, within_limits rep_range, unpermitted) with
63 65 | Pre_exhaust { isolation; compound }, _, _
64 66 when not (Exercise.may_pre_exhaust ~isolation ~compound) ->
65 Removed: Error
66 Removed: (Not_a_pre_exhaust
67 Removed: {
68 Removed: isolation = Exercise.id isolation;
69 Removed: compound = Exercise.id compound;
70 Removed: })
71 Removed: | _, false, _ -> Error Reps_outside_limits
67 Added: raise
68 Added: (Invalid
69 Added: (Not_a_pre_exhaust
70 Added: {
71 Added: isolation = Exercise.id isolation;
72 Added: compound = Exercise.id compound;
73 Added: }))
74 Added: | _, false, _ -> raise (Invalid Reps_outside_limits)
72 75 | _, _, Some candidate ->
73 Removed: Error (Substitute_not_permitted (Exercise.id candidate))
74 Removed: | _ -> Ok { delivery; rep_range; allowed_substitutes }
76 Added: raise (Invalid (Substitute_not_permitted (Exercise.id candidate)))
77 Added: | _ -> { delivery; rep_range; allowed_substitutes }
75 78
76 79 let permits t movement =
77 80 List.exists (Exercise.equal movement) (exercises t)
@@ -93,10 +96,12 @@
93 96 type error = Empty_workout
94 97 type t = { id : id; name : string; stimuli : Stimulus.t list }
95 98
99 Added: exception Invalid of error
100 Added:
96 101 let make ~id ~name ~stimuli =
97 102 match stimuli with
98 Removed: | [] -> Error Empty_workout
99 Removed: | _ -> Ok { id; name; stimuli }
103 Added: | [] -> raise (Invalid Empty_workout)
104 Added: | _ -> { id; name; stimuli }
100 105
101 106 let id t = t.id
102 107 let name t = t.name
@@ -109,8 +114,12 @@
109 114 type error = Empty_routine
110 115 type t = { name : string; workouts : Workout.t list }
111 116
117 Added: exception Invalid of error
118 Added:
112 119 let make ~name ~workouts =
113 Removed: match workouts with [] -> Error Empty_routine | _ -> Ok { name; workouts }
120 Added: match workouts with
121 Added: | [] -> raise (Invalid Empty_routine)
122 Added: | _ -> { name; workouts }
114 123
115 124 let name t = t.name
116 125 let workouts t = t.workouts
@@ -134,10 +143,6 @@
134 143
135 144 (* {1 The Ideal Routine} *)
136 145
137 Removed: let preset_exn pp = function
138 Removed: | Ok v -> v
139 Removed: | Error e -> invalid_arg (Format.asprintf "Routine preset: %a" pp e)
140 Removed:
141 146 let movement id =
142 147 match Exercise.find id with
143 148 | Some e -> e
@@ -153,9 +158,8 @@
153 158 | Error _ -> assert false
154 159
155 160 let prescribe ?(substitutes = []) delivery =
156 Removed: preset_exn Stimulus.pp_error
157 Removed: (Stimulus.make ~delivery ~rep_range:six_to_ten
158 Removed: ~allowed_substitutes:(List.map movement substitutes))
161 Added: Stimulus.make ~delivery ~rep_range:six_to_ten
162 Added: ~allowed_substitutes:(List.map movement substitutes)
159 163
160 164 let single ?substitutes id =
161 165 prescribe ?substitutes (Stimulus.Single (movement id))
@@ -165,11 +169,7 @@
165 169 (Stimulus.Pre_exhaust
166 170 { isolation = movement isolation; compound = movement compound })
167 171
168 Removed: let day ~id ~name stimuli =
169 Removed: preset_exn
170 Removed: (fun ppf Workout.Empty_workout ->
171 Removed: Format.pp_print_string ppf "empty workout")
172 Removed: (Workout.make ~id ~name ~stimuli)
172 Added: let day ~id ~name stimuli = Workout.make ~id ~name ~stimuli
173 173
174 174 let ideal_day_one =
175 175 day ~id:"ideal-day-1" ~name:"Day 1"
@@ -207,8 +207,6 @@
207 207 ]
208 208
209 209 let ideal =
210 Removed: preset_exn
211 Removed: (fun ppf Empty_routine -> Format.pp_print_string ppf "empty routine")
212 Removed: (make ~name:"Ideal Routine"
213 Removed: ~workouts:[ ideal_day_one; ideal_day_two; ideal_day_three ])
210 Added: make ~name:"Ideal Routine"
211 Added: ~workouts:[ ideal_day_one; ideal_day_two; ideal_day_three ]
214 212 end
lib/core/prescription.mli
index 3df159a6..735960d4 100644..100644
@@ -19,12 +19,14 @@
19 19 val rep_limits : Units.Rep_range.t
20 20 (** 6-12; every prescribed range must lie within it. *)
21 21
22 Added: exception Invalid of error
23 Added:
22 24 val make :
23 25 delivery:delivery ->
24 26 rep_range:Units.Rep_range.t ->
25 27 allowed_substitutes:Exercise.t list ->
26 Removed: (t, error) result
27 Removed: (** Substitutions may only narrow catalog whitelists. *)
28 Added: t
29 Added: (** Raises [Invalid] for an invalid pairing, range, or substitution. *)
28 30
29 31 val delivery : t -> delivery
30 32 val rep_range : t -> Units.Rep_range.t
@@ -43,10 +45,11 @@
43 45 type id = private string
44 46 type error = Empty_workout
45 47
46 Removed: val make :
47 Removed: id:string -> name:string -> stimuli:Stimulus.t list -> (t, error) result
48 Removed: (** Rejects an empty workout. *)
48 Added: exception Invalid of error
49 49
50 Added: val make : id:string -> name:string -> stimuli:Stimulus.t list -> t
51 Added: (** Raises [Invalid Empty_workout] for an empty workout. *)
52 Added:
50 53 val id : t -> id
51 54 val name : t -> string
52 55 val stimuli : t -> Stimulus.t list
@@ -62,8 +65,10 @@
62 65 type t
63 66 type error = Empty_routine
64 67
65 Removed: val make : name:string -> workouts:Workout.t list -> (t, error) result
66 Removed: (** Rejects an empty routine. *)
68 Added: exception Invalid of error
69 Added:
70 Added: val make : name:string -> workouts:Workout.t list -> t
71 Added: (** Raises [Invalid Empty_routine] for an empty routine. *)
67 72
68 73 val name : t -> string
69 74
lib/web/services.ml
index 25818e61..26902bcf 100644..100644
@@ -107,16 +107,11 @@
107 107 match build_movement ~exercise ~load ~reps ~extension with
108 108 | Error detail ->
109 109 Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
110 Removed: | Ok movement -> (
111 Removed: match
112 Removed: Evidence.Stimulus.make (Evidence.Stimulus.Single movement)
113 Removed: with
114 Removed: | Error e ->
115 Removed: Lwt.return
116 Removed: (Pages.problem ~title:"Could not record"
117 Removed: ~detail:
118 Removed: (Format.asprintf "%a" Evidence.Stimulus.pp_error e))
119 Removed: | Ok stimulus -> logged (Service.log service stimulus)))));
110 Added: | Ok movement ->
111 Added: logged
112 Added: (Service.log service
113 Added: (Evidence.Stimulus.make
114 Added: (Evidence.Stimulus.Single movement))))));
120 115
121 116 Eliom_registration.Html.register ~service:Routes.log_pair
122 117 (fun
@@ -148,17 +143,11 @@
148 143 with
149 144 | Error detail, _ | _, Error detail ->
150 145 Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
151 Removed: | Ok isolation, Ok compound -> (
152 Removed: match
153 Removed: Evidence.Stimulus.make
154 Removed: (Evidence.Stimulus.Pre_exhaust { isolation; compound })
155 Removed: with
156 Removed: | Error e ->
157 Removed: Lwt.return
158 Removed: (Pages.problem ~title:"Could not record"
159 Removed: ~detail:
160 Removed: (Format.asprintf "%a" Evidence.Stimulus.pp_error e))
161 Removed: | Ok stimulus -> logged (Service.log service stimulus)))));
146 Added: | Ok first, Ok second ->
147 Added: logged
148 Added: (Service.log service
149 Added: (Evidence.Stimulus.make
150 Added: (Evidence.Stimulus.Pair { first; second }))))));
162 151
163 152 Eliom_registration.Html.register ~service:Routes.finish (fun () () ->
164 153 match Service.finish service ~ended_at:(now ()) with
test/test_evidence.ml
index 8d53eca9..2a7e1448 100644..100644
@@ -20,13 +20,9 @@
20 20 Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
21 21 ~outcome
22 22
23 Removed: let single id load r = ok (Stimulus.make (Stimulus.Single (move id load r)))
23 Added: let single id load r = Stimulus.make (Stimulus.Single (move id load r))
24 Added: let pair first second = Stimulus.make (Stimulus.Pair { first; second })
24 25
25 Removed: let pre_exhaust iso_m comp_m =
26 Removed: ok
27 Removed: (Stimulus.make
28 Removed: (Stimulus.Pre_exhaust { isolation = iso_m; compound = comp_m }))
29 Removed:
30 26 (* {1 One stimulus} *)
31 27
32 28 let outcome_tests =
@@ -67,7 +63,7 @@
67 63 `Quick,
68 64 fun () ->
69 65 let s =
70 Removed: pre_exhaust (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)
66 Added: pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)
71 67 in
72 68 Alcotest.(check int)
73 69 "two movements" 2
@@ -76,28 +72,26 @@
76 72 "isolation leads"
77 73 [ "Dumbbell Flyes"; "Incline Presses" ]
78 74 (List.map Exercise.name (Stimulus.exercises s)) );
79 Removed: ( "a mislabelled pairing is refused",
75 Added: ( "an unrelated pair is recorded as performed",
80 76 `Quick,
81 77 fun () ->
82 Removed: match
78 Added: let s =
83 79 Stimulus.make
84 Removed: (Stimulus.Pre_exhaust
80 Added: (Stimulus.Pair
85 81 {
86 Removed: isolation = move "dumbbell-flyes" 20. 9;
87 Removed: compound = move "squats" 100. 8;
82 Added: first = move "dumbbell-flyes" 20. 9;
83 Added: second = move "squats" 100. 8;
88 84 })
89 Removed: with
90 Removed: | Error (Stimulus.Not_a_pre_exhaust { isolation; compound }) ->
91 Removed: Alcotest.(check string)
92 Removed: "isolation" "dumbbell-flyes"
93 Removed: (isolation :> string);
94 Removed: Alcotest.(check string) "compound" "squats" (compound :> string)
95 Removed: | Ok _ -> Alcotest.fail "expected Not_a_pre_exhaust" );
85 Added: in
86 Added: Alcotest.(check (list string))
87 Added: "both movements"
88 Added: [ "Dumbbell Flyes"; "Squats" ]
89 Added: (List.map Exercise.name (Stimulus.exercises s)) );
96 90 ( "extensions are gathered across a pre-exhaust's movements",
97 91 `Quick,
98 92 fun () ->
99 93 let s =
100 Removed: pre_exhaust
94 Added: pair
101 95 (move "lying-french-press" 30. 9)
102 96 (move
103 97 ~outcome:
@@ -121,9 +115,7 @@
121 115 ~reps:(reps 10)
122 116 in
123 117 let s =
124 Removed: ok
125 Removed: (Stimulus.make ~warm_ups:[ w ]
126 Removed: (Stimulus.Single (move "squats" 100. 8)))
118 Added: Stimulus.make ~warm_ups:[ w ] (Stimulus.Single (move "squats" 100. 8))
127 119 in
128 120 Alcotest.(check int) "one warm-up" 1 (List.length (Stimulus.warm_ups s));
129 121 Alcotest.(check int)
@@ -148,10 +140,10 @@
148 140 (* HD1's Day 1, in the order it lists. *)
149 141 let day_one_stimuli =
150 142 [
151 Removed: pre_exhaust (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7);
143 Added: pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7);
152 144 single "laterals" 12. 8;
153 145 single "bent-over-laterals" 10. 9;
154 Removed: pre_exhaust (move "lying-french-press" 30. 8) (move "dips" 0. 6);
146 Added: pair (move "lying-french-press" 30. 8) (move "dips" 0. 6);
155 147 ]
156 148
157 149 let perform stimuli =
@@ -229,11 +221,8 @@
229 221 with
230 222 | Error
231 223 (Workout.Delivery_mismatch
232 Removed: {
233 Removed: prescribed = Workout.As_pre_exhaust;
234 Removed: logged = Workout.As_single;
235 Removed: _;
236 Removed: }) ->
224 Added: { prescribed = Workout.As_pair; logged = Workout.As_single; _ })
225 Added: ->
237 226 ()
238 227 | _ -> Alcotest.fail "expected Delivery_mismatch" );
239 228 ( "the prescribed pair, delivered as prescribed, is accepted",
@@ -243,7 +232,7 @@
243 232 "pec pair conforms" true
244 233 (Result.is_ok
245 234 (Workout.add_stimulus (fresh ())
246 Removed: (pre_exhaust
235 Added: (pair
247 236 (move "dumbbell-flyes" 20. 9)
248 237 (move "incline-press" 60. 7)))) );
249 238 ( "an allowed substitute is accepted in its own role",
@@ -252,8 +241,7 @@
252 241 let w =
253 242 ok
254 243 (Workout.add_stimulus (fresh ())
255 Removed: (pre_exhaust (move "pec-deck" 45. 9)
256 Removed: (move "incline-press" 60. 7)))
244 Added: (pair (move "pec-deck" 45. 9) (move "incline-press" 60. 7)))
257 245 in
258 246 Alcotest.(check int) "recorded" 1 (List.length (Workout.stimuli w));
259 247 Alcotest.(check int)
@@ -267,7 +255,7 @@
267 255 compound. *)
268 256 match
269 257 Workout.add_stimulus (fresh ())
270 Removed: (pre_exhaust (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7))
258 Added: (pair (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7))
271 259 with
272 260 | Error _ -> ()
273 261 | Ok _ -> Alcotest.fail "dips is not the prescribed pec compound" );
@@ -428,7 +416,7 @@
428 416 `Quick,
429 417 fun () ->
430 418 let pair =
431 Removed: pre_exhaust (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)
419 Added: pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)
432 420 in
433 421 let book =
434 422 Log.add Log.empty
test/test_prescription.ml
index ce630c23..fc7df9a1 100644..100644
@@ -32,7 +32,7 @@
32 32 ( "a single movement is prescribable",
33 33 `Quick,
34 34 fun () ->
35 Removed: let p = ok (single "curls") in
35 Added: let p = single "curls" in
36 36 match Prescription.Stimulus.delivery p with
37 37 | Prescription.Stimulus.Single e ->
38 38 Alcotest.(check string) "curls" "Curls" (Exercise.name e)
@@ -41,22 +41,24 @@
41 41 ( "HD1's pec pre-exhaust is prescribable",
42 42 `Quick,
43 43 fun () ->
44 Removed: let p =
45 Removed: ok (pair ~isolation:"dumbbell-flyes" ~compound:"incline-press")
46 Removed: in
44 Added: let p = pair ~isolation:"dumbbell-flyes" ~compound:"incline-press" in
47 45 Alcotest.(check int)
48 46 "two movements, isolation first" 2
49 47 (List.length (Prescription.Stimulus.exercises p));
50 48 Alcotest.(check string)
51 49 "isolation leads" "Dumbbell Flyes"
52 50 (Exercise.name (List.hd (Prescription.Stimulus.exercises p))) );
53 Removed: ( "an invalid pairing is refused",
51 Added: ( "an invalid pairing raises Invalid",
54 52 `Quick,
55 53 fun () ->
56 Removed: match pair ~isolation:"dumbbell-flyes" ~compound:"squats" with
57 Removed: | Ok _ -> Alcotest.fail "expected Error"
58 Removed: | Error (Prescription.Stimulus.Not_a_pre_exhaust _) -> ()
59 Removed: | Error _ -> Alcotest.fail "expected Not_a_pre_exhaust" );
54 Added: match
55 Added: try
56 Added: ignore (pair ~isolation:"dumbbell-flyes" ~compound:"squats");
57 Added: None
58 Added: with Prescription.Stimulus.Invalid error -> Some error
59 Added: with
60 Added: | Some (Prescription.Stimulus.Not_a_pre_exhaust _) -> ()
61 Added: | _ -> Alcotest.fail "expected Not_a_pre_exhaust" );
60 62 ]
61 63
62 64 let rep_window_tests =
@@ -77,27 +79,27 @@
77 79 fun () ->
78 80 List.iter
79 81 (fun (lo, hi) ->
80 Removed: Alcotest.(check bool)
81 Removed: (Printf.sprintf "%d-%d accepted" lo hi)
82 Removed: true
83 Removed: (Result.is_ok
84 Removed: (Prescription.Stimulus.make
85 Removed: ~delivery:(Prescription.Stimulus.Single (get "curls"))
86 Removed: ~rep_range:(range lo hi) ~allowed_substitutes:[])))
82 Added: ignore
83 Added: (Prescription.Stimulus.make
84 Added: ~delivery:(Prescription.Stimulus.Single (get "curls"))
85 Added: ~rep_range:(range lo hi) ~allowed_substitutes:[]))
87 86 [ (6, 10); (6, 12); (8, 12); (8, 8) ] );
88 Removed: ( "a window escaping the limits is refused",
87 Added: ( "a window escaping the limits raises Invalid",
89 88 `Quick,
90 89 fun () ->
91 90 List.iter
92 91 (fun (lo, hi) ->
93 92 match
94 Removed: Prescription.Stimulus.make
95 Removed: ~delivery:(Prescription.Stimulus.Single (get "curls"))
96 Removed: ~rep_range:(range lo hi) ~allowed_substitutes:[]
93 Added: try
94 Added: ignore
95 Added: (Prescription.Stimulus.make
96 Added: ~delivery:(Prescription.Stimulus.Single (get "curls"))
97 Added: ~rep_range:(range lo hi) ~allowed_substitutes:[]);
98 Added: None
99 Added: with Prescription.Stimulus.Invalid error -> Some error
97 100 with
98 Removed: | Error Prescription.Stimulus.Reps_outside_limits -> ()
99 Removed: | Error _ -> Alcotest.fail "expected Reps_outside_limits"
100 Removed: | Ok _ -> Alcotest.failf "%d-%d should be refused" lo hi)
101 Added: | Some Prescription.Stimulus.Reps_outside_limits -> ()
102 Added: | _ -> Alcotest.failf "%d-%d should be refused" lo hi)
101 103 [ (3, 5); (1, 3); (15, 20); (6, 20) ] );
102 104 ]
103 105
@@ -107,10 +109,9 @@
107 109 `Quick,
108 110 fun () ->
109 111 let p =
110 Removed: ok
111 Removed: (prescribe
112 Removed: ~substitutes:[ get "pec-deck" ]
113 Removed: (Prescription.Stimulus.Single (get "dumbbell-flyes")))
112 Added: prescribe
113 Added: ~substitutes:[ get "pec-deck" ]
114 Added: (Prescription.Stimulus.Single (get "dumbbell-flyes"))
114 115 in
115 116 Alcotest.(check bool)
116 117 "pec deck permitted" true
@@ -121,31 +122,32 @@
121 122 Alcotest.(check bool)
122 123 "squats not permitted" false
123 124 (Prescription.Stimulus.permits p (get "squats")) );
124 Removed: ( "a substitute off the catalog whitelist is refused",
125 Added: ( "a substitute off the catalog whitelist raises Invalid",
125 126 `Quick,
126 127 fun () ->
127 128 match
128 Removed: prescribe
129 Removed: ~substitutes:[ get "squats" ]
130 Removed: (Prescription.Stimulus.Single (get "dumbbell-flyes"))
129 Added: try
130 Added: ignore
131 Added: (prescribe
132 Added: ~substitutes:[ get "squats" ]
133 Added: (Prescription.Stimulus.Single (get "dumbbell-flyes")));
134 Added: None
135 Added: with Prescription.Stimulus.Invalid error -> Some error
131 136 with
132 Removed: | Error (Prescription.Stimulus.Substitute_not_permitted id) ->
137 Added: | Some (Prescription.Stimulus.Substitute_not_permitted id) ->
133 138 Alcotest.(check string) "squats" "squats" (id :> string)
134 Removed: | Error _ -> Alcotest.fail "expected Substitute_not_permitted"
135 Removed: | Ok _ -> Alcotest.fail "expected Error" );
139 Added: | _ -> Alcotest.fail "expected Substitute_not_permitted" );
136 140 ( "a substitute for either half of a pre-exhaust is allowed",
137 141 `Quick,
138 142 fun () ->
139 Removed: Alcotest.(check bool)
140 Removed: "pec deck substitutes the isolation" true
141 Removed: (Result.is_ok
142 Removed: (prescribe
143 Removed: ~substitutes:[ get "cable-crossovers" ]
144 Removed: (Prescription.Stimulus.Pre_exhaust
145 Removed: {
146 Removed: isolation = get "dumbbell-flyes";
147 Removed: compound = get "incline-press";
148 Removed: }))) );
143 Added: ignore
144 Added: (prescribe
145 Added: ~substitutes:[ get "cable-crossovers" ]
146 Added: (Prescription.Stimulus.Pre_exhaust
147 Added: {
148 Added: isolation = get "dumbbell-flyes";
149 Added: compound = get "incline-press";
150 Added: })) );
149 151 ]
150 152
151 153 (* {1 One prescribed workout} *)
@@ -153,10 +155,10 @@
153 155 (* HD1's Day 1: pecs pre-exhaust, two delt isolations, triceps pre-exhaust. *)
154 156 let day_one_stimuli =
155 157 [
156 Removed: ok (pair ~isolation:"dumbbell-flyes" ~compound:"incline-press");
157 Removed: ok (single "laterals");
158 Removed: ok (single "bent-over-laterals");
159 Removed: ok (pair ~isolation:"lying-french-press" ~compound:"dips");
158 Added: pair ~isolation:"dumbbell-flyes" ~compound:"incline-press";
159 Added: single "laterals";
160 Added: single "bent-over-laterals";
161 Added: pair ~isolation:"lying-french-press" ~compound:"dips";
160 162 ]
161 163
162 164 let workout_tests =
@@ -165,9 +167,8 @@
165 167 `Quick,
166 168 fun () ->
167 169 let w =
168 Removed: ok
169 Removed: (Prescription.Workout.make ~id:"ideal-day-1" ~name:"Day 1"
170 Removed: ~stimuli:day_one_stimuli)
170 Added: Prescription.Workout.make ~id:"ideal-day-1" ~name:"Day 1"
171 Added: ~stimuli:day_one_stimuli
171 172 in
172 173 Alcotest.(check string) "name" "Day 1" (Prescription.Workout.name w);
173 174 Alcotest.(check string)
@@ -176,31 +177,34 @@
176 177 Alcotest.(check int)
177 178 "four stimuli" 4
178 179 (List.length (Prescription.Workout.stimuli w)) );
179 Removed: ( "an empty workout is refused",
180 Added: ( "an empty workout raises Invalid",
180 181 `Quick,
181 182 fun () ->
182 183 match
183 Removed: Prescription.Workout.make ~id:"empty" ~name:"Nothing" ~stimuli:[]
184 Added: try
185 Added: ignore
186 Added: (Prescription.Workout.make ~id:"empty" ~name:"Nothing" ~stimuli:[]);
187 Added: false
188 Added: with
189 Added: | Prescription.Workout.Invalid Prescription.Workout.Empty_workout ->
190 Added: true
184 191 with
185 Removed: | Error Prescription.Workout.Empty_workout -> ()
186 Removed: | Ok _ -> Alcotest.fail "expected Empty_workout" );
192 Added: | true -> ()
193 Added: | false -> Alcotest.fail "expected Empty_workout" );
187 194 ( "equality is by id, not by content",
188 195 `Quick,
189 196 fun () ->
190 197 let a =
191 Removed: ok
192 Removed: (Prescription.Workout.make ~id:"day-1" ~name:"Day 1"
193 Removed: ~stimuli:day_one_stimuli)
198 Added: Prescription.Workout.make ~id:"day-1" ~name:"Day 1"
199 Added: ~stimuli:day_one_stimuli
194 200 in
195 201 let renamed =
196 Removed: ok
197 Removed: (Prescription.Workout.make ~id:"day-1" ~name:"Renamed"
198 Removed: ~stimuli:[ ok (single "curls") ])
202 Added: Prescription.Workout.make ~id:"day-1" ~name:"Renamed"
203 Added: ~stimuli:[ single "curls" ]
199 204 in
200 205 let other =
201 Removed: ok
202 Removed: (Prescription.Workout.make ~id:"day-2" ~name:"Day 1"
203 Removed: ~stimuli:day_one_stimuli)
206 Added: Prescription.Workout.make ~id:"day-2" ~name:"Day 1"
207 Added: ~stimuli:day_one_stimuli
204 208 in
205 209 Alcotest.(check bool)
206 210 "same id" true
@@ -223,12 +227,19 @@
223 227
224 228 let routine_tests =
225 229 [
226 Removed: ( "an empty routine is refused",
230 Added: ( "an empty routine raises Invalid",
227 231 `Quick,
228 232 fun () ->
229 Removed: match Prescription.Routine.make ~name:"Nothing" ~workouts:[] with
230 Removed: | Error Prescription.Routine.Empty_routine -> ()
231 Removed: | Ok _ -> Alcotest.fail "expected Empty_routine" );
233 Added: match
234 Added: try
235 Added: ignore (Prescription.Routine.make ~name:"Nothing" ~workouts:[]);
236 Added: false
237 Added: with
238 Added: | Prescription.Routine.Invalid Prescription.Routine.Empty_routine ->
239 Added: true
240 Added: with
241 Added: | true -> ()
242 Added: | false -> Alcotest.fail "expected Empty_routine" );
232 243 ( "the Ideal Routine is HD1's three days",
233 244 `Quick,
234 245 fun () ->
@@ -308,9 +319,8 @@
308 319 `Quick,
309 320 fun () ->
310 321 let stranger =
311 Removed: ok
312 Removed: (Prescription.Workout.make ~id:"elsewhere" ~name:"Elsewhere"
313 Removed: ~stimuli:(Prescription.Workout.stimuli (nth 0)))
322 Added: Prescription.Workout.make ~id:"elsewhere" ~name:"Elsewhere"
323 Added: ~stimuli:(Prescription.Workout.stimuli (nth 0))
314 324 in
315 325 Alcotest.(check string)
316 326 "falls back" "Day 1"
test/test_progression.ml
index 28673962..c3531faf 100644..100644
@@ -237,7 +237,7 @@
237 237 stimuli
238 238
239 239 let laterals ?outcome load r =
240 Removed: ok (Stimulus.make (Stimulus.Single (move ?outcome ~id:"laterals" load r)))
240 Added: Stimulus.make (Stimulus.Single (move ?outcome ~id:"laterals" load r))
241 241
242 242 let extended =
243 243 Stimulus.Beyond_failure (Stimulus.Forced_reps, [ Stimulus.Negatives ])
test/test_service.ml
index 304a4994..42a50bae 100644..100644
@@ -23,22 +23,18 @@
23 23 Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
24 24 ~outcome:Stimulus.Positive_failure
25 25
26 Removed: let single id load r = ok (Stimulus.make (Stimulus.Single (move id load r)))
26 Added: let single id load r = Stimulus.make (Stimulus.Single (move id load r))
27 Added: let pair ~first ~second = Stimulus.make (Stimulus.Pair { first; second })
27 28
28 Removed: let pair ~isolation ~compound =
29 Removed: ok (Stimulus.make (Stimulus.Pre_exhaust { isolation; compound }))
30 Removed:
31 29 (* HD1's Day 1 as performed. *)
32 30 let day_one_stimuli =
33 31 [
34 32 pair
35 Removed: ~isolation:(move "dumbbell-flyes" 20. 9)
36 Removed: ~compound:(move "incline-press" 60. 7);
33 Added: ~first:(move "dumbbell-flyes" 20. 9)
34 Added: ~second:(move "incline-press" 60. 7);
37 35 single "laterals" 12. 8;
38 36 single "bent-over-laterals" 10. 9;
39 Removed: pair
40 Removed: ~isolation:(move "lying-french-press" 30. 8)
41 Removed: ~compound:(move "dips" 0. 6);
37 Added: pair ~first:(move "lying-french-press" 30. 8) ~second:(move "dips" 0. 6);
42 38 ]
43 39
44 40 let routine_tests =