[OCaml] High Intensity Training Online
refactor Use primitive effort values
Treat core data as trusted. Keep validation and result handling at external boundaries.
Changed files
- ARCHITECTURE.md
- lib/app/service.ml
- lib/core/evidence.ml
- lib/core/evidence.mli
- lib/core/prescription.ml
- lib/core/prescription.mli
- lib/core/progression.ml
- lib/core/progression.mli
- lib/web/decode.ml
- lib/web/pages.ml
- test/test_decode.ml
- test/test_evidence.ml
- test/test_prescription.ml
- test/test_progression.ml
- test/test_service.ml
ARCHITECTURE.md
@@ -75,9 +75,11 @@
75
75
76
76
### Vocabulary
77
77
78
Removed:
- **Values** — `Evidence.Stimulus.Load` (kg, zero for bodyweight movements),
79
Removed:
`Evidence.Stimulus.Reps`, and `Prescription.Rep_range`. Each is abstract and
80
Removed:
only its validating constructor can create it.
78
Added:
- **Values** — load in kilograms and repetitions are primitive values. The core
79
Added:
accepts them as trusted input and does not return validation results. `hito.web`
80
Added:
is the trust boundary. Its decoder treats form values as untrusted and validates
81
Added:
finite, nonnegative loads and positive repetitions before it calls the core.
82
Added:
`Prescription.Rep_range` validates authored calibration ranges.
81
83
- **Muscle** — the training targets HD1 names, plus the assisting muscles its
82
84
weak-link argument needs. Glutes never appear in HD1 and forearms only
83
85
anatomically; both are here because a compound must have something able to
lib/app/service.ml
@@ -92,11 +92,11 @@
92
92
match t.current with
93
93
| None -> Error No_workout_in_progress
94
94
| Some workout -> (
95
Removed:
match Evidence.Workout.add_stimulus workout stimulus with
96
Removed:
| Error e -> Error (Rejected e)
97
Removed:
| Ok updated ->
98
Removed:
t.current <- Some updated;
99
Removed:
Ok updated)
95
Added:
try
96
Added:
let updated = Evidence.Workout.add_stimulus workout stimulus in
97
Added:
t.current <- Some updated;
98
Added:
Ok updated
99
Added:
with Evidence.Workout.Invalid error -> Error (Rejected error))
100
100
101
101
let finish t ~ended_at =
102
102
match t.current with
@@ -118,16 +118,20 @@
118
118
match R.find t.repo id with
119
119
| None -> Error Unknown_workout
120
120
| Some record -> (
121
Removed:
match
122
Removed:
Evidence.Workout.add_stimulus record.Repository.workout stimulus
123
Removed:
with
124
Removed:
| Error error -> Error (Rejected_edit error)
125
Removed:
| Ok workout -> replace t { record with Repository.workout })
121
Added:
try
122
Added:
let workout =
123
Added:
Evidence.Workout.add_stimulus record.Repository.workout stimulus
124
Added:
in
125
Added:
replace t { record with Repository.workout }
126
Added:
with Evidence.Workout.Invalid error -> Error (Rejected_edit error))
126
127
127
128
let history t = R.history t.repo
128
129
129
130
let progress t exercise =
130
Removed:
Progression.assess (Evidence.Log.observations (R.log t.repo) exercise)
131
Added:
try
132
Added:
Ok
133
Added:
(Progression.assess (Evidence.Log.observations (R.log t.repo) exercise))
134
Added:
with Progression.Invalid error -> Error error
131
135
132
136
let diagnostics t = Progression.diagnose (R.log t.repo)
133
137
end
lib/core/evidence.ml
@@ -17,31 +17,11 @@
17
17
| Rest_pause -> "rest-pause"
18
18
| Static_hold -> "static hold")
19
19
20
Removed:
module Load = struct
21
Removed:
type t = float
22
Removed:
type error = Not_finite | Negative
23
Removed:
24
Removed:
let kg value =
25
Removed:
if not (Float.is_finite value) then Error Not_finite
26
Removed:
else if value < 0. then Error Negative
27
Removed:
else Ok value
28
Removed:
29
Removed:
let to_kg value = value
30
Removed:
end
31
Removed:
32
Removed:
module Reps = struct
33
Removed:
type t = int
34
Removed:
type error = Nonpositive
35
Removed:
36
Removed:
let of_int value = if value > 0 then Ok value else Error Nonpositive
37
Removed:
let to_int value = value
38
Removed:
end
39
Removed:
40
20
module Effort = struct
41
21
type t = {
42
22
exercise : Exercise.t;
43
Removed:
load : Load.t;
44
Removed:
reps : Reps.t;
23
Added:
load : float;
24
Added:
reps : int;
45
25
outcome : outcome;
46
26
}
47
27
@@ -53,8 +33,7 @@
53
33
let extensions t = extensions_of_outcome t.outcome
54
34
55
35
let pp ppf t =
56
Removed:
Format.fprintf ppf "%a %g kg x %d" Exercise.pp t.exercise
57
Removed:
(Load.to_kg t.load) (Reps.to_int t.reps);
36
Added:
Format.fprintf ppf "%a %g kg x %d" Exercise.pp t.exercise t.load t.reps;
58
37
match extensions t with
59
38
| [] -> ()
60
39
| es ->
@@ -106,6 +85,8 @@
106
85
type t = { reported_at : Recovery.timestamp; signals : signal list }
107
86
type error = Duplicate_signal of signal
108
87
88
Added:
exception Invalid of error
89
Added:
109
90
let same_category left right =
110
91
match (left, right) with
111
92
| Sleep _, Sleep _
@@ -121,10 +102,10 @@
121
102
122
103
let make ~reported_at signals =
123
104
let rec validate seen = function
124
Removed:
| [] -> Ok { reported_at; signals }
105
Added:
| [] -> { reported_at; signals }
125
106
| signal :: rest ->
126
107
if List.exists (same_category signal) seen then
127
Removed:
Error (Duplicate_signal signal)
108
Added:
raise (Invalid (Duplicate_signal signal))
128
109
else validate (signal :: seen) rest
129
110
in
130
111
validate [] signals
@@ -145,6 +126,8 @@
145
126
logged : shape;
146
127
}
147
128
129
Added:
exception Invalid of error
130
Added:
148
131
type t = {
149
132
prescription : Prescription.Workout.t;
150
133
clearance : Recovery.clearance;
@@ -226,15 +209,16 @@
226
209
let matching = List.filter (fun (_, p) -> conforms p s) candidates in
227
210
let leading = Exercise.id (List.hd (Stimulus.exercises s)) in
228
211
match (candidates, matching) with
229
Removed:
| [], _ -> Error (Not_prescribed leading)
212
Added:
| [], _ -> raise (Invalid (Not_prescribed leading))
230
213
| (_, p) :: _, [] ->
231
Removed:
Error
232
Removed:
(Delivery_mismatch
233
Removed:
{
234
Removed:
exercise = leading;
235
Removed:
prescribed = prescribed_shape p;
236
Removed:
logged = logged_shape s;
237
Removed:
})
214
Added:
raise
215
Added:
(Invalid
216
Added:
(Delivery_mismatch
217
Added:
{
218
Added:
exercise = leading;
219
Added:
prescribed = prescribed_shape p;
220
Added:
logged = logged_shape s;
221
Added:
}))
238
222
| _, matching ->
239
223
let unanswered =
240
224
List.filter (fun (i, _) -> not (List.mem i (answered t))) matching
@@ -242,7 +226,7 @@
242
226
let i, _ =
243
227
match unanswered with chosen :: _ -> chosen | [] -> List.hd matching
244
228
in
245
Removed:
Ok { t with performed = (i, s) :: t.performed }
229
Added:
{ t with performed = (i, s) :: t.performed }
246
230
247
231
let finish t ~ended_at =
248
232
match t.ended_at with
lib/core/evidence.mli
@@ -12,31 +12,15 @@
12
12
val extensions_of_outcome : outcome -> extension list
13
13
val pp_extension : Format.formatter -> extension -> unit
14
14
15
Removed:
module Load : sig
16
Removed:
type t
17
Removed:
type error = Not_finite | Negative
18
Removed:
19
Removed:
val kg : float -> (t, error) result
20
Removed:
val to_kg : t -> float
21
Removed:
end
22
Removed:
23
Removed:
module Reps : sig
24
Removed:
type t
25
Removed:
type error = Nonpositive
26
Removed:
27
Removed:
val of_int : int -> (t, error) result
28
Removed:
val to_int : t -> int
29
Removed:
end
30
Removed:
31
15
module Effort : sig
32
16
type t
33
17
34
18
val make :
35
Removed:
exercise:Exercise.t -> load:Load.t -> reps:Reps.t -> outcome:outcome -> t
19
Added:
exercise:Exercise.t -> load:float -> reps:int -> outcome:outcome -> t
36
20
37
21
val exercise : t -> Exercise.t
38
Removed:
val load : t -> Load.t
39
Removed:
val reps : t -> Reps.t
22
Added:
val load : t -> float
23
Added:
val reps : t -> int
40
24
val outcome : t -> outcome
41
25
val extensions : t -> extension list
42
26
val pp : Format.formatter -> t -> unit
@@ -79,7 +63,11 @@
79
63
type t
80
64
type error = Duplicate_signal of signal
81
65
82
Removed:
val make : reported_at:Recovery.timestamp -> signal list -> (t, error) result
66
Added:
exception Invalid of error
67
Added:
68
Added:
val make : reported_at:Recovery.timestamp -> signal list -> t
69
Added:
(** Raises [Invalid] when feedback repeats a signal category. *)
70
Added:
83
71
val reported_at : t -> Recovery.timestamp
84
72
val signals : t -> signal list
85
73
end
@@ -100,14 +88,17 @@
100
88
101
89
val pp_error : Format.formatter -> error -> unit
102
90
91
Added:
exception Invalid of error
92
Added:
103
93
val start :
104
94
Prescription.Workout.t ->
105
95
clearance:Recovery.clearance ->
106
96
started_at:Recovery.timestamp ->
107
97
t
108
98
109
Removed:
val add_stimulus : t -> Stimulus.t -> (t, error) result
110
Removed:
(** Records a working stimulus. *)
99
Added:
val add_stimulus : t -> Stimulus.t -> t
100
Added:
(** Raises [Invalid] when the stimulus does not conform to the prescription.
101
Added:
*)
111
102
112
103
val finish : t -> ended_at:Recovery.timestamp -> t
113
104
(** Sets [ended_at] once; later calls retain the first value. *)
lib/core/prescription.ml
@@ -7,11 +7,14 @@
7
7
8
8
let limits = (6, 12)
9
9
10
Added:
exception Invalid of error
11
Added:
10
12
let make ~min ~max =
11
13
let lower, upper = limits in
12
Removed:
if min <= 0 || max < min then Error (Invalid_order { min; max })
13
Removed:
else if min < lower || max > upper then Error (Outside_limits { min; max })
14
Removed:
else Ok (min, max)
14
Added:
if min <= 0 || max < min then raise (Invalid (Invalid_order { min; max }))
15
Added:
else if min < lower || max > upper then
16
Added:
raise (Invalid (Outside_limits { min; max }))
17
Added:
else (min, max)
15
18
16
19
let bounds t = t
17
20
end
@@ -249,7 +252,7 @@
249
252
exercise { equipment = Bodyweight; movement = Sit_up; variation = Standard }
250
253
251
254
(* HD1's guideline window for every listed exercise. *)
252
Removed:
let six_to_ten = Result.get_ok (Rep_range.make ~min:6 ~max:10)
255
Added:
let six_to_ten = Rep_range.make ~min:6 ~max:10
253
256
254
257
let prescribe ?(substitutes = []) delivery =
255
258
Stimulus.make ~delivery ~rep_range:six_to_ten
lib/core/prescription.mli
@@ -7,10 +7,14 @@
7
7
| Invalid_order of { min : int; max : int }
8
8
| Outside_limits of { min : int; max : int }
9
9
10
Added:
exception Invalid of error
11
Added:
10
12
val limits : int * int
11
13
(** HD1's 6-12 calibration limits. *)
12
14
13
Removed:
val make : min:int -> max:int -> (t, error) result
15
Added:
val make : min:int -> max:int -> t
16
Added:
(** Raises [Invalid] for an invalid range. *)
17
Added:
14
18
val bounds : t -> int * int
15
19
end
16
20
lib/core/progression.ml
@@ -1,21 +1,15 @@
1
1
module Effort = Evidence.Stimulus.Effort
2
2
3
3
let beats ~previous ~current =
4
Removed:
let load =
5
Removed:
Float.compare
6
Removed:
(Effort.load current |> Evidence.Stimulus.Load.to_kg)
7
Removed:
(Effort.load previous |> Evidence.Stimulus.Load.to_kg)
8
Removed:
in
9
Removed:
let reps =
10
Removed:
Int.compare
11
Removed:
(Effort.reps current |> Evidence.Stimulus.Reps.to_int)
12
Removed:
(Effort.reps previous |> Evidence.Stimulus.Reps.to_int)
13
Removed:
in
4
Added:
let load = Float.compare (Effort.load current) (Effort.load previous) in
5
Added:
let reps = Int.compare (Effort.reps current) (Effort.reps previous) in
14
6
load > 0 || (load = 0 && reps > 0)
15
7
16
8
type assessment = Progressing | Stalled
17
9
type error = Insufficient_data
18
10
11
Added:
exception Invalid of error
12
Added:
19
13
let pp_assessment ppf = function
20
14
| Progressing -> Format.pp_print_string ppf "progressing"
21
15
| Stalled -> Format.pp_print_string ppf "stalled"
@@ -48,17 +42,17 @@
48
42
let assess observations =
49
43
let window = Recovery.duration_to_seconds stall_window in
50
44
match (observations, last observations) with
51
Removed:
| ([] | [ _ ]), _ | _, None -> Error Insufficient_data
45
Added:
| ([] | [ _ ]), _ | _, None -> raise (Invalid Insufficient_data)
52
46
| first :: _, Some latest -> (
53
47
match last_advance observations with
54
48
| Some advance ->
55
Removed:
if elapsed_between advance latest >= window then Ok Stalled
56
Removed:
else Ok Progressing
49
Added:
if elapsed_between advance latest >= window then Stalled
50
Added:
else Progressing
57
51
| None ->
58
52
(* Never advanced. Only a stall once the record is long enough to say
59
53
so; otherwise two sessions a day apart would condemn the routine. *)
60
Removed:
if elapsed_between first latest >= window then Ok Stalled
61
Removed:
else Error Insufficient_data)
54
Added:
if elapsed_between first latest >= window then Stalled
55
Added:
else raise (Invalid Insufficient_data))
62
56
63
57
type remedy =
64
58
| Lay_off_then_reduce of {
@@ -86,21 +80,14 @@
86
80
extra_rest
87
81
88
82
let load_increase_trigger = 12
83
Added:
let load_increase ~current = (current *. 1.10, current *. 1.20)
89
84
90
Removed:
let load_increase ~current =
91
Removed:
let current_kg = Evidence.Stimulus.Load.to_kg current in
92
Removed:
( Result.get_ok (Evidence.Stimulus.Load.kg (current_kg *. 1.10)),
93
Removed:
Result.get_ok (Evidence.Stimulus.Load.kg (current_kg *. 1.20)) )
85
Added:
type load_verdict = Hold | Increase of float * float | Too_heavy
94
86
95
Removed:
type load_verdict =
96
Removed:
| Hold
97
Removed:
| Increase of Evidence.Stimulus.Load.t * Evidence.Stimulus.Load.t
98
Removed:
| Too_heavy
99
Removed:
100
87
(* The trigger is absolute, so the window's ceiling never gates the verdict —
101
88
only its floor does. *)
102
89
let judge_load ~rep_range effort =
103
Removed:
let reps = Effort.reps effort |> Evidence.Stimulus.Reps.to_int in
90
Added:
let reps = Effort.reps effort in
104
91
let min_reps, _ = Prescription.Rep_range.bounds rep_range in
105
92
if reps >= load_increase_trigger then
106
93
let low, high = load_increase ~current:(Effort.load effort) in
@@ -111,9 +98,7 @@
111
98
let pp_load_verdict ppf = function
112
99
| Hold -> Format.pp_print_string ppf "hold the load"
113
100
| Increase (low, high) ->
114
Removed:
Format.fprintf ppf "raise the load to %g-%g kg"
115
Removed:
(Evidence.Stimulus.Load.to_kg low)
116
Removed:
(Evidence.Stimulus.Load.to_kg high)
101
Added:
Format.fprintf ppf "raise the load to %g-%g kg" low high
117
102
| Too_heavy -> Format.pp_print_string ppf "load is too heavy for the window"
118
103
119
104
type diagnostic =
lib/core/progression.mli
@@ -3,14 +3,17 @@
3
3
type assessment = Progressing | Stalled
4
4
type error = Insufficient_data
5
5
6
Added:
exception Invalid of error
7
Added:
6
8
val pp_assessment : Format.formatter -> assessment -> unit
7
9
val pp_error : Format.formatter -> error -> unit
8
10
9
11
val stall_window : Recovery.duration
10
12
(** 14 days. *)
11
13
12
Removed:
val assess : Evidence.Log.observation list -> (assessment, error) result
13
Removed:
(** Oldest first, for one exercise only. *)
14
Added:
val assess : Evidence.Log.observation list -> assessment
15
Added:
(** Raises [Invalid Insufficient_data] when the record cannot support a
16
Added:
judgment. *)
14
17
15
18
type remedy =
16
19
| Lay_off_then_reduce of {
@@ -27,15 +30,10 @@
27
30
val load_increase_trigger : int
28
31
(** 12 reps, regardless of the prescribed range. *)
29
32
30
Removed:
val load_increase :
31
Removed:
current:Evidence.Stimulus.Load.t ->
32
Removed:
Evidence.Stimulus.Load.t * Evidence.Stimulus.Load.t
33
Added:
val load_increase : current:float -> float * float
33
34
(** 10-20% increase window. *)
34
35
35
Removed:
type load_verdict =
36
Removed:
| Hold
37
Removed:
| Increase of Evidence.Stimulus.Load.t * Evidence.Stimulus.Load.t
38
Removed:
| Too_heavy
36
Added:
type load_verdict = Hold | Increase of float * float | Too_heavy
39
37
40
38
val judge_load :
41
39
rep_range:Prescription.Rep_range.t ->
lib/web/decode.ml
@@ -1,18 +1,16 @@
1
1
module Form = Dream_html.Form
2
Removed:
module Load = Evidence.Stimulus.Load
3
Removed:
module Reps = Evidence.Stimulus.Reps
4
2
5
3
type fields =
6
4
| Single of {
7
Removed:
load : Load.t;
8
Removed:
reps : Reps.t;
5
Added:
load : float;
6
Added:
reps : int;
9
7
extension : Evidence.Stimulus.extension option;
10
8
}
11
9
| Pair of {
12
Removed:
iso_load : Load.t;
13
Removed:
iso_reps : Reps.t;
14
Removed:
comp_load : Load.t;
15
Removed:
comp_reps : Reps.t;
10
Added:
iso_load : float;
11
Added:
iso_reps : int;
12
Added:
comp_load : float;
13
Added:
comp_reps : int;
16
14
extension : Evidence.Stimulus.extension option;
17
15
}
18
16
@@ -27,18 +25,14 @@
27
25
let load value =
28
26
match Form.float value with
29
27
| Error error -> Error error
30
Removed:
| Ok value -> (
31
Removed:
match Load.kg value with
32
Removed:
| Ok load -> Ok load
33
Removed:
| Error _ -> Error "error.load")
28
Added:
| Ok value when Float.is_finite value && value >= 0. -> Ok value
29
Added:
| Ok _ -> Error "error.load"
34
30
35
31
let reps value =
36
32
match Form.int value with
37
33
| Error error -> Error error
38
Removed:
| Ok value -> (
39
Removed:
match Reps.of_int value with
40
Removed:
| Ok reps -> Ok reps
41
Removed:
| Error _ -> Error "error.reps")
34
Added:
| Ok value when value > 0 -> Ok value
35
Added:
| Ok _ -> Error "error.reps"
42
36
43
37
let fields prescription =
44
38
let open Form in
lib/web/pages.ml
@@ -346,8 +346,8 @@
346
346
let effort effort =
347
347
Format.asprintf "%s %g kg x %d"
348
348
(Exercise.name (Evidence.Stimulus.Effort.exercise effort))
349
Removed:
(Evidence.Stimulus.Effort.load effort |> Evidence.Stimulus.Load.to_kg)
350
Removed:
(Evidence.Stimulus.Effort.reps effort |> Evidence.Stimulus.Reps.to_int)
349
Added:
(Evidence.Stimulus.Effort.load effort)
350
Added:
(Evidence.Stimulus.Effort.reps effort)
351
351
in
352
352
let body =
353
353
String.concat " into "
test/test_decode.ml
@@ -9,7 +9,7 @@
9
9
let single =
10
10
Prescription.Stimulus.make
11
11
~delivery:(Prescription.Stimulus.Single (exercise "laterals"))
12
Removed:
~rep_range:(Result.get_ok (Prescription.Rep_range.make ~min:6 ~max:10))
12
Added:
~rep_range:(Prescription.Rep_range.make ~min:6 ~max:10)
13
13
~allowed_substitutes:[]
14
14
15
15
let stimulus_tests =
test/test_evidence.ml
@@ -12,8 +12,8 @@
12
12
| Some e -> e
13
13
| None -> Alcotest.failf "catalog is missing %S" id
14
14
15
Removed:
let load n = Result.get_ok (Stimulus.Load.kg n)
16
Removed:
let reps n = Result.get_ok (Stimulus.Reps.of_int n)
15
Added:
let load n = n
16
Added:
let reps n = n
17
17
let at s = Recovery.timestamp_of_unix_seconds s
18
18
let day n = at (n * 86_400)
19
19
@@ -24,27 +24,11 @@
24
24
let single id load r = Stimulus.make (Stimulus.Single (move id load r))
25
25
let pair first second = Stimulus.make (Stimulus.Pair { first; second })
26
26
27
Removed:
let value_tests =
28
Removed:
[
29
Removed:
( "load rejects non-finite and negative kilograms",
30
Removed:
`Quick,
31
Removed:
fun () ->
32
Removed:
Alcotest.(check bool)
33
Removed:
"NaN" true
34
Removed:
(Result.is_error (Stimulus.Load.kg Float.nan));
35
Removed:
Alcotest.(check bool)
36
Removed:
"negative" true
37
Removed:
(Result.is_error (Stimulus.Load.kg (-0.5))) );
38
Removed:
( "reps reject zero and negative values",
39
Removed:
`Quick,
40
Removed:
fun () ->
41
Removed:
Alcotest.(check bool)
42
Removed:
"zero" true
43
Removed:
(Result.is_error (Stimulus.Reps.of_int 0));
44
Removed:
Alcotest.(check bool)
45
Removed:
"negative" true
46
Removed:
(Result.is_error (Stimulus.Reps.of_int (-1))) );
47
Removed:
]
27
Added:
let invalid_error f =
28
Added:
try
29
Added:
let _ = f () in
30
Added:
None
31
Added:
with Workout.Invalid error -> Some error
48
32
49
33
(* {1 One stimulus} *)
50
34
@@ -144,7 +128,7 @@
144
128
]
145
129
146
130
let perform stimuli =
147
Removed:
List.fold_left (fun w s -> ok (Workout.add_stimulus w s)) (fresh ()) stimuli
131
Added:
List.fold_left (fun w s -> Workout.add_stimulus w s) (fresh ()) stimuli
148
132
149
133
let lifecycle_tests =
150
134
[
@@ -193,7 +177,7 @@
193
177
`Quick,
194
178
fun () ->
195
179
let w = Workout.finish (fresh ()) ~ended_at:(at 60) in
196
Removed:
let w = ok (Workout.add_stimulus w (single "laterals" 12. 8)) in
180
Added:
let w = Workout.add_stimulus w (single "laterals" 12. 8) in
197
181
let w = Workout.finish w ~ended_at:(at 120) in
198
182
Alcotest.(check int)
199
183
"original end" 60
@@ -207,17 +191,21 @@
207
191
( "an unprescribed movement is refused",
208
192
`Quick,
209
193
fun () ->
210
Removed:
match Workout.add_stimulus (fresh ()) (single "shrugs" 80. 10) with
211
Removed:
| Error (Workout.Not_prescribed id) ->
194
Added:
match
195
Added:
invalid_error (fun () ->
196
Added:
Workout.add_stimulus (fresh ()) (single "shrugs" 80. 10))
197
Added:
with
198
Added:
| Some (Workout.Not_prescribed id) ->
212
199
Alcotest.(check string) "shrugs" "shrugs" (id :> string)
213
200
| _ -> Alcotest.fail "expected Not_prescribed" );
214
201
( "a lone set where a pre-exhaust was prescribed is refused",
215
202
`Quick,
216
203
fun () ->
217
204
match
218
Removed:
Workout.add_stimulus (fresh ()) (single "dumbbell-flyes" 20. 9)
205
Added:
invalid_error (fun () ->
206
Added:
Workout.add_stimulus (fresh ()) (single "dumbbell-flyes" 20. 9))
219
207
with
220
Removed:
| Error
208
Added:
| Some
221
209
(Workout.Delivery_mismatch
222
210
{ prescribed = Workout.As_pair; logged = Workout.As_single; _ })
223
211
->
@@ -226,20 +214,16 @@
226
214
( "the prescribed pair, delivered as prescribed, is accepted",
227
215
`Quick,
228
216
fun () ->
229
Removed:
Alcotest.(check bool)
230
Removed:
"pec pair conforms" true
231
Removed:
(Result.is_ok
232
Removed:
(Workout.add_stimulus (fresh ())
233
Removed:
(pair
234
Removed:
(move "dumbbell-flyes" 20. 9)
235
Removed:
(move "incline-press" 60. 7)))) );
217
Added:
ignore
218
Added:
(Workout.add_stimulus (fresh ())
219
Added:
(pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)))
220
Added:
);
236
221
( "an allowed substitute is accepted in its own role",
237
222
`Quick,
238
223
fun () ->
239
224
let w =
240
Removed:
ok
241
Removed:
(Workout.add_stimulus (fresh ())
242
Removed:
(pair (move "pec-deck" 45. 9) (move "incline-press" 60. 7)))
225
Added:
Workout.add_stimulus (fresh ())
226
Added:
(pair (move "pec-deck" 45. 9) (move "incline-press" 60. 7))
243
227
in
244
228
Alcotest.(check int) "recorded" 1 (List.length (Workout.stimuli w));
245
229
Alcotest.(check int)
@@ -252,11 +236,12 @@
252
236
permits only crossovers and pec deck — dips is never the pec
253
237
compound. *)
254
238
match
255
Removed:
Workout.add_stimulus (fresh ())
256
Removed:
(pair (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7))
239
Added:
invalid_error (fun () ->
240
Added:
Workout.add_stimulus (fresh ())
241
Added:
(pair (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7)))
257
242
with
258
Removed:
| Error _ -> ()
259
Removed:
| Ok _ -> Alcotest.fail "dips is not the prescribed pec compound" );
243
Added:
| Some _ -> ()
244
Added:
| None -> Alcotest.fail "dips is not the prescribed pec compound" );
260
245
]
261
246
262
247
let volume_tests =
@@ -278,9 +263,7 @@
278
263
Alcotest.(check int)
279
264
"three left" 3
280
265
(List.length (Workout.unperformed w));
281
Removed:
let w =
282
Removed:
ok (Workout.add_stimulus w (single "bent-over-laterals" 10. 9))
283
Removed:
in
266
Added:
let w = Workout.add_stimulus w (single "bent-over-laterals" 10. 9) in
284
267
Alcotest.(check int) "two left" 2 (List.length (Workout.unperformed w))
285
268
);
286
269
]
@@ -310,7 +293,7 @@
310
293
let logged ~workout:p ~on ~stimuli =
311
294
let w =
312
295
List.fold_left
313
Removed:
(fun w s -> ok (Workout.add_stimulus w s))
296
Added:
(fun w s -> Workout.add_stimulus w s)
314
297
(Workout.start p ~clearance:cleared ~started_at:on)
315
298
stimuli
316
299
in
@@ -381,8 +364,7 @@
381
364
Alcotest.(check (list (float 0.001)))
382
365
"12kg then 14kg" [ 12.; 14. ]
383
366
(List.map
384
Removed:
(fun (o : Log.observation) ->
385
Removed:
Stimulus.Effort.load o.effort |> Stimulus.Load.to_kg)
367
Added:
(fun (o : Log.observation) -> Stimulus.Effort.load o.effort)
386
368
history) );
387
369
( "observations are dated, so a stall can be measured",
388
370
`Quick,
@@ -475,25 +457,29 @@
475
457
fun () ->
476
458
let open Feedback in
477
459
match
478
Removed:
make ~reported_at:(at 60) [ Sleep Below_usual; Sleep Above_usual ]
460
Added:
try
461
Added:
ignore
462
Added:
(make ~reported_at:(at 60)
463
Added:
[ Sleep Below_usual; Sleep Above_usual ]);
464
Added:
None
465
Added:
with Invalid error -> Some error
479
466
with
480
Removed:
| Error (Duplicate_signal (Sleep Above_usual)) -> ()
467
Added:
| Some (Duplicate_signal (Sleep Above_usual)) -> ()
481
468
| _ -> Alcotest.fail "expected duplicate sleep rejection" );
482
469
( "feedback retains its report time and signals",
483
470
`Quick,
484
471
fun () ->
485
472
let open Feedback in
486
473
let feedback =
487
Removed:
ok
488
Removed:
(make ~reported_at:(at 60)
489
Removed:
[
490
Removed:
Sleep Above_usual;
491
Removed:
Appetite Usual;
492
Removed:
Readiness Above_usual;
493
Removed:
Motivation Above_usual;
494
Removed:
Difficulty Usual;
495
Removed:
Preparation_insufficient;
496
Removed:
])
474
Added:
make ~reported_at:(at 60)
475
Added:
[
476
Added:
Sleep Above_usual;
477
Added:
Appetite Usual;
478
Added:
Readiness Above_usual;
479
Added:
Motivation Above_usual;
480
Added:
Difficulty Usual;
481
Added:
Preparation_insufficient;
482
Added:
]
497
483
in
498
484
Alcotest.(check int)
499
485
"report time" 60
@@ -503,7 +489,6 @@
503
489
504
490
let suite =
505
491
[
506
Removed:
("evidence.stimulus.values", value_tests);
507
492
("evidence.stimulus.outcome", outcome_tests);
508
493
("evidence.stimulus.delivery", stimulus_delivery_tests);
509
494
("evidence.workout.lifecycle", lifecycle_tests);
test/test_prescription.ml
@@ -8,7 +8,7 @@
8
8
| Some e -> e
9
9
| None -> Alcotest.failf "catalog is missing %S" id
10
10
11
Removed:
let six_to_ten = Result.get_ok (Prescription.Rep_range.make ~min:6 ~max:10)
11
Added:
let six_to_ten = Prescription.Rep_range.make ~min:6 ~max:10
12
12
13
13
let prescribe ?(substitutes = []) delivery =
14
14
Prescription.Stimulus.make ~delivery ~rep_range:six_to_ten
@@ -73,24 +73,31 @@
73
73
`Quick,
74
74
fun () ->
75
75
List.iter
76
Removed:
(fun (min, max) ->
77
Removed:
match Prescription.Rep_range.make ~min ~max with
78
Removed:
| Ok _ -> ()
79
Removed:
| Error _ -> Alcotest.failf "%d-%d should be accepted" min max)
76
Added:
(fun (min, max) -> ignore (Prescription.Rep_range.make ~min ~max))
80
77
[ (6, 10); (6, 12); (8, 12); (8, 8) ] );
81
78
( "a malformed range is rejected before prescription construction",
82
79
`Quick,
83
80
fun () ->
84
Removed:
match Prescription.Rep_range.make ~min:8 ~max:6 with
85
Removed:
| Error (Prescription.Rep_range.Invalid_order _) -> ()
81
Added:
match
82
Added:
try
83
Added:
ignore (Prescription.Rep_range.make ~min:8 ~max:6);
84
Added:
None
85
Added:
with Prescription.Rep_range.Invalid error -> Some error
86
Added:
with
87
Added:
| Some (Prescription.Rep_range.Invalid_order _) -> ()
86
88
| _ -> Alcotest.fail "expected Invalid_order" );
87
89
( "a range outside HD1's limits is rejected",
88
90
`Quick,
89
91
fun () ->
90
92
List.iter
91
93
(fun (min, max) ->
92
Removed:
match Prescription.Rep_range.make ~min ~max with
93
Removed:
| Error (Prescription.Rep_range.Outside_limits _) -> ()
94
Added:
match
95
Added:
try
96
Added:
ignore (Prescription.Rep_range.make ~min ~max);
97
Added:
None
98
Added:
with Prescription.Rep_range.Invalid error -> Some error
99
Added:
with
100
Added:
| Some (Prescription.Rep_range.Outside_limits _) -> ()
94
101
| _ -> Alcotest.failf "%d-%d should be refused" min max)
95
102
[ (3, 5); (1, 3); (15, 20); (6, 20) ] );
96
103
]
test/test_progression.ml
@@ -10,13 +10,13 @@
10
10
| Some e -> e
11
11
| None -> Alcotest.failf "catalog is missing %S" id
12
12
13
Removed:
let load n = Result.get_ok (Stimulus.Load.kg n)
14
Removed:
let reps n = Result.get_ok (Stimulus.Reps.of_int n)
13
Added:
let load n = n
14
Added:
let reps n = n
15
15
let at s = Recovery.timestamp_of_unix_seconds s
16
16
let day n = at (n * 86_400)
17
17
let secs = Recovery.duration_to_seconds
18
Removed:
let six_to_ten = Result.get_ok (Prescription.Rep_range.make ~min:6 ~max:10)
19
Removed:
let rep_range min max = Result.get_ok (Prescription.Rep_range.make ~min ~max)
18
Added:
let six_to_ten = Prescription.Rep_range.make ~min:6 ~max:10
19
Added:
let rep_range min max = Prescription.Rep_range.make ~min ~max
20
20
21
21
let move ?(outcome = Stimulus.Positive_failure) ?(id = "laterals") load_kg
22
22
rep_count =
@@ -27,6 +27,12 @@
27
27
let seen ~on load r : Evidence.Log.observation =
28
28
{ exercise = get "laterals"; effort = move load r; performed_at = day on }
29
29
30
Added:
let raises_insufficient_data f =
31
Added:
try
32
Added:
let _ = f () in
33
Added:
false
34
Added:
with Progression.Invalid Progression.Insufficient_data -> true
35
Added:
30
36
let assess_tests =
31
37
[
32
38
( "the stall window is two weeks",
@@ -39,14 +45,15 @@
39
45
fun () ->
40
46
Alcotest.(check bool)
41
47
"nothing" true
42
Removed:
(Result.is_error (Progression.assess []));
48
Added:
(raises_insufficient_data (fun () -> Progression.assess []));
43
49
Alcotest.(check bool)
44
50
"a single session" true
45
Removed:
(Result.is_error (Progression.assess [ seen ~on:1 12. 8 ]));
51
Added:
(raises_insufficient_data (fun () ->
52
Added:
Progression.assess [ seen ~on:1 12. 8 ]));
46
53
Alcotest.(check bool)
47
54
"flat but recent" true
48
Removed:
(Result.is_error
49
Removed:
(Progression.assess [ seen ~on:1 12. 8; seen ~on:3 12. 8 ])) );
55
Added:
(raises_insufficient_data (fun () ->
56
Added:
Progression.assess [ seen ~on:1 12. 8; seen ~on:3 12. 8 ])) );
50
57
( "a recent advance is progress",
51
58
`Quick,
52
59
fun () ->
@@ -54,7 +61,7 @@
54
61
"progressing" true
55
62
(Progression.assess
56
63
[ seen ~on:1 12. 8; seen ~on:3 12. 9; seen ~on:5 12. 9 ]
57
Removed:
= Ok Progression.Progressing) );
64
Added:
= Progression.Progressing) );
58
65
( "no advance for two weeks is a stall",
59
66
`Quick,
60
67
fun () ->
@@ -62,7 +69,7 @@
62
69
"stalled" true
63
70
(Progression.assess
64
71
[ seen ~on:1 12. 8; seen ~on:8 12. 8; seen ~on:16 12. 8 ]
65
Removed:
= Ok Progression.Stalled) );
72
Added:
= Progression.Stalled) );
66
73
( "an advance more than two weeks ago is also a stall",
67
74
`Quick,
68
75
fun () ->
@@ -70,7 +77,7 @@
70
77
"stalled" true
71
78
(Progression.assess
72
79
[ seen ~on:1 12. 8; seen ~on:3 12. 9; seen ~on:20 12. 9 ]
73
Removed:
= Ok Progression.Stalled) );
80
Added:
= Progression.Stalled) );
74
81
]
75
82
76
83
let remedy_tests =
@@ -116,9 +123,8 @@
116
123
`Quick,
117
124
fun () ->
118
125
let low, high = Progression.load_increase ~current:(load 100.) in
119
Removed:
Alcotest.(check (float 0.001)) "110kg" 110. (Stimulus.Load.to_kg low);
120
Removed:
Alcotest.(check (float 0.001)) "120kg" 120. (Stimulus.Load.to_kg high)
121
Removed:
);
126
Added:
Alcotest.(check (float 0.001)) "110kg" 110. low;
127
Added:
Alcotest.(check (float 0.001)) "120kg" 120. high );
122
128
( "inside the window the load holds",
123
129
`Quick,
124
130
fun () ->
@@ -139,10 +145,8 @@
139
145
fun () ->
140
146
match Progression.judge_load ~rep_range:six_to_ten (move 100. 12) with
141
147
| Progression.Increase (low, high) ->
142
Removed:
Alcotest.(check (float 0.001))
143
Removed:
"110kg" 110. (Stimulus.Load.to_kg low);
144
Removed:
Alcotest.(check (float 0.001))
145
Removed:
"120kg" 120. (Stimulus.Load.to_kg high)
148
Added:
Alcotest.(check (float 0.001)) "110kg" 110. low;
149
Added:
Alcotest.(check (float 0.001)) "120kg" 120. high
146
150
| _ -> Alcotest.fail "expected Increase" );
147
151
( "failing below the window means the load is too heavy",
148
152
`Quick,
@@ -195,7 +199,7 @@
195
199
196
200
let performed ~clearance ~stimuli =
197
201
List.fold_left
198
Removed:
(fun w s -> ok (Workout.add_stimulus w s))
202
Added:
(fun w s -> Workout.add_stimulus w s)
199
203
(Workout.start prescribed ~clearance ~started_at:(day 1))
200
204
stimuli
201
205
@@ -273,7 +277,7 @@
273
277
"and the routine is stalled" true
274
278
(Progression.assess
275
279
[ seen ~on:1 12. 8; seen ~on:8 12. 8; seen ~on:16 12. 8 ]
276
Removed:
= Ok Progression.Stalled) );
280
Added:
= Progression.Stalled) );
277
281
]
278
282
279
283
let suite =
test/test_service.ml
@@ -12,8 +12,8 @@
12
12
| Some e -> e
13
13
| None -> Alcotest.failf "catalog is missing %S" id
14
14
15
Removed:
let load n = Result.get_ok (Stimulus.Load.kg n)
16
Removed:
let reps n = Result.get_ok (Stimulus.Reps.of_int n)
15
Added:
let load n = n
16
Added:
let reps n = n
17
17
let at s = Recovery.timestamp_of_unix_seconds s
18
18
let day n = at (n * 86_400)
19
19
let ideal = Repository.routine_id "ideal"