[OCaml] High Intensity Training Online
refactor group plans and records by domain role
Prescription and Evidence now make the plan/record distinction structural: plans progress from stimulus to workout to routine, while records progress from stimulus to workout to log. This removes the ambiguous top-level Prescription/Workout_prescription pairing without pretending that a routine cycle and an accumulated log are equivalent. The move preserves distinct error types per submodule. Evidence still records extra volume and early training; Progression remains the only judge. Its load-verdict contract now states and tests HD1's absolute twelve-rep trigger: a rep range's floor detects an excessive load, while its ceiling allows the specified slack before load rises.
Changed files
- lib/app/memory_repo.ml
- lib/app/repository.ml
- lib/app/repository.mli
- lib/app/service.ml
- lib/app/service.mli
- lib/core/dune
- lib/core/entry.ml
- lib/core/entry.mli
- lib/core/evidence.ml
- lib/core/evidence.mli
- lib/core/logbook.ml
- lib/core/logbook.mli
- lib/core/prescription.ml
- lib/core/prescription.mli
- lib/core/progression.ml
- lib/core/progression.mli
- lib/core/routine.ml
- lib/core/routine.mli
- lib/core/stimulus.ml
- lib/core/stimulus.mli
- lib/core/workout_prescription.ml
- lib/core/workout_prescription.mli
- lib/web/pages.ml
- lib/web/pages.mli
- lib/web/routes.ml
- lib/web/services.ml
- test/dune
- test/test_entry.ml
- test/test_evidence.ml
- test/test_hito.ml
- test/test_logbook.ml
- test/test_prescription.ml
- test/test_progression.ml
- test/test_routine.ml
- test/test_service.ml
- test/test_stimulus.ml
- test/test_workout_prescription.ml
lib/app/memory_repo.ml
@@ -1,14 +1,14 @@
1
1
type t = {
2
Removed:
routines : (Repository.routine_id * Routine.t) list;
3
Removed:
mutable log : Logbook.t;
2
Added:
routines : (Repository.routine_id * Prescription.Routine.t) list;
3
Added:
mutable stored_log : Evidence.Log.t;
4
4
mutable stored : Repository.record list; (* most recent first *)
5
5
mutable next_id : int;
6
6
}
7
7
8
8
let create () =
9
9
{
10
Removed:
routines = [ (Repository.routine_id "ideal", Routine.ideal_routine) ];
11
Removed:
log = Logbook.empty;
10
Added:
routines = [ (Repository.routine_id "ideal", Prescription.Routine.ideal) ];
11
Added:
stored_log = Evidence.Log.empty;
12
12
stored = [];
13
13
next_id = 1;
14
14
}
@@ -16,13 +16,13 @@
16
16
let list_routines t = t.routines
17
17
let find_routine t id = List.assoc_opt id t.routines
18
18
19
Removed:
let save t entry =
19
Added:
let save t workout =
20
20
let id = Repository.workout_id (Printf.sprintf "w%d" t.next_id) in
21
Removed:
let record = { Repository.id; entry } in
21
Added:
let record = { Repository.id; workout } in
22
22
t.next_id <- t.next_id + 1;
23
Removed:
t.log <- Logbook.add t.log entry;
23
Added:
t.stored_log <- Evidence.Log.add t.stored_log workout;
24
24
t.stored <- record :: t.stored;
25
25
record
26
26
27
Removed:
let logbook t = t.log
27
Added:
let log t = t.stored_log
28
28
let history t = t.stored
lib/app/repository.ml
@@ -5,14 +5,15 @@
5
5
let workout_id s = s
6
6
7
7
(* Fields are reached through the module type, not from here. *)
8
Removed:
type record = { id : workout_id; entry : Entry.t } [@@warning "-69"]
8
Added:
type record = { id : workout_id; workout : Evidence.Workout.t }
9
Added:
[@@warning "-69"]
9
10
10
11
module type S = sig
11
12
type t
12
13
13
Removed:
val list_routines : t -> (routine_id * Routine.t) list
14
Removed:
val find_routine : t -> routine_id -> Routine.t option
15
Removed:
val save : t -> Entry.t -> record
16
Removed:
val logbook : t -> Logbook.t
14
Added:
val list_routines : t -> (routine_id * Prescription.Routine.t) list
15
Added:
val find_routine : t -> routine_id -> Prescription.Routine.t option
16
Added:
val save : t -> Evidence.Workout.t -> record
17
Added:
val log : t -> Evidence.Log.t
17
18
val history : t -> record list
18
19
end
lib/app/repository.mli
@@ -9,21 +9,21 @@
9
9
val routine_id : string -> routine_id
10
10
val workout_id : string -> workout_id
11
11
12
Removed:
type record = { id : workout_id; entry : Entry.t }
13
Removed:
(** A stored workout. The entry already knows its prescription, its timestamps,
14
Removed:
and the basis on which it was begun. *)
12
Added:
type record = { id : workout_id; workout : Evidence.Workout.t }
13
Added:
(** A stored workout. It already knows its prescription, its timestamps, and the
14
Added:
basis on which it was begun. *)
15
15
16
16
module type S = sig
17
17
type t
18
18
19
Removed:
val list_routines : t -> (routine_id * Routine.t) list
20
Removed:
val find_routine : t -> routine_id -> Routine.t option
19
Added:
val list_routines : t -> (routine_id * Prescription.Routine.t) list
20
Added:
val find_routine : t -> routine_id -> Prescription.Routine.t option
21
21
22
Removed:
val save : t -> Entry.t -> record
23
Removed:
(** Store the entry under an identity the adapter assigns. Callers do not
22
Added:
val save : t -> Evidence.Workout.t -> record
23
Added:
(** Store the workout under an identity the adapter assigns. Callers do not
24
24
invent identifiers. *)
25
25
26
Removed:
val logbook : t -> Logbook.t
26
Added:
val log : t -> Evidence.Log.t
27
27
(** The stored log — the only source of evidence. *)
28
28
29
29
val history : t -> record list
lib/app/service.ml
@@ -1,5 +1,5 @@
1
1
module Make (R : Repository.S) = struct
2
Removed:
type t = { repo : R.t; mutable current : Entry.t option }
2
Added:
type t = { repo : R.t; mutable current : Evidence.Workout.t option }
3
3
4
4
let make ~repo = { repo; current = None }
5
5
let list_routines t = R.list_routines t.repo
@@ -18,34 +18,34 @@
18
18
19
19
(* Where the cycle stands. With nothing logged, start at the beginning. *)
20
20
let next_of routine log =
21
Removed:
match Logbook.last_prescription log with
22
Removed:
| Some last -> Routine.workout_after routine last
23
Removed:
| None -> List.hd (Routine.workouts routine)
21
Added:
match Evidence.Log.last_prescription log with
22
Added:
| Some last -> Prescription.Routine.workout_after routine last
23
Added:
| None -> List.hd (Prescription.Routine.workouts routine)
24
24
25
25
let next_workout t ~routine:id =
26
Removed:
Result.map (fun r -> next_of r (R.logbook t.repo)) (routine t id)
26
Added:
Result.map (fun r -> next_of r (R.log t.repo)) (routine t id)
27
27
28
28
(* How long HD1 asks you to rest depends on where in the cycle you are, so
29
29
the recommendation comes from the last workout performed. *)
30
30
let recommended routine log =
31
Removed:
match Logbook.last_prescription log with
32
Removed:
| Some last -> Routine.recovery_after routine last
33
Removed:
| None -> Routine.training_interval
31
Added:
match Evidence.Log.last_prescription log with
32
Added:
| Some last -> Prescription.Routine.recovery_after routine last
33
Added:
| None -> Prescription.Routine.training_interval
34
34
35
35
let readiness t ~routine:id ~now =
36
36
Result.map
37
37
(fun r ->
38
Removed:
let log = R.logbook t.repo in
39
Removed:
Logbook.readiness log ~now ~recommended:(recommended r log))
38
Added:
let log = R.log t.repo in
39
Added:
Evidence.Log.readiness log ~now ~recommended:(recommended r log))
40
40
(routine t id)
41
41
42
42
let begin_workout t ~routine:id ~now ?override () =
43
43
match routine t id with
44
44
| Error e -> Error e
45
45
| Ok r -> (
46
Removed:
let log = R.logbook t.repo in
46
Added:
let log = R.log t.repo in
47
47
let readiness =
48
Removed:
Logbook.readiness log ~now ~recommended:(recommended r log)
48
Added:
Evidence.Log.readiness log ~now ~recommended:(recommended r log)
49
49
in
50
50
let clearance =
51
51
match (Recovery.clear readiness, override) with
@@ -56,26 +56,26 @@
56
56
match clearance with
57
57
| None -> Error (Not_recovered readiness)
58
58
| Some clearance ->
59
Removed:
let entry =
60
Removed:
Entry.start (next_of r log) ~clearance ~started_at:now
59
Added:
let workout =
60
Added:
Evidence.Workout.start (next_of r log) ~clearance ~started_at:now
61
61
in
62
Removed:
t.current <- Some entry;
63
Removed:
Ok entry)
62
Added:
t.current <- Some workout;
63
Added:
Ok workout)
64
64
65
65
let in_progress t = t.current
66
66
67
Removed:
type log_error = No_workout_in_progress | Rejected of Entry.error
67
Added:
type log_error = No_workout_in_progress | Rejected of Evidence.Workout.error
68
68
69
69
let pp_log_error ppf = function
70
70
| No_workout_in_progress ->
71
71
Format.pp_print_string ppf "no workout in progress"
72
Removed:
| Rejected e -> Entry.pp_error ppf e
72
Added:
| Rejected e -> Evidence.Workout.pp_error ppf e
73
73
74
74
let log t stimulus =
75
75
match t.current with
76
76
| None -> Error No_workout_in_progress
77
Removed:
| Some entry -> (
78
Removed:
match Entry.add_stimulus entry stimulus with
77
Added:
| Some workout -> (
78
Added:
match Evidence.Workout.add_stimulus workout stimulus with
79
79
| Error e -> Error (Rejected e)
80
80
| Ok updated ->
81
81
t.current <- Some updated;
@@ -84,11 +84,13 @@
84
84
let finish t ~ended_at =
85
85
match t.current with
86
86
| None -> None
87
Removed:
| Some entry ->
88
Removed:
(* [current] only ever holds an unfinished entry — it is cleared the
87
Added:
| Some workout ->
88
Added:
(* [current] only ever holds an unfinished workout — it is cleared the
89
89
moment one is finished — so this cannot fail. *)
90
90
let finished =
91
Removed:
Result.value (Entry.finish entry ~ended_at) ~default:entry
91
Added:
Result.value
92
Added:
(Evidence.Workout.finish workout ~ended_at)
93
Added:
~default:workout
92
94
in
93
95
let record = R.save t.repo finished in
94
96
t.current <- None;
@@ -97,7 +99,8 @@
97
99
let history t = R.history t.repo
98
100
99
101
let progress t exercise =
100
Removed:
Progression.assess (Logbook.evidence (R.logbook t.repo) exercise)
102
Added:
Progression.assess (Evidence.Log.observations (R.log t.repo) exercise)
101
103
102
Removed:
let diagnostics t = Progression.diagnose (Logbook.entries (R.logbook t.repo))
104
Added:
let diagnostics t =
105
Added:
Progression.diagnose (Evidence.Log.workouts (R.log t.repo))
103
106
end
lib/app/service.mli
@@ -1,12 +1,12 @@
1
1
(** Application service: orchestrates the core over a {!Repository.S}. The API a
2
2
client calls — no Eliom, no HTML, no serialization.
3
3
4
Removed:
Recovery gating lives here, not in the client. {!Entry.start} demands a
5
Removed:
{!Recovery.clearance}, and this module is the only thing that decides how
6
Removed:
one is obtained: earned by having rested, or taken deliberately through
7
Removed:
{!begin_workout}'s [?override] with a stated reason. Putting that policy
8
Removed:
here means a native client cannot quietly adopt looser rules than the web
9
Removed:
one. *)
4
Added:
Recovery gating lives here, not in the client. {!Evidence.Workout.start}
5
Added:
demands a {!Recovery.clearance}, and this module is the only thing that
6
Added:
decides how one is obtained: earned by having rested, or taken deliberately
7
Added:
through {!begin_workout}'s [?override] with a stated reason. Putting that
8
Added:
policy here means a native client cannot quietly adopt looser rules than the
9
Added:
web one. *)
10
10
11
11
module Make (R : Repository.S) : sig
12
12
type t
@@ -14,7 +14,7 @@
14
14
val make : repo:R.t -> t
15
15
(** [repo] is the store this service reads and writes. *)
16
16
17
Removed:
val list_routines : t -> (Repository.routine_id * Routine.t) list
17
Added:
val list_routines : t -> (Repository.routine_id * Prescription.Routine.t) list
18
18
19
19
type error =
20
20
| Unknown_routine
@@ -25,7 +25,7 @@
25
25
val pp_error : Format.formatter -> error -> unit
26
26
27
27
val next_workout :
28
Removed:
t -> routine:Repository.routine_id -> (Workout_prescription.t, error) result
28
Added:
t -> routine:Repository.routine_id -> (Prescription.Workout.t, error) result
29
29
(** Where the cycle stands: the workout after the last one logged. *)
30
30
31
31
val readiness :
@@ -40,23 +40,23 @@
40
40
now:Recovery.timestamp ->
41
41
?override:string ->
42
42
unit ->
43
Removed:
(Entry.t, error) result
43
Added:
(Evidence.Workout.t, error) result
44
44
(** Start the next workout. [Error (Not_recovered _)] unless recovery is
45
45
complete or [?override] states why you are training anyway; the reason is
46
Removed:
kept with the entry and reaches {!Progression.diagnose}. *)
46
Added:
kept with the workout and reaches {!Progression.diagnose}. *)
47
47
48
Removed:
val in_progress : t -> Entry.t option
48
Added:
val in_progress : t -> Evidence.Workout.t option
49
49
(** The workout being logged, if any. Single-user: one slot for the whole
50
50
server. This must become per-trainee before authentication exists. *)
51
51
52
52
type log_error =
53
53
| No_workout_in_progress
54
Removed:
| Rejected of Entry.error
55
Removed:
(** The workout refused the stimulus; see {!Entry.error}. *)
54
Added:
| Rejected of Evidence.Workout.error
55
Added:
(** The workout refused the stimulus; see {!Evidence.Workout.error}. *)
56
56
57
57
val pp_log_error : Format.formatter -> log_error -> unit
58
58
59
Removed:
val log : t -> Stimulus.t -> (Entry.t, log_error) result
59
Added:
val log : t -> Evidence.Stimulus.t -> (Evidence.Workout.t, log_error) result
60
60
(** Record a stimulus against the workout in progress. *)
61
61
62
62
val finish : t -> ended_at:Recovery.timestamp -> Repository.record option
lib/core/dune
@@ -1,20 +1,8 @@
1
Removed:
; Modules are added here as the HD1 rebuild lands them, so the build stays
2
Removed:
; green at every step. Target set: units muscle exercise prescription
3
Removed:
; workout_prescription routine stimulus recovery entry logbook progression.
1
Added:
; Two namespaces mirror the plan/record split: Prescription states what to do,
2
Added:
; Evidence records what was done, and Progression is the only judge.
4
3
5
4
(library
6
5
(name hito_core)
7
6
(public_name hito.core)
8
Removed:
(modules
9
Removed:
units
10
Removed:
muscle
11
Removed:
exercise
12
Removed:
recovery
13
Removed:
prescription
14
Removed:
workout_prescription
15
Removed:
routine
16
Removed:
stimulus
17
Removed:
entry
18
Removed:
logbook
19
Removed:
progression)
7
Added:
(modules units muscle exercise recovery prescription evidence progression)
20
8
(wrapped false))
lib/core/entry.ml
@@ -1,130 +0,0 @@
1
Removed:
type shape = As_single | As_pre_exhaust
2
Removed:
3
Removed:
type error =
4
Removed:
| Not_prescribed of Exercise.id
5
Removed:
| Delivery_mismatch of {
6
Removed:
exercise : Exercise.id;
7
Removed:
prescribed : shape;
8
Removed:
logged : shape;
9
Removed:
}
10
Removed:
| Already_finished
11
Removed:
12
Removed:
type t = {
13
Removed:
prescription : Workout_prescription.t;
14
Removed:
clearance : Recovery.clearance;
15
Removed:
started_at : Recovery.timestamp;
16
Removed:
ended_at : Recovery.timestamp option;
17
Removed:
(* Each performed stimulus with the index of the prescribed slot it answers,
18
Removed:
so that unanswered slots stay visible. *)
19
Removed:
performed : (int * Stimulus.t) list;
20
Removed:
}
21
Removed:
22
Removed:
let pp_shape ppf = function
23
Removed:
| As_single -> Format.pp_print_string ppf "a single set"
24
Removed:
| As_pre_exhaust -> Format.pp_print_string ppf "a pre-exhaust pair"
25
Removed:
26
Removed:
let pp_error ppf = function
27
Removed:
| Not_prescribed id ->
28
Removed:
Format.fprintf ppf "%s is not prescribed for this workout" (id :> string)
29
Removed:
| Delivery_mismatch { exercise; prescribed; logged } ->
30
Removed:
Format.fprintf ppf "%s is prescribed as %a but was logged as %a"
31
Removed:
(exercise :> string)
32
Removed:
pp_shape prescribed pp_shape logged
33
Removed:
| Already_finished -> Format.pp_print_string ppf "this workout is finished"
34
Removed:
35
Removed:
let start prescription ~clearance ~started_at =
36
Removed:
{ prescription; clearance; started_at; ended_at = None; performed = [] }
37
Removed:
38
Removed:
let prescription t = t.prescription
39
Removed:
let clearance t = t.clearance
40
Removed:
let started_at t = t.started_at
41
Removed:
let ended_at t = t.ended_at
42
Removed:
let is_finished t = Option.is_some t.ended_at
43
Removed:
let stimuli t = List.map snd (List.rev t.performed)
44
Removed:
45
Removed:
let duration t =
46
Removed:
Option.map
47
Removed:
(fun ended -> Recovery.elapsed ~since:t.started_at ~now:ended)
48
Removed:
t.ended_at
49
Removed:
50
Removed:
let prescribed_shape p =
51
Removed:
match Prescription.delivery p with
52
Removed:
| Prescription.Single _ -> As_single
53
Removed:
| Prescription.Pre_exhaust _ -> As_pre_exhaust
54
Removed:
55
Removed:
let logged_shape s =
56
Removed:
match Stimulus.delivery s with
57
Removed:
| Stimulus.Single _ -> As_single
58
Removed:
| Stimulus.Pre_exhaust _ -> As_pre_exhaust
59
Removed:
60
Removed:
(* A logged movement answers a prescribed one when it is that movement, or a
61
Removed:
substitute the prescription allows *for that movement*. *)
62
Removed:
let fills ~prescribed ~logged p =
63
Removed:
Exercise.equal prescribed logged
64
Removed:
|| List.exists (Exercise.equal logged) (Prescription.allowed_substitutes p)
65
Removed:
&& Exercise.may_substitute ~original:prescribed ~candidate:logged
66
Removed:
67
Removed:
(* Whether the prescription mentions every movement logged, ignoring how they
68
Removed:
were delivered. This is what makes a shape complaint possible: the movements
69
Removed:
belong to this slot, but the delivery does not match it. *)
70
Removed:
let mentions p s =
71
Removed:
List.for_all (fun e -> Prescription.permits p e) (Stimulus.exercises s)
72
Removed:
73
Removed:
(* Whether the stimulus answers the prescription exactly: same number of
74
Removed:
movements, each filling the prescribed role in order. *)
75
Removed:
let conforms p s =
76
Removed:
let logged = Stimulus.exercises s in
77
Removed:
let prescribed = Prescription.exercises p in
78
Removed:
List.length logged = List.length prescribed
79
Removed:
&& List.for_all2
80
Removed:
(fun prescribed logged -> fills ~prescribed ~logged p)
81
Removed:
prescribed logged
82
Removed:
83
Removed:
let indexed t =
84
Removed:
List.mapi
85
Removed:
(fun i p -> (i, p))
86
Removed:
(Workout_prescription.prescriptions t.prescription)
87
Removed:
88
Removed:
let answered t = List.map fst t.performed
89
Removed:
90
Removed:
let outstanding t =
91
Removed:
indexed t |> List.filter (fun (i, _) -> not (List.mem i (answered t)))
92
Removed:
93
Removed:
let unperformed t = List.map snd (outstanding t)
94
Removed:
95
Removed:
let add_stimulus t s =
96
Removed:
if is_finished t then Error Already_finished
97
Removed:
else
98
Removed:
let candidates = List.filter (fun (_, p) -> mentions p s) (indexed t) in
99
Removed:
let matching = List.filter (fun (_, p) -> conforms p s) candidates in
100
Removed:
(* A stimulus always has at least one movement. *)
101
Removed:
let leading = Exercise.id (List.hd (Stimulus.exercises s)) in
102
Removed:
match (candidates, matching) with
103
Removed:
| [], _ -> Error (Not_prescribed leading)
104
Removed:
| (_, p) :: _, [] ->
105
Removed:
Error
106
Removed:
(Delivery_mismatch
107
Removed:
{
108
Removed:
exercise = leading;
109
Removed:
prescribed = prescribed_shape p;
110
Removed:
logged = logged_shape s;
111
Removed:
})
112
Removed:
| _, matching ->
113
Removed:
(* Prefer an unanswered slot, so repeated work is visible as extra
114
Removed:
volume rather than silently overwriting a slot. *)
115
Removed:
let unanswered =
116
Removed:
List.filter (fun (i, _) -> not (List.mem i (answered t))) matching
117
Removed:
in
118
Removed:
let i, _ =
119
Removed:
match unanswered with chosen :: _ -> chosen | [] -> List.hd matching
120
Removed:
in
121
Removed:
Ok { t with performed = (i, s) :: t.performed }
122
Removed:
123
Removed:
let finish t ~ended_at =
124
Removed:
if is_finished t then Error Already_finished
125
Removed:
else Ok { t with ended_at = Some ended_at }
126
Removed:
127
Removed:
let pp ppf t =
128
Removed:
Format.fprintf ppf "%a (%d of %d)" Workout_prescription.pp t.prescription
129
Removed:
(List.length t.performed)
130
Removed:
(List.length (Workout_prescription.prescriptions t.prescription))
lib/core/entry.mli
@@ -1,71 +0,0 @@
1
Removed:
(** One workout being performed, or one already performed: the prescription it
2
Removed:
answers to, when it ran, and the stimuli it delivered.
3
Removed:
4
Removed:
An entry is the point where plan meets record. It admits only stimuli its
5
Removed:
prescription actually calls for — the delivery shape must agree, and each
6
Removed:
movement must be prescribed or an allowed substitute — so a workout cannot
7
Removed:
drift into something else and still claim to be the prescribed one.
8
Removed:
9
Removed:
What it does not do is edit history. A stimulus that was performed can be
10
Removed:
recorded even if it should not have been performed; judging that is
11
Removed:
{!Progression}'s work. *)
12
Removed:
13
Removed:
type t
14
Removed:
15
Removed:
(** Whether a stimulus was delivered as one movement or as a pre-exhaust pair.
16
Removed:
*)
17
Removed:
type shape = As_single | As_pre_exhaust
18
Removed:
19
Removed:
type error =
20
Removed:
| Not_prescribed of Exercise.id
21
Removed:
(** No prescription in this workout covers the movement. *)
22
Removed:
| Delivery_mismatch of {
23
Removed:
exercise : Exercise.id;
24
Removed:
prescribed : shape;
25
Removed:
logged : shape;
26
Removed:
}
27
Removed:
(** The movement is prescribed, but not delivered the prescribed way — a
28
Removed:
pre-exhaust pair is not interchangeable with a lone set. *)
29
Removed:
| Already_finished
30
Removed:
31
Removed:
val pp_error : Format.formatter -> error -> unit
32
Removed:
33
Removed:
val start :
34
Removed:
Workout_prescription.t ->
35
Removed:
clearance:Recovery.clearance ->
36
Removed:
started_at:Recovery.timestamp ->
37
Removed:
t
38
Removed:
(** Beginning a workout demands a {!Recovery.clearance}: under HD1 training
39
Removed:
before recovery completes is the primary error, so it cannot happen by
40
Removed:
accident. The clearance is kept, because how it was obtained is evidence. *)
41
Removed:
42
Removed:
val add_stimulus : t -> Stimulus.t -> (t, error) result
43
Removed:
val finish : t -> ended_at:Recovery.timestamp -> (t, error) result
44
Removed:
45
Removed:
(** {1 Reading an entry} *)
46
Removed:
47
Removed:
val prescription : t -> Workout_prescription.t
48
Removed:
49
Removed:
val clearance : t -> Recovery.clearance
50
Removed:
(** On what basis this workout was begun. *)
51
Removed:
52
Removed:
val started_at : t -> Recovery.timestamp
53
Removed:
val ended_at : t -> Recovery.timestamp option
54
Removed:
val is_finished : t -> bool
55
Removed:
56
Removed:
val duration : t -> Recovery.duration option
57
Removed:
(** [Some] once finished. HD1 reads a shortening duration on the same workout as
58
Removed:
rising intensity, so it is a progress signal. *)
59
Removed:
60
Removed:
val stimuli : t -> Stimulus.t list
61
Removed:
(** In the order performed. *)
62
Removed:
63
Removed:
val outstanding : t -> (int * Prescription.t) list
64
Removed:
(** Prescribed stimuli this entry has yet to answer, each with its position in
65
Removed:
the workout — a caller that offers to log one has to be able to say which.
66
Removed:
*)
67
Removed:
68
Removed:
val unperformed : t -> Prescription.t list
69
Removed:
(** {!outstanding} without the positions. *)
70
Removed:
71
Removed:
val pp : Format.formatter -> t -> unit
lib/core/evidence.ml
@@ -0,0 +1,306 @@
1
Added:
module Stimulus = struct
2
Added:
type extension = Forced_reps | Negatives | Rest_pause | Static_hold
3
Added:
4
Added:
type outcome =
5
Added:
| Positive_failure
6
Added:
| Beyond_failure of extension * extension list
7
Added:
8
Added:
let extensions_of_outcome = function
9
Added:
| Positive_failure -> []
10
Added:
| Beyond_failure (first, rest) -> first :: rest
11
Added:
12
Added:
let pp_extension ppf e =
13
Added:
Format.pp_print_string ppf
14
Added:
(match e with
15
Added:
| Forced_reps -> "forced reps"
16
Added:
| Negatives -> "negatives"
17
Added:
| Rest_pause -> "rest-pause"
18
Added:
| Static_hold -> "static hold")
19
Added:
20
Added:
module Warm_up = struct
21
Added:
type t = {
22
Added:
exercise : Exercise.t;
23
Added:
load : Units.Weight.t;
24
Added:
reps : Units.Reps.t;
25
Added:
}
26
Added:
27
Added:
let make ~exercise ~load ~reps = { exercise; load; reps }
28
Added:
let exercise t = t.exercise
29
Added:
let load t = t.load
30
Added:
let reps t = t.reps
31
Added:
32
Added:
let pp ppf t =
33
Added:
Format.fprintf ppf "%a %a x %a" Exercise.pp t.exercise Units.Weight.pp
34
Added:
t.load Units.Reps.pp t.reps
35
Added:
end
36
Added:
37
Added:
module Movement = struct
38
Added:
type t = {
39
Added:
exercise : Exercise.t;
40
Added:
load : Units.Weight.t;
41
Added:
reps : Units.Reps.t;
42
Added:
outcome : outcome;
43
Added:
}
44
Added:
45
Added:
let make ~exercise ~load ~reps ~outcome = { exercise; load; reps; outcome }
46
Added:
let exercise t = t.exercise
47
Added:
let load t = t.load
48
Added:
let reps t = t.reps
49
Added:
let outcome t = t.outcome
50
Added:
let extensions t = extensions_of_outcome t.outcome
51
Added:
52
Added:
let pp ppf t =
53
Added:
Format.fprintf ppf "%a %a x %a" Exercise.pp t.exercise Units.Weight.pp
54
Added:
t.load Units.Reps.pp t.reps;
55
Added:
match extensions t with
56
Added:
| [] -> ()
57
Added:
| es ->
58
Added:
Format.fprintf ppf " (%a)"
59
Added:
(Format.pp_print_list
60
Added:
~pp_sep:(fun ppf () -> Format.pp_print_string ppf ", ")
61
Added:
pp_extension)
62
Added:
es
63
Added:
end
64
Added:
65
Added:
type delivery =
66
Added:
| Single of Movement.t
67
Added:
| Pre_exhaust of { isolation : Movement.t; compound : Movement.t }
68
Added:
69
Added:
type t = { delivery : delivery; warm_ups : Warm_up.t list }
70
Added:
71
Added:
type error =
72
Added:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
73
Added:
74
Added:
let pp_error ppf (Not_a_pre_exhaust { isolation; compound }) =
75
Added:
Format.fprintf ppf "%s cannot pre-exhaust for %s"
76
Added:
(isolation :> string)
77
Added:
(compound :> string)
78
Added:
79
Added:
let make ?(warm_ups = []) delivery =
80
Added:
match delivery with
81
Added:
| Pre_exhaust { isolation; compound }
82
Added:
when not
83
Added:
(Exercise.may_pre_exhaust
84
Added:
~isolation:(Movement.exercise isolation)
85
Added:
~compound:(Movement.exercise compound)) ->
86
Added:
Error
87
Added:
(Not_a_pre_exhaust
88
Added:
{
89
Added:
isolation = Exercise.id (Movement.exercise isolation);
90
Added:
compound = Exercise.id (Movement.exercise compound);
91
Added:
})
92
Added:
| _ -> Ok { delivery; warm_ups }
93
Added:
94
Added:
let delivery t = t.delivery
95
Added:
let warm_ups t = t.warm_ups
96
Added:
97
Added:
let movements t =
98
Added:
match t.delivery with
99
Added:
| Single m -> [ m ]
100
Added:
| Pre_exhaust { isolation; compound } -> [ isolation; compound ]
101
Added:
102
Added:
let exercises t = List.map Movement.exercise (movements t)
103
Added:
let extensions t = List.concat_map Movement.extensions (movements t)
104
Added:
let is_extended t = extensions t <> []
105
Added:
106
Added:
let pp ppf t =
107
Added:
match t.delivery with
108
Added:
| Single m -> Movement.pp ppf m
109
Added:
| Pre_exhaust { isolation; compound } ->
110
Added:
Format.fprintf ppf "%a into %a" Movement.pp isolation Movement.pp
111
Added:
compound
112
Added:
end
113
Added:
114
Added:
module Workout = struct
115
Added:
type shape = As_single | As_pre_exhaust
116
Added:
117
Added:
type error =
118
Added:
| Not_prescribed of Exercise.id
119
Added:
| Delivery_mismatch of {
120
Added:
exercise : Exercise.id;
121
Added:
prescribed : shape;
122
Added:
logged : shape;
123
Added:
}
124
Added:
| Already_finished
125
Added:
126
Added:
type t = {
127
Added:
prescription : Prescription.Workout.t;
128
Added:
clearance : Recovery.clearance;
129
Added:
started_at : Recovery.timestamp;
130
Added:
ended_at : Recovery.timestamp option;
131
Added:
(* Each performed stimulus with the index of the prescribed slot it answers,
132
Added:
so that unanswered slots stay visible. *)
133
Added:
performed : (int * Stimulus.t) list;
134
Added:
}
135
Added:
136
Added:
let pp_shape ppf = function
137
Added:
| As_single -> Format.pp_print_string ppf "a single set"
138
Added:
| As_pre_exhaust -> Format.pp_print_string ppf "a pre-exhaust pair"
139
Added:
140
Added:
let pp_error ppf = function
141
Added:
| Not_prescribed id ->
142
Added:
Format.fprintf ppf "%s is not prescribed for this workout"
143
Added:
(id :> string)
144
Added:
| Delivery_mismatch { exercise; prescribed; logged } ->
145
Added:
Format.fprintf ppf "%s is prescribed as %a but was logged as %a"
146
Added:
(exercise :> string)
147
Added:
pp_shape prescribed pp_shape logged
148
Added:
| Already_finished -> Format.pp_print_string ppf "this workout is finished"
149
Added:
150
Added:
let start prescription ~clearance ~started_at =
151
Added:
{ prescription; clearance; started_at; ended_at = None; performed = [] }
152
Added:
153
Added:
let prescription t = t.prescription
154
Added:
let clearance t = t.clearance
155
Added:
let started_at t = t.started_at
156
Added:
let ended_at t = t.ended_at
157
Added:
let is_finished t = Option.is_some t.ended_at
158
Added:
let stimuli t = List.map snd (List.rev t.performed)
159
Added:
160
Added:
let duration t =
161
Added:
Option.map
162
Added:
(fun ended -> Recovery.elapsed ~since:t.started_at ~now:ended)
163
Added:
t.ended_at
164
Added:
165
Added:
let prescribed_shape p =
166
Added:
match Prescription.Stimulus.delivery p with
167
Added:
| Prescription.Stimulus.Single _ -> As_single
168
Added:
| Prescription.Stimulus.Pre_exhaust _ -> As_pre_exhaust
169
Added:
170
Added:
let logged_shape s =
171
Added:
match Stimulus.delivery s with
172
Added:
| Stimulus.Single _ -> As_single
173
Added:
| Stimulus.Pre_exhaust _ -> As_pre_exhaust
174
Added:
175
Added:
(* A logged movement answers a prescribed one when it is that movement, or a
176
Added:
substitute the prescription allows *for that movement*. *)
177
Added:
let fills ~prescribed ~logged p =
178
Added:
Exercise.equal prescribed logged
179
Added:
|| List.exists (Exercise.equal logged)
180
Added:
(Prescription.Stimulus.allowed_substitutes p)
181
Added:
&& Exercise.may_substitute ~original:prescribed ~candidate:logged
182
Added:
183
Added:
(* Whether the prescription mentions every movement logged, ignoring how they
184
Added:
were delivered. This is what makes a shape complaint possible: the movements
185
Added:
belong to this slot, but the delivery does not match it. *)
186
Added:
let mentions p s =
187
Added:
List.for_all
188
Added:
(fun e -> Prescription.Stimulus.permits p e)
189
Added:
(Stimulus.exercises s)
190
Added:
191
Added:
(* Whether the stimulus answers the prescription exactly: same number of
192
Added:
movements, each filling the prescribed role in order. *)
193
Added:
let conforms p s =
194
Added:
let logged = Stimulus.exercises s in
195
Added:
let prescribed = Prescription.Stimulus.exercises p in
196
Added:
List.length logged = List.length prescribed
197
Added:
&& List.for_all2
198
Added:
(fun prescribed logged -> fills ~prescribed ~logged p)
199
Added:
prescribed logged
200
Added:
201
Added:
let indexed t =
202
Added:
List.mapi (fun i p -> (i, p)) (Prescription.Workout.stimuli t.prescription)
203
Added:
204
Added:
let answered t = List.map fst t.performed
205
Added:
206
Added:
let outstanding t =
207
Added:
indexed t |> List.filter (fun (i, _) -> not (List.mem i (answered t)))
208
Added:
209
Added:
let unperformed t = List.map snd (outstanding t)
210
Added:
211
Added:
let add_stimulus t s =
212
Added:
if is_finished t then Error Already_finished
213
Added:
else
214
Added:
let candidates = List.filter (fun (_, p) -> mentions p s) (indexed t) in
215
Added:
let matching = List.filter (fun (_, p) -> conforms p s) candidates in
216
Added:
(* A stimulus always has at least one movement. *)
217
Added:
let leading = Exercise.id (List.hd (Stimulus.exercises s)) in
218
Added:
match (candidates, matching) with
219
Added:
| [], _ -> Error (Not_prescribed leading)
220
Added:
| (_, p) :: _, [] ->
221
Added:
Error
222
Added:
(Delivery_mismatch
223
Added:
{
224
Added:
exercise = leading;
225
Added:
prescribed = prescribed_shape p;
226
Added:
logged = logged_shape s;
227
Added:
})
228
Added:
| _, matching ->
229
Added:
(* Prefer an unanswered slot, so repeated work is visible as extra
230
Added:
volume rather than silently overwriting a slot. *)
231
Added:
let unanswered =
232
Added:
List.filter (fun (i, _) -> not (List.mem i (answered t))) matching
233
Added:
in
234
Added:
let i, _ =
235
Added:
match unanswered with
236
Added:
| chosen :: _ -> chosen
237
Added:
| [] -> List.hd matching
238
Added:
in
239
Added:
Ok { t with performed = (i, s) :: t.performed }
240
Added:
241
Added:
let finish t ~ended_at =
242
Added:
if is_finished t then Error Already_finished
243
Added:
else Ok { t with ended_at = Some ended_at }
244
Added:
245
Added:
let pp ppf t =
246
Added:
Format.fprintf ppf "%a (%d of %d)" Prescription.Workout.pp t.prescription
247
Added:
(List.length t.performed)
248
Added:
(List.length (Prescription.Workout.stimuli t.prescription))
249
Added:
end
250
Added:
251
Added:
module Log = struct
252
Added:
type t = Workout.t list
253
Added:
254
Added:
type observation = {
255
Added:
exercise : Exercise.t;
256
Added:
movement : Stimulus.Movement.t;
257
Added:
performed_at : Recovery.timestamp;
258
Added:
}
259
Added:
260
Added:
let empty = []
261
Added:
let add t workout = workout :: t
262
Added:
263
Added:
let started workout =
264
Added:
Recovery.timestamp_to_unix_seconds (Workout.started_at workout)
265
Added:
266
Added:
(* Sorted on read, so workouts need not be added in order. *)
267
Added:
let chronological t =
268
Added:
List.sort (fun a b -> Int.compare (started a) (started b)) t
269
Added:
270
Added:
let workouts t = List.rev (chronological t)
271
Added:
272
Added:
let last_prescription t =
273
Added:
match workouts t with
274
Added:
| [] -> None
275
Added:
| latest :: _ -> Some (Workout.prescription latest)
276
Added:
277
Added:
let observations_of workout =
278
Added:
Workout.stimuli workout
279
Added:
|> List.concat_map Stimulus.movements
280
Added:
|> List.map (fun movement ->
281
Added:
{
282
Added:
exercise = Stimulus.Movement.exercise movement;
283
Added:
movement;
284
Added:
performed_at = Workout.started_at workout;
285
Added:
})
286
Added:
287
Added:
let observations t exercise =
288
Added:
chronological t
289
Added:
|> List.concat_map observations_of
290
Added:
|> List.filter (fun o -> Exercise.equal o.exercise exercise)
291
Added:
292
Added:
let readiness t ~now ~recommended =
293
Added:
let finished =
294
Added:
chronological t
295
Added:
|> List.filter_map (fun w -> Workout.ended_at w)
296
Added:
|> List.rev
297
Added:
in
298
Added:
match finished with
299
Added:
| [] -> Recovery.Ready
300
Added:
| last :: _ ->
301
Added:
Recovery.evaluate_readiness
302
Added:
~elapsed:(Recovery.elapsed ~since:last ~now)
303
Added:
~recommended
304
Added:
305
Added:
let pp ppf t = Format.fprintf ppf "%d workouts" (List.length t)
306
Added:
end
lib/core/evidence.mli
@@ -0,0 +1,207 @@
1
Added:
(** The record: what was actually done, at every scale {!Prescription} plans
2
Added:
one.
3
Added:
4
Added:
The only source of evidence in the system. It records; it does not interpret
5
Added:
— what the evidence means is {!Progression}'s business, and a stimulus that
6
Added:
should not have been performed is still recorded. *)
7
Added:
8
Added:
(** One stimulus: a single drive to muscular failure, and the record of what it
9
Added:
took.
10
Added:
11
Added:
The unit of work. HD1 prescribes one set per exercise, so there is no set
12
Added:
count. Reaching failure is not recorded because it is not optional — a
13
Added:
movement here always went to failure. *)
14
Added:
module Stimulus : sig
15
Added:
(** A means of continuing past positive failure. HD1 treats these as
16
Added:
occasional: used on every exercise they lead straight to overtraining, and
17
Added:
forced reps and negatives both need a spotter. *)
18
Added:
type extension = Forced_reps | Negatives | Rest_pause | Static_hold
19
Added:
20
Added:
(** How the drive ended. *)
21
Added:
type outcome =
22
Added:
| Positive_failure (** Unable to complete another rep unaided. *)
23
Added:
| Beyond_failure of extension * extension list
24
Added:
(** In the order applied — HD1 stacks negatives after forced reps. Split
25
Added:
so that "beyond failure by no means at all" cannot be written. *)
26
Added:
27
Added:
val extensions_of_outcome : outcome -> extension list
28
Added:
val pp_extension : Format.formatter -> extension -> unit
29
Added:
30
Added:
(** Preparation for a stimulus: enough to bring blood to the muscles and
31
Added:
joints, no more. Carries no outcome, so a warm-up cannot reach failure. *)
32
Added:
module Warm_up : sig
33
Added:
type t
34
Added:
35
Added:
val make :
36
Added:
exercise:Exercise.t -> load:Units.Weight.t -> reps:Units.Reps.t -> t
37
Added:
38
Added:
val exercise : t -> Exercise.t
39
Added:
val load : t -> Units.Weight.t
40
Added:
val reps : t -> Units.Reps.t
41
Added:
val pp : Format.formatter -> t -> unit
42
Added:
end
43
Added:
44
Added:
(** One movement driven to failure within a stimulus. *)
45
Added:
module Movement : sig
46
Added:
type t
47
Added:
48
Added:
val make :
49
Added:
exercise:Exercise.t ->
50
Added:
load:Units.Weight.t ->
51
Added:
reps:Units.Reps.t ->
52
Added:
outcome:outcome ->
53
Added:
t
54
Added:
55
Added:
val exercise : t -> Exercise.t
56
Added:
val load : t -> Units.Weight.t
57
Added:
val reps : t -> Units.Reps.t
58
Added:
val outcome : t -> outcome
59
Added:
val extensions : t -> extension list
60
Added:
val pp : Format.formatter -> t -> unit
61
Added:
end
62
Added:
63
Added:
(** How the stimulus was delivered — the performed counterpart of
64
Added:
{!Prescription.Stimulus.delivery}. *)
65
Added:
type delivery =
66
Added:
| Single of Movement.t
67
Added:
| Pre_exhaust of { isolation : Movement.t; compound : Movement.t }
68
Added:
69
Added:
type t
70
Added:
71
Added:
type error =
72
Added:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
73
Added:
74
Added:
val pp_error : Format.formatter -> error -> unit
75
Added:
76
Added:
val make : ?warm_ups:Warm_up.t list -> delivery -> (t, error) result
77
Added:
(** A [Pre_exhaust] must genuinely pre-exhaust; two unrelated movements are
78
Added:
two stimuli, not one. This refuses a mislabelled pairing, not an honest
79
Added:
record. *)
80
Added:
81
Added:
val delivery : t -> delivery
82
Added:
83
Added:
val movements : t -> Movement.t list
84
Added:
(** In performance order; isolation first for a pre-exhaust. *)
85
Added:
86
Added:
val warm_ups : t -> Warm_up.t list
87
Added:
val exercises : t -> Exercise.t list
88
Added:
89
Added:
val extensions : t -> extension list
90
Added:
(** Everything that carried this stimulus past failure, across its movements.
91
Added:
*)
92
Added:
93
Added:
val is_extended : t -> bool
94
Added:
val pp : Format.formatter -> t -> unit
95
Added:
end
96
Added:
97
Added:
(** One workout being performed, or one already performed: the prescription it
98
Added:
answers to, when it ran, and the stimuli it delivered.
99
Added:
100
Added:
Where plan meets record. It admits only stimuli its prescription calls for —
101
Added:
the delivery shape must agree, and each movement must be prescribed or an
102
Added:
allowed substitute — so a workout cannot drift into something else and still
103
Added:
claim to be the prescribed one. *)
104
Added:
module Workout : sig
105
Added:
type t
106
Added:
107
Added:
(** Whether a stimulus was delivered as one movement or as a pre-exhaust pair.
108
Added:
*)
109
Added:
type shape = As_single | As_pre_exhaust
110
Added:
111
Added:
type error =
112
Added:
| Not_prescribed of Exercise.id
113
Added:
(** No prescription in this workout covers the movement. *)
114
Added:
| Delivery_mismatch of {
115
Added:
exercise : Exercise.id;
116
Added:
prescribed : shape;
117
Added:
logged : shape;
118
Added:
}
119
Added:
(** The movement is prescribed, but not delivered the prescribed way — a
120
Added:
pre-exhaust pair is not interchangeable with a lone set. *)
121
Added:
| Already_finished
122
Added:
123
Added:
val pp_error : Format.formatter -> error -> unit
124
Added:
125
Added:
val start :
126
Added:
Prescription.Workout.t ->
127
Added:
clearance:Recovery.clearance ->
128
Added:
started_at:Recovery.timestamp ->
129
Added:
t
130
Added:
(** Beginning a workout demands a {!Recovery.clearance}: under HD1 training
131
Added:
before recovery completes is the primary error, so it cannot happen by
132
Added:
accident. The clearance is kept, because how it was obtained is evidence.
133
Added:
*)
134
Added:
135
Added:
val add_stimulus : t -> Stimulus.t -> (t, error) result
136
Added:
val finish : t -> ended_at:Recovery.timestamp -> (t, error) result
137
Added:
138
Added:
(** {1 Reading a workout} *)
139
Added:
140
Added:
val prescription : t -> Prescription.Workout.t
141
Added:
142
Added:
val clearance : t -> Recovery.clearance
143
Added:
(** On what basis this workout was begun. *)
144
Added:
145
Added:
val started_at : t -> Recovery.timestamp
146
Added:
val ended_at : t -> Recovery.timestamp option
147
Added:
val is_finished : t -> bool
148
Added:
149
Added:
val duration : t -> Recovery.duration option
150
Added:
(** [Some] once finished. HD1 reads a shortening duration on the same workout
151
Added:
as rising intensity, so it is a progress signal. *)
152
Added:
153
Added:
val stimuli : t -> Stimulus.t list
154
Added:
(** In the order performed. *)
155
Added:
156
Added:
val outstanding : t -> (int * Prescription.Stimulus.t) list
157
Added:
(** Prescribed stimuli this workout has yet to answer, each with its position
158
Added:
— a caller that offers to log one has to be able to say which. *)
159
Added:
160
Added:
val unperformed : t -> Prescription.Stimulus.t list
161
Added:
(** {!outstanding} without the positions. *)
162
Added:
163
Added:
val pp : Format.formatter -> t -> unit
164
Added:
end
165
Added:
166
Added:
(** The training diary: every workout performed, and the questions history can
167
Added:
answer.
168
Added:
169
Added:
HD1 insists on keeping records — progress is knowable only from them, and
170
Added:
"even a one rep increase is significant". *)
171
Added:
module Log : sig
172
Added:
type t
173
Added:
174
Added:
val empty : t
175
Added:
val add : t -> Workout.t -> t
176
Added:
177
Added:
val workouts : t -> Workout.t list
178
Added:
(** Most recent first, by when each workout began. *)
179
Added:
180
Added:
val last_prescription : t -> Prescription.Workout.t option
181
Added:
(** What was performed most recently, which is what
182
Added:
{!Prescription.Routine.workout_after} needs to know where the cycle
183
Added:
stands. *)
184
Added:
185
Added:
type observation = {
186
Added:
exercise : Exercise.t;
187
Added:
movement : Stimulus.Movement.t;
188
Added:
performed_at : Recovery.timestamp;
189
Added:
}
190
Added:
(** One movement as it was performed, on the day it was performed. Dated
191
Added:
because a stall is defined by progress ceasing *for two weeks*, so
192
Added:
evidence without time cannot answer the question. *)
193
Added:
194
Added:
val observations : t -> Exercise.t -> observation list
195
Added:
(** Every recorded performance of that movement, oldest first. *)
196
Added:
197
Added:
val readiness :
198
Added:
t ->
199
Added:
now:Recovery.timestamp ->
200
Added:
recommended:Recovery.duration ->
201
Added:
Recovery.readiness
202
Added:
(** Measured from the end of the last finished workout. [Ready] when nothing
203
Added:
has been logged yet, or when the last workout is still unfinished — there
204
Added:
is no completed effort to recover from. *)
205
Added:
206
Added:
val pp : Format.formatter -> t -> unit
207
Added:
end
lib/core/logbook.ml
@@ -1,50 +0,0 @@
1
Removed:
type t = Entry.t list
2
Removed:
3
Removed:
type observation = {
4
Removed:
exercise : Exercise.t;
5
Removed:
movement : Stimulus.Movement.t;
6
Removed:
performed_at : Recovery.timestamp;
7
Removed:
}
8
Removed:
9
Removed:
let empty = []
10
Removed:
let add t entry = entry :: t
11
Removed:
let started entry = Recovery.timestamp_to_unix_seconds (Entry.started_at entry)
12
Removed:
13
Removed:
(* Sorted on read, so entries need not be added in order. *)
14
Removed:
let chronological t =
15
Removed:
List.sort (fun a b -> Int.compare (started a) (started b)) t
16
Removed:
17
Removed:
let entries t = List.rev (chronological t)
18
Removed:
19
Removed:
let last_prescription t =
20
Removed:
match entries t with
21
Removed:
| [] -> None
22
Removed:
| latest :: _ -> Some (Entry.prescription latest)
23
Removed:
24
Removed:
let observations_of entry =
25
Removed:
Entry.stimuli entry
26
Removed:
|> List.concat_map Stimulus.movements
27
Removed:
|> List.map (fun movement ->
28
Removed:
{
29
Removed:
exercise = Stimulus.Movement.exercise movement;
30
Removed:
movement;
31
Removed:
performed_at = Entry.started_at entry;
32
Removed:
})
33
Removed:
34
Removed:
let evidence t exercise =
35
Removed:
chronological t
36
Removed:
|> List.concat_map observations_of
37
Removed:
|> List.filter (fun o -> Exercise.equal o.exercise exercise)
38
Removed:
39
Removed:
let readiness t ~now ~recommended =
40
Removed:
let finished =
41
Removed:
chronological t |> List.filter_map (fun e -> Entry.ended_at e) |> List.rev
42
Removed:
in
43
Removed:
match finished with
44
Removed:
| [] -> Recovery.Ready
45
Removed:
| last :: _ ->
46
Removed:
Recovery.evaluate_readiness
47
Removed:
~elapsed:(Recovery.elapsed ~since:last ~now)
48
Removed:
~recommended
49
Removed:
50
Removed:
let pp ppf t = Format.fprintf ppf "%d workouts" (List.length t)
lib/core/logbook.mli
@@ -1,42 +0,0 @@
1
Removed:
(** The training diary: every workout performed, and the questions history can
2
Removed:
answer.
3
Removed:
4
Removed:
HD1 insists on keeping records — progress is knowable only from them, and
5
Removed:
"even a one rep increase is significant". So this is the only source of
6
Removed:
evidence in the system. It records; it does not interpret. What the evidence
7
Removed:
means is {!Progression}'s business. *)
8
Removed:
9
Removed:
type t
10
Removed:
11
Removed:
val empty : t
12
Removed:
val add : t -> Entry.t -> t
13
Removed:
14
Removed:
val entries : t -> Entry.t list
15
Removed:
(** Most recent first, by when each workout began. *)
16
Removed:
17
Removed:
val last_prescription : t -> Workout_prescription.t option
18
Removed:
(** What was performed most recently, which is what {!Routine.workout_after}
19
Removed:
needs to know where the cycle stands. *)
20
Removed:
21
Removed:
type observation = {
22
Removed:
exercise : Exercise.t;
23
Removed:
movement : Stimulus.Movement.t;
24
Removed:
performed_at : Recovery.timestamp;
25
Removed:
}
26
Removed:
(** One movement as it was performed, on the day it was performed. Dated because
27
Removed:
a stall is defined by progress ceasing *for two weeks*, so evidence without
28
Removed:
time cannot answer the question. *)
29
Removed:
30
Removed:
val evidence : t -> Exercise.t -> observation list
31
Removed:
(** Every recorded performance of that movement, oldest first. *)
32
Removed:
33
Removed:
val readiness :
34
Removed:
t ->
35
Removed:
now:Recovery.timestamp ->
36
Removed:
recommended:Recovery.duration ->
37
Removed:
Recovery.readiness
38
Removed:
(** Measured from the end of the last finished workout. [Ready] when nothing has
39
Removed:
been logged yet, or when the last workout is still unfinished — there is no
40
Removed:
completed effort to recover from. *)
41
Removed:
42
Removed:
val pp : Format.formatter -> t -> unit
lib/core/prescription.ml
@@ -1,86 +1,214 @@
1
Removed:
type delivery =
2
Removed:
| Single of Exercise.t
3
Removed:
| Pre_exhaust of { isolation : Exercise.t; compound : Exercise.t }
1
Added:
module Stimulus = struct
2
Added:
type delivery =
3
Added:
| Single of Exercise.t
4
Added:
| Pre_exhaust of { isolation : Exercise.t; compound : Exercise.t }
4
5
5
Removed:
type t = {
6
Removed:
delivery : delivery;
7
Removed:
rep_range : Units.Rep_range.t;
8
Removed:
allowed_substitutes : Exercise.t list;
9
Removed:
}
6
Added:
type t = {
7
Added:
delivery : delivery;
8
Added:
rep_range : Units.Rep_range.t;
9
Added:
allowed_substitutes : Exercise.t list;
10
Added:
}
10
11
11
Removed:
type error =
12
Removed:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
13
Removed:
| Reps_outside_limits
14
Removed:
| Substitute_not_permitted of Exercise.id
12
Added:
type error =
13
Added:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
14
Added:
| Reps_outside_limits
15
Added:
| Substitute_not_permitted of Exercise.id
15
16
16
Removed:
(* 6 and 12 are statically valid, so these cannot fail. *)
17
Removed:
let reps_exn n =
18
Removed:
match Units.Reps.of_int n with Ok r -> r | Error _ -> assert false
17
Added:
(* 6 and 12 are statically valid, so these cannot fail. *)
18
Added:
let reps_exn n =
19
Added:
match Units.Reps.of_int n with Ok r -> r | Error _ -> assert false
19
20
20
Removed:
let rep_limits =
21
Removed:
match Units.Rep_range.make ~min:(reps_exn 6) ~max:(reps_exn 12) with
22
Removed:
| Ok r -> r
23
Removed:
| Error _ -> assert false
21
Added:
let rep_limits =
22
Added:
match Units.Rep_range.make ~min:(reps_exn 6) ~max:(reps_exn 12) with
23
Added:
| Ok r -> r
24
Added:
| Error _ -> assert false
24
25
25
Removed:
let pp_error ppf = function
26
Removed:
| Not_a_pre_exhaust { isolation; compound } ->
27
Removed:
Format.fprintf ppf "%s cannot pre-exhaust for %s"
28
Removed:
(isolation :> string)
29
Removed:
(compound :> string)
30
Removed:
| Reps_outside_limits ->
31
Removed:
Format.fprintf ppf "rep window must lie within %a" Units.Rep_range.pp
32
Removed:
rep_limits
33
Removed:
| Substitute_not_permitted id ->
34
Removed:
Format.fprintf ppf "%s is not a permitted substitute" (id :> string)
26
Added:
let pp_error ppf = function
27
Added:
| Not_a_pre_exhaust { isolation; compound } ->
28
Added:
Format.fprintf ppf "%s cannot pre-exhaust for %s"
29
Added:
(isolation :> string)
30
Added:
(compound :> string)
31
Added:
| Reps_outside_limits ->
32
Added:
Format.fprintf ppf "rep window must lie within %a" Units.Rep_range.pp
33
Added:
rep_limits
34
Added:
| Substitute_not_permitted id ->
35
Added:
Format.fprintf ppf "%s is not a permitted substitute" (id :> string)
35
36
36
Removed:
let delivery t = t.delivery
37
Removed:
let rep_range t = t.rep_range
38
Removed:
let allowed_substitutes t = t.allowed_substitutes
37
Added:
let delivery t = t.delivery
38
Added:
let rep_range t = t.rep_range
39
Added:
let allowed_substitutes t = t.allowed_substitutes
39
40
40
Removed:
let delivery_exercises = function
41
Removed:
| Single e -> [ e ]
42
Removed:
| Pre_exhaust { isolation; compound } -> [ isolation; compound ]
41
Added:
let delivery_exercises = function
42
Added:
| Single e -> [ e ]
43
Added:
| Pre_exhaust { isolation; compound } -> [ isolation; compound ]
43
44
44
Removed:
let exercises t = delivery_exercises t.delivery
45
Added:
let exercises t = delivery_exercises t.delivery
45
46
46
Removed:
let within_limits range =
47
Removed:
Units.Rep_range.contains rep_limits (Units.Rep_range.min range)
48
Removed:
&& Units.Rep_range.contains rep_limits (Units.Rep_range.max range)
47
Added:
let within_limits range =
48
Added:
Units.Rep_range.contains rep_limits (Units.Rep_range.min range)
49
Added:
&& Units.Rep_range.contains rep_limits (Units.Rep_range.max range)
49
50
50
Removed:
let make ~delivery ~rep_range ~allowed_substitutes =
51
Removed:
let movements = delivery_exercises delivery in
52
Removed:
let unpermitted =
53
Removed:
List.find_opt
54
Removed:
(fun candidate ->
55
Removed:
not
56
Removed:
(List.exists
57
Removed:
(fun original -> Exercise.may_substitute ~original ~candidate)
58
Removed:
movements))
59
Removed:
allowed_substitutes
60
Removed:
in
61
Removed:
match (delivery, within_limits rep_range, unpermitted) with
62
Removed:
| Pre_exhaust { isolation; compound }, _, _
63
Removed:
when not (Exercise.may_pre_exhaust ~isolation ~compound) ->
64
Removed:
Error
65
Removed:
(Not_a_pre_exhaust
66
Removed:
{
67
Removed:
isolation = Exercise.id isolation;
68
Removed:
compound = Exercise.id compound;
69
Removed:
})
70
Removed:
| _, false, _ -> Error Reps_outside_limits
71
Removed:
| _, _, Some candidate ->
72
Removed:
Error (Substitute_not_permitted (Exercise.id candidate))
73
Removed:
| _ -> Ok { delivery; rep_range; allowed_substitutes }
51
Added:
let make ~delivery ~rep_range ~allowed_substitutes =
52
Added:
let movements = delivery_exercises delivery in
53
Added:
let unpermitted =
54
Added:
List.find_opt
55
Added:
(fun candidate ->
56
Added:
not
57
Added:
(List.exists
58
Added:
(fun original -> Exercise.may_substitute ~original ~candidate)
59
Added:
movements))
60
Added:
allowed_substitutes
61
Added:
in
62
Added:
match (delivery, within_limits rep_range, unpermitted) with
63
Added:
| Pre_exhaust { isolation; compound }, _, _
64
Added:
when not (Exercise.may_pre_exhaust ~isolation ~compound) ->
65
Added:
Error
66
Added:
(Not_a_pre_exhaust
67
Added:
{
68
Added:
isolation = Exercise.id isolation;
69
Added:
compound = Exercise.id compound;
70
Added:
})
71
Added:
| _, false, _ -> Error Reps_outside_limits
72
Added:
| _, _, Some candidate ->
73
Added:
Error (Substitute_not_permitted (Exercise.id candidate))
74
Added:
| _ -> Ok { delivery; rep_range; allowed_substitutes }
74
75
75
Removed:
let permits t movement =
76
Removed:
List.exists (Exercise.equal movement) (exercises t)
77
Removed:
|| List.exists (Exercise.equal movement) t.allowed_substitutes
76
Added:
let permits t movement =
77
Added:
List.exists (Exercise.equal movement) (exercises t)
78
Added:
|| List.exists (Exercise.equal movement) t.allowed_substitutes
78
79
79
Removed:
let pp_delivery ppf = function
80
Removed:
| Single e -> Exercise.pp ppf e
81
Removed:
| Pre_exhaust { isolation; compound } ->
82
Removed:
Format.fprintf ppf "%a into %a" Exercise.pp isolation Exercise.pp compound
80
Added:
let pp_delivery ppf = function
81
Added:
| Single e -> Exercise.pp ppf e
82
Added:
| Pre_exhaust { isolation; compound } ->
83
Added:
Format.fprintf ppf "%a into %a" Exercise.pp isolation Exercise.pp
84
Added:
compound
83
85
84
Removed:
let pp ppf t =
85
Removed:
Format.fprintf ppf "%a for %a reps" pp_delivery t.delivery Units.Rep_range.pp
86
Removed:
t.rep_range
86
Added:
let pp ppf t =
87
Added:
Format.fprintf ppf "%a for %a reps" pp_delivery t.delivery
88
Added:
Units.Rep_range.pp t.rep_range
89
Added:
end
90
Added:
91
Added:
module Workout = struct
92
Added:
type id = string
93
Added:
type error = Empty_workout
94
Added:
type t = { id : id; name : string; stimuli : Stimulus.t list }
95
Added:
96
Added:
let make ~id ~name ~stimuli =
97
Added:
match stimuli with
98
Added:
| [] -> Error Empty_workout
99
Added:
| _ -> Ok { id; name; stimuli }
100
Added:
101
Added:
let id t = t.id
102
Added:
let name t = t.name
103
Added:
let stimuli t = t.stimuli
104
Added:
let equal a b = String.equal a.id b.id
105
Added:
let pp ppf t = Format.pp_print_string ppf t.name
106
Added:
end
107
Added:
108
Added:
module Routine = struct
109
Added:
type error = Empty_routine
110
Added:
type t = { name : string; workouts : Workout.t list }
111
Added:
112
Added:
let make ~name ~workouts =
113
Added:
match workouts with [] -> Error Empty_routine | _ -> Ok { name; workouts }
114
Added:
115
Added:
let name t = t.name
116
Added:
let workouts t = t.workouts
117
Added:
let pp ppf t = Format.pp_print_string ppf t.name
118
Added:
119
Added:
let workout_after t performed =
120
Added:
let rec next = function
121
Added:
| [] | [ _ ] -> List.hd t.workouts
122
Added:
| w :: (following :: _ as rest) ->
123
Added:
if Workout.equal w performed then following else next rest
124
Added:
in
125
Added:
next t.workouts
126
Added:
127
Added:
let training_interval = Recovery.hours 48
128
Added:
let cycle_rest = Recovery.hours 72
129
Added:
130
Added:
let recovery_after t performed =
131
Added:
match List.rev t.workouts with
132
Added:
| last :: _ when Workout.equal last performed -> cycle_rest
133
Added:
| _ -> training_interval
134
Added:
135
Added:
(* {1 The Ideal Routine} *)
136
Added:
137
Added:
let preset_exn pp = function
138
Added:
| Ok v -> v
139
Added:
| Error e -> invalid_arg (Format.asprintf "Routine preset: %a" pp e)
140
Added:
141
Added:
let movement id =
142
Added:
match Exercise.find id with
143
Added:
| Some e -> e
144
Added:
| None -> invalid_arg (Format.sprintf "Routine preset: no exercise %S" id)
145
Added:
146
Added:
(* HD1's guideline window for every listed exercise. *)
147
Added:
let six_to_ten =
148
Added:
let reps n =
149
Added:
match Units.Reps.of_int n with Ok r -> r | Error _ -> assert false
150
Added:
in
151
Added:
match Units.Rep_range.make ~min:(reps 6) ~max:(reps 10) with
152
Added:
| Ok r -> r
153
Added:
| Error _ -> assert false
154
Added:
155
Added:
let prescribe ?(substitutes = []) delivery =
156
Added:
preset_exn Stimulus.pp_error
157
Added:
(Stimulus.make ~delivery ~rep_range:six_to_ten
158
Added:
~allowed_substitutes:(List.map movement substitutes))
159
Added:
160
Added:
let single ?substitutes id =
161
Added:
prescribe ?substitutes (Stimulus.Single (movement id))
162
Added:
163
Added:
let pre_exhaust ?substitutes ~isolation ~compound () =
164
Added:
prescribe ?substitutes
165
Added:
(Stimulus.Pre_exhaust
166
Added:
{ isolation = movement isolation; compound = movement compound })
167
Added:
168
Added:
let day ~id ~name stimuli =
169
Added:
preset_exn
170
Added:
(fun ppf Workout.Empty_workout ->
171
Added:
Format.pp_print_string ppf "empty workout")
172
Added:
(Workout.make ~id ~name ~stimuli)
173
Added:
174
Added:
let ideal_day_one =
175
Added:
day ~id:"ideal-day-1" ~name:"Day 1"
176
Added:
[
177
Added:
pre_exhaust
178
Added:
~substitutes:[ "cable-crossovers"; "pec-deck" ]
179
Added:
~isolation:"dumbbell-flyes" ~compound:"incline-press" ();
180
Added:
single "laterals";
181
Added:
single ~substitutes:[ "reverse-pec-deck" ] "bent-over-laterals";
182
Added:
pre_exhaust
183
Added:
~substitutes:[ "pressdowns"; "triceps-machine" ]
184
Added:
~isolation:"lying-french-press" ~compound:"dips" ();
185
Added:
]
186
Added:
187
Added:
let ideal_day_two =
188
Added:
day ~id:"ideal-day-2" ~name:"Day 2"
189
Added:
[
190
Added:
pre_exhaust
191
Added:
~substitutes:[ "straight-arm-pulldowns" ]
192
Added:
~isolation:"pullovers" ~compound:"close-grip-pulldowns" ();
193
Added:
single "bent-over-rows";
194
Added:
single "shrugs";
195
Added:
single ~substitutes:[ "deadlifts" ] "hyperextensions";
196
Added:
single ~substitutes:[ "preacher-curls" ] "curls";
197
Added:
]
198
Added:
199
Added:
let ideal_day_three =
200
Added:
day ~id:"ideal-day-3" ~name:"Day 3"
201
Added:
[
202
Added:
pre_exhaust ~substitutes:[ "squats" ] ~isolation:"leg-extensions"
203
Added:
~compound:"leg-presses" ();
204
Added:
single "leg-curls";
205
Added:
single "calf-raises";
206
Added:
single "sit-ups";
207
Added:
]
208
Added:
209
Added:
let ideal =
210
Added:
preset_exn
211
Added:
(fun ppf Empty_routine -> Format.pp_print_string ppf "empty routine")
212
Added:
(make ~name:"Ideal Routine"
213
Added:
~workouts:[ ideal_day_one; ideal_day_two; ideal_day_three ])
214
Added:
end
lib/core/prescription.mli
@@ -1,57 +1,131 @@
1
Added:
(** The plan: what to do, at every scale HD1 prescribes one.
2
Added:
3
Added:
A stimulus is one drive to failure, a workout is a sequence of them, and a
4
Added:
routine is the cycle of workouts. Nothing here observes anything — the
5
Added:
performed counterpart is {!Evidence}, and judging one against the other is
6
Added:
{!Progression}'s work. *)
7
Added:
1
8
(** One prescribed stimulus: how a single drive to failure is to be delivered,
2
9
and the rep window that calibrates its load.
3
10
4
11
Heavy Duty prescribes one working set, so that is implicit and not
5
Removed:
configurable. Purely a plan — it knows nothing of what was performed.
6
Removed:
Judging performance against a prescription is {!Progression}'s job. *)
12
Added:
configurable. *)
13
Added:
module Stimulus : sig
14
Added:
type t
7
15
8
Removed:
type t
16
Added:
(** How the stimulus is delivered. HD1 knows only these two shapes: a single
17
Added:
movement, or an isolation carried straight into a compound. There is no
18
Added:
antagonist superset — "superset" in HD1 always means pre-exhaustion. *)
19
Added:
type delivery =
20
Added:
| Single of Exercise.t
21
Added:
| Pre_exhaust of { isolation : Exercise.t; compound : Exercise.t }
22
Added:
(** Performed with no pause: even a three-second delay lets the target
23
Added:
recover and restores the weak link. *)
9
24
10
Removed:
(** How the stimulus is delivered. HD1 knows only these two shapes: a single
11
Removed:
movement, or an isolation carried straight into a compound. There is no
12
Removed:
antagonist superset — "superset" in HD1 always means pre-exhaustion. *)
13
Removed:
type delivery =
14
Removed:
| Single of Exercise.t
15
Removed:
| Pre_exhaust of { isolation : Exercise.t; compound : Exercise.t }
16
Removed:
(** Performed with no pause: even a three-second delay lets the target
17
Removed:
recover and restores the weak link. *)
25
Added:
type error =
26
Added:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
27
Added:
(** The pair cannot pre-exhaust; see {!Exercise.may_pre_exhaust}. *)
28
Added:
| Reps_outside_limits (** The rep window escapes {!rep_limits}. *)
29
Added:
| Substitute_not_permitted of Exercise.id
30
Added:
(** A substitute is on no delivery movement's catalog whitelist. *)
18
31
19
Removed:
type error =
20
Removed:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
21
Removed:
(** The pair cannot pre-exhaust; see {!Exercise.may_pre_exhaust}. *)
22
Removed:
| Reps_outside_limits (** The rep window escapes {!rep_limits}. *)
23
Removed:
| Substitute_not_permitted of Exercise.id
24
Removed:
(** A substitute is on no delivery movement's catalog whitelist. *)
32
Added:
val pp_error : Format.formatter -> error -> unit
25
33
26
Removed:
val pp_error : Format.formatter -> error -> unit
34
Added:
val rep_limits : Units.Rep_range.t
35
Added:
(** HD1's stimulus window, 6-12: fewer than six does not tax the reserves
36
Added:
sufficiently, and beyond twelve the set ends in cardiorespiratory
37
Added:
insufficiency before the muscle reaches failure. A prescribed range must
38
Added:
lie within it. *)
27
39
28
Removed:
val rep_limits : Units.Rep_range.t
29
Removed:
(** HD1's stimulus window, 6-12: fewer than six does not tax the reserves
30
Removed:
sufficiently, and beyond twelve the set ends in cardiorespiratory
31
Removed:
insufficiency before the muscle reaches failure. A prescribed range must lie
32
Removed:
within it. *)
40
Added:
val make :
41
Added:
delivery:delivery ->
42
Added:
rep_range:Units.Rep_range.t ->
43
Added:
allowed_substitutes:Exercise.t list ->
44
Added:
(t, error) result
45
Added:
(** Each substitute must be permitted for one of the delivery's movements, so
46
Added:
a prescription may only narrow the curated set. *)
33
47
34
Removed:
val make :
35
Removed:
delivery:delivery ->
36
Removed:
rep_range:Units.Rep_range.t ->
37
Removed:
allowed_substitutes:Exercise.t list ->
38
Removed:
(t, error) result
39
Removed:
(** Each substitute must be permitted for one of the delivery's movements, so a
40
Removed:
prescription may only narrow the curated set. *)
48
Added:
val delivery : t -> delivery
41
49
42
Removed:
val delivery : t -> delivery
50
Added:
val rep_range : t -> Units.Rep_range.t
51
Added:
(** Calibrates load selection only. Reps are an outcome: a set ends at
52
Added:
failure, never because a number was reached. *)
43
53
44
Removed:
val rep_range : t -> Units.Rep_range.t
45
Removed:
(** Calibrates load selection only. Reps are an outcome: a set ends at failure,
46
Removed:
never because a number was reached. *)
54
Added:
val allowed_substitutes : t -> Exercise.t list
47
55
48
Removed:
val allowed_substitutes : t -> Exercise.t list
56
Added:
val exercises : t -> Exercise.t list
57
Added:
(** The delivery's movements, in performance order. *)
49
58
50
Removed:
val exercises : t -> Exercise.t list
51
Removed:
(** The delivery's movements, in performance order. *)
59
Added:
val permits : t -> Exercise.t -> bool
60
Added:
(** Whether the movement may be logged against this prescription — one of its
61
Added:
own, or an allowed substitute. *)
52
62
53
Removed:
val permits : t -> Exercise.t -> bool
54
Removed:
(** Whether the movement may be logged against this prescription — one of its
55
Removed:
own, or an allowed substitute. *)
63
Added:
val pp : Format.formatter -> t -> unit
64
Added:
end
56
65
57
Removed:
val pp : Format.formatter -> t -> unit
66
Added:
(** One prescribed workout, such as HD1's Day 1: an ordered sequence of
67
Added:
prescribed stimuli.
68
Added:
69
Added:
Each stimulus is exactly one drive to failure, so the workout's volume is
70
Added:
its length — HD1's "least amount required" is structural here. *)
71
Added:
module Workout : sig
72
Added:
type t
73
Added:
type id = private string
74
Added:
type error = Empty_workout
75
Added:
76
Added:
val make :
77
Added:
id:string -> name:string -> stimuli:Stimulus.t list -> (t, error) result
78
Added:
(** [Error Empty_workout] if [stimuli] is empty. *)
79
Added:
80
Added:
val id : t -> id
81
Added:
val name : t -> string
82
Added:
83
Added:
val stimuli : t -> Stimulus.t list
84
Added:
(** In performance order. *)
85
Added:
86
Added:
val equal : t -> t -> bool
87
Added:
(** By {!id}, which is what lets a routine find its place in the cycle. *)
88
Added:
89
Added:
val pp : Format.formatter -> t -> unit
90
Added:
end
91
Added:
92
Added:
(** The cycle of workouts, and how long to rest between them. *)
93
Added:
module Routine : sig
94
Added:
type t
95
Added:
type error = Empty_routine
96
Added:
97
Added:
val make : name:string -> workouts:Workout.t list -> (t, error) result
98
Added:
(** [Error Empty_routine] if [workouts] is empty. *)
99
Added:
100
Added:
val name : t -> string
101
Added:
102
Added:
val workouts : t -> Workout.t list
103
Added:
(** In cycle order. *)
104
Added:
105
Added:
val workout_after : t -> Workout.t -> Workout.t
106
Added:
(** The next workout in the cycle, wrapping at the end. Falls back to the
107
Added:
first workout when [t] does not contain the one given. *)
108
Added:
109
Added:
val pp : Format.formatter -> t -> unit
110
Added:
111
Added:
(** {1 Rest between workouts}
112
Added:
113
Added:
HD1 prescribes training every other day, then two full days off at the
114
Added:
conclusion of each cycle — so the recommended rest depends on where in the
115
Added:
cycle you are, and is not one flat interval. *)
116
Added:
117
Added:
val training_interval : Recovery.duration
118
Added:
(** 48h: every other day, within a cycle. *)
119
Added:
120
Added:
val cycle_rest : Recovery.duration
121
Added:
(** 72h: the two days off once the cycle completes. *)
122
Added:
123
Added:
val recovery_after : t -> Workout.t -> Recovery.duration
124
Added:
(** How long to rest having performed that workout. *)
125
Added:
126
Added:
(** {1 Presets} *)
127
Added:
128
Added:
val ideal : t
129
Added:
(** HD1's Ideal Routine, three workouts: pecs/delts/triceps, then
130
Added:
lats/traps/erectors/biceps, then legs/abs. *)
131
Added:
end
lib/core/progression.ml
@@ -1,13 +1,11 @@
1
Added:
module Movement = Evidence.Stimulus.Movement
2
Added:
1
3
let beats ~previous ~current =
2
4
let load =
3
Removed:
Units.Weight.compare
4
Removed:
(Stimulus.Movement.load current)
5
Removed:
(Stimulus.Movement.load previous)
5
Added:
Units.Weight.compare (Movement.load current) (Movement.load previous)
6
6
in
7
7
let reps =
8
Removed:
Units.Reps.compare
9
Removed:
(Stimulus.Movement.reps current)
10
Removed:
(Stimulus.Movement.reps previous)
8
Added:
Units.Reps.compare (Movement.reps current) (Movement.reps previous)
11
9
in
12
10
load > 0 || (load = 0 && reps > 0)
13
11
@@ -27,7 +25,7 @@
27
25
(* The most recent observation that improved on the one before it. *)
28
26
let last_advance observations =
29
27
let rec scan found = function
30
Removed:
| (previous : Logbook.observation) :: (current :: _ as rest) ->
28
Added:
| (previous : Evidence.Log.observation) :: (current :: _ as rest) ->
31
29
let found =
32
30
if beats ~previous:previous.movement ~current:current.movement then
33
31
Some current
@@ -38,7 +36,8 @@
38
36
in
39
37
scan None observations
40
38
41
Removed:
let elapsed_between (a : Logbook.observation) (b : Logbook.observation) =
39
Added:
let elapsed_between (a : Evidence.Log.observation)
40
Added:
(b : Evidence.Log.observation) =
42
41
Recovery.duration_to_seconds
43
42
(Recovery.elapsed ~since:a.performed_at ~now:b.performed_at)
44
43
@@ -97,10 +96,12 @@
97
96
| Increase of Units.Weight.t * Units.Weight.t
98
97
| Too_heavy
99
98
99
Added:
(* The trigger is absolute, so the window's ceiling never gates the verdict —
100
Added:
only its floor does. *)
100
101
let judge_load ~rep_range movement =
101
Removed:
let reps = Stimulus.Movement.reps movement in
102
Added:
let reps = Movement.reps movement in
102
103
if Units.Reps.compare reps load_increase_trigger >= 0 then
103
Removed:
let low, high = load_increase ~current:(Stimulus.Movement.load movement) in
104
Added:
let low, high = load_increase ~current:(Movement.load movement) in
104
105
Increase (low, high)
105
106
else if Units.Reps.compare reps (Units.Rep_range.min rep_range) < 0 then
106
107
Too_heavy
@@ -117,18 +118,18 @@
117
118
| Extensions_on_every_stimulus of int
118
119
| Trained_under_recovered of int
119
120
120
Removed:
let all_extended entry =
121
Removed:
match Entry.stimuli entry with
121
Added:
let all_extended workout =
122
Added:
match Evidence.Workout.stimuli workout with
122
123
| [] -> false
123
Removed:
| stimuli -> List.for_all Stimulus.is_extended stimuli
124
Added:
| stimuli -> List.for_all Evidence.Stimulus.is_extended stimuli
124
125
125
Removed:
let under_recovered entry =
126
Removed:
match Recovery.basis (Entry.clearance entry) with
126
Added:
let under_recovered workout =
127
Added:
match Recovery.basis (Evidence.Workout.clearance workout) with
127
128
| Recovery.Recovered -> false
128
129
| Recovery.Overridden _ -> true
129
130
130
Removed:
let diagnose entries =
131
Removed:
let count predicate = List.length (List.filter predicate entries) in
131
Added:
let diagnose workouts =
132
Added:
let count predicate = List.length (List.filter predicate workouts) in
132
133
let extended = count all_extended in
133
134
let overridden = count under_recovered in
134
135
let when_present n d = if n > 0 then [ d n ] else [] in
lib/core/progression.mli
@@ -1,6 +1,6 @@
1
1
(** Assessment: what the record says, and what follows from it.
2
2
3
Removed:
The only module that judges. Prescriptions state what to do, the logbook
3
Added:
The only module that judges. {!Prescription} states what to do, {!Evidence}
4
4
states what happened, and this decides what that means.
5
5
6
6
Its central asymmetry is Mentzer's: when progress halts, the answer is never
@@ -10,7 +10,10 @@
10
10
11
11
(** {1 Progress} *)
12
12
13
Removed:
val beats : previous:Stimulus.Movement.t -> current:Stimulus.Movement.t -> bool
13
Added:
val beats :
14
Added:
previous:Evidence.Stimulus.Movement.t ->
15
Added:
current:Evidence.Stimulus.Movement.t ->
16
Added:
bool
14
17
(** Whether the later performance is an advance: more load, or the same load for
15
18
more reps. HD1 counts "an increase in reps, weight or both", and holds that
16
19
even a single extra rep is significant. Fewer reps at a heavier load still
@@ -26,8 +29,10 @@
26
29
(** Two weeks. Progress must have ceased *entirely* for this long before the
27
30
routine is judged to be overtraining. *)
28
31
29
Removed:
val assess : Logbook.observation list -> (assessment, error) result
30
Removed:
(** Oldest first. [Error Insufficient_data] while the record is too short or too
32
Added:
val assess : Evidence.Log.observation list -> (assessment, error) result
33
Added:
(** Oldest first, and all of one exercise — {!Evidence.Log.observations} returns
34
Added:
exactly that. Mixing exercises compares unrelated movements and means
35
Added:
nothing. [Error Insufficient_data] while the record is too short or too
31
36
recent to distinguish a stall from an ordinary gap between advances. *)
32
37
33
38
(** {1 The one sanctioned response to a stall} *)
@@ -49,9 +54,9 @@
49
54
(** {1 Whether the load still calibrates the window} *)
50
55
51
56
val load_increase_trigger : Units.Reps.t
52
Removed:
(** Twelve reps. Note the slack: a window of 6-10 is not breached at 11 — HD1
53
Removed:
raises the load once twelve are reached, because beyond twelve the set ends
54
Removed:
in cardiorespiratory failure before the muscle does. *)
57
Added:
(** Twelve reps, and absolute: HD1 raises the load on reaching twelve, whatever
58
Added:
window was prescribed, because beyond twelve the set ends in
59
Added:
cardiorespiratory failure before the muscle does. *)
55
60
56
61
val load_increase : current:Units.Weight.t -> Units.Weight.t * Units.Weight.t
57
62
(** The 10-20% window to move into. A window, not a figure: HD1 says "or any
@@ -64,7 +69,11 @@
64
69
| Too_heavy (** Failure arrived below the window's floor. *)
65
70
66
71
val judge_load :
67
Removed:
rep_range:Units.Rep_range.t -> Stimulus.Movement.t -> load_verdict
72
Added:
rep_range:Units.Rep_range.t -> Evidence.Stimulus.Movement.t -> load_verdict
73
Added:
(** Only [rep_range]'s floor gates the verdict. Its ceiling does not: exceeding
74
Added:
the prescribed window is the slack HD1 allows — a 6-10 band is not breached
75
Added:
at eleven — and the load rises at {!load_increase_trigger} regardless of
76
Added:
where the ceiling sits. *)
68
77
69
78
val pp_load_verdict : Format.formatter -> load_verdict -> unit
70
79
@@ -82,7 +91,7 @@
82
91
| Trained_under_recovered of int
83
92
(** Workouts begun on an overridden clearance. *)
84
93
85
Removed:
val diagnose : Entry.t list -> diagnostic list
94
Added:
val diagnose : Evidence.Workout.t list -> diagnostic list
86
95
(** Only the habits actually present. *)
87
96
88
97
val pp_diagnostic : Format.formatter -> diagnostic -> unit
lib/core/routine.ml
@@ -1,105 +0,0 @@
1
Removed:
type error = Empty_routine
2
Removed:
type t = { name : string; workouts : Workout_prescription.t list }
3
Removed:
4
Removed:
let make ~name ~workouts =
5
Removed:
match workouts with [] -> Error Empty_routine | _ -> Ok { name; workouts }
6
Removed:
7
Removed:
let name t = t.name
8
Removed:
let workouts t = t.workouts
9
Removed:
let pp ppf t = Format.pp_print_string ppf t.name
10
Removed:
11
Removed:
let workout_after t performed =
12
Removed:
let rec next = function
13
Removed:
| [] | [ _ ] -> List.hd t.workouts
14
Removed:
| w :: (following :: _ as rest) ->
15
Removed:
if Workout_prescription.equal w performed then following else next rest
16
Removed:
in
17
Removed:
next t.workouts
18
Removed:
19
Removed:
let training_interval = Recovery.hours 48
20
Removed:
let cycle_rest = Recovery.hours 72
21
Removed:
22
Removed:
let recovery_after t performed =
23
Removed:
match List.rev t.workouts with
24
Removed:
| last :: _ when Workout_prescription.equal last performed -> cycle_rest
25
Removed:
| _ -> training_interval
26
Removed:
27
Removed:
(* {1 The Ideal Routine} *)
28
Removed:
29
Removed:
let preset_exn pp = function
30
Removed:
| Ok v -> v
31
Removed:
| Error e -> invalid_arg (Format.asprintf "Routine preset: %a" pp e)
32
Removed:
33
Removed:
let movement id =
34
Removed:
match Exercise.find id with
35
Removed:
| Some e -> e
36
Removed:
| None -> invalid_arg (Format.sprintf "Routine preset: no exercise %S" id)
37
Removed:
38
Removed:
(* HD1's guideline window for every listed exercise. *)
39
Removed:
let six_to_ten =
40
Removed:
let reps n =
41
Removed:
match Units.Reps.of_int n with Ok r -> r | Error _ -> assert false
42
Removed:
in
43
Removed:
match Units.Rep_range.make ~min:(reps 6) ~max:(reps 10) with
44
Removed:
| Ok r -> r
45
Removed:
| Error _ -> assert false
46
Removed:
47
Removed:
let prescribe ?(substitutes = []) delivery =
48
Removed:
preset_exn Prescription.pp_error
49
Removed:
(Prescription.make ~delivery ~rep_range:six_to_ten
50
Removed:
~allowed_substitutes:(List.map movement substitutes))
51
Removed:
52
Removed:
let single ?substitutes id =
53
Removed:
prescribe ?substitutes (Prescription.Single (movement id))
54
Removed:
55
Removed:
let pre_exhaust ?substitutes ~isolation ~compound () =
56
Removed:
prescribe ?substitutes
57
Removed:
(Prescription.Pre_exhaust
58
Removed:
{ isolation = movement isolation; compound = movement compound })
59
Removed:
60
Removed:
let workout ~id ~name prescriptions =
61
Removed:
preset_exn
62
Removed:
(fun ppf Workout_prescription.Empty_workout ->
63
Removed:
Format.pp_print_string ppf "empty workout")
64
Removed:
(Workout_prescription.make ~id ~name ~prescriptions)
65
Removed:
66
Removed:
let ideal_day_one =
67
Removed:
workout ~id:"ideal-day-1" ~name:"Day 1"
68
Removed:
[
69
Removed:
pre_exhaust
70
Removed:
~substitutes:[ "cable-crossovers"; "pec-deck" ]
71
Removed:
~isolation:"dumbbell-flyes" ~compound:"incline-press" ();
72
Removed:
single "laterals";
73
Removed:
single ~substitutes:[ "reverse-pec-deck" ] "bent-over-laterals";
74
Removed:
pre_exhaust
75
Removed:
~substitutes:[ "pressdowns"; "triceps-machine" ]
76
Removed:
~isolation:"lying-french-press" ~compound:"dips" ();
77
Removed:
]
78
Removed:
79
Removed:
let ideal_day_two =
80
Removed:
workout ~id:"ideal-day-2" ~name:"Day 2"
81
Removed:
[
82
Removed:
pre_exhaust
83
Removed:
~substitutes:[ "straight-arm-pulldowns" ]
84
Removed:
~isolation:"pullovers" ~compound:"close-grip-pulldowns" ();
85
Removed:
single "bent-over-rows";
86
Removed:
single "shrugs";
87
Removed:
single ~substitutes:[ "deadlifts" ] "hyperextensions";
88
Removed:
single ~substitutes:[ "preacher-curls" ] "curls";
89
Removed:
]
90
Removed:
91
Removed:
let ideal_day_three =
92
Removed:
workout ~id:"ideal-day-3" ~name:"Day 3"
93
Removed:
[
94
Removed:
pre_exhaust ~substitutes:[ "squats" ] ~isolation:"leg-extensions"
95
Removed:
~compound:"leg-presses" ();
96
Removed:
single "leg-curls";
97
Removed:
single "calf-raises";
98
Removed:
single "sit-ups";
99
Removed:
]
100
Removed:
101
Removed:
let ideal_routine =
102
Removed:
preset_exn
103
Removed:
(fun ppf Empty_routine -> Format.pp_print_string ppf "empty routine")
104
Removed:
(make ~name:"Ideal Routine"
105
Removed:
~workouts:[ ideal_day_one; ideal_day_two; ideal_day_three ])
lib/core/routine.mli
@@ -1,44 +0,0 @@
1
Removed:
(** A routine: the sequence of prescribed workouts cycled through over time, and
2
Removed:
how long to rest between them.
3
Removed:
4
Removed:
A routine prescribes; it never judges. What the evidence says about it is
5
Removed:
{!Progression}'s business. *)
6
Removed:
7
Removed:
type t
8
Removed:
type error = Empty_routine
9
Removed:
10
Removed:
val make :
11
Removed:
name:string -> workouts:Workout_prescription.t list -> (t, error) result
12
Removed:
(** [Error Empty_routine] if [workouts] is empty. *)
13
Removed:
14
Removed:
val name : t -> string
15
Removed:
16
Removed:
val workouts : t -> Workout_prescription.t list
17
Removed:
(** In cycle order. *)
18
Removed:
19
Removed:
val workout_after : t -> Workout_prescription.t -> Workout_prescription.t
20
Removed:
(** The next workout in the cycle, wrapping at the end. Falls back to the first
21
Removed:
workout when [t] does not contain the one given. *)
22
Removed:
23
Removed:
val pp : Format.formatter -> t -> unit
24
Removed:
25
Removed:
(** {1 Rest between workouts}
26
Removed:
27
Removed:
HD1 prescribes training every other day, then two full days off at the
28
Removed:
conclusion of each cycle — so the recommended rest depends on where in the
29
Removed:
cycle you are, and is not one flat interval. *)
30
Removed:
31
Removed:
val training_interval : Recovery.duration
32
Removed:
(** 48h: every other day, within a cycle. *)
33
Removed:
34
Removed:
val cycle_rest : Recovery.duration
35
Removed:
(** 72h: the two days off once the cycle completes. *)
36
Removed:
37
Removed:
val recovery_after : t -> Workout_prescription.t -> Recovery.duration
38
Removed:
(** How long to rest having performed that workout. *)
39
Removed:
40
Removed:
(** {1 Presets} *)
41
Removed:
42
Removed:
val ideal_routine : t
43
Removed:
(** HD1's Ideal Routine, three workouts: pecs/delts/triceps, then
44
Removed:
lats/traps/erectors/biceps, then legs/abs. *)
lib/core/stimulus.ml
@@ -1,102 +0,0 @@
1
Removed:
type extension = Forced_reps | Negatives | Rest_pause | Static_hold
2
Removed:
type outcome = Positive_failure | Beyond_failure of extension * extension list
3
Removed:
4
Removed:
let extensions_of_outcome = function
5
Removed:
| Positive_failure -> []
6
Removed:
| Beyond_failure (first, rest) -> first :: rest
7
Removed:
8
Removed:
let pp_extension ppf e =
9
Removed:
Format.pp_print_string ppf
10
Removed:
(match e with
11
Removed:
| Forced_reps -> "forced reps"
12
Removed:
| Negatives -> "negatives"
13
Removed:
| Rest_pause -> "rest-pause"
14
Removed:
| Static_hold -> "static hold")
15
Removed:
16
Removed:
module Warm_up = struct
17
Removed:
type t = { exercise : Exercise.t; load : Units.Weight.t; reps : Units.Reps.t }
18
Removed:
19
Removed:
let make ~exercise ~load ~reps = { exercise; load; reps }
20
Removed:
let exercise t = t.exercise
21
Removed:
let load t = t.load
22
Removed:
let reps t = t.reps
23
Removed:
24
Removed:
let pp ppf t =
25
Removed:
Format.fprintf ppf "%a %a x %a" Exercise.pp t.exercise Units.Weight.pp
26
Removed:
t.load Units.Reps.pp t.reps
27
Removed:
end
28
Removed:
29
Removed:
module Movement = struct
30
Removed:
type t = {
31
Removed:
exercise : Exercise.t;
32
Removed:
load : Units.Weight.t;
33
Removed:
reps : Units.Reps.t;
34
Removed:
outcome : outcome;
35
Removed:
}
36
Removed:
37
Removed:
let make ~exercise ~load ~reps ~outcome = { exercise; load; reps; outcome }
38
Removed:
let exercise t = t.exercise
39
Removed:
let load t = t.load
40
Removed:
let reps t = t.reps
41
Removed:
let outcome t = t.outcome
42
Removed:
let extensions t = extensions_of_outcome t.outcome
43
Removed:
44
Removed:
let pp ppf t =
45
Removed:
Format.fprintf ppf "%a %a x %a" Exercise.pp t.exercise Units.Weight.pp
46
Removed:
t.load Units.Reps.pp t.reps;
47
Removed:
match extensions t with
48
Removed:
| [] -> ()
49
Removed:
| es ->
50
Removed:
Format.fprintf ppf " (%a)"
51
Removed:
(Format.pp_print_list
52
Removed:
~pp_sep:(fun ppf () -> Format.pp_print_string ppf ", ")
53
Removed:
pp_extension)
54
Removed:
es
55
Removed:
end
56
Removed:
57
Removed:
type delivery =
58
Removed:
| Single of Movement.t
59
Removed:
| Pre_exhaust of { isolation : Movement.t; compound : Movement.t }
60
Removed:
61
Removed:
type t = { delivery : delivery; warm_ups : Warm_up.t list }
62
Removed:
63
Removed:
type error =
64
Removed:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
65
Removed:
66
Removed:
let pp_error ppf (Not_a_pre_exhaust { isolation; compound }) =
67
Removed:
Format.fprintf ppf "%s cannot pre-exhaust for %s"
68
Removed:
(isolation :> string)
69
Removed:
(compound :> string)
70
Removed:
71
Removed:
let make ?(warm_ups = []) delivery =
72
Removed:
match delivery with
73
Removed:
| Pre_exhaust { isolation; compound }
74
Removed:
when not
75
Removed:
(Exercise.may_pre_exhaust
76
Removed:
~isolation:(Movement.exercise isolation)
77
Removed:
~compound:(Movement.exercise compound)) ->
78
Removed:
Error
79
Removed:
(Not_a_pre_exhaust
80
Removed:
{
81
Removed:
isolation = Exercise.id (Movement.exercise isolation);
82
Removed:
compound = Exercise.id (Movement.exercise compound);
83
Removed:
})
84
Removed:
| _ -> Ok { delivery; warm_ups }
85
Removed:
86
Removed:
let delivery t = t.delivery
87
Removed:
let warm_ups t = t.warm_ups
88
Removed:
89
Removed:
let movements t =
90
Removed:
match t.delivery with
91
Removed:
| Single m -> [ m ]
92
Removed:
| Pre_exhaust { isolation; compound } -> [ isolation; compound ]
93
Removed:
94
Removed:
let exercises t = List.map Movement.exercise (movements t)
95
Removed:
let extensions t = List.concat_map Movement.extensions (movements t)
96
Removed:
let is_extended t = extensions t <> []
97
Removed:
98
Removed:
let pp ppf t =
99
Removed:
match t.delivery with
100
Removed:
| Single m -> Movement.pp ppf m
101
Removed:
| Pre_exhaust { isolation; compound } ->
102
Removed:
Format.fprintf ppf "%a into %a" Movement.pp isolation Movement.pp compound
lib/core/stimulus.mli
@@ -1,86 +0,0 @@
1
Removed:
(** One stimulus: a single drive to muscular failure, and the record of what it
2
Removed:
took.
3
Removed:
4
Removed:
The unit of work. HD1 prescribes one set per exercise, so there is no set
5
Removed:
count. Reaching failure is not recorded because it is not optional — a
6
Removed:
movement here always went to failure. *)
7
Removed:
8
Removed:
(** A means of continuing past positive failure. HD1 treats these as occasional:
9
Removed:
used on every exercise they lead straight to overtraining, and forced reps
10
Removed:
and negatives both need a spotter. *)
11
Removed:
type extension = Forced_reps | Negatives | Rest_pause | Static_hold
12
Removed:
13
Removed:
(** How the drive ended. *)
14
Removed:
type outcome =
15
Removed:
| Positive_failure (** Unable to complete another rep unaided. *)
16
Removed:
| Beyond_failure of extension * extension list
17
Removed:
(** In the order applied — HD1 stacks negatives after forced reps. Split
18
Removed:
so that "beyond failure by no means at all" cannot be written. *)
19
Removed:
20
Removed:
val extensions_of_outcome : outcome -> extension list
21
Removed:
val pp_extension : Format.formatter -> extension -> unit
22
Removed:
23
Removed:
(** Preparation for a stimulus: enough to bring blood to the muscles and joints,
24
Removed:
no more. Carries no outcome, so a warm-up cannot reach failure. *)
25
Removed:
module Warm_up : sig
26
Removed:
type t
27
Removed:
28
Removed:
val make :
29
Removed:
exercise:Exercise.t -> load:Units.Weight.t -> reps:Units.Reps.t -> t
30
Removed:
31
Removed:
val exercise : t -> Exercise.t
32
Removed:
val load : t -> Units.Weight.t
33
Removed:
val reps : t -> Units.Reps.t
34
Removed:
val pp : Format.formatter -> t -> unit
35
Removed:
end
36
Removed:
37
Removed:
(** One movement driven to failure within a stimulus. *)
38
Removed:
module Movement : sig
39
Removed:
type t
40
Removed:
41
Removed:
val make :
42
Removed:
exercise:Exercise.t ->
43
Removed:
load:Units.Weight.t ->
44
Removed:
reps:Units.Reps.t ->
45
Removed:
outcome:outcome ->
46
Removed:
t
47
Removed:
48
Removed:
val exercise : t -> Exercise.t
49
Removed:
val load : t -> Units.Weight.t
50
Removed:
val reps : t -> Units.Reps.t
51
Removed:
val outcome : t -> outcome
52
Removed:
val extensions : t -> extension list
53
Removed:
val pp : Format.formatter -> t -> unit
54
Removed:
end
55
Removed:
56
Removed:
(** How the stimulus was delivered — the performed counterpart of
57
Removed:
{!Prescription.delivery}. *)
58
Removed:
type delivery =
59
Removed:
| Single of Movement.t
60
Removed:
| Pre_exhaust of { isolation : Movement.t; compound : Movement.t }
61
Removed:
62
Removed:
type t
63
Removed:
64
Removed:
type error =
65
Removed:
| Not_a_pre_exhaust of { isolation : Exercise.id; compound : Exercise.id }
66
Removed:
67
Removed:
val pp_error : Format.formatter -> error -> unit
68
Removed:
69
Removed:
val make : ?warm_ups:Warm_up.t list -> delivery -> (t, error) result
70
Removed:
(** A [Pre_exhaust] must genuinely pre-exhaust; two unrelated movements are two
71
Removed:
stimuli, not one. This refuses a mislabelled pairing, not an honest record.
72
Removed:
*)
73
Removed:
74
Removed:
val delivery : t -> delivery
75
Removed:
76
Removed:
val movements : t -> Movement.t list
77
Removed:
(** In performance order; isolation first for a pre-exhaust. *)
78
Removed:
79
Removed:
val warm_ups : t -> Warm_up.t list
80
Removed:
val exercises : t -> Exercise.t list
81
Removed:
82
Removed:
val extensions : t -> extension list
83
Removed:
(** Everything that carried this stimulus past failure, across its movements. *)
84
Removed:
85
Removed:
val is_extended : t -> bool
86
Removed:
val pp : Format.formatter -> t -> unit
lib/core/workout_prescription.ml
@@ -1,14 +0,0 @@
1
Removed:
type id = string
2
Removed:
type error = Empty_workout
3
Removed:
type t = { id : id; name : string; prescriptions : Prescription.t list }
4
Removed:
5
Removed:
let make ~id ~name ~prescriptions =
6
Removed:
match prescriptions with
7
Removed:
| [] -> Error Empty_workout
8
Removed:
| _ -> Ok { id; name; prescriptions }
9
Removed:
10
Removed:
let id t = t.id
11
Removed:
let name t = t.name
12
Removed:
let prescriptions t = t.prescriptions
13
Removed:
let equal a b = String.equal a.id b.id
14
Removed:
let pp ppf t = Format.pp_print_string ppf t.name
lib/core/workout_prescription.mli
@@ -1,28 +0,0 @@
1
Removed:
(** One prescribed workout within a routine, such as HD1's Day 1: an ordered
2
Removed:
sequence of prescribed stimuli.
3
Removed:
4
Removed:
Each prescription is exactly one drive to failure, so the workout's volume
5
Removed:
is its length — HD1's "least amount required" is structural here. Static: no
6
Removed:
history, no targets. *)
7
Removed:
8
Removed:
type t
9
Removed:
type id = private string
10
Removed:
type error = Empty_workout
11
Removed:
12
Removed:
val make :
13
Removed:
id:string ->
14
Removed:
name:string ->
15
Removed:
prescriptions:Prescription.t list ->
16
Removed:
(t, error) result
17
Removed:
(** [Error Empty_workout] if [prescriptions] is empty. *)
18
Removed:
19
Removed:
val id : t -> id
20
Removed:
val name : t -> string
21
Removed:
22
Removed:
val prescriptions : t -> Prescription.t list
23
Removed:
(** In performance order. *)
24
Removed:
25
Removed:
val equal : t -> t -> bool
26
Removed:
(** By {!id}, which is what lets a routine find its place in the cycle. *)
27
Removed:
28
Removed:
val pp : Format.formatter -> t -> unit
lib/web/pages.ml
@@ -54,15 +54,17 @@
54
54
let problem ~title:t ~detail =
55
55
shell ~title:t [ h2 [ txt t ]; p ~a:[ a_class [ "warn" ] ] [ txt detail ] ]
56
56
57
Removed:
(* A prescription described in words: the movements, and the rep window that
58
Removed:
calibrates the load. *)
57
Added:
(* A prescribed stimulus described in words: the movements, and the rep window
58
Added:
that calibrates the load. *)
59
59
let describe_prescription p =
60
60
let window =
61
Removed:
Format.asprintf "%a reps" Units.Rep_range.pp (Prescription.rep_range p)
61
Added:
Format.asprintf "%a reps" Units.Rep_range.pp
62
Added:
(Prescription.Stimulus.rep_range p)
62
63
in
63
Removed:
match Prescription.delivery p with
64
Removed:
| Prescription.Single e -> Printf.sprintf "%s — %s" (Exercise.name e) window
65
Removed:
| Prescription.Pre_exhaust { isolation; compound } ->
64
Added:
match Prescription.Stimulus.delivery p with
65
Added:
| Prescription.Stimulus.Single e ->
66
Added:
Printf.sprintf "%s — %s" (Exercise.name e) window
67
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
66
68
Printf.sprintf "%s into %s, no pause — %s" (Exercise.name isolation)
67
69
(Exercise.name compound) window
68
70
@@ -75,7 +77,8 @@
75
77
| first :: rest -> Form.select ~name Form.string first rest
76
78
| [] -> assert false
77
79
78
Removed:
let choose_routine ~(routines : (Repository.routine_id * Routine.t) list) =
80
Added:
let choose_routine
81
Added:
~(routines : (Repository.routine_id * Prescription.Routine.t) list) =
79
82
shell ~title:"Choose a routine"
80
83
[
81
84
h2 [ txt "Routines" ];
@@ -86,13 +89,13 @@
86
89
(fun (routine, reason) ->
87
90
[
88
91
fieldset
89
Removed:
~legend:(legend [ txt (Routine.name r) ])
92
Added:
~legend:(legend [ txt (Prescription.Routine.name r) ])
90
93
[
91
94
p
92
95
[
93
96
txt
94
97
(Printf.sprintf "%d workouts in the cycle."
95
Removed:
(List.length (Routine.workouts r)));
98
Added:
(List.length (Prescription.Routine.workouts r)));
96
99
];
97
100
Form.input ~input_type:`Hidden ~name:routine
98
101
~value:(id_string id) Form.string;
@@ -116,7 +119,7 @@
116
119
in
117
120
shell ~title:"Not recovered"
118
121
[
119
Removed:
h2 [ txt ("Next: " ^ Workout_prescription.name workout) ];
122
Added:
h2 [ txt ("Next: " ^ Prescription.Workout.name workout) ];
120
123
div
121
124
~a:[ a_class [ "warn" ] ]
122
125
[
@@ -246,26 +249,28 @@
246
249
let describe_stimulus s =
247
250
let movement m =
248
251
Format.asprintf "%s %a x %a"
249
Removed:
(Exercise.name (Stimulus.Movement.exercise m))
250
Removed:
Units.Weight.pp (Stimulus.Movement.load m) Units.Reps.pp
251
Removed:
(Stimulus.Movement.reps m)
252
Added:
(Exercise.name (Evidence.Stimulus.Movement.exercise m))
253
Added:
Units.Weight.pp
254
Added:
(Evidence.Stimulus.Movement.load m)
255
Added:
Units.Reps.pp
256
Added:
(Evidence.Stimulus.Movement.reps m)
252
257
in
253
258
let body =
254
Removed:
String.concat " into " (List.map movement (Stimulus.movements s))
259
Added:
String.concat " into " (List.map movement (Evidence.Stimulus.movements s))
255
260
in
256
Removed:
match Stimulus.extensions s with
261
Added:
match Evidence.Stimulus.extensions s with
257
262
| [] -> body
258
263
| es ->
259
264
body ^ ", "
260
265
^ String.concat " then "
261
Removed:
(List.map (Format.asprintf "%a" Stimulus.pp_extension) es)
266
Added:
(List.map (Format.asprintf "%a" Evidence.Stimulus.pp_extension) es)
262
267
263
Removed:
let log_workout ~entry =
264
Removed:
let prescription = Entry.prescription entry in
265
Removed:
let performed = Entry.stimuli entry in
266
Removed:
let outstanding = Entry.outstanding entry in
268
Added:
let log_workout ~workout =
269
Added:
let prescription = Evidence.Workout.prescription workout in
270
Added:
let performed = Evidence.Workout.stimuli workout in
271
Added:
let outstanding = Evidence.Workout.outstanding workout in
267
272
let override_note =
268
Removed:
match Recovery.basis (Entry.clearance entry) with
273
Added:
match Recovery.basis (Evidence.Workout.clearance workout) with
269
274
| Recovery.Recovered -> []
270
275
| Recovery.Overridden { reason; _ } ->
271
276
[
@@ -275,15 +280,15 @@
275
280
]
276
281
in
277
282
shell
278
Removed:
~title:(Workout_prescription.name prescription)
283
Added:
~title:(Prescription.Workout.name prescription)
279
284
(override_note
280
285
@ [
281
Removed:
h2 [ txt (Workout_prescription.name prescription) ];
286
Added:
h2 [ txt (Prescription.Workout.name prescription) ];
282
287
p
283
288
[
284
289
txt
285
290
(Printf.sprintf "%d of %d recorded." (List.length performed)
286
Removed:
(List.length (Workout_prescription.prescriptions prescription)));
291
Added:
(List.length (Prescription.Workout.stimuli prescription)));
287
292
];
288
293
]
289
294
@ (if performed = [] then []
@@ -298,9 +303,10 @@
298
303
h2 [ txt "Still to do" ]
299
304
:: List.map
300
305
(fun (slot, p) ->
301
Removed:
match Prescription.delivery p with
302
Removed:
| Prescription.Single _ -> single_form ~slot ~prescription:p
303
Removed:
| Prescription.Pre_exhaust { isolation; compound } ->
306
Added:
match Prescription.Stimulus.delivery p with
307
Added:
| Prescription.Stimulus.Single _ ->
308
Added:
single_form ~slot ~prescription:p
309
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
304
310
pair_form ~slot ~prescription:p ~isolation ~compound)
305
311
outstanding)
306
312
@ [
@@ -321,17 +327,18 @@
321
327
ul
322
328
(List.map
323
329
(fun r ->
324
Removed:
let e = r.Repository.entry in
330
Added:
let w = r.Repository.workout in
325
331
li
326
332
[
327
333
txt
328
334
(Printf.sprintf "%s — %d stimuli"
329
Removed:
(Workout_prescription.name (Entry.prescription e))
330
Removed:
(List.length (Entry.stimuli e)));
335
Added:
(Prescription.Workout.name
336
Added:
(Evidence.Workout.prescription w))
337
Added:
(List.length (Evidence.Workout.stimuli w)));
331
338
ul
332
339
(List.map
333
340
(fun s -> li [ txt (describe_stimulus s) ])
334
Removed:
(Entry.stimuli e));
341
Added:
(Evidence.Workout.stimuli w));
335
342
])
336
343
records));
337
344
]
lib/web/pages.mli
@@ -6,11 +6,12 @@
6
6
7
7
type page = Html_types.html Eliom_content.Html.elt
8
8
9
Removed:
val choose_routine : routines:(Repository.routine_id * Routine.t) list -> page
9
Added:
val choose_routine :
10
Added:
routines:(Repository.routine_id * Prescription.Routine.t) list -> page
10
11
11
12
val recovery_gate :
12
13
routine:Repository.routine_id ->
13
Removed:
workout:Workout_prescription.t ->
14
Added:
workout:Prescription.Workout.t ->
14
15
readiness:Recovery.readiness ->
15
16
page
16
17
(** The refusal. States how much of the recommended rest remains, and offers to
@@ -18,7 +19,7 @@
18
19
recovery as the primary error, so it is deliberately a second step rather
19
20
than one click. *)
20
21
21
Removed:
val log_workout : entry:Entry.t -> page
22
Added:
val log_workout : workout:Evidence.Workout.t -> page
22
23
(** The workout in progress: what is outstanding, what has been performed, and a
23
24
form per outstanding stimulus. *)
24
25
lib/web/routes.ml
@@ -10,10 +10,10 @@
10
10
form did not offer, rather than silently dropping it. *)
11
11
let extension_of_string = function
12
12
| "" -> Ok None
13
Removed:
| "forced" -> Ok (Some Stimulus.Forced_reps)
14
Removed:
| "negatives" -> Ok (Some Stimulus.Negatives)
15
Removed:
| "rest-pause" -> Ok (Some Stimulus.Rest_pause)
16
Removed:
| "static" -> Ok (Some Stimulus.Static_hold)
13
Added:
| "forced" -> Ok (Some Evidence.Stimulus.Forced_reps)
14
Added:
| "negatives" -> Ok (Some Evidence.Stimulus.Negatives)
15
Added:
| "rest-pause" -> Ok (Some Evidence.Stimulus.Rest_pause)
16
Added:
| "static" -> Ok (Some Evidence.Stimulus.Static_hold)
17
17
| other -> Error other
18
18
19
19
let extension_choices =
lib/web/services.ml
@@ -12,7 +12,7 @@
12
12
13
13
let home_page () =
14
14
match Service.in_progress service with
15
Removed:
| Some entry -> Pages.log_workout ~entry
15
Added:
| Some workout -> Pages.log_workout ~workout
16
16
| None -> Pages.choose_routine ~routines:(Service.list_routines service)
17
17
18
18
let register () =
@@ -22,7 +22,7 @@
22
22
Eliom_registration.Html.register ~service:Routes.log (fun () () ->
23
23
Lwt.return
24
24
(match Service.in_progress service with
25
Removed:
| Some entry -> Pages.log_workout ~entry
25
Added:
| Some workout -> Pages.log_workout ~workout
26
26
| None ->
27
27
Pages.problem ~title:"No workout in progress"
28
28
~detail:"Choose a routine to begin one."));
@@ -40,7 +40,7 @@
40
40
(match
41
41
Service.begin_workout service ~routine ~now:(now ()) ?override ()
42
42
with
43
Removed:
| Ok entry -> Pages.log_workout ~entry
43
Added:
| Ok workout -> Pages.log_workout ~workout
44
44
| Error (Service.Not_recovered readiness) -> (
45
45
match Service.next_workout service ~routine with
46
46
| Ok workout -> Pages.recovery_gate ~routine ~workout ~readiness
@@ -54,13 +54,13 @@
54
54
let logged result =
55
55
Lwt.return
56
56
(match result with
57
Removed:
| Ok entry -> Pages.log_workout ~entry
57
Added:
| Ok workout -> Pages.log_workout ~workout
58
58
| Error Service.No_workout_in_progress ->
59
59
Pages.problem ~title:"No workout in progress"
60
60
~detail:"Choose a routine to begin one."
61
61
| Error (Service.Rejected e) ->
62
62
Pages.problem ~title:"That is not what was prescribed"
63
Removed:
~detail:(Format.asprintf "%a" Entry.pp_error e))
63
Added:
~detail:(Format.asprintf "%a" Evidence.Workout.pp_error e))
64
64
in
65
65
66
66
let build_movement ~exercise ~load ~reps ~extension =
@@ -68,10 +68,10 @@
68
68
| Ok load, Ok reps ->
69
69
let outcome =
70
70
match extension with
71
Removed:
| None -> Stimulus.Positive_failure
72
Removed:
| Some e -> Stimulus.Beyond_failure (e, [])
71
Added:
| None -> Evidence.Stimulus.Positive_failure
72
Added:
| Some e -> Evidence.Stimulus.Beyond_failure (e, [])
73
73
in
74
Removed:
Ok (Stimulus.Movement.make ~exercise ~load ~reps ~outcome)
74
Added:
Ok (Evidence.Stimulus.Movement.make ~exercise ~load ~reps ~outcome)
75
75
| Error e, _ | _, Error e -> Error (Format.asprintf "%a" Units.pp_error e)
76
76
in
77
77
@@ -79,9 +79,9 @@
79
79
let prescribed_at slot =
80
80
match Service.in_progress service with
81
81
| None -> None
82
Removed:
| Some entry ->
83
Removed:
List.assoc_opt slot (Entry.outstanding entry)
84
Removed:
|> Option.map (fun p -> (entry, p))
82
Added:
| Some workout ->
83
Added:
List.assoc_opt slot (Evidence.Workout.outstanding workout)
84
Added:
|> Option.map (fun p -> (workout, p))
85
85
in
86
86
87
87
Eliom_registration.Html.register ~service:Routes.log_single
@@ -97,22 +97,25 @@
97
97
(Pages.problem ~title:"No such outstanding stimulus"
98
98
~detail:"That slot is not awaiting a record.")
99
99
| Ok extension, Some (_, prescription) -> (
100
Removed:
match Prescription.delivery prescription with
101
Removed:
| Prescription.Pre_exhaust _ ->
100
Added:
match Prescription.Stimulus.delivery prescription with
101
Added:
| Prescription.Stimulus.Pre_exhaust _ ->
102
102
Lwt.return
103
103
(Pages.problem ~title:"That slot prescribes a pair"
104
104
~detail:
105
105
"A pre-exhaust pair cannot be recorded as a single set.")
106
Removed:
| Prescription.Single exercise -> (
106
Added:
| Prescription.Stimulus.Single exercise -> (
107
107
match build_movement ~exercise ~load ~reps ~extension with
108
108
| Error detail ->
109
109
Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
110
110
| Ok movement -> (
111
Removed:
match Stimulus.make (Stimulus.Single movement) with
111
Added:
match
112
Added:
Evidence.Stimulus.make (Evidence.Stimulus.Single movement)
113
Added:
with
112
114
| Error e ->
113
115
Lwt.return
114
116
(Pages.problem ~title:"Could not record"
115
Removed:
~detail:(Format.asprintf "%a" Stimulus.pp_error e))
117
Added:
~detail:
118
Added:
(Format.asprintf "%a" Evidence.Stimulus.pp_error e))
116
119
| Ok stimulus -> logged (Service.log service stimulus)))));
117
120
118
121
Eliom_registration.Html.register ~service:Routes.log_pair
@@ -129,12 +132,12 @@
129
132
(Pages.problem ~title:"No such outstanding stimulus"
130
133
~detail:"That slot is not awaiting a record.")
131
134
| Ok extension, Some (_, prescription) -> (
132
Removed:
match Prescription.delivery prescription with
133
Removed:
| Prescription.Single _ ->
135
Added:
match Prescription.Stimulus.delivery prescription with
136
Added:
| Prescription.Stimulus.Single _ ->
134
137
Lwt.return
135
138
(Pages.problem ~title:"That slot prescribes a single set"
136
139
~detail:"Only a pre-exhaust slot takes two movements.")
137
Removed:
| Prescription.Pre_exhaust { isolation; compound } -> (
140
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } -> (
138
141
(* HD1 applies the extension to the movement that finishes the
139
142
pair, so it lands on the compound. *)
140
143
match
@@ -147,12 +150,14 @@
147
150
Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
148
151
| Ok isolation, Ok compound -> (
149
152
match
150
Removed:
Stimulus.make (Stimulus.Pre_exhaust { isolation; compound })
153
Added:
Evidence.Stimulus.make
154
Added:
(Evidence.Stimulus.Pre_exhaust { isolation; compound })
151
155
with
152
156
| Error e ->
153
157
Lwt.return
154
158
(Pages.problem ~title:"Could not record"
155
Removed:
~detail:(Format.asprintf "%a" Stimulus.pp_error e))
159
Added:
~detail:
160
Added:
(Format.asprintf "%a" Evidence.Stimulus.pp_error e))
156
161
| Ok stimulus -> logged (Service.log service stimulus)))));
157
162
158
163
Eliom_registration.Html.register ~service:Routes.finish (fun () () ->
test/dune
@@ -1,5 +1,3 @@
1
Removed:
; Every module of the HD1 rebuild now has a registered suite.
2
Removed:
3
1
(test
4
2
(name test_hito)
5
3
(modules
@@ -7,13 +5,9 @@
7
5
test_units
8
6
test_muscle
9
7
test_exercise
10
Removed:
test_prescription
11
Removed:
test_workout_prescription
12
Removed:
test_routine
13
Removed:
test_stimulus
14
8
test_recovery
15
Removed:
test_entry
16
Removed:
test_logbook
9
Added:
test_prescription
10
Added:
test_evidence
17
11
test_progression
18
12
test_service)
19
13
(libraries hito.core hito.app alcotest))
test/test_entry.ml
@@ -1,208 +0,0 @@
1
Removed:
(** Unit tests for {!Entry}. *)
2
Removed:
3
Removed:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
Removed:
5
Removed:
let get id =
6
Removed:
match Exercise.find id with
7
Removed:
| Some e -> e
8
Removed:
| None -> Alcotest.failf "catalog is missing %S" id
9
Removed:
10
Removed:
let kg n = ok (Units.Weight.of_kg n)
11
Removed:
let reps n = ok (Units.Reps.of_int n)
12
Removed:
let at s = Recovery.timestamp_of_unix_seconds s
13
Removed:
14
Removed:
let move ?(outcome = Stimulus.Positive_failure) id load r =
15
Removed:
Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
16
Removed:
~outcome
17
Removed:
18
Removed:
let single id load r = ok (Stimulus.make (Stimulus.Single (move id load r)))
19
Removed:
20
Removed:
let pre_exhaust iso_m comp_m =
21
Removed:
ok
22
Removed:
(Stimulus.make
23
Removed:
(Stimulus.Pre_exhaust { isolation = iso_m; compound = comp_m }))
24
Removed:
25
Removed:
let day_one = List.hd (Routine.workouts Routine.ideal_routine)
26
Removed:
let cleared = Option.get (Recovery.clear Recovery.Ready)
27
Removed:
let fresh () = Entry.start day_one ~clearance:cleared ~started_at:(at 0)
28
Removed:
29
Removed:
(* HD1's Day 1, in the order it lists. *)
30
Removed:
let day_one_stimuli =
31
Removed:
[
32
Removed:
pre_exhaust (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7);
33
Removed:
single "laterals" 12. 8;
34
Removed:
single "bent-over-laterals" 10. 9;
35
Removed:
pre_exhaust (move "lying-french-press" 30. 8) (move "dips" 0. 6);
36
Removed:
]
37
Removed:
38
Removed:
let lifecycle_tests =
39
Removed:
[
40
Removed:
( "a fresh entry has performed nothing and answers its prescription",
41
Removed:
`Quick,
42
Removed:
fun () ->
43
Removed:
let e = fresh () in
44
Removed:
Alcotest.(check string)
45
Removed:
"prescription" "Day 1"
46
Removed:
(Workout_prescription.name (Entry.prescription e));
47
Removed:
Alcotest.(check int) "no stimuli" 0 (List.length (Entry.stimuli e));
48
Removed:
Alcotest.(check int)
49
Removed:
"four slots outstanding" 4
50
Removed:
(List.length (Entry.unperformed e));
51
Removed:
Alcotest.(check bool) "unfinished" false (Entry.is_finished e);
52
Removed:
Alcotest.(check bool)
53
Removed:
"no duration" true
54
Removed:
(Option.is_none (Entry.duration e)) );
55
Removed:
( "HD1's Day 1 can be logged end to end",
56
Removed:
`Quick,
57
Removed:
fun () ->
58
Removed:
let e =
59
Removed:
List.fold_left
60
Removed:
(fun e s -> ok (Entry.add_stimulus e s))
61
Removed:
(fresh ()) day_one_stimuli
62
Removed:
in
63
Removed:
Alcotest.(check int) "four stimuli" 4 (List.length (Entry.stimuli e));
64
Removed:
Alcotest.(check int)
65
Removed:
"nothing outstanding" 0
66
Removed:
(List.length (Entry.unperformed e));
67
Removed:
let finished = ok (Entry.finish e ~ended_at:(at 2400)) in
68
Removed:
Alcotest.(check bool) "finished" true (Entry.is_finished finished);
69
Removed:
Alcotest.(check (option int))
70
Removed:
"40 minutes" (Some 2400)
71
Removed:
(Option.map Recovery.duration_to_seconds (Entry.duration finished)) );
72
Removed:
( "stimuli come back in the order performed",
73
Removed:
`Quick,
74
Removed:
fun () ->
75
Removed:
let e =
76
Removed:
List.fold_left
77
Removed:
(fun e s -> ok (Entry.add_stimulus e s))
78
Removed:
(fresh ())
79
Removed:
[ single "laterals" 12. 8; single "bent-over-laterals" 10. 9 ]
80
Removed:
in
81
Removed:
Alcotest.(check (list string))
82
Removed:
"as performed"
83
Removed:
[ "Laterals"; "Bent-over Dumbbell Laterals" ]
84
Removed:
(List.map
85
Removed:
(fun s -> Exercise.name (List.hd (Stimulus.exercises s)))
86
Removed:
(Entry.stimuli e)) );
87
Removed:
( "a finished entry accepts nothing further",
88
Removed:
`Quick,
89
Removed:
fun () ->
90
Removed:
let e = ok (Entry.finish (fresh ()) ~ended_at:(at 60)) in
91
Removed:
(match Entry.add_stimulus e (single "laterals" 12. 8) with
92
Removed:
| Error Entry.Already_finished -> ()
93
Removed:
| _ -> Alcotest.fail "expected Already_finished");
94
Removed:
match Entry.finish e ~ended_at:(at 120) with
95
Removed:
| Error Entry.Already_finished -> ()
96
Removed:
| _ -> Alcotest.fail "expected Already_finished" );
97
Removed:
]
98
Removed:
99
Removed:
let conformance_tests =
100
Removed:
[
101
Removed:
( "an unprescribed movement is refused",
102
Removed:
`Quick,
103
Removed:
fun () ->
104
Removed:
match Entry.add_stimulus (fresh ()) (single "shrugs" 80. 10) with
105
Removed:
| Error (Entry.Not_prescribed id) ->
106
Removed:
Alcotest.(check string) "shrugs" "shrugs" (id :> string)
107
Removed:
| _ -> Alcotest.fail "expected Not_prescribed" );
108
Removed:
( "a lone set where a pre-exhaust was prescribed is refused",
109
Removed:
`Quick,
110
Removed:
fun () ->
111
Removed:
match Entry.add_stimulus (fresh ()) (single "dumbbell-flyes" 20. 9) with
112
Removed:
| Error
113
Removed:
(Entry.Delivery_mismatch
114
Removed:
{
115
Removed:
prescribed = Entry.As_pre_exhaust;
116
Removed:
logged = Entry.As_single;
117
Removed:
_;
118
Removed:
}) ->
119
Removed:
()
120
Removed:
| _ -> Alcotest.fail "expected Delivery_mismatch" );
121
Removed:
( "the prescribed pair, delivered as prescribed, is accepted",
122
Removed:
`Quick,
123
Removed:
fun () ->
124
Removed:
Alcotest.(check bool)
125
Removed:
"pec pair conforms" true
126
Removed:
(Result.is_ok
127
Removed:
(Entry.add_stimulus (fresh ())
128
Removed:
(pre_exhaust
129
Removed:
(move "dumbbell-flyes" 20. 9)
130
Removed:
(move "incline-press" 60. 7)))) );
131
Removed:
( "an allowed substitute is accepted in its own role",
132
Removed:
`Quick,
133
Removed:
fun () ->
134
Removed:
let e =
135
Removed:
ok
136
Removed:
(Entry.add_stimulus (fresh ())
137
Removed:
(pre_exhaust (move "pec-deck" 45. 9)
138
Removed:
(move "incline-press" 60. 7)))
139
Removed:
in
140
Removed:
Alcotest.(check int) "recorded" 1 (List.length (Entry.stimuli e));
141
Removed:
Alcotest.(check int) "slot filled" 3 (List.length (Entry.unperformed e))
142
Removed:
);
143
Removed:
( "a movement off the prescription's substitute list is refused",
144
Removed:
`Quick,
145
Removed:
fun () ->
146
Removed:
(* Cable crossovers substitute for flyes in the catalog, but Day 1
147
Removed:
permits only crossovers and pec deck — squats never. *)
148
Removed:
match
149
Removed:
Entry.add_stimulus (fresh ())
150
Removed:
(pre_exhaust (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7))
151
Removed:
with
152
Removed:
| Error _ -> ()
153
Removed:
| Ok _ -> Alcotest.fail "dips is not the prescribed pec compound" );
154
Removed:
]
155
Removed:
156
Removed:
let volume_tests =
157
Removed:
[
158
Removed:
( "repeated work is recorded, and shows as more stimuli than slots",
159
Removed:
`Quick,
160
Removed:
fun () ->
161
Removed:
(* HD1 forbids extra volume, but the log must still say what happened;
162
Removed:
diagnosing it is Progression's job. *)
163
Removed:
let e =
164
Removed:
List.fold_left
165
Removed:
(fun e s -> ok (Entry.add_stimulus e s))
166
Removed:
(fresh ())
167
Removed:
[ single "laterals" 12. 8; single "laterals" 12. 6 ]
168
Removed:
in
169
Removed:
Alcotest.(check int) "two stimuli" 2 (List.length (Entry.stimuli e));
170
Removed:
Alcotest.(check int)
171
Removed:
"still three slots outstanding" 3
172
Removed:
(List.length (Entry.unperformed e)) );
173
Removed:
( "unperformed shrinks as slots are answered",
174
Removed:
`Quick,
175
Removed:
fun () ->
176
Removed:
let e = ok (Entry.add_stimulus (fresh ()) (single "laterals" 12. 8)) in
177
Removed:
Alcotest.(check int) "three left" 3 (List.length (Entry.unperformed e));
178
Removed:
let e = ok (Entry.add_stimulus e (single "bent-over-laterals" 10. 9)) in
179
Removed:
Alcotest.(check int) "two left" 2 (List.length (Entry.unperformed e)) );
180
Removed:
]
181
Removed:
182
Removed:
let clearance_tests =
183
Removed:
[
184
Removed:
( "an entry keeps the basis on which it was begun",
185
Removed:
`Quick,
186
Removed:
fun () ->
187
Removed:
let recovering =
188
Removed:
Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12)
189
Removed:
~recommended:Routine.training_interval
190
Removed:
in
191
Removed:
let e =
192
Removed:
Entry.start day_one
193
Removed:
~clearance:(Recovery.override recovering ~reason:"away next week")
194
Removed:
~started_at:(at 0)
195
Removed:
in
196
Removed:
match Recovery.basis (Entry.clearance e) with
197
Removed:
| Recovery.Overridden { reason; _ } ->
198
Removed:
Alcotest.(check string) "reason" "away next week" reason
199
Removed:
| Recovery.Recovered -> Alcotest.fail "expected Overridden" );
200
Removed:
]
201
Removed:
202
Removed:
let suite =
203
Removed:
[
204
Removed:
("entry.lifecycle", lifecycle_tests);
205
Removed:
("entry.conformance", conformance_tests);
206
Removed:
("entry.volume", volume_tests);
207
Removed:
("entry.clearance", clearance_tests);
208
Removed:
]
test/test_evidence.ml
@@ -0,0 +1,498 @@
1
Added:
(** Unit tests for {!Evidence}, authored against the evidence.mli contract. *)
2
Added:
3
Added:
module Stimulus = Evidence.Stimulus
4
Added:
module Workout = Evidence.Workout
5
Added:
module Log = Evidence.Log
6
Added:
7
Added:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
8
Added:
9
Added:
let get id =
10
Added:
match Exercise.find id with
11
Added:
| Some e -> e
12
Added:
| None -> Alcotest.failf "catalog is missing %S" id
13
Added:
14
Added:
let kg n = ok (Units.Weight.of_kg n)
15
Added:
let reps n = ok (Units.Reps.of_int n)
16
Added:
let at s = Recovery.timestamp_of_unix_seconds s
17
Added:
let day n = at (n * 86_400)
18
Added:
19
Added:
let move ?(outcome = Stimulus.Positive_failure) id load r =
20
Added:
Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
21
Added:
~outcome
22
Added:
23
Added:
let single id load r = ok (Stimulus.make (Stimulus.Single (move id load r)))
24
Added:
25
Added:
let pre_exhaust iso_m comp_m =
26
Added:
ok
27
Added:
(Stimulus.make
28
Added:
(Stimulus.Pre_exhaust { isolation = iso_m; compound = comp_m }))
29
Added:
30
Added:
(* {1 One stimulus} *)
31
Added:
32
Added:
let outcome_tests =
33
Added:
[
34
Added:
( "positive failure used no extension",
35
Added:
`Quick,
36
Added:
fun () ->
37
Added:
Alcotest.(check (list string))
38
Added:
"none" []
39
Added:
(List.map
40
Added:
(Format.asprintf "%a" Stimulus.pp_extension)
41
Added:
(Stimulus.extensions_of_outcome Stimulus.Positive_failure)) );
42
Added:
( "extensions stack in the order applied",
43
Added:
`Quick,
44
Added:
fun () ->
45
Added:
let o =
46
Added:
Stimulus.Beyond_failure (Stimulus.Forced_reps, [ Stimulus.Negatives ])
47
Added:
in
48
Added:
Alcotest.(check (list string))
49
Added:
"forced reps then negatives"
50
Added:
[ "forced reps"; "negatives" ]
51
Added:
(List.map
52
Added:
(Format.asprintf "%a" Stimulus.pp_extension)
53
Added:
(Stimulus.extensions_of_outcome o)) );
54
Added:
]
55
Added:
56
Added:
let stimulus_delivery_tests =
57
Added:
[
58
Added:
( "a single movement is one stimulus",
59
Added:
`Quick,
60
Added:
fun () ->
61
Added:
let s = single "curls" 40. 8 in
62
Added:
Alcotest.(check int)
63
Added:
"one movement" 1
64
Added:
(List.length (Stimulus.movements s));
65
Added:
Alcotest.(check bool) "not extended" false (Stimulus.is_extended s) );
66
Added:
( "a pre-exhaust pair is one stimulus, isolation first",
67
Added:
`Quick,
68
Added:
fun () ->
69
Added:
let s =
70
Added:
pre_exhaust (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)
71
Added:
in
72
Added:
Alcotest.(check int)
73
Added:
"two movements" 2
74
Added:
(List.length (Stimulus.movements s));
75
Added:
Alcotest.(check (list string))
76
Added:
"isolation leads"
77
Added:
[ "Dumbbell Flyes"; "Incline Presses" ]
78
Added:
(List.map Exercise.name (Stimulus.exercises s)) );
79
Added:
( "a mislabelled pairing is refused",
80
Added:
`Quick,
81
Added:
fun () ->
82
Added:
match
83
Added:
Stimulus.make
84
Added:
(Stimulus.Pre_exhaust
85
Added:
{
86
Added:
isolation = move "dumbbell-flyes" 20. 9;
87
Added:
compound = move "squats" 100. 8;
88
Added:
})
89
Added:
with
90
Added:
| Error (Stimulus.Not_a_pre_exhaust { isolation; compound }) ->
91
Added:
Alcotest.(check string)
92
Added:
"isolation" "dumbbell-flyes"
93
Added:
(isolation :> string);
94
Added:
Alcotest.(check string) "compound" "squats" (compound :> string)
95
Added:
| Ok _ -> Alcotest.fail "expected Not_a_pre_exhaust" );
96
Added:
( "extensions are gathered across a pre-exhaust's movements",
97
Added:
`Quick,
98
Added:
fun () ->
99
Added:
let s =
100
Added:
pre_exhaust
101
Added:
(move "lying-french-press" 30. 9)
102
Added:
(move
103
Added:
~outcome:
104
Added:
(Stimulus.Beyond_failure
105
Added:
(Stimulus.Forced_reps, [ Stimulus.Negatives ]))
106
Added:
"dips" 0. 6)
107
Added:
in
108
Added:
Alcotest.(check bool) "extended" true (Stimulus.is_extended s);
109
Added:
Alcotest.(check int)
110
Added:
"two extensions" 2
111
Added:
(List.length (Stimulus.extensions s)) );
112
Added:
]
113
Added:
114
Added:
let warm_up_tests =
115
Added:
[
116
Added:
( "warm-ups sit alongside the stimulus, not inside it",
117
Added:
`Quick,
118
Added:
fun () ->
119
Added:
let w =
120
Added:
Stimulus.Warm_up.make ~exercise:(get "squats") ~load:(kg 40.)
121
Added:
~reps:(reps 10)
122
Added:
in
123
Added:
let s =
124
Added:
ok
125
Added:
(Stimulus.make ~warm_ups:[ w ]
126
Added:
(Stimulus.Single (move "squats" 100. 8)))
127
Added:
in
128
Added:
Alcotest.(check int) "one warm-up" 1 (List.length (Stimulus.warm_ups s));
129
Added:
Alcotest.(check int)
130
Added:
"still one drive to failure" 1
131
Added:
(List.length (Stimulus.movements s)) );
132
Added:
( "a stimulus needs no warm-up",
133
Added:
`Quick,
134
Added:
fun () ->
135
Added:
Alcotest.(check int)
136
Added:
"none" 0
137
Added:
(List.length (Stimulus.warm_ups (single "sit-ups" 0. 12))) );
138
Added:
]
139
Added:
140
Added:
(* {1 One performed workout} *)
141
Added:
142
Added:
let routine = Prescription.Routine.ideal
143
Added:
let prescribed n = List.nth (Prescription.Routine.workouts routine) n
144
Added:
let day_one = prescribed 0
145
Added:
let cleared = Option.get (Recovery.clear Recovery.Ready)
146
Added:
let fresh () = Workout.start day_one ~clearance:cleared ~started_at:(at 0)
147
Added:
148
Added:
(* HD1's Day 1, in the order it lists. *)
149
Added:
let day_one_stimuli =
150
Added:
[
151
Added:
pre_exhaust (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7);
152
Added:
single "laterals" 12. 8;
153
Added:
single "bent-over-laterals" 10. 9;
154
Added:
pre_exhaust (move "lying-french-press" 30. 8) (move "dips" 0. 6);
155
Added:
]
156
Added:
157
Added:
let perform stimuli =
158
Added:
List.fold_left (fun w s -> ok (Workout.add_stimulus w s)) (fresh ()) stimuli
159
Added:
160
Added:
let lifecycle_tests =
161
Added:
[
162
Added:
( "a fresh workout has performed nothing and answers its prescription",
163
Added:
`Quick,
164
Added:
fun () ->
165
Added:
let w = fresh () in
166
Added:
Alcotest.(check string)
167
Added:
"prescription" "Day 1"
168
Added:
(Prescription.Workout.name (Workout.prescription w));
169
Added:
Alcotest.(check int) "no stimuli" 0 (List.length (Workout.stimuli w));
170
Added:
Alcotest.(check int)
171
Added:
"four slots outstanding" 4
172
Added:
(List.length (Workout.unperformed w));
173
Added:
Alcotest.(check bool) "unfinished" false (Workout.is_finished w);
174
Added:
Alcotest.(check bool)
175
Added:
"no duration" true
176
Added:
(Option.is_none (Workout.duration w)) );
177
Added:
( "HD1's Day 1 can be logged end to end",
178
Added:
`Quick,
179
Added:
fun () ->
180
Added:
let w = perform day_one_stimuli in
181
Added:
Alcotest.(check int) "four stimuli" 4 (List.length (Workout.stimuli w));
182
Added:
Alcotest.(check int)
183
Added:
"nothing outstanding" 0
184
Added:
(List.length (Workout.unperformed w));
185
Added:
let finished = ok (Workout.finish w ~ended_at:(at 2400)) in
186
Added:
Alcotest.(check bool) "finished" true (Workout.is_finished finished);
187
Added:
Alcotest.(check (option int))
188
Added:
"40 minutes" (Some 2400)
189
Added:
(Option.map Recovery.duration_to_seconds (Workout.duration finished))
190
Added:
);
191
Added:
( "stimuli come back in the order performed",
192
Added:
`Quick,
193
Added:
fun () ->
194
Added:
let w =
195
Added:
perform [ single "laterals" 12. 8; single "bent-over-laterals" 10. 9 ]
196
Added:
in
197
Added:
Alcotest.(check (list string))
198
Added:
"as performed"
199
Added:
[ "Laterals"; "Bent-over Dumbbell Laterals" ]
200
Added:
(List.map
201
Added:
(fun s -> Exercise.name (List.hd (Stimulus.exercises s)))
202
Added:
(Workout.stimuli w)) );
203
Added:
( "a finished workout accepts nothing further",
204
Added:
`Quick,
205
Added:
fun () ->
206
Added:
let w = ok (Workout.finish (fresh ()) ~ended_at:(at 60)) in
207
Added:
(match Workout.add_stimulus w (single "laterals" 12. 8) with
208
Added:
| Error Workout.Already_finished -> ()
209
Added:
| _ -> Alcotest.fail "expected Already_finished");
210
Added:
match Workout.finish w ~ended_at:(at 120) with
211
Added:
| Error Workout.Already_finished -> ()
212
Added:
| _ -> Alcotest.fail "expected Already_finished" );
213
Added:
]
214
Added:
215
Added:
let conformance_tests =
216
Added:
[
217
Added:
( "an unprescribed movement is refused",
218
Added:
`Quick,
219
Added:
fun () ->
220
Added:
match Workout.add_stimulus (fresh ()) (single "shrugs" 80. 10) with
221
Added:
| Error (Workout.Not_prescribed id) ->
222
Added:
Alcotest.(check string) "shrugs" "shrugs" (id :> string)
223
Added:
| _ -> Alcotest.fail "expected Not_prescribed" );
224
Added:
( "a lone set where a pre-exhaust was prescribed is refused",
225
Added:
`Quick,
226
Added:
fun () ->
227
Added:
match
228
Added:
Workout.add_stimulus (fresh ()) (single "dumbbell-flyes" 20. 9)
229
Added:
with
230
Added:
| Error
231
Added:
(Workout.Delivery_mismatch
232
Added:
{
233
Added:
prescribed = Workout.As_pre_exhaust;
234
Added:
logged = Workout.As_single;
235
Added:
_;
236
Added:
}) ->
237
Added:
()
238
Added:
| _ -> Alcotest.fail "expected Delivery_mismatch" );
239
Added:
( "the prescribed pair, delivered as prescribed, is accepted",
240
Added:
`Quick,
241
Added:
fun () ->
242
Added:
Alcotest.(check bool)
243
Added:
"pec pair conforms" true
244
Added:
(Result.is_ok
245
Added:
(Workout.add_stimulus (fresh ())
246
Added:
(pre_exhaust
247
Added:
(move "dumbbell-flyes" 20. 9)
248
Added:
(move "incline-press" 60. 7)))) );
249
Added:
( "an allowed substitute is accepted in its own role",
250
Added:
`Quick,
251
Added:
fun () ->
252
Added:
let w =
253
Added:
ok
254
Added:
(Workout.add_stimulus (fresh ())
255
Added:
(pre_exhaust (move "pec-deck" 45. 9)
256
Added:
(move "incline-press" 60. 7)))
257
Added:
in
258
Added:
Alcotest.(check int) "recorded" 1 (List.length (Workout.stimuli w));
259
Added:
Alcotest.(check int)
260
Added:
"slot filled" 3
261
Added:
(List.length (Workout.unperformed w)) );
262
Added:
( "a movement off the prescription's substitute list is refused",
263
Added:
`Quick,
264
Added:
fun () ->
265
Added:
(* Cable crossovers substitute for flyes in the catalog, but Day 1
266
Added:
permits only crossovers and pec deck — dips is never the pec
267
Added:
compound. *)
268
Added:
match
269
Added:
Workout.add_stimulus (fresh ())
270
Added:
(pre_exhaust (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7))
271
Added:
with
272
Added:
| Error _ -> ()
273
Added:
| Ok _ -> Alcotest.fail "dips is not the prescribed pec compound" );
274
Added:
]
275
Added:
276
Added:
let volume_tests =
277
Added:
[
278
Added:
( "repeated work is recorded, and shows as more stimuli than slots",
279
Added:
`Quick,
280
Added:
fun () ->
281
Added:
(* HD1 forbids extra volume, but the log must still say what happened;
282
Added:
diagnosing it is Progression's job. *)
283
Added:
let w = perform [ single "laterals" 12. 8; single "laterals" 12. 6 ] in
284
Added:
Alcotest.(check int) "two stimuli" 2 (List.length (Workout.stimuli w));
285
Added:
Alcotest.(check int)
286
Added:
"still three slots outstanding" 3
287
Added:
(List.length (Workout.unperformed w)) );
288
Added:
( "unperformed shrinks as slots are answered",
289
Added:
`Quick,
290
Added:
fun () ->
291
Added:
let w = perform [ single "laterals" 12. 8 ] in
292
Added:
Alcotest.(check int)
293
Added:
"three left" 3
294
Added:
(List.length (Workout.unperformed w));
295
Added:
let w =
296
Added:
ok (Workout.add_stimulus w (single "bent-over-laterals" 10. 9))
297
Added:
in
298
Added:
Alcotest.(check int) "two left" 2 (List.length (Workout.unperformed w))
299
Added:
);
300
Added:
]
301
Added:
302
Added:
let clearance_tests =
303
Added:
[
304
Added:
( "a workout keeps the basis on which it was begun",
305
Added:
`Quick,
306
Added:
fun () ->
307
Added:
let recovering =
308
Added:
Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12)
309
Added:
~recommended:Prescription.Routine.training_interval
310
Added:
in
311
Added:
let w =
312
Added:
Workout.start day_one
313
Added:
~clearance:(Recovery.override recovering ~reason:"away next week")
314
Added:
~started_at:(at 0)
315
Added:
in
316
Added:
match Recovery.basis (Workout.clearance w) with
317
Added:
| Recovery.Overridden { reason; _ } ->
318
Added:
Alcotest.(check string) "reason" "away next week" reason
319
Added:
| Recovery.Recovered -> Alcotest.fail "expected Overridden" );
320
Added:
]
321
Added:
322
Added:
(* {1 The log} *)
323
Added:
324
Added:
(* A finished workout: Day n of the Ideal Routine, with stimuli logged. *)
325
Added:
let logged ~workout:p ~on ~stimuli =
326
Added:
let w =
327
Added:
List.fold_left
328
Added:
(fun w s -> ok (Workout.add_stimulus w s))
329
Added:
(Workout.start p ~clearance:cleared ~started_at:on)
330
Added:
stimuli
331
Added:
in
332
Added:
ok (Workout.finish w ~ended_at:on)
333
Added:
334
Added:
let laterals load r = single "laterals" load r
335
Added:
336
Added:
let log_basic_tests =
337
Added:
[
338
Added:
( "an empty log knows nothing",
339
Added:
`Quick,
340
Added:
fun () ->
341
Added:
Alcotest.(check int)
342
Added:
"no workouts" 0
343
Added:
(List.length (Log.workouts Log.empty));
344
Added:
Alcotest.(check bool)
345
Added:
"no last prescription" true
346
Added:
(Option.is_none (Log.last_prescription Log.empty)) );
347
Added:
( "workouts come back most recent first, however they were added",
348
Added:
`Quick,
349
Added:
fun () ->
350
Added:
let book =
351
Added:
( Log.empty |> fun b ->
352
Added:
Log.add b (logged ~workout:(prescribed 1) ~on:(day 3) ~stimuli:[])
353
Added:
)
354
Added:
|> fun b ->
355
Added:
Log.add b (logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[])
356
Added:
in
357
Added:
Alcotest.(check (list string))
358
Added:
"newest first" [ "Day 2"; "Day 1" ]
359
Added:
(List.map
360
Added:
(fun w -> Prescription.Workout.name (Workout.prescription w))
361
Added:
(Log.workouts book)) );
362
Added:
( "the last prescription is what the cycle should advance from",
363
Added:
`Quick,
364
Added:
fun () ->
365
Added:
let book =
366
Added:
Log.add Log.empty
367
Added:
(logged ~workout:(prescribed 1) ~on:(day 1) ~stimuli:[])
368
Added:
in
369
Added:
let last = Option.get (Log.last_prescription book) in
370
Added:
Alcotest.(check string)
371
Added:
"performed Day 2" "Day 2"
372
Added:
(Prescription.Workout.name last);
373
Added:
Alcotest.(check string)
374
Added:
"so Day 3 is next" "Day 3"
375
Added:
(Prescription.Workout.name
376
Added:
(Prescription.Routine.workout_after routine last)) );
377
Added:
]
378
Added:
379
Added:
let observation_tests =
380
Added:
[
381
Added:
( "observations for a movement come back oldest first",
382
Added:
`Quick,
383
Added:
fun () ->
384
Added:
let book =
385
Added:
( Log.empty |> fun b ->
386
Added:
Log.add b
387
Added:
(logged ~workout:(prescribed 0) ~on:(day 5)
388
Added:
~stimuli:[ laterals 14. 7 ]) )
389
Added:
|> fun b ->
390
Added:
Log.add b
391
Added:
(logged ~workout:(prescribed 0) ~on:(day 1)
392
Added:
~stimuli:[ laterals 12. 8 ])
393
Added:
in
394
Added:
let history = Log.observations book (get "laterals") in
395
Added:
Alcotest.(check int) "two observations" 2 (List.length history);
396
Added:
Alcotest.(check (list (float 0.001)))
397
Added:
"12kg then 14kg" [ 12.; 14. ]
398
Added:
(List.map
399
Added:
(fun (o : Log.observation) ->
400
Added:
Units.Weight.to_kg (Stimulus.Movement.load o.movement))
401
Added:
history) );
402
Added:
( "observations are dated, so a stall can be measured",
403
Added:
`Quick,
404
Added:
fun () ->
405
Added:
let book =
406
Added:
Log.add Log.empty
407
Added:
(logged ~workout:(prescribed 0) ~on:(day 2)
408
Added:
~stimuli:[ laterals 12. 8 ])
409
Added:
in
410
Added:
match Log.observations book (get "laterals") with
411
Added:
| [ o ] ->
412
Added:
Alcotest.(check int)
413
Added:
"day 2" 172_800
414
Added:
(Recovery.timestamp_to_unix_seconds o.performed_at)
415
Added:
| _ -> Alcotest.fail "expected one observation" );
416
Added:
( "a movement never performed has no observations",
417
Added:
`Quick,
418
Added:
fun () ->
419
Added:
let book =
420
Added:
Log.add Log.empty
421
Added:
(logged ~workout:(prescribed 0) ~on:(day 1)
422
Added:
~stimuli:[ laterals 12. 8 ])
423
Added:
in
424
Added:
Alcotest.(check int)
425
Added:
"none" 0
426
Added:
(List.length (Log.observations book (get "squats"))) );
427
Added:
( "both halves of a pre-exhaust are recorded separately",
428
Added:
`Quick,
429
Added:
fun () ->
430
Added:
let pair =
431
Added:
pre_exhaust (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7)
432
Added:
in
433
Added:
let book =
434
Added:
Log.add Log.empty
435
Added:
(logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[ pair ])
436
Added:
in
437
Added:
Alcotest.(check int)
438
Added:
"isolation" 1
439
Added:
(List.length (Log.observations book (get "dumbbell-flyes")));
440
Added:
Alcotest.(check int)
441
Added:
"compound" 1
442
Added:
(List.length (Log.observations book (get "incline-press"))) );
443
Added:
]
444
Added:
445
Added:
let readiness_tests =
446
Added:
[
447
Added:
( "an empty log is ready: nothing to recover from",
448
Added:
`Quick,
449
Added:
fun () ->
450
Added:
Alcotest.(check bool)
451
Added:
"ready" true
452
Added:
(Recovery.is_ready
453
Added:
(Log.readiness Log.empty ~now:(day 1)
454
Added:
~recommended:Prescription.Routine.training_interval)) );
455
Added:
( "readiness is measured from the last finished workout",
456
Added:
`Quick,
457
Added:
fun () ->
458
Added:
let book =
459
Added:
Log.add Log.empty
460
Added:
(logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[])
461
Added:
in
462
Added:
Alcotest.(check bool)
463
Added:
"one day later, still recovering" false
464
Added:
(Recovery.is_ready
465
Added:
(Log.readiness book ~now:(day 2)
466
Added:
~recommended:Prescription.Routine.training_interval));
467
Added:
Alcotest.(check bool)
468
Added:
"two days later, ready" true
469
Added:
(Recovery.is_ready
470
Added:
(Log.readiness book ~now:(day 3)
471
Added:
~recommended:Prescription.Routine.training_interval)) );
472
Added:
( "an unfinished workout leaves nothing to recover from",
473
Added:
`Quick,
474
Added:
fun () ->
475
Added:
let unfinished =
476
Added:
Workout.start (prescribed 0) ~clearance:cleared ~started_at:(day 1)
477
Added:
in
478
Added:
let book = Log.add Log.empty unfinished in
479
Added:
Alcotest.(check bool)
480
Added:
"ready" true
481
Added:
(Recovery.is_ready
482
Added:
(Log.readiness book ~now:(day 1)
483
Added:
~recommended:Prescription.Routine.training_interval)) );
484
Added:
]
485
Added:
486
Added:
let suite =
487
Added:
[
488
Added:
("evidence.stimulus.outcome", outcome_tests);
489
Added:
("evidence.stimulus.delivery", stimulus_delivery_tests);
490
Added:
("evidence.stimulus.warm_up", warm_up_tests);
491
Added:
("evidence.workout.lifecycle", lifecycle_tests);
492
Added:
("evidence.workout.conformance", conformance_tests);
493
Added:
("evidence.workout.volume", volume_tests);
494
Added:
("evidence.workout.clearance", clearance_tests);
495
Added:
("evidence.log.basics", log_basic_tests);
496
Added:
("evidence.log.observations", observation_tests);
497
Added:
("evidence.log.readiness", readiness_tests);
498
Added:
]
test/test_hito.ml
@@ -7,7 +7,5 @@
7
7
let () =
8
8
Alcotest.run "hito"
9
9
(Test_units.suite @ Test_muscle.suite @ Test_exercise.suite
10
Removed:
@ Test_prescription.suite @ Test_workout_prescription.suite
11
Removed:
@ Test_routine.suite @ Test_stimulus.suite @ Test_recovery.suite
12
Removed:
@ Test_entry.suite @ Test_logbook.suite @ Test_progression.suite
13
Removed:
@ Test_service.suite)
10
Added:
@ Test_recovery.suite @ Test_prescription.suite @ Test_evidence.suite
11
Added:
@ Test_progression.suite @ Test_service.suite)
test/test_logbook.ml
@@ -1,196 +0,0 @@
1
Removed:
(** Unit tests for {!Logbook}. *)
2
Removed:
3
Removed:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
Removed:
5
Removed:
let get id =
6
Removed:
match Exercise.find id with
7
Removed:
| Some e -> e
8
Removed:
| None -> Alcotest.failf "catalog is missing %S" id
9
Removed:
10
Removed:
let kg n = ok (Units.Weight.of_kg n)
11
Removed:
let reps n = ok (Units.Reps.of_int n)
12
Removed:
let at s = Recovery.timestamp_of_unix_seconds s
13
Removed:
let day n = at (n * 86_400)
14
Removed:
let cleared = Option.get (Recovery.clear Recovery.Ready)
15
Removed:
let routine = Routine.ideal_routine
16
Removed:
let workout n = List.nth (Routine.workouts routine) n
17
Removed:
18
Removed:
let move id load r =
19
Removed:
Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
20
Removed:
~outcome:Stimulus.Positive_failure
21
Removed:
22
Removed:
let single id load r = ok (Stimulus.make (Stimulus.Single (move id load r)))
23
Removed:
24
Removed:
(* A finished workout: Day n of the Ideal Routine, with one stimulus logged. *)
25
Removed:
let logged ~workout:w ~on ~stimuli =
26
Removed:
let e =
27
Removed:
List.fold_left
28
Removed:
(fun e s -> ok (Entry.add_stimulus e s))
29
Removed:
(Entry.start w ~clearance:cleared ~started_at:on)
30
Removed:
stimuli
31
Removed:
in
32
Removed:
ok (Entry.finish e ~ended_at:on)
33
Removed:
34
Removed:
let laterals load r = single "laterals" load r
35
Removed:
36
Removed:
let basic_tests =
37
Removed:
[
38
Removed:
( "an empty logbook knows nothing",
39
Removed:
`Quick,
40
Removed:
fun () ->
41
Removed:
Alcotest.(check int)
42
Removed:
"no entries" 0
43
Removed:
(List.length (Logbook.entries Logbook.empty));
44
Removed:
Alcotest.(check bool)
45
Removed:
"no last prescription" true
46
Removed:
(Option.is_none (Logbook.last_prescription Logbook.empty)) );
47
Removed:
( "entries come back most recent first, however they were added",
48
Removed:
`Quick,
49
Removed:
fun () ->
50
Removed:
let book =
51
Removed:
( Logbook.empty |> fun b ->
52
Removed:
Logbook.add b (logged ~workout:(workout 1) ~on:(day 3) ~stimuli:[])
53
Removed:
)
54
Removed:
|> fun b ->
55
Removed:
Logbook.add b (logged ~workout:(workout 0) ~on:(day 1) ~stimuli:[])
56
Removed:
in
57
Removed:
Alcotest.(check (list string))
58
Removed:
"newest first" [ "Day 2"; "Day 1" ]
59
Removed:
(List.map
60
Removed:
(fun e -> Workout_prescription.name (Entry.prescription e))
61
Removed:
(Logbook.entries book)) );
62
Removed:
( "the last prescription is what the cycle should advance from",
63
Removed:
`Quick,
64
Removed:
fun () ->
65
Removed:
let book =
66
Removed:
Logbook.add Logbook.empty
67
Removed:
(logged ~workout:(workout 1) ~on:(day 1) ~stimuli:[])
68
Removed:
in
69
Removed:
let last = Option.get (Logbook.last_prescription book) in
70
Removed:
Alcotest.(check string)
71
Removed:
"performed Day 2" "Day 2"
72
Removed:
(Workout_prescription.name last);
73
Removed:
Alcotest.(check string)
74
Removed:
"so Day 3 is next" "Day 3"
75
Removed:
(Workout_prescription.name (Routine.workout_after routine last)) );
76
Removed:
]
77
Removed:
78
Removed:
let evidence_tests =
79
Removed:
[
80
Removed:
( "evidence for a movement comes back oldest first",
81
Removed:
`Quick,
82
Removed:
fun () ->
83
Removed:
let book =
84
Removed:
( Logbook.empty |> fun b ->
85
Removed:
Logbook.add b
86
Removed:
(logged ~workout:(workout 0) ~on:(day 5)
87
Removed:
~stimuli:[ laterals 14. 7 ]) )
88
Removed:
|> fun b ->
89
Removed:
Logbook.add b
90
Removed:
(logged ~workout:(workout 0) ~on:(day 1)
91
Removed:
~stimuli:[ laterals 12. 8 ])
92
Removed:
in
93
Removed:
let history = Logbook.evidence book (get "laterals") in
94
Removed:
Alcotest.(check int) "two observations" 2 (List.length history);
95
Removed:
Alcotest.(check (list (float 0.001)))
96
Removed:
"12kg then 14kg" [ 12.; 14. ]
97
Removed:
(List.map
98
Removed:
(fun (o : Logbook.observation) ->
99
Removed:
Units.Weight.to_kg (Stimulus.Movement.load o.movement))
100
Removed:
history) );
101
Removed:
( "observations are dated, so a stall can be measured",
102
Removed:
`Quick,
103
Removed:
fun () ->
104
Removed:
let book =
105
Removed:
Logbook.add Logbook.empty
106
Removed:
(logged ~workout:(workout 0) ~on:(day 2)
107
Removed:
~stimuli:[ laterals 12. 8 ])
108
Removed:
in
109
Removed:
match Logbook.evidence book (get "laterals") with
110
Removed:
| [ o ] ->
111
Removed:
Alcotest.(check int)
112
Removed:
"day 2" 172_800
113
Removed:
(Recovery.timestamp_to_unix_seconds o.performed_at)
114
Removed:
| _ -> Alcotest.fail "expected one observation" );
115
Removed:
( "a movement never performed has no evidence",
116
Removed:
`Quick,
117
Removed:
fun () ->
118
Removed:
let book =
119
Removed:
Logbook.add Logbook.empty
120
Removed:
(logged ~workout:(workout 0) ~on:(day 1)
121
Removed:
~stimuli:[ laterals 12. 8 ])
122
Removed:
in
123
Removed:
Alcotest.(check int)
124
Removed:
"none" 0
125
Removed:
(List.length (Logbook.evidence book (get "squats"))) );
126
Removed:
( "both halves of a pre-exhaust are recorded separately",
127
Removed:
`Quick,
128
Removed:
fun () ->
129
Removed:
let pair =
130
Removed:
ok
131
Removed:
(Stimulus.make
132
Removed:
(Stimulus.Pre_exhaust
133
Removed:
{
134
Removed:
isolation = move "dumbbell-flyes" 20. 9;
135
Removed:
compound = move "incline-press" 60. 7;
136
Removed:
}))
137
Removed:
in
138
Removed:
let book =
139
Removed:
Logbook.add Logbook.empty
140
Removed:
(logged ~workout:(workout 0) ~on:(day 1) ~stimuli:[ pair ])
141
Removed:
in
142
Removed:
Alcotest.(check int)
143
Removed:
"isolation" 1
144
Removed:
(List.length (Logbook.evidence book (get "dumbbell-flyes")));
145
Removed:
Alcotest.(check int)
146
Removed:
"compound" 1
147
Removed:
(List.length (Logbook.evidence book (get "incline-press"))) );
148
Removed:
]
149
Removed:
150
Removed:
let readiness_tests =
151
Removed:
[
152
Removed:
( "an empty logbook is ready: nothing to recover from",
153
Removed:
`Quick,
154
Removed:
fun () ->
155
Removed:
Alcotest.(check bool)
156
Removed:
"ready" true
157
Removed:
(Recovery.is_ready
158
Removed:
(Logbook.readiness Logbook.empty ~now:(day 1)
159
Removed:
~recommended:Routine.training_interval)) );
160
Removed:
( "readiness is measured from the last finished workout",
161
Removed:
`Quick,
162
Removed:
fun () ->
163
Removed:
let book =
164
Removed:
Logbook.add Logbook.empty
165
Removed:
(logged ~workout:(workout 0) ~on:(day 1) ~stimuli:[])
166
Removed:
in
167
Removed:
Alcotest.(check bool)
168
Removed:
"one day later, still recovering" false
169
Removed:
(Recovery.is_ready
170
Removed:
(Logbook.readiness book ~now:(day 2)
171
Removed:
~recommended:Routine.training_interval));
172
Removed:
Alcotest.(check bool)
173
Removed:
"two days later, ready" true
174
Removed:
(Recovery.is_ready
175
Removed:
(Logbook.readiness book ~now:(day 3)
176
Removed:
~recommended:Routine.training_interval)) );
177
Removed:
( "an unfinished workout leaves nothing to recover from",
178
Removed:
`Quick,
179
Removed:
fun () ->
180
Removed:
let unfinished =
181
Removed:
Entry.start (workout 0) ~clearance:cleared ~started_at:(day 1)
182
Removed:
in
183
Removed:
let book = Logbook.add Logbook.empty unfinished in
184
Removed:
Alcotest.(check bool)
185
Removed:
"ready" true
186
Removed:
(Recovery.is_ready
187
Removed:
(Logbook.readiness book ~now:(day 1)
188
Removed:
~recommended:Routine.training_interval)) );
189
Removed:
]
190
Removed:
191
Removed:
let suite =
192
Removed:
[
193
Removed:
("logbook.basics", basic_tests);
194
Removed:
("logbook.evidence", evidence_tests);
195
Removed:
("logbook.readiness", readiness_tests);
196
Removed:
]
test/test_prescription.ml
@@ -14,53 +14,48 @@
14
14
15
15
let six_to_ten = range 6 10
16
16
17
Removed:
let single id =
18
Removed:
Prescription.make
19
Removed:
~delivery:(Prescription.Single (get id))
20
Removed:
~rep_range:six_to_ten ~allowed_substitutes:[]
17
Added:
let prescribe ?(substitutes = []) delivery =
18
Added:
Prescription.Stimulus.make ~delivery ~rep_range:six_to_ten
19
Added:
~allowed_substitutes:substitutes
21
20
21
Added:
let single id = prescribe (Prescription.Stimulus.Single (get id))
22
Added:
23
Added:
let pair ~isolation ~compound =
24
Added:
prescribe
25
Added:
(Prescription.Stimulus.Pre_exhaust
26
Added:
{ isolation = get isolation; compound = get compound })
27
Added:
28
Added:
(* {1 One prescribed stimulus} *)
29
Added:
22
30
let delivery_tests =
23
31
[
24
32
( "a single movement is prescribable",
25
33
`Quick,
26
34
fun () ->
27
35
let p = ok (single "curls") in
28
Removed:
match Prescription.delivery p with
29
Removed:
| Prescription.Single e ->
36
Added:
match Prescription.Stimulus.delivery p with
37
Added:
| Prescription.Stimulus.Single e ->
30
38
Alcotest.(check string) "curls" "Curls" (Exercise.name e)
31
Removed:
| Prescription.Pre_exhaust _ -> Alcotest.fail "expected Single" );
39
Added:
| Prescription.Stimulus.Pre_exhaust _ -> Alcotest.fail "expected Single"
40
Added:
);
32
41
( "HD1's pec pre-exhaust is prescribable",
33
42
`Quick,
34
43
fun () ->
35
44
let p =
36
Removed:
ok
37
Removed:
(Prescription.make
38
Removed:
~delivery:
39
Removed:
(Prescription.Pre_exhaust
40
Removed:
{
41
Removed:
isolation = get "dumbbell-flyes";
42
Removed:
compound = get "incline-press";
43
Removed:
})
44
Removed:
~rep_range:six_to_ten ~allowed_substitutes:[])
45
Added:
ok (pair ~isolation:"dumbbell-flyes" ~compound:"incline-press")
45
46
in
46
47
Alcotest.(check int)
47
48
"two movements, isolation first" 2
48
Removed:
(List.length (Prescription.exercises p));
49
Added:
(List.length (Prescription.Stimulus.exercises p));
49
50
Alcotest.(check string)
50
51
"isolation leads" "Dumbbell Flyes"
51
Removed:
(Exercise.name (List.hd (Prescription.exercises p))) );
52
Added:
(Exercise.name (List.hd (Prescription.Stimulus.exercises p))) );
52
53
( "an invalid pairing is refused",
53
54
`Quick,
54
55
fun () ->
55
Removed:
match
56
Removed:
Prescription.make
57
Removed:
~delivery:
58
Removed:
(Prescription.Pre_exhaust
59
Removed:
{ isolation = get "dumbbell-flyes"; compound = get "squats" })
60
Removed:
~rep_range:six_to_ten ~allowed_substitutes:[]
61
Removed:
with
56
Added:
match pair ~isolation:"dumbbell-flyes" ~compound:"squats" with
62
57
| Ok _ -> Alcotest.fail "expected Error"
63
Removed:
| Error (Prescription.Not_a_pre_exhaust _) -> ()
58
Added:
| Error (Prescription.Stimulus.Not_a_pre_exhaust _) -> ()
64
59
| Error _ -> Alcotest.fail "expected Not_a_pre_exhaust" );
65
60
]
66
61
@@ -71,10 +66,12 @@
71
66
fun () ->
72
67
Alcotest.(check int)
73
68
"min 6" 6
74
Removed:
(Units.Reps.to_int (Units.Rep_range.min Prescription.rep_limits));
69
Added:
(Units.Reps.to_int
70
Added:
(Units.Rep_range.min Prescription.Stimulus.rep_limits));
75
71
Alcotest.(check int)
76
72
"max 12" 12
77
Removed:
(Units.Reps.to_int (Units.Rep_range.max Prescription.rep_limits)) );
73
Added:
(Units.Reps.to_int
74
Added:
(Units.Rep_range.max Prescription.Stimulus.rep_limits)) );
78
75
( "a window inside the limits is accepted",
79
76
`Quick,
80
77
fun () ->
@@ -84,8 +81,8 @@
84
81
(Printf.sprintf "%d-%d accepted" lo hi)
85
82
true
86
83
(Result.is_ok
87
Removed:
(Prescription.make
88
Removed:
~delivery:(Prescription.Single (get "curls"))
84
Added:
(Prescription.Stimulus.make
85
Added:
~delivery:(Prescription.Stimulus.Single (get "curls"))
89
86
~rep_range:(range lo hi) ~allowed_substitutes:[])))
90
87
[ (6, 10); (6, 12); (8, 12); (8, 8) ] );
91
88
( "a window escaping the limits is refused",
@@ -94,11 +91,11 @@
94
91
List.iter
95
92
(fun (lo, hi) ->
96
93
match
97
Removed:
Prescription.make
98
Removed:
~delivery:(Prescription.Single (get "curls"))
94
Added:
Prescription.Stimulus.make
95
Added:
~delivery:(Prescription.Stimulus.Single (get "curls"))
99
96
~rep_range:(range lo hi) ~allowed_substitutes:[]
100
97
with
101
Removed:
| Error Prescription.Reps_outside_limits -> ()
98
Added:
| Error Prescription.Stimulus.Reps_outside_limits -> ()
102
99
| Error _ -> Alcotest.fail "expected Reps_outside_limits"
103
100
| Ok _ -> Alcotest.failf "%d-%d should be refused" lo hi)
104
101
[ (3, 5); (1, 3); (15, 20); (6, 20) ] );
@@ -111,30 +108,28 @@
111
108
fun () ->
112
109
let p =
113
110
ok
114
Removed:
(Prescription.make
115
Removed:
~delivery:(Prescription.Single (get "dumbbell-flyes"))
116
Removed:
~rep_range:six_to_ten
117
Removed:
~allowed_substitutes:[ get "pec-deck" ])
111
Added:
(prescribe
112
Added:
~substitutes:[ get "pec-deck" ]
113
Added:
(Prescription.Stimulus.Single (get "dumbbell-flyes")))
118
114
in
119
115
Alcotest.(check bool)
120
116
"pec deck permitted" true
121
Removed:
(Prescription.permits p (get "pec-deck"));
117
Added:
(Prescription.Stimulus.permits p (get "pec-deck"));
122
118
Alcotest.(check bool)
123
119
"flyes permitted" true
124
Removed:
(Prescription.permits p (get "dumbbell-flyes"));
120
Added:
(Prescription.Stimulus.permits p (get "dumbbell-flyes"));
125
121
Alcotest.(check bool)
126
122
"squats not permitted" false
127
Removed:
(Prescription.permits p (get "squats")) );
123
Added:
(Prescription.Stimulus.permits p (get "squats")) );
128
124
( "a substitute off the catalog whitelist is refused",
129
125
`Quick,
130
126
fun () ->
131
127
match
132
Removed:
Prescription.make
133
Removed:
~delivery:(Prescription.Single (get "dumbbell-flyes"))
134
Removed:
~rep_range:six_to_ten
135
Removed:
~allowed_substitutes:[ get "squats" ]
128
Added:
prescribe
129
Added:
~substitutes:[ get "squats" ]
130
Added:
(Prescription.Stimulus.Single (get "dumbbell-flyes"))
136
131
with
137
Removed:
| Error (Prescription.Substitute_not_permitted id) ->
132
Added:
| Error (Prescription.Stimulus.Substitute_not_permitted id) ->
138
133
Alcotest.(check string) "squats" "squats" (id :> string)
139
134
| Error _ -> Alcotest.fail "expected Substitute_not_permitted"
140
135
| Ok _ -> Alcotest.fail "expected Error" );
@@ -144,20 +139,217 @@
144
139
Alcotest.(check bool)
145
140
"pec deck substitutes the isolation" true
146
141
(Result.is_ok
147
Removed:
(Prescription.make
148
Removed:
~delivery:
149
Removed:
(Prescription.Pre_exhaust
150
Removed:
{
151
Removed:
isolation = get "dumbbell-flyes";
152
Removed:
compound = get "incline-press";
153
Removed:
})
154
Removed:
~rep_range:six_to_ten
155
Removed:
~allowed_substitutes:[ get "cable-crossovers" ])) );
142
Added:
(prescribe
143
Added:
~substitutes:[ get "cable-crossovers" ]
144
Added:
(Prescription.Stimulus.Pre_exhaust
145
Added:
{
146
Added:
isolation = get "dumbbell-flyes";
147
Added:
compound = get "incline-press";
148
Added:
}))) );
156
149
]
157
150
151
Added:
(* {1 One prescribed workout} *)
152
Added:
153
Added:
(* HD1's Day 1: pecs pre-exhaust, two delt isolations, triceps pre-exhaust. *)
154
Added:
let day_one_stimuli =
155
Added:
[
156
Added:
ok (pair ~isolation:"dumbbell-flyes" ~compound:"incline-press");
157
Added:
ok (single "laterals");
158
Added:
ok (single "bent-over-laterals");
159
Added:
ok (pair ~isolation:"lying-french-press" ~compound:"dips");
160
Added:
]
161
Added:
162
Added:
let workout_tests =
163
Added:
[
164
Added:
( "HD1's Day 1 is prescribable, in order",
165
Added:
`Quick,
166
Added:
fun () ->
167
Added:
let w =
168
Added:
ok
169
Added:
(Prescription.Workout.make ~id:"ideal-day-1" ~name:"Day 1"
170
Added:
~stimuli:day_one_stimuli)
171
Added:
in
172
Added:
Alcotest.(check string) "name" "Day 1" (Prescription.Workout.name w);
173
Added:
Alcotest.(check string)
174
Added:
"id" "ideal-day-1"
175
Added:
(Prescription.Workout.id w :> string);
176
Added:
Alcotest.(check int)
177
Added:
"four stimuli" 4
178
Added:
(List.length (Prescription.Workout.stimuli w)) );
179
Added:
( "an empty workout is refused",
180
Added:
`Quick,
181
Added:
fun () ->
182
Added:
match
183
Added:
Prescription.Workout.make ~id:"empty" ~name:"Nothing" ~stimuli:[]
184
Added:
with
185
Added:
| Error Prescription.Workout.Empty_workout -> ()
186
Added:
| Ok _ -> Alcotest.fail "expected Empty_workout" );
187
Added:
( "equality is by id, not by content",
188
Added:
`Quick,
189
Added:
fun () ->
190
Added:
let a =
191
Added:
ok
192
Added:
(Prescription.Workout.make ~id:"day-1" ~name:"Day 1"
193
Added:
~stimuli:day_one_stimuli)
194
Added:
in
195
Added:
let renamed =
196
Added:
ok
197
Added:
(Prescription.Workout.make ~id:"day-1" ~name:"Renamed"
198
Added:
~stimuli:[ ok (single "curls") ])
199
Added:
in
200
Added:
let other =
201
Added:
ok
202
Added:
(Prescription.Workout.make ~id:"day-2" ~name:"Day 1"
203
Added:
~stimuli:day_one_stimuli)
204
Added:
in
205
Added:
Alcotest.(check bool)
206
Added:
"same id" true
207
Added:
(Prescription.Workout.equal a renamed);
208
Added:
Alcotest.(check bool)
209
Added:
"different id" false
210
Added:
(Prescription.Workout.equal a other) );
211
Added:
]
212
Added:
213
Added:
(* {1 The routine} *)
214
Added:
215
Added:
let secs = Recovery.duration_to_seconds
216
Added:
let ideal = Prescription.Routine.ideal
217
Added:
let days = Prescription.Routine.workouts ideal
218
Added:
219
Added:
let nth n =
220
Added:
match List.nth_opt days n with
221
Added:
| Some w -> w
222
Added:
| None -> Alcotest.failf "Ideal Routine has no workout %d" n
223
Added:
224
Added:
let routine_tests =
225
Added:
[
226
Added:
( "an empty routine is refused",
227
Added:
`Quick,
228
Added:
fun () ->
229
Added:
match Prescription.Routine.make ~name:"Nothing" ~workouts:[] with
230
Added:
| Error Prescription.Routine.Empty_routine -> ()
231
Added:
| Ok _ -> Alcotest.fail "expected Empty_routine" );
232
Added:
( "the Ideal Routine is HD1's three days",
233
Added:
`Quick,
234
Added:
fun () ->
235
Added:
Alcotest.(check string)
236
Added:
"name" "Ideal Routine"
237
Added:
(Prescription.Routine.name ideal);
238
Added:
Alcotest.(check int) "three workouts" 3 (List.length days);
239
Added:
Alcotest.(check (list string))
240
Added:
"in order"
241
Added:
[ "Day 1"; "Day 2"; "Day 3" ]
242
Added:
(List.map Prescription.Workout.name days) );
243
Added:
( "each day prescribes the movements HD1 lists",
244
Added:
`Quick,
245
Added:
fun () ->
246
Added:
Alcotest.(check (list int))
247
Added:
"stimuli per day" [ 4; 5; 4 ]
248
Added:
(List.map
249
Added:
(fun w -> List.length (Prescription.Workout.stimuli w))
250
Added:
days) );
251
Added:
( "Day 1 opens with the pec pre-exhaust and closes with the triceps one",
252
Added:
`Quick,
253
Added:
fun () ->
254
Added:
let ps = Prescription.Workout.stimuli (nth 0) in
255
Added:
let names p =
256
Added:
List.map Exercise.name (Prescription.Stimulus.exercises p)
257
Added:
in
258
Added:
Alcotest.(check (list string))
259
Added:
"flyes into incline press"
260
Added:
[ "Dumbbell Flyes"; "Incline Presses" ]
261
Added:
(names (List.hd ps));
262
Added:
Alcotest.(check (list string))
263
Added:
"french press into dips"
264
Added:
[ "Lying French Presses"; "Dips" ]
265
Added:
(names (List.nth ps 3)) );
266
Added:
( "Day 2's superset is the lat pre-exhaust, not an antagonist pairing",
267
Added:
`Quick,
268
Added:
fun () ->
269
Added:
let ps = Prescription.Workout.stimuli (nth 1) in
270
Added:
match Prescription.Stimulus.delivery (List.hd ps) with
271
Added:
| Prescription.Stimulus.Pre_exhaust { isolation; compound } ->
272
Added:
Alcotest.(check string)
273
Added:
"isolation" "Pullovers" (Exercise.name isolation);
274
Added:
Alcotest.(check string)
275
Added:
"compound" "Close-grip, palms-up Pulldowns"
276
Added:
(Exercise.name compound)
277
Added:
| Prescription.Stimulus.Single _ ->
278
Added:
Alcotest.fail "expected a pre-exhaust" );
279
Added:
( "HD1's alternatives are permitted where it offers them",
280
Added:
`Quick,
281
Added:
fun () ->
282
Added:
let legs = List.hd (Prescription.Workout.stimuli (nth 2)) in
283
Added:
Alcotest.(check bool)
284
Added:
"squats may replace the leg press" true
285
Added:
(Prescription.Stimulus.permits legs (get "squats"));
286
Added:
let pecs = List.hd (Prescription.Workout.stimuli (nth 0)) in
287
Added:
Alcotest.(check bool)
288
Added:
"pec deck may replace flyes" true
289
Added:
(Prescription.Stimulus.permits pecs (get "pec-deck")) );
290
Added:
]
291
Added:
292
Added:
let rotation_tests =
293
Added:
[
294
Added:
( "the cycle advances and wraps",
295
Added:
`Quick,
296
Added:
fun () ->
297
Added:
let name w = Prescription.Workout.name w in
298
Added:
Alcotest.(check string)
299
Added:
"1 -> 2" "Day 2"
300
Added:
(name (Prescription.Routine.workout_after ideal (nth 0)));
301
Added:
Alcotest.(check string)
302
Added:
"2 -> 3" "Day 3"
303
Added:
(name (Prescription.Routine.workout_after ideal (nth 1)));
304
Added:
Alcotest.(check string)
305
Added:
"3 wraps to 1" "Day 1"
306
Added:
(name (Prescription.Routine.workout_after ideal (nth 2))) );
307
Added:
( "an unknown workout falls back to the start of the cycle",
308
Added:
`Quick,
309
Added:
fun () ->
310
Added:
let stranger =
311
Added:
ok
312
Added:
(Prescription.Workout.make ~id:"elsewhere" ~name:"Elsewhere"
313
Added:
~stimuli:(Prescription.Workout.stimuli (nth 0)))
314
Added:
in
315
Added:
Alcotest.(check string)
316
Added:
"falls back" "Day 1"
317
Added:
(Prescription.Workout.name
318
Added:
(Prescription.Routine.workout_after ideal stranger)) );
319
Added:
]
320
Added:
321
Added:
let rest_tests =
322
Added:
[
323
Added:
( "HD1's intervals are every other day, then two days off",
324
Added:
`Quick,
325
Added:
fun () ->
326
Added:
Alcotest.(check int)
327
Added:
"48h" 172_800
328
Added:
(secs Prescription.Routine.training_interval);
329
Added:
Alcotest.(check int)
330
Added:
"72h" 259_200
331
Added:
(secs Prescription.Routine.cycle_rest) );
332
Added:
( "rest within the cycle is 48h, and 72h once it completes",
333
Added:
`Quick,
334
Added:
fun () ->
335
Added:
Alcotest.(check int)
336
Added:
"after Day 1" 172_800
337
Added:
(secs (Prescription.Routine.recovery_after ideal (nth 0)));
338
Added:
Alcotest.(check int)
339
Added:
"after Day 2" 172_800
340
Added:
(secs (Prescription.Routine.recovery_after ideal (nth 1)));
341
Added:
Alcotest.(check int)
342
Added:
"after Day 3" 259_200
343
Added:
(secs (Prescription.Routine.recovery_after ideal (nth 2))) );
344
Added:
]
345
Added:
158
346
let suite =
159
347
[
160
Removed:
("prescription.delivery", delivery_tests);
161
Removed:
("prescription.rep_window", rep_window_tests);
162
Removed:
("prescription.substitutes", substitute_tests);
348
Added:
("prescription.stimulus.delivery", delivery_tests);
349
Added:
("prescription.stimulus.rep_window", rep_window_tests);
350
Added:
("prescription.stimulus.substitutes", substitute_tests);
351
Added:
("prescription.workout", workout_tests);
352
Added:
("prescription.routine", routine_tests);
353
Added:
("prescription.routine.rotation", rotation_tests);
354
Added:
("prescription.routine.rest", rest_tests);
163
355
]
test/test_progression.ml
@@ -1,5 +1,8 @@
1
1
(** Unit tests for {!Progression}. *)
2
2
3
Added:
module Stimulus = Evidence.Stimulus
4
Added:
module Workout = Evidence.Workout
5
Added:
3
6
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
7
5
8
let get id =
@@ -20,7 +23,7 @@
20
23
~outcome
21
24
22
25
(* An observation is a public record, so evidence can be written directly. *)
23
Removed:
let seen ~on load r : Logbook.observation =
26
Added:
let seen ~on load r : Evidence.Log.observation =
24
27
{ exercise = get "laterals"; movement = move load r; performed_at = day on }
25
28
26
29
let beats_tests =
@@ -185,16 +188,52 @@
185
188
"4 reps of 6-10" true
186
189
(Progression.judge_load ~rep_range:six_to_ten (move 12. 4)
187
190
= Progression.Too_heavy) );
191
Added:
(* The window's ceiling never gates the verdict: HD1's trigger is the
192
Added:
absolute twelve, and overshooting a narrower band is the slack it
193
Added:
allows. Only the floor decides Too_heavy. *)
194
Added:
( "a band's ceiling does not gate the verdict",
195
Added:
`Quick,
196
Added:
fun () ->
197
Added:
Alcotest.(check bool)
198
Added:
"10 reps of 6-8 still holds" true
199
Added:
(Progression.judge_load ~rep_range:(range 6 8) (move 12. 10)
200
Added:
= Progression.Hold) );
201
Added:
( "the twelve-rep trigger is absolute, whatever the ceiling",
202
Added:
`Quick,
203
Added:
fun () ->
204
Added:
List.iter
205
Added:
(fun (lo, hi) ->
206
Added:
match
207
Added:
Progression.judge_load ~rep_range:(range lo hi) (move 100. 12)
208
Added:
with
209
Added:
| Progression.Increase _ -> ()
210
Added:
| _ ->
211
Added:
Alcotest.failf "%d-%d at twelve reps must call for more load" lo
212
Added:
hi)
213
Added:
[ (6, 8); (6, 10); (6, 12); (8, 12); (12, 12) ] );
214
Added:
( "the floor moves with the band",
215
Added:
`Quick,
216
Added:
fun () ->
217
Added:
Alcotest.(check bool)
218
Added:
"7 reps of 8-12 is too heavy" true
219
Added:
(Progression.judge_load ~rep_range:(range 8 12) (move 12. 7)
220
Added:
= Progression.Too_heavy);
221
Added:
Alcotest.(check bool)
222
Added:
"7 reps of 6-10 holds" true
223
Added:
(Progression.judge_load ~rep_range:six_to_ten (move 12. 7)
224
Added:
= Progression.Hold) );
188
225
]
189
226
190
Removed:
(* Entries, for the diagnostics. *)
227
Added:
(* Performed workouts, for the diagnostics. *)
191
228
let cleared = Option.get (Recovery.clear Recovery.Ready)
192
Removed:
let workout = List.hd (Routine.workouts Routine.ideal_routine)
193
229
194
Removed:
let entry ~clearance ~stimuli =
230
Added:
let prescribed =
231
Added:
List.hd (Prescription.Routine.workouts Prescription.Routine.ideal)
232
Added:
233
Added:
let performed ~clearance ~stimuli =
195
234
List.fold_left
196
Removed:
(fun e s -> ok (Entry.add_stimulus e s))
197
Removed:
(Entry.start workout ~clearance ~started_at:(day 1))
235
Added:
(fun w s -> ok (Workout.add_stimulus w s))
236
Added:
(Workout.start prescribed ~clearance ~started_at:(day 1))
198
237
stimuli
199
238
200
239
let laterals ?outcome load r =
@@ -208,41 +247,42 @@
208
247
( "a clean record yields no diagnostics",
209
248
`Quick,
210
249
fun () ->
211
Removed:
let e = entry ~clearance:cleared ~stimuli:[ laterals 12. 8 ] in
212
Removed:
Alcotest.(check int) "none" 0 (List.length (Progression.diagnose [ e ]))
250
Added:
let w = performed ~clearance:cleared ~stimuli:[ laterals 12. 8 ] in
251
Added:
Alcotest.(check int) "none" 0 (List.length (Progression.diagnose [ w ]))
213
252
);
214
253
( "extending every stimulus is flagged",
215
254
`Quick,
216
255
fun () ->
217
Removed:
let e =
218
Removed:
entry ~clearance:cleared ~stimuli:[ laterals ~outcome:extended 12. 8 ]
256
Added:
let w =
257
Added:
performed ~clearance:cleared
258
Added:
~stimuli:[ laterals ~outcome:extended 12. 8 ]
219
259
in
220
Removed:
match Progression.diagnose [ e ] with
260
Added:
match Progression.diagnose [ w ] with
221
261
| [ Progression.Extensions_on_every_stimulus n ] ->
222
262
Alcotest.(check int) "one workout" 1 n
223
263
| _ -> Alcotest.fail "expected the extension diagnostic" );
224
264
( "extending only some stimuli is not flagged",
225
265
`Quick,
226
266
fun () ->
227
Removed:
let e =
228
Removed:
entry ~clearance:cleared
267
Added:
let w =
268
Added:
performed ~clearance:cleared
229
269
~stimuli:[ laterals ~outcome:extended 12. 8; laterals 10. 9 ]
230
270
in
231
Removed:
Alcotest.(check int) "none" 0 (List.length (Progression.diagnose [ e ]))
271
Added:
Alcotest.(check int) "none" 0 (List.length (Progression.diagnose [ w ]))
232
272
);
233
273
( "training on an override is flagged",
234
274
`Quick,
235
275
fun () ->
236
276
let recovering =
237
277
Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12)
238
Removed:
~recommended:Routine.training_interval
278
Added:
~recommended:Prescription.Routine.training_interval
239
279
in
240
Removed:
let e =
241
Removed:
entry
280
Added:
let w =
281
Added:
performed
242
282
~clearance:(Recovery.override recovering ~reason:"impatient")
243
283
~stimuli:[ laterals 12. 8 ]
244
284
in
245
Removed:
match Progression.diagnose [ e ] with
285
Added:
match Progression.diagnose [ w ] with
246
286
| [ Progression.Trained_under_recovered n ] ->
247
287
Alcotest.(check int) "one workout" 1 n
248
288
| _ -> Alcotest.fail "expected the under-recovery diagnostic" );
@@ -251,14 +291,14 @@
251
291
fun () ->
252
292
let recovering =
253
293
Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12)
254
Removed:
~recommended:Routine.training_interval
294
Added:
~recommended:Prescription.Routine.training_interval
255
295
in
256
Removed:
let e =
257
Removed:
entry
296
Added:
let w =
297
Added:
performed
258
298
~clearance:(Recovery.override recovering ~reason:"impatient")
259
299
~stimuli:[ laterals ~outcome:extended 12. 8 ]
260
300
in
261
Removed:
Alcotest.(check int) "both" 2 (List.length (Progression.diagnose [ e ]));
301
Added:
Alcotest.(check int) "both" 2 (List.length (Progression.diagnose [ w ]));
262
302
Alcotest.(check bool)
263
303
"and the routine is stalled" true
264
304
(Progression.assess
test/test_routine.ml
@@ -1,135 +0,0 @@
1
Removed:
(** Unit tests for {!Routine}. *)
2
Removed:
3
Removed:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
Removed:
let secs = Recovery.duration_to_seconds
5
Removed:
let ideal = Routine.ideal_routine
6
Removed:
let days = Routine.workouts ideal
7
Removed:
8
Removed:
let nth n =
9
Removed:
match List.nth_opt days n with
10
Removed:
| Some w -> w
11
Removed:
| None -> Alcotest.failf "Ideal Routine has no workout %d" n
12
Removed:
13
Removed:
let construction_tests =
14
Removed:
[
15
Removed:
( "an empty routine is refused",
16
Removed:
`Quick,
17
Removed:
fun () ->
18
Removed:
match Routine.make ~name:"Nothing" ~workouts:[] with
19
Removed:
| Error Routine.Empty_routine -> ()
20
Removed:
| Ok _ -> Alcotest.fail "expected Empty_routine" );
21
Removed:
( "the Ideal Routine is HD1's three days",
22
Removed:
`Quick,
23
Removed:
fun () ->
24
Removed:
Alcotest.(check string) "name" "Ideal Routine" (Routine.name ideal);
25
Removed:
Alcotest.(check int) "three workouts" 3 (List.length days);
26
Removed:
Alcotest.(check (list string))
27
Removed:
"in order"
28
Removed:
[ "Day 1"; "Day 2"; "Day 3" ]
29
Removed:
(List.map Workout_prescription.name days) );
30
Removed:
( "each day prescribes the movements HD1 lists",
31
Removed:
`Quick,
32
Removed:
fun () ->
33
Removed:
Alcotest.(check (list int))
34
Removed:
"stimuli per day" [ 4; 5; 4 ]
35
Removed:
(List.map
36
Removed:
(fun w -> List.length (Workout_prescription.prescriptions w))
37
Removed:
days) );
38
Removed:
( "Day 1 opens with the pec pre-exhaust and closes with the triceps one",
39
Removed:
`Quick,
40
Removed:
fun () ->
41
Removed:
let ps = Workout_prescription.prescriptions (nth 0) in
42
Removed:
let names p = List.map Exercise.name (Prescription.exercises p) in
43
Removed:
Alcotest.(check (list string))
44
Removed:
"flyes into incline press"
45
Removed:
[ "Dumbbell Flyes"; "Incline Presses" ]
46
Removed:
(names (List.hd ps));
47
Removed:
Alcotest.(check (list string))
48
Removed:
"french press into dips"
49
Removed:
[ "Lying French Presses"; "Dips" ]
50
Removed:
(names (List.nth ps 3)) );
51
Removed:
( "Day 2's superset is the lat pre-exhaust, not an antagonist pairing",
52
Removed:
`Quick,
53
Removed:
fun () ->
54
Removed:
let ps = Workout_prescription.prescriptions (nth 1) in
55
Removed:
match Prescription.delivery (List.hd ps) with
56
Removed:
| Prescription.Pre_exhaust { isolation; compound } ->
57
Removed:
Alcotest.(check string)
58
Removed:
"isolation" "Pullovers" (Exercise.name isolation);
59
Removed:
Alcotest.(check string)
60
Removed:
"compound" "Close-grip, palms-up Pulldowns"
61
Removed:
(Exercise.name compound)
62
Removed:
| Prescription.Single _ -> Alcotest.fail "expected a pre-exhaust" );
63
Removed:
( "HD1's alternatives are permitted where it offers them",
64
Removed:
`Quick,
65
Removed:
fun () ->
66
Removed:
let get id =
67
Removed:
match Exercise.find id with
68
Removed:
| Some e -> e
69
Removed:
| None -> Alcotest.failf "no exercise %S" id
70
Removed:
in
71
Removed:
let legs = List.hd (Workout_prescription.prescriptions (nth 2)) in
72
Removed:
Alcotest.(check bool)
73
Removed:
"squats may replace the leg press" true
74
Removed:
(Prescription.permits legs (get "squats"));
75
Removed:
let pecs = List.hd (Workout_prescription.prescriptions (nth 0)) in
76
Removed:
Alcotest.(check bool)
77
Removed:
"pec deck may replace flyes" true
78
Removed:
(Prescription.permits pecs (get "pec-deck")) );
79
Removed:
]
80
Removed:
81
Removed:
let rotation_tests =
82
Removed:
[
83
Removed:
( "the cycle advances and wraps",
84
Removed:
`Quick,
85
Removed:
fun () ->
86
Removed:
let name w = Workout_prescription.name w in
87
Removed:
Alcotest.(check string)
88
Removed:
"1 -> 2" "Day 2"
89
Removed:
(name (Routine.workout_after ideal (nth 0)));
90
Removed:
Alcotest.(check string)
91
Removed:
"2 -> 3" "Day 3"
92
Removed:
(name (Routine.workout_after ideal (nth 1)));
93
Removed:
Alcotest.(check string)
94
Removed:
"3 wraps to 1" "Day 1"
95
Removed:
(name (Routine.workout_after ideal (nth 2))) );
96
Removed:
( "an unknown workout falls back to the start of the cycle",
97
Removed:
`Quick,
98
Removed:
fun () ->
99
Removed:
let stranger =
100
Removed:
ok
101
Removed:
(Workout_prescription.make ~id:"elsewhere" ~name:"Elsewhere"
102
Removed:
~prescriptions:(Workout_prescription.prescriptions (nth 0)))
103
Removed:
in
104
Removed:
Alcotest.(check string)
105
Removed:
"falls back" "Day 1"
106
Removed:
(Workout_prescription.name (Routine.workout_after ideal stranger)) );
107
Removed:
]
108
Removed:
109
Removed:
let rest_tests =
110
Removed:
[
111
Removed:
( "HD1's intervals are every other day, then two days off",
112
Removed:
`Quick,
113
Removed:
fun () ->
114
Removed:
Alcotest.(check int) "48h" 172_800 (secs Routine.training_interval);
115
Removed:
Alcotest.(check int) "72h" 259_200 (secs Routine.cycle_rest) );
116
Removed:
( "rest within the cycle is 48h, and 72h once it completes",
117
Removed:
`Quick,
118
Removed:
fun () ->
119
Removed:
Alcotest.(check int)
120
Removed:
"after Day 1" 172_800
121
Removed:
(secs (Routine.recovery_after ideal (nth 0)));
122
Removed:
Alcotest.(check int)
123
Removed:
"after Day 2" 172_800
124
Removed:
(secs (Routine.recovery_after ideal (nth 1)));
125
Removed:
Alcotest.(check int)
126
Removed:
"after Day 3" 259_200
127
Removed:
(secs (Routine.recovery_after ideal (nth 2))) );
128
Removed:
]
129
Removed:
130
Removed:
let suite =
131
Removed:
[
132
Removed:
("routine.construction", construction_tests);
133
Removed:
("routine.rotation", rotation_tests);
134
Removed:
("routine.rest", rest_tests);
135
Removed:
]
test/test_service.ml
@@ -2,6 +2,8 @@
2
2
3
3
open Hito_app
4
4
module S = Service.Make (Memory_repo)
5
Added:
module Stimulus = Evidence.Stimulus
6
Added:
module Workout = Evidence.Workout
5
7
6
8
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
7
9
@@ -46,7 +48,9 @@
46
48
fun () ->
47
49
match S.list_routines (service ()) with
48
50
| [ (_, r) ] ->
49
Removed:
Alcotest.(check string) "name" "Ideal Routine" (Routine.name r)
51
Added:
Alcotest.(check string)
52
Added:
"name" "Ideal Routine"
53
Added:
(Prescription.Routine.name r)
50
54
| rs -> Alcotest.failf "expected one routine, got %d" (List.length rs)
51
55
);
52
56
( "an unknown routine is refused",
@@ -61,7 +65,7 @@
61
65
`Quick,
62
66
fun () ->
63
67
let w = ok (S.next_workout (service ()) ~routine:ideal) in
64
Removed:
Alcotest.(check string) "Day 1" "Day 1" (Workout_prescription.name w) );
68
Added:
Alcotest.(check string) "Day 1" "Day 1" (Prescription.Workout.name w) );
65
69
]
66
70
67
71
let clearance_tests =
@@ -94,22 +98,22 @@
94
98
let s = service () in
95
99
let _ = ok (S.begin_workout s ~routine:ideal ~now:(day 1) ()) in
96
100
let _ = S.finish s ~ended_at:(day 1) in
97
Removed:
let entry = ok (S.begin_workout s ~routine:ideal ~now:(day 3) ()) in
101
Added:
let w = ok (S.begin_workout s ~routine:ideal ~now:(day 3) ()) in
98
102
Alcotest.(check string)
99
103
"Day 2" "Day 2"
100
Removed:
(Workout_prescription.name (Entry.prescription entry)) );
104
Added:
(Prescription.Workout.name (Workout.prescription w)) );
101
105
( "an override is accepted and keeps its reason on the record",
102
106
`Quick,
103
107
fun () ->
104
108
let s = service () in
105
109
let _ = ok (S.begin_workout s ~routine:ideal ~now:(day 1) ()) in
106
110
let _ = S.finish s ~ended_at:(day 1) in
107
Removed:
let entry =
111
Added:
let w =
108
112
ok
109
113
(S.begin_workout s ~routine:ideal ~now:(day 2)
110
114
~override:"travelling tomorrow" ())
111
115
in
112
Removed:
match Recovery.basis (Entry.clearance entry) with
116
Added:
match Recovery.basis (Workout.clearance w) with
113
117
| Recovery.Overridden { reason; _ } ->
114
118
Alcotest.(check string) "reason" "travelling tomorrow" reason
115
119
| Recovery.Recovered -> Alcotest.fail "expected Overridden" );
@@ -117,12 +121,12 @@
117
121
`Quick,
118
122
fun () ->
119
123
let s = service () in
120
Removed:
let entry =
124
Added:
let w =
121
125
ok
122
126
(S.begin_workout s ~routine:ideal ~now:(day 1)
123
127
~override:"just in case" ())
124
128
in
125
Removed:
match Recovery.basis (Entry.clearance entry) with
129
Added:
match Recovery.basis (Workout.clearance w) with
126
130
| Recovery.Recovered -> ()
127
131
| Recovery.Overridden _ ->
128
132
Alcotest.fail "nothing was outstanding to override" );
@@ -142,7 +146,7 @@
142
146
let s = service () in
143
147
let _ = ok (S.begin_workout s ~routine:ideal ~now:(day 1) ()) in
144
148
match S.log s (single "shrugs" 80. 10) with
145
Removed:
| Error (S.Rejected (Entry.Not_prescribed _)) -> ()
149
Added:
| Error (S.Rejected (Workout.Not_prescribed _)) -> ()
146
150
| _ -> Alcotest.fail "expected Rejected Not_prescribed" );
147
151
( "Day 1 can be logged in full and finished",
148
152
`Quick,
@@ -150,17 +154,15 @@
150
154
let s = service () in
151
155
let _ = ok (S.begin_workout s ~routine:ideal ~now:(day 1) ()) in
152
156
List.iter (fun st -> ignore (ok (S.log s st))) day_one_stimuli;
153
Removed:
let entry = Option.get (S.in_progress s) in
157
Added:
let w = Option.get (S.in_progress s) in
158
Added:
Alcotest.(check int) "four stimuli" 4 (List.length (Workout.stimuli w));
154
159
Alcotest.(check int)
155
Removed:
"four stimuli" 4
156
Removed:
(List.length (Entry.stimuli entry));
157
Removed:
Alcotest.(check int)
158
160
"nothing outstanding" 0
159
Removed:
(List.length (Entry.unperformed entry));
161
Added:
(List.length (Workout.unperformed w));
160
162
let record = Option.get (S.finish s ~ended_at:(at 3600)) in
161
163
Alcotest.(check bool)
162
164
"persisted as finished" true
163
Removed:
(Entry.is_finished record.Repository.entry);
165
Added:
(Workout.is_finished record.Repository.workout);
164
166
Alcotest.(check bool)
165
167
"slot cleared" true
166
168
(Option.is_none (S.in_progress s)) );
@@ -184,12 +186,12 @@
184
186
per three workouts. Log whole cycles and record laterals whenever
185
187
Day 1 comes round, at an unchanging load. *)
186
188
let run ~on ~load =
187
Removed:
let entry =
189
Added:
let w =
188
190
ok (S.begin_workout s ~routine:ideal ~now:on ~override:"fixture" ())
189
191
in
190
192
if
191
193
String.equal "Day 1"
192
Removed:
(Workout_prescription.name (Entry.prescription entry))
194
Added:
(Prescription.Workout.name (Workout.prescription w))
193
195
then ignore (ok (S.log s (single "laterals" load 8)));
194
196
ignore (S.finish s ~ended_at:on)
195
197
in
test/test_stimulus.ml
@@ -1,140 +0,0 @@
1
Removed:
(** Unit tests for {!Stimulus}. *)
2
Removed:
3
Removed:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
Removed:
5
Removed:
let get id =
6
Removed:
match Exercise.find id with
7
Removed:
| Some e -> e
8
Removed:
| None -> Alcotest.failf "catalog is missing %S" id
9
Removed:
10
Removed:
let kg n = ok (Units.Weight.of_kg n)
11
Removed:
let reps n = ok (Units.Reps.of_int n)
12
Removed:
13
Removed:
let move ?(outcome = Stimulus.Positive_failure) id load r =
14
Removed:
Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
15
Removed:
~outcome
16
Removed:
17
Removed:
let outcome_tests =
18
Removed:
[
19
Removed:
( "positive failure used no extension",
20
Removed:
`Quick,
21
Removed:
fun () ->
22
Removed:
Alcotest.(check (list string))
23
Removed:
"none" []
24
Removed:
(List.map
25
Removed:
(Format.asprintf "%a" Stimulus.pp_extension)
26
Removed:
(Stimulus.extensions_of_outcome Stimulus.Positive_failure)) );
27
Removed:
( "extensions stack in the order applied",
28
Removed:
`Quick,
29
Removed:
fun () ->
30
Removed:
let o =
31
Removed:
Stimulus.Beyond_failure (Stimulus.Forced_reps, [ Stimulus.Negatives ])
32
Removed:
in
33
Removed:
Alcotest.(check (list string))
34
Removed:
"forced reps then negatives"
35
Removed:
[ "forced reps"; "negatives" ]
36
Removed:
(List.map
37
Removed:
(Format.asprintf "%a" Stimulus.pp_extension)
38
Removed:
(Stimulus.extensions_of_outcome o)) );
39
Removed:
]
40
Removed:
41
Removed:
let delivery_tests =
42
Removed:
[
43
Removed:
( "a single movement is one stimulus",
44
Removed:
`Quick,
45
Removed:
fun () ->
46
Removed:
let s = ok (Stimulus.make (Stimulus.Single (move "curls" 40. 8))) in
47
Removed:
Alcotest.(check int)
48
Removed:
"one movement" 1
49
Removed:
(List.length (Stimulus.movements s));
50
Removed:
Alcotest.(check bool) "not extended" false (Stimulus.is_extended s) );
51
Removed:
( "a pre-exhaust pair is one stimulus, isolation first",
52
Removed:
`Quick,
53
Removed:
fun () ->
54
Removed:
let s =
55
Removed:
ok
56
Removed:
(Stimulus.make
57
Removed:
(Stimulus.Pre_exhaust
58
Removed:
{
59
Removed:
isolation = move "dumbbell-flyes" 20. 9;
60
Removed:
compound = move "incline-press" 60. 7;
61
Removed:
}))
62
Removed:
in
63
Removed:
Alcotest.(check int)
64
Removed:
"two movements" 2
65
Removed:
(List.length (Stimulus.movements s));
66
Removed:
Alcotest.(check (list string))
67
Removed:
"isolation leads"
68
Removed:
[ "Dumbbell Flyes"; "Incline Presses" ]
69
Removed:
(List.map Exercise.name (Stimulus.exercises s)) );
70
Removed:
( "a mislabelled pairing is refused",
71
Removed:
`Quick,
72
Removed:
fun () ->
73
Removed:
match
74
Removed:
Stimulus.make
75
Removed:
(Stimulus.Pre_exhaust
76
Removed:
{
77
Removed:
isolation = move "dumbbell-flyes" 20. 9;
78
Removed:
compound = move "squats" 100. 8;
79
Removed:
})
80
Removed:
with
81
Removed:
| Error (Stimulus.Not_a_pre_exhaust { isolation; compound }) ->
82
Removed:
Alcotest.(check string)
83
Removed:
"isolation" "dumbbell-flyes"
84
Removed:
(isolation :> string);
85
Removed:
Alcotest.(check string) "compound" "squats" (compound :> string)
86
Removed:
| Ok _ -> Alcotest.fail "expected Not_a_pre_exhaust" );
87
Removed:
( "extensions are gathered across a pre-exhaust's movements",
88
Removed:
`Quick,
89
Removed:
fun () ->
90
Removed:
let s =
91
Removed:
ok
92
Removed:
(Stimulus.make
93
Removed:
(Stimulus.Pre_exhaust
94
Removed:
{
95
Removed:
isolation = move "lying-french-press" 30. 9;
96
Removed:
compound =
97
Removed:
move
98
Removed:
~outcome:
99
Removed:
(Stimulus.Beyond_failure
100
Removed:
(Stimulus.Forced_reps, [ Stimulus.Negatives ]))
101
Removed:
"dips" 0. 6;
102
Removed:
}))
103
Removed:
in
104
Removed:
Alcotest.(check bool) "extended" true (Stimulus.is_extended s);
105
Removed:
Alcotest.(check int)
106
Removed:
"two extensions" 2
107
Removed:
(List.length (Stimulus.extensions s)) );
108
Removed:
]
109
Removed:
110
Removed:
let warm_up_tests =
111
Removed:
[
112
Removed:
( "warm-ups sit alongside the stimulus, not inside it",
113
Removed:
`Quick,
114
Removed:
fun () ->
115
Removed:
let w =
116
Removed:
Stimulus.Warm_up.make ~exercise:(get "squats") ~load:(kg 40.)
117
Removed:
~reps:(reps 10)
118
Removed:
in
119
Removed:
let s =
120
Removed:
ok
121
Removed:
(Stimulus.make ~warm_ups:[ w ]
122
Removed:
(Stimulus.Single (move "squats" 100. 8)))
123
Removed:
in
124
Removed:
Alcotest.(check int) "one warm-up" 1 (List.length (Stimulus.warm_ups s));
125
Removed:
Alcotest.(check int)
126
Removed:
"still one drive to failure" 1
127
Removed:
(List.length (Stimulus.movements s)) );
128
Removed:
( "a stimulus needs no warm-up",
129
Removed:
`Quick,
130
Removed:
fun () ->
131
Removed:
let s = ok (Stimulus.make (Stimulus.Single (move "sit-ups" 0. 12))) in
132
Removed:
Alcotest.(check int) "none" 0 (List.length (Stimulus.warm_ups s)) );
133
Removed:
]
134
Removed:
135
Removed:
let suite =
136
Removed:
[
137
Removed:
("stimulus.outcome", outcome_tests);
138
Removed:
("stimulus.delivery", delivery_tests);
139
Removed:
("stimulus.warm_up", warm_up_tests);
140
Removed:
]
test/test_workout_prescription.ml
@@ -1,85 +0,0 @@
1
Removed:
(** Unit tests for {!Workout_prescription}. *)
2
Removed:
3
Removed:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
Removed:
5
Removed:
let get id =
6
Removed:
match Exercise.find id with
7
Removed:
| Some e -> e
8
Removed:
| None -> Alcotest.failf "catalog is missing %S" id
9
Removed:
10
Removed:
let six_to_ten =
11
Removed:
let reps n = ok (Units.Reps.of_int n) in
12
Removed:
ok (Units.Rep_range.make ~min:(reps 6) ~max:(reps 10))
13
Removed:
14
Removed:
let prescribe delivery =
15
Removed:
ok (Prescription.make ~delivery ~rep_range:six_to_ten ~allowed_substitutes:[])
16
Removed:
17
Removed:
let single id = prescribe (Prescription.Single (get id))
18
Removed:
19
Removed:
let pre_exhaust ~isolation ~compound =
20
Removed:
prescribe
21
Removed:
(Prescription.Pre_exhaust
22
Removed:
{ isolation = get isolation; compound = get compound })
23
Removed:
24
Removed:
(* HD1's Day 1: pecs pre-exhaust, two delt isolations, triceps pre-exhaust. *)
25
Removed:
let day_one =
26
Removed:
[
27
Removed:
pre_exhaust ~isolation:"dumbbell-flyes" ~compound:"incline-press";
28
Removed:
single "laterals";
29
Removed:
single "bent-over-laterals";
30
Removed:
pre_exhaust ~isolation:"lying-french-press" ~compound:"dips";
31
Removed:
]
32
Removed:
33
Removed:
let tests =
34
Removed:
[
35
Removed:
( "HD1's Day 1 is prescribable, in order",
36
Removed:
`Quick,
37
Removed:
fun () ->
38
Removed:
let w =
39
Removed:
ok
40
Removed:
(Workout_prescription.make ~id:"ideal-day-1" ~name:"Day 1"
41
Removed:
~prescriptions:day_one)
42
Removed:
in
43
Removed:
Alcotest.(check string) "name" "Day 1" (Workout_prescription.name w);
44
Removed:
Alcotest.(check string)
45
Removed:
"id" "ideal-day-1"
46
Removed:
(Workout_prescription.id w :> string);
47
Removed:
Alcotest.(check int)
48
Removed:
"four stimuli" 4
49
Removed:
(List.length (Workout_prescription.prescriptions w)) );
50
Removed:
( "an empty workout is refused",
51
Removed:
`Quick,
52
Removed:
fun () ->
53
Removed:
match
54
Removed:
Workout_prescription.make ~id:"empty" ~name:"Nothing"
55
Removed:
~prescriptions:[]
56
Removed:
with
57
Removed:
| Error Workout_prescription.Empty_workout -> ()
58
Removed:
| Ok _ -> Alcotest.fail "expected Empty_workout" );
59
Removed:
( "equality is by id, not by content",
60
Removed:
`Quick,
61
Removed:
fun () ->
62
Removed:
let a =
63
Removed:
ok
64
Removed:
(Workout_prescription.make ~id:"day-1" ~name:"Day 1"
65
Removed:
~prescriptions:day_one)
66
Removed:
in
67
Removed:
let renamed =
68
Removed:
ok
69
Removed:
(Workout_prescription.make ~id:"day-1" ~name:"Renamed"
70
Removed:
~prescriptions:[ single "curls" ])
71
Removed:
in
72
Removed:
let other =
73
Removed:
ok
74
Removed:
(Workout_prescription.make ~id:"day-2" ~name:"Day 1"
75
Removed:
~prescriptions:day_one)
76
Removed:
in
77
Removed:
Alcotest.(check bool)
78
Removed:
"same id" true
79
Removed:
(Workout_prescription.equal a renamed);
80
Removed:
Alcotest.(check bool)
81
Removed:
"different id" false
82
Removed:
(Workout_prescription.equal a other) );
83
Removed:
]
84
Removed:
85
Removed:
let suite = [ ("workout_prescription", tests) ]