[OCaml] High Intensity Training Online

refactor Remove units module

Keep numeric validation at domain constructors and store prescribed\nrep ranges as validated integer tuples.

Commit
a4d4d1bcf5d29deeb25dfd840b0c5005506f5651
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
lib/core/dune
index a0b7034c..f919df98 100644..100644
@@ -4,5 +4,5 @@
4 4 (library
5 5 (name hito_core)
6 6 (public_name hito.core)
7 Removed: (modules units exercise recovery prescription evidence progression)
7 Added: (modules exercise recovery prescription evidence progression)
8 8 (wrapped false))
lib/core/evidence.ml
index 61904b49..40131dc8 100644..100644
@@ -20,21 +20,29 @@
20 20 module Movement = struct
21 21 type t = {
22 22 exercise : Exercise.t;
23 Removed: load : Units.Weight.t;
24 Removed: reps : Units.Reps.t;
23 Added: load_kg : float;
24 Added: reps : int;
25 25 outcome : outcome;
26 26 }
27 27
28 Removed: let make ~exercise ~load ~reps ~outcome = { exercise; load; reps; outcome }
28 Added: type error = Invalid_load | Invalid_reps
29 Added:
30 Added: exception Invalid of error
31 Added:
32 Added: let make ~exercise ~load_kg ~reps ~outcome =
33 Added: if (not (Float.is_finite load_kg)) || load_kg < 0. then
34 Added: raise (Invalid Invalid_load)
35 Added: else if reps <= 0 then raise (Invalid Invalid_reps)
36 Added: else { exercise; load_kg; reps; outcome }
37 Added:
29 38 let exercise t = t.exercise
30 Removed: let load t = t.load
39 Added: let load_kg t = t.load_kg
31 40 let reps t = t.reps
32 41 let outcome t = t.outcome
33 42 let extensions t = extensions_of_outcome t.outcome
34 43
35 44 let pp ppf t =
36 Removed: Format.fprintf ppf "%a %a x %a" Exercise.pp t.exercise Units.Weight.pp
37 Removed: t.load Units.Reps.pp t.reps;
45 Added: Format.fprintf ppf "%a %g kg x %d" Exercise.pp t.exercise t.load_kg t.reps;
38 46 match extensions t with
39 47 | [] -> ()
40 48 | es ->
lib/core/evidence.mli
index 87be2853..a850f9a1 100644..100644
@@ -14,17 +14,16 @@
14 14
15 15 module Movement : sig
16 16 type t
17 Added: type error = Invalid_load | Invalid_reps
17 18
19 Added: exception Invalid of error
20 Added:
18 21 val make :
19 Removed: exercise:Exercise.t ->
20 Removed: load:Units.Weight.t ->
21 Removed: reps:Units.Reps.t ->
22 Removed: outcome:outcome ->
23 Removed: t
22 Added: exercise:Exercise.t -> load_kg:float -> reps:int -> outcome:outcome -> t
24 23
25 24 val exercise : t -> Exercise.t
26 Removed: val load : t -> Units.Weight.t
27 Removed: val reps : t -> Units.Reps.t
25 Added: val load_kg : t -> float
26 Added: val reps : t -> int
28 27 val outcome : t -> outcome
29 28 val extensions : t -> extension list
30 29 val pp : Format.formatter -> t -> unit
lib/core/prescription.ml
index fe15e744..65c2770c 100644..100644
@@ -5,32 +5,28 @@
5 5
6 6 type t = {
7 7 delivery : delivery;
8 Removed: rep_range : Units.Rep_range.t;
8 Added: rep_range : int * int;
9 9 allowed_substitutes : Exercise.t list;
10 10 }
11 11
12 12 type error =
13 13 | Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
14 Added: | Invalid_rep_range of { min_reps : int; max_reps : int }
14 15 | Reps_outside_limits
15 16 | Substitute_not_permitted of Exercise.id
16 17
17 Removed: (* 6 and 12 are statically valid, so these cannot fail. *)
18 Removed: let reps_exn n =
19 Removed: match Units.Reps.of_int n with Ok r -> r | Error _ -> assert false
18 Added: let rep_limits = (6, 12)
20 19
21 Removed: let rep_limits =
22 Removed: match Units.Rep_range.make ~min:(reps_exn 6) ~max:(reps_exn 12) with
23 Removed: | Ok r -> r
24 Removed: | Error _ -> assert false
25 Removed:
26 20 let pp_error ppf = function
27 21 | Not_a_pre_exhaust { isolation; compound } ->
28 22 Format.fprintf ppf "%s cannot pre-exhaust for %s"
29 23 (isolation :> string)
30 24 (compound :> string)
25 Added: | Invalid_rep_range { min_reps; max_reps } ->
26 Added: Format.fprintf ppf "invalid rep window %d-%d" min_reps max_reps
31 27 | Reps_outside_limits ->
32 Removed: Format.fprintf ppf "rep window must lie within %a" Units.Rep_range.pp
33 Removed: rep_limits
28 Added: Format.fprintf ppf "rep window must lie within %d-%d" (fst rep_limits)
29 Added: (snd rep_limits)
34 30 | Substitute_not_permitted id ->
35 31 Format.fprintf ppf "%s is not a permitted substitute" (id :> string)
36 32
@@ -44,9 +40,9 @@
44 40
45 41 let exercises t = delivery_exercises t.delivery
46 42
47 Removed: let within_limits range =
48 Removed: Units.Rep_range.contains rep_limits (Units.Rep_range.min range)
49 Removed: && Units.Rep_range.contains rep_limits (Units.Rep_range.max range)
43 Added: let within_limits (min_reps, max_reps) =
44 Added: let lower, upper = rep_limits in
45 Added: min_reps >= lower && max_reps <= upper
50 46
51 47 exception Invalid of error
52 48
@@ -61,8 +57,14 @@
61 57 movements))
62 58 allowed_substitutes
63 59 in
64 Removed: match (delivery, within_limits rep_range, unpermitted) with
65 Removed: | Pre_exhaust { isolation; compound }, _, _
60 Added: let min_reps, max_reps = rep_range in
61 Added: match
62 Added: ( delivery,
63 Added: min_reps > 0 && max_reps >= min_reps,
64 Added: within_limits rep_range,
65 Added: unpermitted )
66 Added: with
67 Added: | Pre_exhaust { isolation; compound }, _, _, _
66 68 when not (Exercise.may_pre_exhaust ~isolation ~compound) ->
67 69 raise
68 70 (Invalid
@@ -71,8 +73,10 @@
71 73 isolation = Exercise.id isolation;
72 74 compound = Exercise.id compound;
73 75 }))
74 Removed: | _, false, _ -> raise (Invalid Reps_outside_limits)
75 Removed: | _, _, Some candidate ->
76 Added: | _, false, _, _ ->
77 Added: raise (Invalid (Invalid_rep_range { min_reps; max_reps }))
78 Added: | _, _, false, _ -> raise (Invalid Reps_outside_limits)
79 Added: | _, _, _, Some candidate ->
76 80 raise (Invalid (Substitute_not_permitted (Exercise.id candidate)))
77 81 | _ -> { delivery; rep_range; allowed_substitutes }
78 82
@@ -87,8 +91,9 @@
87 91 compound
88 92
89 93 let pp ppf t =
90 Removed: Format.fprintf ppf "%a for %a reps" pp_delivery t.delivery
91 Removed: Units.Rep_range.pp t.rep_range
94 Added: let min_reps, max_reps = t.rep_range in
95 Added: Format.fprintf ppf "%a for %d-%d reps" pp_delivery t.delivery min_reps
96 Added: max_reps
92 97 end
93 98
94 99 module Workout = struct
@@ -146,13 +151,7 @@
146 151 | None -> invalid_arg (Format.sprintf "Routine preset: no exercise %S" id)
147 152
148 153 (* HD1's guideline window for every listed exercise. *)
149 Removed: let six_to_ten =
150 Removed: let reps n =
151 Removed: match Units.Reps.of_int n with Ok r -> r | Error _ -> assert false
152 Removed: in
153 Removed: match Units.Rep_range.make ~min:(reps 6) ~max:(reps 10) with
154 Removed: | Ok r -> r
155 Removed: | Error _ -> assert false
154 Added: let six_to_ten = (6, 10)
156 155
157 156 let prescribe ?(substitutes = []) delivery =
158 157 Stimulus.make ~delivery ~rep_range:six_to_ten
lib/core/prescription.mli
index 3865125b..0dc1a11a 100644..100644
@@ -11,25 +11,26 @@
11 11
12 12 type error =
13 13 | Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
14 Added: | Invalid_rep_range of { min_reps : int; max_reps : int }
14 15 | Reps_outside_limits
15 16 | Substitute_not_permitted of Exercise.id
16 17
17 18 val pp_error : Format.formatter -> error -> unit
18 19
19 Removed: val rep_limits : Units.Rep_range.t
20 Added: val rep_limits : int * int
20 21 (** 6-12; every prescribed range must lie within it. *)
21 22
22 23 exception Invalid of error
23 24
24 25 val make :
25 26 delivery:delivery ->
26 Removed: rep_range:Units.Rep_range.t ->
27 Added: rep_range:int * int ->
27 28 allowed_substitutes:Exercise.t list ->
28 29 t
29 30 (** Raises [Invalid] for an invalid pairing, range, or substitution. *)
30 31
31 32 val delivery : t -> delivery
32 Removed: val rep_range : t -> Units.Rep_range.t
33 Added: val rep_range : t -> int * int
33 34 val allowed_substitutes : t -> Exercise.t list
34 35
35 36 val exercises : t -> Exercise.t list
lib/core/progression.ml
index 8627efb1..6503f9dd 100644..100644
@@ -2,11 +2,9 @@
2 2
3 3 let beats ~previous ~current =
4 4 let load =
5 Removed: Units.Weight.compare (Movement.load current) (Movement.load previous)
5 Added: Float.compare (Movement.load_kg current) (Movement.load_kg previous)
6 6 in
7 Removed: let reps =
8 Removed: Units.Reps.compare (Movement.reps current) (Movement.reps previous)
9 Removed: in
7 Added: let reps = Int.compare (Movement.reps current) (Movement.reps previous) in
10 8 load > 0 || (load = 0 && reps > 0)
11 9
12 10 type assessment = Progressing | Stalled
@@ -81,37 +79,26 @@
81 79 Recovery.pp_duration lay_off drop_stimuli_per_workout Recovery.pp_duration
82 80 extra_rest
83 81
84 Removed: let load_increase_trigger =
85 Removed: match Units.Reps.of_int 12 with Ok r -> r | Error _ -> assert false
82 Added: let load_increase_trigger = 12
83 Added: let load_increase ~current_kg = (current_kg *. 1.10, current_kg *. 1.20)
86 84
87 Removed: let load_increase ~current =
88 Removed: let scale factor =
89 Removed: Units.Weight.of_kg (Units.Weight.to_kg current *. factor)
90 Removed: |> Result.value ~default:current
91 Removed: in
92 Removed: (scale 1.10, scale 1.20)
85 Added: type load_verdict = Hold | Increase of float * float | Too_heavy
93 86
94 Removed: type load_verdict =
95 Removed: | Hold
96 Removed: | Increase of Units.Weight.t * Units.Weight.t
97 Removed: | Too_heavy
98 Removed:
99 87 (* The trigger is absolute, so the window's ceiling never gates the verdict —
100 88 only its floor does. *)
101 89 let judge_load ~rep_range movement =
102 90 let reps = Movement.reps movement in
103 Removed: if Units.Reps.compare reps load_increase_trigger >= 0 then
104 Removed: let low, high = load_increase ~current:(Movement.load movement) in
91 Added: let min_reps, _ = rep_range in
92 Added: if reps >= load_increase_trigger then
93 Added: let low, high = load_increase ~current_kg:(Movement.load_kg movement) in
105 94 Increase (low, high)
106 Removed: else if Units.Reps.compare reps (Units.Rep_range.min rep_range) < 0 then
107 Removed: Too_heavy
95 Added: else if reps < min_reps then Too_heavy
108 96 else Hold
109 97
110 98 let pp_load_verdict ppf = function
111 99 | Hold -> Format.pp_print_string ppf "hold the load"
112 100 | Increase (low, high) ->
113 Removed: Format.fprintf ppf "raise the load to %a-%a" Units.Weight.pp low
114 Removed: Units.Weight.pp high
101 Added: Format.fprintf ppf "raise the load to %g-%g kg" low high
115 102 | Too_heavy -> Format.pp_print_string ppf "load is too heavy for the window"
116 103
117 104 type diagnostic =
lib/core/progression.mli
index 931cf664..a7d71d6d 100644..100644
@@ -24,19 +24,16 @@
24 24
25 25 val pp_remedy : Format.formatter -> remedy -> unit
26 26
27 Removed: val load_increase_trigger : Units.Reps.t
27 Added: val load_increase_trigger : int
28 28 (** 12 reps, regardless of the prescribed range. *)
29 29
30 Removed: val load_increase : current:Units.Weight.t -> Units.Weight.t * Units.Weight.t
30 Added: val load_increase : current_kg:float -> float * float
31 31 (** 10-20% increase window. *)
32 32
33 Removed: type load_verdict =
34 Removed: | Hold
35 Removed: | Increase of Units.Weight.t * Units.Weight.t
36 Removed: | Too_heavy
33 Added: type load_verdict = Hold | Increase of float * float | Too_heavy
37 34
38 35 val judge_load :
39 Removed: rep_range:Units.Rep_range.t -> Evidence.Stimulus.Movement.t -> load_verdict
36 Added: rep_range:int * int -> Evidence.Stimulus.Movement.t -> load_verdict
40 37 (** Only the range floor matters: below it is [Too_heavy]; at twelve reps the
41 38 verdict is [Increase]. *)
42 39
lib/core/units.ml
index ecc0020c..00000000 100644..000000
@@ -1,43 +0,0 @@
1 Removed: type error = Negative | Not_positive | Inverted_range
2 Removed:
3 Removed: let pp_error ppf = function
4 Removed: | Negative -> Format.pp_print_string ppf "must be zero or greater"
5 Removed: | Not_positive -> Format.pp_print_string ppf "must be greater than zero"
6 Removed: | Inverted_range -> Format.pp_print_string ppf "lower bound exceeds upper"
7 Removed:
8 Removed: module Weight = struct
9 Removed: type t = float
10 Removed:
11 Removed: let of_kg kg =
12 Removed: if Float.is_finite kg && kg >= 0. then Ok kg else Error Negative
13 Removed:
14 Removed: let to_kg t = t
15 Removed: let compare = Float.compare
16 Removed: let equal = Float.equal
17 Removed: let pp ppf t = Format.fprintf ppf "%g kg" t
18 Removed: end
19 Removed:
20 Removed: module Reps = struct
21 Removed: type t = int
22 Removed:
23 Removed: let of_int n = if n > 0 then Ok n else Error Not_positive
24 Removed: let to_int t = t
25 Removed: let compare = Int.compare
26 Removed: let equal = Int.equal
27 Removed: let pp ppf t = Format.fprintf ppf "%d" t
28 Removed: end
29 Removed:
30 Removed: module Rep_range = struct
31 Removed: type t = { min : Reps.t; max : Reps.t }
32 Removed:
33 Removed: let make ~min ~max =
34 Removed: if Reps.compare min max <= 0 then Ok { min; max } else Error Inverted_range
35 Removed:
36 Removed: let min t = t.min
37 Removed: let max t = t.max
38 Removed:
39 Removed: let contains t reps =
40 Removed: Reps.compare reps t.min >= 0 && Reps.compare reps t.max <= 0
41 Removed:
42 Removed: let pp ppf t = Format.fprintf ppf "%a-%a" Reps.pp t.min Reps.pp t.max
43 Removed: end
lib/core/units.mli
index f4914720..00000000 100644..000000
@@ -1,41 +0,0 @@
1 Removed: (** Validated training quantities. *)
2 Removed:
3 Removed: type error =
4 Removed: | Negative (** Negative or non-finite value. *)
5 Removed: | Not_positive (** Non-positive value. *)
6 Removed: | Inverted_range (** Lower bound exceeds upper bound. *)
7 Removed:
8 Removed: val pp_error : Format.formatter -> error -> unit
9 Removed:
10 Removed: (** Nonnegative kilograms; zero is valid for body-weight movements. *)
11 Removed: module Weight : sig
12 Removed: type t
13 Removed:
14 Removed: val of_kg : float -> (t, error) result
15 Removed: val to_kg : t -> float
16 Removed: val compare : t -> t -> int
17 Removed: val equal : t -> t -> bool
18 Removed: val pp : Format.formatter -> t -> unit
19 Removed: end
20 Removed:
21 Removed: (** Strictly positive completed repetitions. *)
22 Removed: module Reps : sig
23 Removed: type t
24 Removed:
25 Removed: val of_int : int -> (t, error) result
26 Removed: val to_int : t -> int
27 Removed: val compare : t -> t -> int
28 Removed: val equal : t -> t -> bool
29 Removed: val pp : Format.formatter -> t -> unit
30 Removed: end
31 Removed:
32 Removed: (** Inclusive load-calibration range. *)
33 Removed: module Rep_range : sig
34 Removed: type t
35 Removed:
36 Removed: val make : min:Reps.t -> max:Reps.t -> (t, error) result
37 Removed: val min : t -> Reps.t
38 Removed: val max : t -> Reps.t
39 Removed: val contains : t -> Reps.t -> bool
40 Removed: val pp : Format.formatter -> t -> unit
41 Removed: end
lib/web/pages.ml
index 7006fd8e..1ea78bb3 100644..100644
@@ -89,10 +89,8 @@
89 89 (* A prescribed stimulus described in words: the movements, and the rep window
90 90 that calibrates the load. *)
91 91 let describe_prescription p =
92 Removed: let window =
93 Removed: Format.asprintf "%a reps" Units.Rep_range.pp
94 Removed: (Prescription.Stimulus.rep_range p)
95 Removed: in
92 Added: let min_reps, max_reps = Prescription.Stimulus.rep_range p in
93 Added: let window = Printf.sprintf "%d-%d reps" min_reps max_reps in
96 94 match Prescription.Stimulus.delivery p with
97 95 | Prescription.Stimulus.Single e ->
98 96 Printf.sprintf "%s — %s" (Exercise.name e) window
@@ -328,11 +326,9 @@
328 326
329 327 let describe_stimulus s =
330 328 let movement m =
331 Removed: Format.asprintf "%s %a x %a"
329 Added: Format.asprintf "%s %g kg x %d"
332 330 (Exercise.name (Evidence.Stimulus.Movement.exercise m))
333 Removed: Units.Weight.pp
334 Removed: (Evidence.Stimulus.Movement.load m)
335 Removed: Units.Reps.pp
331 Added: (Evidence.Stimulus.Movement.load_kg m)
336 332 (Evidence.Stimulus.Movement.reps m)
337 333 in
338 334 let body =
lib/web/services.ml
index 42050c61..13e55ce0 100644..100644
@@ -89,15 +89,19 @@
89 89 ~detail:"That routine is not in the catalogue."));
90 90
91 91 let build_movement ~exercise ~load ~reps ~extension =
92 Removed: match (Units.Weight.of_kg load, Units.Reps.of_int reps) with
93 Removed: | Ok load, Ok reps ->
94 Removed: let outcome =
95 Removed: match extension with
96 Removed: | None -> Evidence.Stimulus.Positive_failure
97 Removed: | Some e -> Evidence.Stimulus.Beyond_failure (e, [])
98 Removed: in
99 Removed: Ok (Evidence.Stimulus.Movement.make ~exercise ~load ~reps ~outcome)
100 Removed: | Error e, _ | _, Error e -> Error (Format.asprintf "%a" Units.pp_error e)
92 Added: let outcome =
93 Added: match extension with
94 Added: | None -> Evidence.Stimulus.Positive_failure
95 Added: | Some e -> Evidence.Stimulus.Beyond_failure (e, [])
96 Added: in
97 Added: try
98 Added: Ok
99 Added: (Evidence.Stimulus.Movement.make ~exercise ~load_kg:load ~reps ~outcome)
100 Added: with
101 Added: | Evidence.Stimulus.Movement.Invalid Invalid_load ->
102 Added: Error "Load must be finite and nonnegative."
103 Added: | Evidence.Stimulus.Movement.Invalid Invalid_reps ->
104 Added: Error "Reps must be positive."
101 105 in
102 106
103 107 (* The slot names which prescribed stimulus is being answered. *)
test/dune
index 2881db49..d5eb891b 100644..100644
@@ -2,7 +2,6 @@
2 2 (name test_hito)
3 3 (modules
4 4 test_hito
5 Removed: test_units
6 5 test_exercise
7 6 test_recovery
8 7 test_prescription
test/test_evidence.ml
index f9e6a491..6ae88ddb 100644..100644
@@ -11,13 +11,13 @@
11 11 | Some e -> e
12 12 | None -> Alcotest.failf "catalog is missing %S" id
13 13
14 Removed: let kg n = ok (Units.Weight.of_kg n)
15 Removed: let reps n = ok (Units.Reps.of_int n)
14 Added: let kg n = n
15 Added: let reps n = n
16 16 let at s = Recovery.timestamp_of_unix_seconds s
17 17 let day n = at (n * 86_400)
18 18
19 19 let move ?(outcome = Stimulus.Positive_failure) id load r =
20 Removed: Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
20 Added: Stimulus.Movement.make ~exercise:(get id) ~load_kg:(kg load) ~reps:(reps r)
21 21 ~outcome
22 22
23 23 let single id load r = Stimulus.make (Stimulus.Single (move id load r))
@@ -360,8 +360,7 @@
360 360 Alcotest.(check (list (float 0.001)))
361 361 "12kg then 14kg" [ 12.; 14. ]
362 362 (List.map
363 Removed: (fun (o : Log.observation) ->
364 Removed: Units.Weight.to_kg (Stimulus.Movement.load o.movement))
363 Added: (fun (o : Log.observation) -> Stimulus.Movement.load_kg o.movement)
365 364 history) );
366 365 ( "observations are dated, so a stall can be measured",
367 366 `Quick,
test/test_hito.ml
index 144674cc..1ac78399 100644..100644
@@ -6,6 +6,5 @@
6 6
7 7 let () =
8 8 Alcotest.run "hito"
9 Removed: (Test_units.suite @ Test_exercise.suite @ Test_recovery.suite
10 Removed: @ Test_prescription.suite @ Test_evidence.suite @ Test_progression.suite
11 Removed: @ Test_service.suite)
9 Added: (Test_exercise.suite @ Test_recovery.suite @ Test_prescription.suite
10 Added: @ Test_evidence.suite @ Test_progression.suite @ Test_service.suite)
test/test_prescription.ml
index 54b89f84..a6237684 100644..100644
@@ -8,10 +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 =
12 Removed: let reps n = ok (Units.Reps.of_int n) in
13 Removed: ok (Units.Rep_range.make ~min:(reps lo) ~max:(reps hi))
14 Removed:
11 Added: let range lo hi = (lo, hi)
15 12 let six_to_ten = range 6 10
16 13
17 14 let prescribe ?(substitutes = []) delivery =
@@ -71,14 +68,9 @@
71 68 ( "rep_limits is HD1's 6-12 stimulus window",
72 69 `Quick,
73 70 fun () ->
74 Removed: Alcotest.(check int)
75 Removed: "min 6" 6
76 Removed: (Units.Reps.to_int
77 Removed: (Units.Rep_range.min Prescription.Stimulus.rep_limits));
78 Removed: Alcotest.(check int)
79 Removed: "max 12" 12
80 Removed: (Units.Reps.to_int
81 Removed: (Units.Rep_range.max Prescription.Stimulus.rep_limits)) );
71 Added: Alcotest.(check int) "min 6" 6 (fst Prescription.Stimulus.rep_limits);
72 Added: Alcotest.(check int) "max 12" 12 (snd Prescription.Stimulus.rep_limits)
73 Added: );
82 74 ( "a window inside the limits is accepted",
83 75 `Quick,
84 76 fun () ->
test/test_progression.ml
index fe776421..c4afac85 100644..100644
@@ -10,16 +10,16 @@
10 10 | Some e -> e
11 11 | None -> Alcotest.failf "catalog is missing %S" id
12 12
13 Removed: let kg n = ok (Units.Weight.of_kg n)
14 Removed: let reps n = ok (Units.Reps.of_int n)
13 Added: let kg 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 range lo hi = ok (Units.Rep_range.make ~min:(reps lo) ~max:(reps hi))
18 Added: let range lo hi = (lo, hi)
19 19 let six_to_ten = range 6 10
20 20
21 21 let move ?(outcome = Stimulus.Positive_failure) ?(id = "laterals") load r =
22 Removed: Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
22 Added: Stimulus.Movement.make ~exercise:(get id) ~load_kg:(kg load) ~reps:(reps r)
23 23 ~outcome
24 24
25 25 (* An observation is a public record, so evidence can be written directly. *)
@@ -110,15 +110,13 @@
110 110 ( "the load rises at twelve reps",
111 111 `Quick,
112 112 fun () ->
113 Removed: Alcotest.(check int)
114 Removed: "trigger" 12
115 Removed: (Units.Reps.to_int Progression.load_increase_trigger) );
113 Added: Alcotest.(check int) "trigger" 12 Progression.load_increase_trigger );
116 114 ( "the increase is a 10-20% window",
117 115 `Quick,
118 116 fun () ->
119 Removed: let low, high = Progression.load_increase ~current:(kg 100.) in
120 Removed: Alcotest.(check (float 0.001)) "110kg" 110. (Units.Weight.to_kg low);
121 Removed: Alcotest.(check (float 0.001)) "120kg" 120. (Units.Weight.to_kg high) );
117 Added: let low, high = Progression.load_increase ~current_kg:(kg 100.) in
118 Added: Alcotest.(check (float 0.001)) "110kg" 110. low;
119 Added: Alcotest.(check (float 0.001)) "120kg" 120. high );
122 120 ( "inside the window the load holds",
123 121 `Quick,
124 122 fun () ->
@@ -139,9 +137,8 @@
139 137 fun () ->
140 138 match Progression.judge_load ~rep_range:six_to_ten (move 100. 12) with
141 139 | Progression.Increase (low, high) ->
142 Removed: Alcotest.(check (float 0.001)) "110kg" 110. (Units.Weight.to_kg low);
143 Removed: Alcotest.(check (float 0.001))
144 Removed: "120kg" 120. (Units.Weight.to_kg high)
140 Added: Alcotest.(check (float 0.001)) "110kg" 110. low;
141 Added: Alcotest.(check (float 0.001)) "120kg" 120. high
145 142 | _ -> Alcotest.fail "expected Increase" );
146 143 ( "failing below the window means the load is too heavy",
147 144 `Quick,
test/test_service.ml
index e6593ad0..7bc1e95b 100644..100644
@@ -12,15 +12,15 @@
12 12 | Some e -> e
13 13 | None -> Alcotest.failf "catalog is missing %S" id
14 14
15 Removed: let kg n = ok (Units.Weight.of_kg n)
16 Removed: let reps n = ok (Units.Reps.of_int n)
15 Added: let kg 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"
20 20 let service () = S.make ~repo:(Memory_repo.create ())
21 21
22 22 let move id load r =
23 Removed: Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
23 Added: Stimulus.Movement.make ~exercise:(get id) ~load_kg:(kg load) ~reps:(reps r)
24 24 ~outcome:Stimulus.Positive_failure
25 25
26 26 let single id load r = Stimulus.make (Stimulus.Single (move id load r))
test/test_units.ml
index 9c0ee182..00000000 100644..000000
@@ -1,133 +0,0 @@
1 Removed: (** Unit tests for {!Units}, authored against the units.mli contract.
2 Removed:
3 Removed: Per project policy units.mli is the source of truth: if any assertion here
4 Removed: contradicts the interface, the interface wins and the test is fixed. *)
5 Removed:
6 Removed: let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
7 Removed: let reps n = ok (Units.Reps.of_int n)
8 Removed:
9 Removed: let weight_tests =
10 Removed: [
11 Removed: ( "of_kg rejects negative",
12 Removed: `Quick,
13 Removed: fun () ->
14 Removed: Alcotest.(check bool)
15 Removed: "negative rejected" true
16 Removed: (Result.is_error (Units.Weight.of_kg (-1.0))) );
17 Removed: ( "of_kg rejects non-finite",
18 Removed: `Quick,
19 Removed: fun () ->
20 Removed: Alcotest.(check bool)
21 Removed: "nan rejected" true
22 Removed: (Result.is_error (Units.Weight.of_kg Float.nan));
23 Removed: Alcotest.(check bool)
24 Removed: "infinity rejected" true
25 Removed: (Result.is_error (Units.Weight.of_kg Float.infinity)) );
26 Removed: ( "of_kg accepts zero for body-weight movements",
27 Removed: `Quick,
28 Removed: fun () ->
29 Removed: let zero = ok (Units.Weight.of_kg 0.0) in
30 Removed: Alcotest.(check (float 0.0001)) "0kg" 0.0 (Units.Weight.to_kg zero) );
31 Removed: ( "round-trips kilograms",
32 Removed: `Quick,
33 Removed: fun () ->
34 Removed: let w = ok (Units.Weight.of_kg 60.0) in
35 Removed: Alcotest.(check (float 0.0001)) "60kg" 60.0 (Units.Weight.to_kg w) );
36 Removed: ( "orders by load",
37 Removed: `Quick,
38 Removed: fun () ->
39 Removed: let light = ok (Units.Weight.of_kg 40.0) in
40 Removed: let heavy = ok (Units.Weight.of_kg 60.0) in
41 Removed: Alcotest.(check bool)
42 Removed: "40 < 60" true
43 Removed: (Units.Weight.compare light heavy < 0);
44 Removed: Alcotest.(check bool)
45 Removed: "60 = 60" true
46 Removed: (Units.Weight.equal heavy (ok (Units.Weight.of_kg 60.0))) );
47 Removed: ]
48 Removed:
49 Removed: let reps_tests =
50 Removed: [
51 Removed: ( "of_int rejects zero",
52 Removed: `Quick,
53 Removed: fun () ->
54 Removed: Alcotest.(check bool)
55 Removed: "zero rejected" true
56 Removed: (Result.is_error (Units.Reps.of_int 0)) );
57 Removed: ( "of_int rejects negative",
58 Removed: `Quick,
59 Removed: fun () ->
60 Removed: Alcotest.(check bool)
61 Removed: "negative rejected" true
62 Removed: (Result.is_error (Units.Reps.of_int (-3))) );
63 Removed: ( "of_int accepts positive",
64 Removed: `Quick,
65 Removed: fun () ->
66 Removed: Alcotest.(check bool)
67 Removed: "positive accepted" true
68 Removed: (Result.is_ok (Units.Reps.of_int 8)) );
69 Removed: ( "round-trips and orders",
70 Removed: `Quick,
71 Removed: fun () ->
72 Removed: Alcotest.(check int) "8" 8 (Units.Reps.to_int (reps 8));
73 Removed: Alcotest.(check bool)
74 Removed: "6 < 10" true
75 Removed: (Units.Reps.compare (reps 6) (reps 10) < 0);
76 Removed: Alcotest.(check bool) "8 = 8" true (Units.Reps.equal (reps 8) (reps 8))
77 Removed: );
78 Removed: ]
79 Removed:
80 Removed: let rep_range_tests =
81 Removed: [
82 Removed: ( "make rejects inverted range",
83 Removed: `Quick,
84 Removed: fun () ->
85 Removed: Alcotest.(check bool)
86 Removed: "inverted rejected" true
87 Removed: (Result.is_error (Units.Rep_range.make ~min:(reps 10) ~max:(reps 6)))
88 Removed: );
89 Removed: ( "make accepts a single-rep band",
90 Removed: `Quick,
91 Removed: fun () ->
92 Removed: Alcotest.(check bool)
93 Removed: "min = max accepted" true
94 Removed: (Result.is_ok (Units.Rep_range.make ~min:(reps 8) ~max:(reps 8))) );
95 Removed: ( "HD1's 6-10 window contains its interior and bounds",
96 Removed: `Quick,
97 Removed: fun () ->
98 Removed: let r = ok (Units.Rep_range.make ~min:(reps 6) ~max:(reps 10)) in
99 Removed: Alcotest.(check bool)
100 Removed: "contains 8" true
101 Removed: (Units.Rep_range.contains r (reps 8));
102 Removed: Alcotest.(check bool)
103 Removed: "contains 6" true
104 Removed: (Units.Rep_range.contains r (reps 6));
105 Removed: Alcotest.(check bool)
106 Removed: "contains 10" true
107 Removed: (Units.Rep_range.contains r (reps 10)) );
108 Removed: ( "excludes reps outside the window",
109 Removed: `Quick,
110 Removed: fun () ->
111 Removed: let r = ok (Units.Rep_range.make ~min:(reps 6) ~max:(reps 10)) in
112 Removed: Alcotest.(check bool)
113 Removed: "excludes 5" false
114 Removed: (Units.Rep_range.contains r (reps 5));
115 Removed: Alcotest.(check bool)
116 Removed: "excludes 12" false
117 Removed: (Units.Rep_range.contains r (reps 12)) );
118 Removed: ( "exposes its bounds",
119 Removed: `Quick,
120 Removed: fun () ->
121 Removed: let r = ok (Units.Rep_range.make ~min:(reps 6) ~max:(reps 10)) in
122 Removed: Alcotest.(check int) "min" 6 (Units.Reps.to_int (Units.Rep_range.min r));
123 Removed: Alcotest.(check int)
124 Removed: "max" 10
125 Removed: (Units.Reps.to_int (Units.Rep_range.max r)) );
126 Removed: ]
127 Removed:
128 Removed: let suite =
129 Removed: [
130 Removed: ("units.weight", weight_tests);
131 Removed: ("units.reps", reps_tests);
132 Removed: ("units.rep_range", rep_range_tests);
133 Removed: ]