[OCaml] High Intensity Training Online
refactor Add typed training values
Validate loads, repetitions, and prescription ranges at their construction boundaries. This makes invalid training values unrepresentable in movement, progression, and prescription flows.
Changed files
- ARCHITECTURE.md
- 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,8 +75,9 @@
75
75
76
76
### Vocabulary
77
77
78
Removed:
- **Units** — `Weight` (kg, zero for bodyweight movements), `Reps`, `Rep_range`.
79
Removed:
Abstract, reachable only through validating constructors.
78
Added:
- **Values** — `Evidence.Stimulus.Load` (kg, zero for bodyweight movements),
79
Added:
`Evidence.Stimulus.Reps`, and `Prescription.Rep_range`. Each is abstract and
80
Added:
only its validating constructor can create it.
80
81
- **Muscle** — the training targets HD1 names, plus the assisting muscles its
81
82
weak-link argument needs. Glutes never appear in HD1 and forearms only
82
83
anatomically; both are here because a compound must have something able to
lib/core/evidence.ml
@@ -17,32 +17,44 @@
17
17
| Rest_pause -> "rest-pause"
18
18
| Static_hold -> "static hold")
19
19
20
Added:
module Load = struct
21
Added:
type t = float
22
Added:
type error = Not_finite | Negative
23
Added:
24
Added:
let kg value =
25
Added:
if not (Float.is_finite value) then Error Not_finite
26
Added:
else if value < 0. then Error Negative
27
Added:
else Ok value
28
Added:
29
Added:
let to_kg value = value
30
Added:
end
31
Added:
32
Added:
module Reps = struct
33
Added:
type t = int
34
Added:
type error = Nonpositive
35
Added:
36
Added:
let of_int value = if value > 0 then Ok value else Error Nonpositive
37
Added:
let to_int value = value
38
Added:
end
39
Added:
20
40
module Movement = struct
21
41
type t = {
22
42
exercise : Exercise.t;
23
Removed:
load_kg : float;
24
Removed:
reps : int;
43
Added:
load : Load.t;
44
Added:
reps : Reps.t;
25
45
outcome : outcome;
26
46
}
27
47
28
Removed:
type error = Invalid_load | Invalid_reps
29
Removed:
30
Removed:
exception Invalid of error
31
Removed:
32
Removed:
let make ~exercise ~load_kg ~reps ~outcome =
33
Removed:
if (not (Float.is_finite load_kg)) || load_kg < 0. then
34
Removed:
raise (Invalid Invalid_load)
35
Removed:
else if reps <= 0 then raise (Invalid Invalid_reps)
36
Removed:
else { exercise; load_kg; reps; outcome }
37
Removed:
48
Added:
let make ~exercise ~load ~reps ~outcome = { exercise; load; reps; outcome }
38
49
let exercise t = t.exercise
39
Removed:
let load_kg t = t.load_kg
50
Added:
let load t = t.load
40
51
let reps t = t.reps
41
52
let outcome t = t.outcome
42
53
let extensions t = extensions_of_outcome t.outcome
43
54
44
55
let pp ppf t =
45
Removed:
Format.fprintf ppf "%a %g kg x %d" Exercise.pp t.exercise t.load_kg t.reps;
56
Added:
Format.fprintf ppf "%a %g kg x %d" Exercise.pp t.exercise
57
Added:
(Load.to_kg t.load) (Reps.to_int t.reps);
46
58
match extensions t with
47
59
| [] -> ()
48
60
| es ->
lib/core/evidence.mli
@@ -12,18 +12,31 @@
12
12
val extensions_of_outcome : outcome -> extension list
13
13
val pp_extension : Format.formatter -> extension -> unit
14
14
15
Removed:
module Movement : sig
15
Added:
module Load : sig
16
16
type t
17
Removed:
type error = Invalid_load | Invalid_reps
17
Added:
type error = Not_finite | Negative
18
18
19
Removed:
exception Invalid of error
19
Added:
val kg : float -> (t, error) result
20
Added:
val to_kg : t -> float
21
Added:
end
20
22
23
Added:
module Reps : sig
24
Added:
type t
25
Added:
type error = Nonpositive
26
Added:
27
Added:
val of_int : int -> (t, error) result
28
Added:
val to_int : t -> int
29
Added:
end
30
Added:
31
Added:
module Movement : sig
32
Added:
type t
33
Added:
21
34
val make :
22
Removed:
exercise:Exercise.t -> load_kg:float -> reps:int -> outcome:outcome -> t
35
Added:
exercise:Exercise.t -> load:Load.t -> reps:Reps.t -> outcome:outcome -> t
23
36
24
37
val exercise : t -> Exercise.t
25
Removed:
val load_kg : t -> float
26
Removed:
val reps : t -> int
38
Added:
val load : t -> Load.t
39
Added:
val reps : t -> Reps.t
27
40
val outcome : t -> outcome
28
41
val extensions : t -> extension list
29
42
val pp : Format.formatter -> t -> unit
lib/core/prescription.ml
@@ -1,3 +1,21 @@
1
Added:
module Rep_range = struct
2
Added:
type t = int * int
3
Added:
4
Added:
type error =
5
Added:
| Invalid_order of { min : int; max : int }
6
Added:
| Outside_limits of { min : int; max : int }
7
Added:
8
Added:
let limits = (6, 12)
9
Added:
10
Added:
let make ~min ~max =
11
Added:
let lower, upper = limits in
12
Added:
if min <= 0 || max < min then Error (Invalid_order { min; max })
13
Added:
else if min < lower || max > upper then Error (Outside_limits { min; max })
14
Added:
else Ok (min, max)
15
Added:
16
Added:
let bounds t = t
17
Added:
end
18
Added:
1
19
module Stimulus = struct
2
20
type delivery =
3
21
| Single of Exercise.t
@@ -5,32 +23,26 @@
5
23
6
24
type t = {
7
25
delivery : delivery;
8
Removed:
rep_range : int * int;
26
Added:
rep_range : Rep_range.t;
9
27
allowed_substitutes : Exercise.t list;
10
28
}
11
29
12
30
type error =
13
31
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
14
Removed:
| Invalid_rep_range of { min_reps : int; max_reps : int }
15
Removed:
| Reps_outside_limits
16
32
| Substitute_not_permitted of Exercise.id
17
33
18
Removed:
let rep_limits = (6, 12)
19
Removed:
20
34
let pp_error ppf = function
21
35
| Not_a_pre_exhaust { isolation; compound } ->
22
36
Format.fprintf ppf "%s cannot pre-exhaust for %s"
23
37
(isolation :> string)
24
38
(compound :> string)
25
Removed:
| Invalid_rep_range { min_reps; max_reps } ->
26
Removed:
Format.fprintf ppf "invalid rep window %d-%d" min_reps max_reps
27
Removed:
| Reps_outside_limits ->
28
Removed:
Format.fprintf ppf "rep window must lie within %d-%d" (fst rep_limits)
29
Removed:
(snd rep_limits)
30
39
| Substitute_not_permitted id ->
31
40
Format.fprintf ppf "%s is not a permitted substitute" (id :> string)
32
41
33
42
let delivery t = t.delivery
43
Added:
44
Added:
exception Invalid of error
45
Added:
34
46
let rep_range t = t.rep_range
35
47
let allowed_substitutes t = t.allowed_substitutes
36
48
@@ -40,12 +52,6 @@
40
52
41
53
let exercises t = delivery_exercises t.delivery
42
54
43
Removed:
let within_limits (min_reps, max_reps) =
44
Removed:
let lower, upper = rep_limits in
45
Removed:
min_reps >= lower && max_reps <= upper
46
Removed:
47
Removed:
exception Invalid of error
48
Removed:
49
55
let make ~delivery ~rep_range ~allowed_substitutes =
50
56
let movements = delivery_exercises delivery in
51
57
let unpermitted =
@@ -57,14 +63,8 @@
57
63
movements))
58
64
allowed_substitutes
59
65
in
60
Removed:
let min_reps, max_reps = rep_range in
61
Removed:
match
62
Removed:
( delivery,
63
Removed:
min_reps > 0 && max_reps >= min_reps,
64
Removed:
within_limits rep_range,
65
Removed:
unpermitted )
66
Removed:
with
67
Removed:
| Pre_exhaust { isolation; compound }, _, _, _
66
Added:
match (delivery, unpermitted) with
67
Added:
| Pre_exhaust { isolation; compound }, _
68
68
when not (Exercise.may_pre_exhaust ~isolation ~compound) ->
69
69
raise
70
70
(Invalid
@@ -73,10 +73,7 @@
73
73
isolation = Exercise.id isolation;
74
74
compound = Exercise.id compound;
75
75
}))
76
Removed:
| _, false, _, _ ->
77
Removed:
raise (Invalid (Invalid_rep_range { min_reps; max_reps }))
78
Removed:
| _, _, false, _ -> raise (Invalid Reps_outside_limits)
79
Removed:
| _, _, _, Some candidate ->
76
Added:
| _, Some candidate ->
80
77
raise (Invalid (Substitute_not_permitted (Exercise.id candidate)))
81
78
| _ -> { delivery; rep_range; allowed_substitutes }
82
79
@@ -91,7 +88,7 @@
91
88
compound
92
89
93
90
let pp ppf t =
94
Removed:
let min_reps, max_reps = t.rep_range in
91
Added:
let min_reps, max_reps = Rep_range.bounds t.rep_range in
95
92
Format.fprintf ppf "%a for %d-%d reps" pp_delivery t.delivery min_reps
96
93
max_reps
97
94
end
@@ -151,7 +148,7 @@
151
148
| None -> invalid_arg (Format.sprintf "Routine preset: no exercise %S" id)
152
149
153
150
(* HD1's guideline window for every listed exercise. *)
154
Removed:
let six_to_ten = (6, 10)
151
Added:
let six_to_ten = Result.get_ok (Rep_range.make ~min:6 ~max:10)
155
152
156
153
let prescribe ?(substitutes = []) delivery =
157
154
Stimulus.make ~delivery ~rep_range:six_to_ten
lib/core/prescription.mli
@@ -1,5 +1,19 @@
1
1
(** Plans for stimuli, workouts, and routines. *)
2
2
3
Added:
module Rep_range : sig
4
Added:
type t
5
Added:
6
Added:
type error =
7
Added:
| Invalid_order of { min : int; max : int }
8
Added:
| Outside_limits of { min : int; max : int }
9
Added:
10
Added:
val limits : int * int
11
Added:
(** HD1's 6-12 calibration limits. *)
12
Added:
13
Added:
val make : min:int -> max:int -> (t, error) result
14
Added:
val bounds : t -> int * int
15
Added:
end
16
Added:
3
17
(** One prescribed drive to failure. *)
4
18
module Stimulus : sig
5
19
type t
@@ -11,26 +25,21 @@
11
25
12
26
type error =
13
27
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
14
Removed:
| Invalid_rep_range of { min_reps : int; max_reps : int }
15
Removed:
| Reps_outside_limits
16
28
| Substitute_not_permitted of Exercise.id
17
29
18
30
val pp_error : Format.formatter -> error -> unit
19
31
20
Removed:
val rep_limits : int * int
21
Removed:
(** 6-12; every prescribed range must lie within it. *)
22
Removed:
23
32
exception Invalid of error
24
33
25
34
val make :
26
35
delivery:delivery ->
27
Removed:
rep_range:int * int ->
36
Added:
rep_range:Rep_range.t ->
28
37
allowed_substitutes:Exercise.t list ->
29
38
t
30
Removed:
(** Raises [Invalid] for an invalid pairing, range, or substitution. *)
39
Added:
(** Raises [Invalid] for an invalid pairing or substitution. *)
31
40
32
41
val delivery : t -> delivery
33
Removed:
val rep_range : t -> int * int
42
Added:
val rep_range : t -> Rep_range.t
34
43
val allowed_substitutes : t -> Exercise.t list
35
44
36
45
val exercises : t -> Exercise.t list
lib/core/progression.ml
@@ -2,9 +2,15 @@
2
2
3
3
let beats ~previous ~current =
4
4
let load =
5
Removed:
Float.compare (Movement.load_kg current) (Movement.load_kg previous)
5
Added:
Float.compare
6
Added:
(Movement.load current |> Evidence.Stimulus.Load.to_kg)
7
Added:
(Movement.load previous |> Evidence.Stimulus.Load.to_kg)
6
8
in
7
Removed:
let reps = Int.compare (Movement.reps current) (Movement.reps previous) in
9
Added:
let reps =
10
Added:
Int.compare
11
Added:
(Movement.reps current |> Evidence.Stimulus.Reps.to_int)
12
Added:
(Movement.reps previous |> Evidence.Stimulus.Reps.to_int)
13
Added:
in
8
14
load > 0 || (load = 0 && reps > 0)
9
15
10
16
type assessment = Progressing | Stalled
@@ -80,17 +86,24 @@
80
86
extra_rest
81
87
82
88
let load_increase_trigger = 12
83
Removed:
let load_increase ~current_kg = (current_kg *. 1.10, current_kg *. 1.20)
84
89
85
Removed:
type load_verdict = Hold | Increase of float * float | Too_heavy
90
Added:
let load_increase ~current =
91
Added:
let current_kg = Evidence.Stimulus.Load.to_kg current in
92
Added:
( Result.get_ok (Evidence.Stimulus.Load.kg (current_kg *. 1.10)),
93
Added:
Result.get_ok (Evidence.Stimulus.Load.kg (current_kg *. 1.20)) )
86
94
95
Added:
type load_verdict =
96
Added:
| Hold
97
Added:
| Increase of Evidence.Stimulus.Load.t * Evidence.Stimulus.Load.t
98
Added:
| Too_heavy
99
Added:
87
100
(* The trigger is absolute, so the window's ceiling never gates the verdict —
88
101
only its floor does. *)
89
102
let judge_load ~rep_range movement =
90
Removed:
let reps = Movement.reps movement in
91
Removed:
let min_reps, _ = rep_range in
103
Added:
let reps = Movement.reps movement |> Evidence.Stimulus.Reps.to_int in
104
Added:
let min_reps, _ = Prescription.Rep_range.bounds rep_range in
92
105
if reps >= load_increase_trigger then
93
Removed:
let low, high = load_increase ~current_kg:(Movement.load_kg movement) in
106
Added:
let low, high = load_increase ~current:(Movement.load movement) in
94
107
Increase (low, high)
95
108
else if reps < min_reps then Too_heavy
96
109
else Hold
@@ -98,7 +111,9 @@
98
111
let pp_load_verdict ppf = function
99
112
| Hold -> Format.pp_print_string ppf "hold the load"
100
113
| Increase (low, high) ->
101
Removed:
Format.fprintf ppf "raise the load to %g-%g kg" low high
114
Added:
Format.fprintf ppf "raise the load to %g-%g kg"
115
Added:
(Evidence.Stimulus.Load.to_kg low)
116
Added:
(Evidence.Stimulus.Load.to_kg high)
102
117
| Too_heavy -> Format.pp_print_string ppf "load is too heavy for the window"
103
118
104
119
type diagnostic =
lib/core/progression.mli
@@ -27,13 +27,20 @@
27
27
val load_increase_trigger : int
28
28
(** 12 reps, regardless of the prescribed range. *)
29
29
30
Removed:
val load_increase : current_kg:float -> float * float
30
Added:
val load_increase :
31
Added:
current:Evidence.Stimulus.Load.t ->
32
Added:
Evidence.Stimulus.Load.t * Evidence.Stimulus.Load.t
31
33
(** 10-20% increase window. *)
32
34
33
Removed:
type load_verdict = Hold | Increase of float * float | Too_heavy
35
Added:
type load_verdict =
36
Added:
| Hold
37
Added:
| Increase of Evidence.Stimulus.Load.t * Evidence.Stimulus.Load.t
38
Added:
| Too_heavy
34
39
35
40
val judge_load :
36
Removed:
rep_range:int * int -> Evidence.Stimulus.Movement.t -> load_verdict
41
Added:
rep_range:Prescription.Rep_range.t ->
42
Added:
Evidence.Stimulus.Movement.t ->
43
Added:
load_verdict
37
44
(** Only the range floor matters: below it is [Too_heavy]; at twelve reps the
38
45
verdict is [Increase]. *)
39
46
lib/web/decode.ml
@@ -1,16 +1,18 @@
1
1
module Form = Dream_html.Form
2
Added:
module Load = Evidence.Stimulus.Load
3
Added:
module Reps = Evidence.Stimulus.Reps
2
4
3
5
type fields =
4
6
| Single of {
5
Removed:
load : float;
6
Removed:
reps : int;
7
Added:
load : Load.t;
8
Added:
reps : Reps.t;
7
9
extension : Evidence.Stimulus.extension option;
8
10
}
9
11
| Pair of {
10
Removed:
iso_load : float;
11
Removed:
iso_reps : int;
12
Removed:
comp_load : float;
13
Removed:
comp_reps : int;
12
Added:
iso_load : Load.t;
13
Added:
iso_reps : Reps.t;
14
Added:
comp_load : Load.t;
15
Added:
comp_reps : Reps.t;
14
16
extension : Evidence.Stimulus.extension option;
15
17
}
16
18
@@ -22,71 +24,68 @@
22
24
| "static" -> Ok (Some Evidence.Stimulus.Static_hold)
23
25
| _ -> Error "error.extension"
24
26
25
Removed:
let load =
26
Removed:
Form.ensure "error.load"
27
Removed:
(fun value -> Float.is_finite value && value >= 0.)
28
Removed:
Form.required Form.float
27
Added:
let load value =
28
Added:
match Form.float value with
29
Added:
| Error error -> Error error
30
Added:
| Ok value -> (
31
Added:
match Load.kg value with
32
Added:
| Ok load -> Ok load
33
Added:
| Error _ -> Error "error.load")
29
34
30
Removed:
let reps = Form.required (Form.int ~min:1)
35
Added:
let reps value =
36
Added:
match Form.int value with
37
Added:
| Error error -> Error error
38
Added:
| Ok value -> (
39
Added:
match Reps.of_int value with
40
Added:
| Ok reps -> Ok reps
41
Added:
| Error _ -> Error "error.reps")
31
42
32
43
let fields prescription =
33
44
let open Form in
34
45
match Prescription.Stimulus.delivery prescription with
35
46
| Prescription.Stimulus.Single _ ->
36
Removed:
let+ load = load "load"
37
Removed:
and+ reps = reps "reps"
47
Added:
let+ load = required load "load"
48
Added:
and+ reps = required reps "reps"
38
49
and+ extension = required extension "extension" in
39
50
Single { load; reps; extension }
40
51
| Prescription.Stimulus.Pre_exhaust _ ->
41
Removed:
let+ iso_load = load "iso_load"
42
Removed:
and+ iso_reps = reps "iso_reps"
43
Removed:
and+ comp_load = load "comp_load"
44
Removed:
and+ comp_reps = reps "comp_reps"
52
Added:
let+ iso_load = required load "iso_load"
53
Added:
and+ iso_reps = required reps "iso_reps"
54
Added:
and+ comp_load = required load "comp_load"
55
Added:
and+ comp_reps = required reps "comp_reps"
45
56
and+ extension = required extension "extension" in
46
57
Pair { iso_load; iso_reps; comp_load; comp_reps; extension }
47
58
48
Removed:
let movement ~exercise ~load_kg ~reps ~outcome =
49
Removed:
try
50
Removed:
Ok (Evidence.Stimulus.Movement.make ~exercise ~load_kg ~reps ~outcome)
51
Removed:
with
52
Removed:
| Evidence.Stimulus.Movement.Invalid Evidence.Stimulus.Movement.Invalid_load
53
Removed:
->
54
Removed:
Error "error.load"
55
Removed:
| Evidence.Stimulus.Movement.Invalid Evidence.Stimulus.Movement.Invalid_reps
56
Removed:
->
57
Removed:
Error "error.reps"
58
Removed:
59
59
let stimulus prescription =
60
60
let open Form in
61
61
let* values = fields prescription in
62
62
match (Prescription.Stimulus.delivery prescription, values) with
63
Removed:
| Prescription.Stimulus.Single exercise, Single { load; reps; extension } -> (
64
Removed:
match
65
Removed:
movement ~exercise ~load_kg:load ~reps
66
Removed:
~outcome:
67
Removed:
(match extension with
68
Removed:
| None -> Evidence.Stimulus.Positive_failure
69
Removed:
| Some extension -> Evidence.Stimulus.Beyond_failure (extension, []))
70
Removed:
with
71
Removed:
| Ok movement ->
72
Removed:
ok (Evidence.Stimulus.make (Evidence.Stimulus.Single movement))
73
Removed:
| Error key -> Form.error "load" key)
63
Added:
| Prescription.Stimulus.Single exercise, Single { load; reps; extension } ->
64
Added:
let outcome =
65
Added:
match extension with
66
Added:
| None -> Evidence.Stimulus.Positive_failure
67
Added:
| Some extension -> Evidence.Stimulus.Beyond_failure (extension, [])
68
Added:
in
69
Added:
ok
70
Added:
(Evidence.Stimulus.make
71
Added:
(Evidence.Stimulus.Single
72
Added:
(Evidence.Stimulus.Movement.make ~exercise ~load ~reps ~outcome)))
74
73
| ( Prescription.Stimulus.Pre_exhaust { isolation; compound },
75
Removed:
Pair { iso_load; iso_reps; comp_load; comp_reps; extension } ) -> (
76
Removed:
match
77
Removed:
( movement ~exercise:isolation ~load_kg:iso_load ~reps:iso_reps
78
Removed:
~outcome:Evidence.Stimulus.Positive_failure,
79
Removed:
movement ~exercise:compound ~load_kg:comp_load ~reps:comp_reps
80
Removed:
~outcome:
81
Removed:
(match extension with
82
Removed:
| None -> Evidence.Stimulus.Positive_failure
83
Removed:
| Some extension ->
84
Removed:
Evidence.Stimulus.Beyond_failure (extension, [])) )
85
Removed:
with
86
Removed:
| Ok first, Ok second ->
87
Removed:
ok (Evidence.Stimulus.make (Evidence.Stimulus.Pair { first; second }))
88
Removed:
| Error key, _ -> Form.error "iso_load" key
89
Removed:
| _, Error key -> Form.error "comp_load" key)
74
Added:
Pair { iso_load; iso_reps; comp_load; comp_reps; extension } ) ->
75
Added:
let second_outcome =
76
Added:
match extension with
77
Added:
| None -> Evidence.Stimulus.Positive_failure
78
Added:
| Some extension -> Evidence.Stimulus.Beyond_failure (extension, [])
79
Added:
in
80
Added:
let first =
81
Added:
Evidence.Stimulus.Movement.make ~exercise:isolation ~load:iso_load
82
Added:
~reps:iso_reps ~outcome:Evidence.Stimulus.Positive_failure
83
Added:
in
84
Added:
let second =
85
Added:
Evidence.Stimulus.Movement.make ~exercise:compound ~load:comp_load
86
Added:
~reps:comp_reps ~outcome:second_outcome
87
Added:
in
88
Added:
ok (Evidence.Stimulus.make (Evidence.Stimulus.Pair { first; second }))
90
89
| _ -> assert false
91
90
92
91
let override = Form.required Form.bool "override"
@@ -95,7 +94,7 @@
95
94
| "error.required" -> "Enter a value."
96
95
| "error.expected.number" -> "Enter a valid number."
97
96
| "error.expected.int" -> "Enter a valid whole number."
98
Removed:
| "error.range" | "error.reps" -> "Enter at least one repetition."
97
Added:
| "error.reps" -> "Enter at least one repetition."
99
98
| "error.load" -> "Enter a finite, nonnegative load."
100
99
| "error.extension" -> "Select one of the offered endings."
101
100
| key -> key
lib/web/pages.ml
@@ -108,7 +108,9 @@
108
108
let id_string (id : Repository.routine_id) = (id :> string)
109
109
110
110
let describe_prescription prescription =
111
Removed:
let min_reps, max_reps = Prescription.Stimulus.rep_range prescription in
111
Added:
let min_reps, max_reps =
112
Added:
Prescription.Rep_range.bounds (Prescription.Stimulus.rep_range prescription)
113
Added:
in
112
114
let window = Printf.sprintf "%d-%d reps" min_reps max_reps in
113
115
match Prescription.Stimulus.delivery prescription with
114
116
| Prescription.Stimulus.Single exercise ->
@@ -286,8 +288,8 @@
286
288
let movement movement =
287
289
Format.asprintf "%s %g kg x %d"
288
290
(Exercise.name (Evidence.Stimulus.Movement.exercise movement))
289
Removed:
(Evidence.Stimulus.Movement.load_kg movement)
290
Removed:
(Evidence.Stimulus.Movement.reps movement)
291
Added:
(Evidence.Stimulus.Movement.load movement |> Evidence.Stimulus.Load.to_kg)
292
Added:
(Evidence.Stimulus.Movement.reps movement |> Evidence.Stimulus.Reps.to_int)
291
293
in
292
294
let body =
293
295
String.concat " into "
test/test_decode.ml
@@ -9,7 +9,8 @@
9
9
let single =
10
10
Prescription.Stimulus.make
11
11
~delivery:(Prescription.Stimulus.Single (exercise "laterals"))
12
Removed:
~rep_range:(6, 10) ~allowed_substitutes:[]
12
Added:
~rep_range:(Result.get_ok (Prescription.Rep_range.make ~min:6 ~max:10))
13
Added:
~allowed_substitutes:[]
13
14
14
15
let stimulus_tests =
15
16
[
test/test_evidence.ml
@@ -12,18 +12,40 @@
12
12
| Some e -> e
13
13
| None -> Alcotest.failf "catalog is missing %S" id
14
14
15
Removed:
let kg n = n
16
Removed:
let reps n = n
15
Added:
let load n = Result.get_ok (Stimulus.Load.kg n)
16
Added:
let reps n = Result.get_ok (Stimulus.Reps.of_int n)
17
17
let at s = Recovery.timestamp_of_unix_seconds s
18
18
let day n = at (n * 86_400)
19
19
20
Removed:
let move ?(outcome = Stimulus.Positive_failure) id load r =
21
Removed:
Stimulus.Movement.make ~exercise:(get id) ~load_kg:(kg load) ~reps:(reps r)
22
Removed:
~outcome
20
Added:
let move ?(outcome = Stimulus.Positive_failure) id load_kg rep_count =
21
Added:
Stimulus.Movement.make ~exercise:(get id) ~load:(load load_kg)
22
Added:
~reps:(reps rep_count) ~outcome
23
23
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
Added:
let value_tests =
28
Added:
[
29
Added:
( "load rejects non-finite and negative kilograms",
30
Added:
`Quick,
31
Added:
fun () ->
32
Added:
Alcotest.(check bool)
33
Added:
"NaN" true
34
Added:
(Result.is_error (Stimulus.Load.kg Float.nan));
35
Added:
Alcotest.(check bool)
36
Added:
"negative" true
37
Added:
(Result.is_error (Stimulus.Load.kg (-0.5))) );
38
Added:
( "reps reject zero and negative values",
39
Added:
`Quick,
40
Added:
fun () ->
41
Added:
Alcotest.(check bool)
42
Added:
"zero" true
43
Added:
(Result.is_error (Stimulus.Reps.of_int 0));
44
Added:
Alcotest.(check bool)
45
Added:
"negative" true
46
Added:
(Result.is_error (Stimulus.Reps.of_int (-1))) );
47
Added:
]
48
Added:
27
49
(* {1 One stimulus} *)
28
50
29
51
let outcome_tests =
@@ -361,7 +383,8 @@
361
383
Alcotest.(check (list (float 0.001)))
362
384
"12kg then 14kg" [ 12.; 14. ]
363
385
(List.map
364
Removed:
(fun (o : Log.observation) -> Stimulus.Movement.load_kg o.movement)
386
Added:
(fun (o : Log.observation) ->
387
Added:
Stimulus.Movement.load o.movement |> Stimulus.Load.to_kg)
365
388
history) );
366
389
( "observations are dated, so a stall can be measured",
367
390
`Quick,
@@ -482,6 +505,7 @@
482
505
483
506
let suite =
484
507
[
508
Added:
("evidence.stimulus.values", value_tests);
485
509
("evidence.stimulus.outcome", outcome_tests);
486
510
("evidence.stimulus.delivery", stimulus_delivery_tests);
487
511
("evidence.workout.lifecycle", lifecycle_tests);
test/test_prescription.ml
@@ -8,8 +8,7 @@
8
8
| Some e -> e
9
9
| None -> Alcotest.failf "catalog is missing %S" id
10
10
11
Removed:
let range lo hi = (lo, hi)
12
Removed:
let six_to_ten = range 6 10
11
Added:
let six_to_ten = Result.get_ok (Prescription.Rep_range.make ~min:6 ~max:10)
13
12
14
13
let prescribe ?(substitutes = []) delivery =
15
14
Prescription.Stimulus.make ~delivery ~rep_range:six_to_ten
@@ -65,38 +64,34 @@
65
64
66
65
let rep_window_tests =
67
66
[
68
Removed:
( "rep_limits is HD1's 6-12 stimulus window",
67
Added:
( "Rep_range limits are HD1's 6-12 stimulus window",
69
68
`Quick,
70
69
fun () ->
71
Removed:
Alcotest.(check int) "min 6" 6 (fst Prescription.Stimulus.rep_limits);
72
Removed:
Alcotest.(check int) "max 12" 12 (snd Prescription.Stimulus.rep_limits)
73
Removed:
);
74
Removed:
( "a window inside the limits is accepted",
70
Added:
Alcotest.(check int) "min 6" 6 (fst Prescription.Rep_range.limits);
71
Added:
Alcotest.(check int) "max 12" 12 (snd Prescription.Rep_range.limits) );
72
Added:
( "a window inside the limits is a prescription value",
75
73
`Quick,
76
74
fun () ->
77
75
List.iter
78
Removed:
(fun (lo, hi) ->
79
Removed:
ignore
80
Removed:
(Prescription.Stimulus.make
81
Removed:
~delivery:(Prescription.Stimulus.Single (get "curls"))
82
Removed:
~rep_range:(range lo hi) ~allowed_substitutes:[]))
76
Added:
(fun (min, max) ->
77
Added:
match Prescription.Rep_range.make ~min ~max with
78
Added:
| Ok _ -> ()
79
Added:
| Error _ -> Alcotest.failf "%d-%d should be accepted" min max)
83
80
[ (6, 10); (6, 12); (8, 12); (8, 8) ] );
84
Removed:
( "a window escaping the limits raises Invalid",
81
Added:
( "a malformed range is rejected before prescription construction",
85
82
`Quick,
86
83
fun () ->
84
Added:
match Prescription.Rep_range.make ~min:8 ~max:6 with
85
Added:
| Error (Prescription.Rep_range.Invalid_order _) -> ()
86
Added:
| _ -> Alcotest.fail "expected Invalid_order" );
87
Added:
( "a range outside HD1's limits is rejected",
88
Added:
`Quick,
89
Added:
fun () ->
87
90
List.iter
88
Removed:
(fun (lo, hi) ->
89
Removed:
match
90
Removed:
try
91
Removed:
ignore
92
Removed:
(Prescription.Stimulus.make
93
Removed:
~delivery:(Prescription.Stimulus.Single (get "curls"))
94
Removed:
~rep_range:(range lo hi) ~allowed_substitutes:[]);
95
Removed:
None
96
Removed:
with Prescription.Stimulus.Invalid error -> Some error
97
Removed:
with
98
Removed:
| Some Prescription.Stimulus.Reps_outside_limits -> ()
99
Removed:
| _ -> Alcotest.failf "%d-%d should be refused" lo hi)
91
Added:
(fun (min, max) ->
92
Added:
match Prescription.Rep_range.make ~min ~max with
93
Added:
| Error (Prescription.Rep_range.Outside_limits _) -> ()
94
Added:
| _ -> Alcotest.failf "%d-%d should be refused" min max)
100
95
[ (3, 5); (1, 3); (15, 20); (6, 20) ] );
101
96
]
102
97
test/test_progression.ml
@@ -10,17 +10,18 @@
10
10
| Some e -> e
11
11
| None -> Alcotest.failf "catalog is missing %S" id
12
12
13
Removed:
let kg n = n
14
Removed:
let reps n = n
13
Added:
let load n = Result.get_ok (Stimulus.Load.kg n)
14
Added:
let reps n = Result.get_ok (Stimulus.Reps.of_int 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 range lo hi = (lo, hi)
19
Removed:
let six_to_ten = range 6 10
18
Added:
let six_to_ten = Result.get_ok (Prescription.Rep_range.make ~min:6 ~max:10)
19
Added:
let rep_range min max = Result.get_ok (Prescription.Rep_range.make ~min ~max)
20
20
21
Removed:
let move ?(outcome = Stimulus.Positive_failure) ?(id = "laterals") load r =
22
Removed:
Stimulus.Movement.make ~exercise:(get id) ~load_kg:(kg load) ~reps:(reps r)
23
Removed:
~outcome
21
Added:
let move ?(outcome = Stimulus.Positive_failure) ?(id = "laterals") load_kg
22
Added:
rep_count =
23
Added:
Stimulus.Movement.make ~exercise:(get id) ~load:(load load_kg)
24
Added:
~reps:(reps rep_count) ~outcome
24
25
25
26
(* An observation is a public record, so evidence can be written directly. *)
26
27
let seen ~on load r : Evidence.Log.observation =
@@ -114,9 +115,10 @@
114
115
( "the increase is a 10-20% window",
115
116
`Quick,
116
117
fun () ->
117
Removed:
let low, high = Progression.load_increase ~current_kg:(kg 100.) in
118
Removed:
Alcotest.(check (float 0.001)) "110kg" 110. low;
119
Removed:
Alcotest.(check (float 0.001)) "120kg" 120. high );
118
Added:
let low, high = Progression.load_increase ~current:(load 100.) in
119
Added:
Alcotest.(check (float 0.001)) "110kg" 110. (Stimulus.Load.to_kg low);
120
Added:
Alcotest.(check (float 0.001)) "120kg" 120. (Stimulus.Load.to_kg high)
121
Added:
);
120
122
( "inside the window the load holds",
121
123
`Quick,
122
124
fun () ->
@@ -137,8 +139,10 @@
137
139
fun () ->
138
140
match Progression.judge_load ~rep_range:six_to_ten (move 100. 12) with
139
141
| Progression.Increase (low, high) ->
140
Removed:
Alcotest.(check (float 0.001)) "110kg" 110. low;
141
Removed:
Alcotest.(check (float 0.001)) "120kg" 120. high
142
Added:
Alcotest.(check (float 0.001))
143
Added:
"110kg" 110. (Stimulus.Load.to_kg low);
144
Added:
Alcotest.(check (float 0.001))
145
Added:
"120kg" 120. (Stimulus.Load.to_kg high)
142
146
| _ -> Alcotest.fail "expected Increase" );
143
147
( "failing below the window means the load is too heavy",
144
148
`Quick,
@@ -155,7 +159,7 @@
155
159
fun () ->
156
160
Alcotest.(check bool)
157
161
"10 reps of 6-8 still holds" true
158
Removed:
(Progression.judge_load ~rep_range:(range 6 8) (move 12. 10)
162
Added:
(Progression.judge_load ~rep_range:(rep_range 6 8) (move 12. 10)
159
163
= Progression.Hold) );
160
164
( "the twelve-rep trigger is absolute, whatever the ceiling",
161
165
`Quick,
@@ -163,7 +167,7 @@
163
167
List.iter
164
168
(fun (lo, hi) ->
165
169
match
166
Removed:
Progression.judge_load ~rep_range:(range lo hi) (move 100. 12)
170
Added:
Progression.judge_load ~rep_range:(rep_range lo hi) (move 100. 12)
167
171
with
168
172
| Progression.Increase _ -> ()
169
173
| _ ->
@@ -175,7 +179,7 @@
175
179
fun () ->
176
180
Alcotest.(check bool)
177
181
"7 reps of 8-12 is too heavy" true
178
Removed:
(Progression.judge_load ~rep_range:(range 8 12) (move 12. 7)
182
Added:
(Progression.judge_load ~rep_range:(rep_range 8 12) (move 12. 7)
179
183
= Progression.Too_heavy);
180
184
Alcotest.(check bool)
181
185
"7 reps of 6-10 holds" true
test/test_service.ml
@@ -12,16 +12,16 @@
12
12
| Some e -> e
13
13
| None -> Alcotest.failf "catalog is missing %S" id
14
14
15
Removed:
let kg n = n
16
Removed:
let reps n = n
15
Added:
let load n = Result.get_ok (Stimulus.Load.kg n)
16
Added:
let reps n = Result.get_ok (Stimulus.Reps.of_int 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"
20
20
let service () = S.make ~repo:(Memory_repo.create ())
21
21
22
Removed:
let move id load r =
23
Removed:
Stimulus.Movement.make ~exercise:(get id) ~load_kg:(kg load) ~reps:(reps r)
24
Removed:
~outcome:Stimulus.Positive_failure
22
Added:
let move id load_kg rep_count =
23
Added:
Stimulus.Movement.make ~exercise:(get id) ~load:(load load_kg)
24
Added:
~reps:(reps rep_count) ~outcome:Stimulus.Positive_failure
25
25
26
26
let single id load r = Stimulus.make (Stimulus.Single (move id load r))
27
27
let pair ~first ~second = Stimulus.make (Stimulus.Pair { first; second })