[OCaml] High Intensity Training Online
feat implement Entry, where plan meets record
An entry is a workout being performed against its prescription. Starting one demands a Recovery.clearance, so training before recovery completes cannot happen by accident, and the clearance is retained because how it was obtained is evidence. Conformance is checked in two stages. A prescription is a candidate when it mentions every movement logged; it matches when the stimulus answers it exactly, same number of movements each filling the prescribed role. That separation is what lets a lone set logged against a prescribed pre-exhaust report a delivery mismatch rather than an unhelpful "not prescribed" — the movements do belong to that slot, they were just not delivered as prescribed. Substitutes must be permitted by the prescription and be a legitimate substitute for the movement they replace, not merely for some movement in the pair. Extra volume is recorded, not refused. HD1 forbids it in the strongest terms, but the log's job is to say what happened: repeated work shows up as more stimuli than slots, and unperformed shows what is outstanding, so Progression can diagnose it. The prescription side is where volume is constrained — a workout prescribes exactly one drive to failure per slot and cannot prescribe more. duration is a progress signal rather than bookkeeping: HD1 reads a shortening time on the same workout as rising intensity. 84 Alcotests, logging HD1's Day 1 end to end.
Changed files
lib/core/dune
@@ -13,5 +13,6 @@
13
13
prescription
14
14
workout_prescription
15
15
routine
16
Removed:
stimulus)
16
Added:
stimulus
17
Added:
entry)
17
18
(wrapped false))
lib/core/entry.ml
@@ -0,0 +1,130 @@
1
Added:
type shape = As_single | As_pre_exhaust
2
Added:
3
Added:
type error =
4
Added:
| Not_prescribed of Exercise.id
5
Added:
| Delivery_mismatch of {
6
Added:
exercise : Exercise.id;
7
Added:
prescribed : shape;
8
Added:
logged : shape;
9
Added:
}
10
Added:
| Already_finished
11
Added:
12
Added:
type t = {
13
Added:
prescription : Workout_prescription.t;
14
Added:
clearance : Recovery.clearance;
15
Added:
started_at : Recovery.timestamp;
16
Added:
ended_at : Recovery.timestamp option;
17
Added:
(* Each performed stimulus with the index of the prescribed slot it answers,
18
Added:
so that unanswered slots stay visible. *)
19
Added:
performed : (int * Stimulus.t) list;
20
Added:
}
21
Added:
22
Added:
let pp_shape ppf = function
23
Added:
| As_single -> Format.pp_print_string ppf "a single set"
24
Added:
| As_pre_exhaust -> Format.pp_print_string ppf "a pre-exhaust pair"
25
Added:
26
Added:
let pp_error ppf = function
27
Added:
| Not_prescribed id ->
28
Added:
Format.fprintf ppf "%s is not prescribed for this workout" (id :> string)
29
Added:
| Delivery_mismatch { exercise; prescribed; logged } ->
30
Added:
Format.fprintf ppf "%s is prescribed as %a but was logged as %a"
31
Added:
(exercise :> string)
32
Added:
pp_shape prescribed pp_shape logged
33
Added:
| Already_finished -> Format.pp_print_string ppf "this workout is finished"
34
Added:
35
Added:
let start prescription ~clearance ~started_at =
36
Added:
{ prescription; clearance; started_at; ended_at = None; performed = [] }
37
Added:
38
Added:
let prescription t = t.prescription
39
Added:
let clearance t = t.clearance
40
Added:
let started_at t = t.started_at
41
Added:
let ended_at t = t.ended_at
42
Added:
let is_finished t = Option.is_some t.ended_at
43
Added:
let stimuli t = List.map snd (List.rev t.performed)
44
Added:
45
Added:
let duration t =
46
Added:
Option.map
47
Added:
(fun ended -> Recovery.elapsed ~since:t.started_at ~now:ended)
48
Added:
t.ended_at
49
Added:
50
Added:
let prescribed_shape p =
51
Added:
match Prescription.delivery p with
52
Added:
| Prescription.Single _ -> As_single
53
Added:
| Prescription.Pre_exhaust _ -> As_pre_exhaust
54
Added:
55
Added:
let logged_shape s =
56
Added:
match Stimulus.delivery s with
57
Added:
| Stimulus.Single _ -> As_single
58
Added:
| Stimulus.Pre_exhaust _ -> As_pre_exhaust
59
Added:
60
Added:
(* A logged movement answers a prescribed one when it is that movement, or a
61
Added:
substitute the prescription allows *for that movement*. *)
62
Added:
let fills ~prescribed ~logged p =
63
Added:
Exercise.equal prescribed logged
64
Added:
|| List.exists (Exercise.equal logged) (Prescription.allowed_substitutes p)
65
Added:
&& Exercise.may_substitute ~original:prescribed ~candidate:logged
66
Added:
67
Added:
(* Whether the prescription mentions every movement logged, ignoring how they
68
Added:
were delivered. This is what makes a shape complaint possible: the movements
69
Added:
belong to this slot, but the delivery does not match it. *)
70
Added:
let mentions p s =
71
Added:
List.for_all (fun e -> Prescription.permits p e) (Stimulus.exercises s)
72
Added:
73
Added:
(* Whether the stimulus answers the prescription exactly: same number of
74
Added:
movements, each filling the prescribed role in order. *)
75
Added:
let conforms p s =
76
Added:
let logged = Stimulus.exercises s in
77
Added:
let prescribed = Prescription.exercises p in
78
Added:
List.length logged = List.length prescribed
79
Added:
&& List.for_all2
80
Added:
(fun prescribed logged -> fills ~prescribed ~logged p)
81
Added:
prescribed logged
82
Added:
83
Added:
let indexed t =
84
Added:
List.mapi
85
Added:
(fun i p -> (i, p))
86
Added:
(Workout_prescription.prescriptions t.prescription)
87
Added:
88
Added:
let answered t = List.map fst t.performed
89
Added:
90
Added:
let unperformed t =
91
Added:
indexed t
92
Added:
|> List.filter (fun (i, _) -> not (List.mem i (answered t)))
93
Added:
|> List.map snd
94
Added:
95
Added:
let add_stimulus t s =
96
Added:
if is_finished t then Error Already_finished
97
Added:
else
98
Added:
let candidates = List.filter (fun (_, p) -> mentions p s) (indexed t) in
99
Added:
let matching = List.filter (fun (_, p) -> conforms p s) candidates in
100
Added:
(* A stimulus always has at least one movement. *)
101
Added:
let leading = Exercise.id (List.hd (Stimulus.exercises s)) in
102
Added:
match (candidates, matching) with
103
Added:
| [], _ -> Error (Not_prescribed leading)
104
Added:
| (_, p) :: _, [] ->
105
Added:
Error
106
Added:
(Delivery_mismatch
107
Added:
{
108
Added:
exercise = leading;
109
Added:
prescribed = prescribed_shape p;
110
Added:
logged = logged_shape s;
111
Added:
})
112
Added:
| _, matching ->
113
Added:
(* Prefer an unanswered slot, so repeated work is visible as extra
114
Added:
volume rather than silently overwriting a slot. *)
115
Added:
let unanswered =
116
Added:
List.filter (fun (i, _) -> not (List.mem i (answered t))) matching
117
Added:
in
118
Added:
let i, _ =
119
Added:
match unanswered with chosen :: _ -> chosen | [] -> List.hd matching
120
Added:
in
121
Added:
Ok { t with performed = (i, s) :: t.performed }
122
Added:
123
Added:
let finish t ~ended_at =
124
Added:
if is_finished t then Error Already_finished
125
Added:
else Ok { t with ended_at = Some ended_at }
126
Added:
127
Added:
let pp ppf t =
128
Added:
Format.fprintf ppf "%a (%d of %d)" Workout_prescription.pp t.prescription
129
Added:
(List.length t.performed)
130
Added:
(List.length (Workout_prescription.prescriptions t.prescription))
lib/core/entry.mli
@@ -0,0 +1,67 @@
1
Added:
(** One workout being performed, or one already performed: the prescription it
2
Added:
answers to, when it ran, and the stimuli it delivered.
3
Added:
4
Added:
An entry is the point where plan meets record. It admits only stimuli its
5
Added:
prescription actually calls for — the delivery shape must agree, and each
6
Added:
movement must be prescribed or an allowed substitute — so a workout cannot
7
Added:
drift into something else and still claim to be the prescribed one.
8
Added:
9
Added:
What it does not do is edit history. A stimulus that was performed can be
10
Added:
recorded even if it should not have been performed; judging that is
11
Added:
{!Progression}'s work. *)
12
Added:
13
Added:
type t
14
Added:
15
Added:
(** Whether a stimulus was delivered as one movement or as a pre-exhaust pair.
16
Added:
*)
17
Added:
type shape = As_single | As_pre_exhaust
18
Added:
19
Added:
type error =
20
Added:
| Not_prescribed of Exercise.id
21
Added:
(** No prescription in this workout covers the movement. *)
22
Added:
| Delivery_mismatch of {
23
Added:
exercise : Exercise.id;
24
Added:
prescribed : shape;
25
Added:
logged : shape;
26
Added:
}
27
Added:
(** The movement is prescribed, but not delivered the prescribed way — a
28
Added:
pre-exhaust pair is not interchangeable with a lone set. *)
29
Added:
| Already_finished
30
Added:
31
Added:
val pp_error : Format.formatter -> error -> unit
32
Added:
33
Added:
val start :
34
Added:
Workout_prescription.t ->
35
Added:
clearance:Recovery.clearance ->
36
Added:
started_at:Recovery.timestamp ->
37
Added:
t
38
Added:
(** Beginning a workout demands a {!Recovery.clearance}: under HD1 training
39
Added:
before recovery completes is the primary error, so it cannot happen by
40
Added:
accident. The clearance is kept, because how it was obtained is evidence. *)
41
Added:
42
Added:
val add_stimulus : t -> Stimulus.t -> (t, error) result
43
Added:
val finish : t -> ended_at:Recovery.timestamp -> (t, error) result
44
Added:
45
Added:
(** {1 Reading an entry} *)
46
Added:
47
Added:
val prescription : t -> Workout_prescription.t
48
Added:
49
Added:
val clearance : t -> Recovery.clearance
50
Added:
(** On what basis this workout was begun. *)
51
Added:
52
Added:
val started_at : t -> Recovery.timestamp
53
Added:
val ended_at : t -> Recovery.timestamp option
54
Added:
val is_finished : t -> bool
55
Added:
56
Added:
val duration : t -> Recovery.duration option
57
Added:
(** [Some] once finished. HD1 treats a shortening duration on the same workout
58
Added:
as rising intensity, so this is a progress signal and not mere bookkeeping.
59
Added:
*)
60
Added:
61
Added:
val stimuli : t -> Stimulus.t list
62
Added:
(** In the order performed. *)
63
Added:
64
Added:
val unperformed : t -> Prescription.t list
65
Added:
(** Prescribed stimuli this entry has yet to answer. *)
66
Added:
67
Added:
val pp : Format.formatter -> t -> unit
test/dune
@@ -12,5 +12,6 @@
12
12
test_workout_prescription
13
13
test_routine
14
14
test_stimulus
15
Removed:
test_recovery)
15
Added:
test_recovery
16
Added:
test_entry)
16
17
(libraries hito.core alcotest))
test/test_entry.ml
@@ -0,0 +1,208 @@
1
Added:
(** Unit tests for {!Entry}. *)
2
Added:
3
Added:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
Added:
5
Added:
let get id =
6
Added:
match Exercise.find id with
7
Added:
| Some e -> e
8
Added:
| None -> Alcotest.failf "catalog is missing %S" id
9
Added:
10
Added:
let kg n = ok (Units.Weight.of_kg n)
11
Added:
let reps n = ok (Units.Reps.of_int n)
12
Added:
let at s = Recovery.timestamp_of_unix_seconds s
13
Added:
14
Added:
let move ?(outcome = Stimulus.Positive_failure) id load r =
15
Added:
Stimulus.Movement.make ~exercise:(get id) ~load:(kg load) ~reps:(reps r)
16
Added:
~outcome
17
Added:
18
Added:
let single id load r = ok (Stimulus.make (Stimulus.Single (move id load r)))
19
Added:
20
Added:
let pre_exhaust iso_m comp_m =
21
Added:
ok
22
Added:
(Stimulus.make
23
Added:
(Stimulus.Pre_exhaust { isolation = iso_m; compound = comp_m }))
24
Added:
25
Added:
let day_one = List.hd (Routine.workouts Routine.ideal_routine)
26
Added:
let cleared = Option.get (Recovery.clear Recovery.Ready)
27
Added:
let fresh () = Entry.start day_one ~clearance:cleared ~started_at:(at 0)
28
Added:
29
Added:
(* HD1's Day 1, in the order it lists. *)
30
Added:
let day_one_stimuli =
31
Added:
[
32
Added:
pre_exhaust (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7);
33
Added:
single "laterals" 12. 8;
34
Added:
single "bent-over-laterals" 10. 9;
35
Added:
pre_exhaust (move "lying-french-press" 30. 8) (move "dips" 0. 6);
36
Added:
]
37
Added:
38
Added:
let lifecycle_tests =
39
Added:
[
40
Added:
( "a fresh entry has performed nothing and answers its prescription",
41
Added:
`Quick,
42
Added:
fun () ->
43
Added:
let e = fresh () in
44
Added:
Alcotest.(check string)
45
Added:
"prescription" "Day 1"
46
Added:
(Workout_prescription.name (Entry.prescription e));
47
Added:
Alcotest.(check int) "no stimuli" 0 (List.length (Entry.stimuli e));
48
Added:
Alcotest.(check int)
49
Added:
"four slots outstanding" 4
50
Added:
(List.length (Entry.unperformed e));
51
Added:
Alcotest.(check bool) "unfinished" false (Entry.is_finished e);
52
Added:
Alcotest.(check bool)
53
Added:
"no duration" true
54
Added:
(Option.is_none (Entry.duration e)) );
55
Added:
( "HD1's Day 1 can be logged end to end",
56
Added:
`Quick,
57
Added:
fun () ->
58
Added:
let e =
59
Added:
List.fold_left
60
Added:
(fun e s -> ok (Entry.add_stimulus e s))
61
Added:
(fresh ()) day_one_stimuli
62
Added:
in
63
Added:
Alcotest.(check int) "four stimuli" 4 (List.length (Entry.stimuli e));
64
Added:
Alcotest.(check int)
65
Added:
"nothing outstanding" 0
66
Added:
(List.length (Entry.unperformed e));
67
Added:
let finished = ok (Entry.finish e ~ended_at:(at 2400)) in
68
Added:
Alcotest.(check bool) "finished" true (Entry.is_finished finished);
69
Added:
Alcotest.(check (option int))
70
Added:
"40 minutes" (Some 2400)
71
Added:
(Option.map Recovery.duration_to_seconds (Entry.duration finished)) );
72
Added:
( "stimuli come back in the order performed",
73
Added:
`Quick,
74
Added:
fun () ->
75
Added:
let e =
76
Added:
List.fold_left
77
Added:
(fun e s -> ok (Entry.add_stimulus e s))
78
Added:
(fresh ())
79
Added:
[ single "laterals" 12. 8; single "bent-over-laterals" 10. 9 ]
80
Added:
in
81
Added:
Alcotest.(check (list string))
82
Added:
"as performed"
83
Added:
[ "Laterals"; "Bent-over Dumbbell Laterals" ]
84
Added:
(List.map
85
Added:
(fun s -> Exercise.name (List.hd (Stimulus.exercises s)))
86
Added:
(Entry.stimuli e)) );
87
Added:
( "a finished entry accepts nothing further",
88
Added:
`Quick,
89
Added:
fun () ->
90
Added:
let e = ok (Entry.finish (fresh ()) ~ended_at:(at 60)) in
91
Added:
(match Entry.add_stimulus e (single "laterals" 12. 8) with
92
Added:
| Error Entry.Already_finished -> ()
93
Added:
| _ -> Alcotest.fail "expected Already_finished");
94
Added:
match Entry.finish e ~ended_at:(at 120) with
95
Added:
| Error Entry.Already_finished -> ()
96
Added:
| _ -> Alcotest.fail "expected Already_finished" );
97
Added:
]
98
Added:
99
Added:
let conformance_tests =
100
Added:
[
101
Added:
( "an unprescribed movement is refused",
102
Added:
`Quick,
103
Added:
fun () ->
104
Added:
match Entry.add_stimulus (fresh ()) (single "shrugs" 80. 10) with
105
Added:
| Error (Entry.Not_prescribed id) ->
106
Added:
Alcotest.(check string) "shrugs" "shrugs" (id :> string)
107
Added:
| _ -> Alcotest.fail "expected Not_prescribed" );
108
Added:
( "a lone set where a pre-exhaust was prescribed is refused",
109
Added:
`Quick,
110
Added:
fun () ->
111
Added:
match Entry.add_stimulus (fresh ()) (single "dumbbell-flyes" 20. 9) with
112
Added:
| Error
113
Added:
(Entry.Delivery_mismatch
114
Added:
{
115
Added:
prescribed = Entry.As_pre_exhaust;
116
Added:
logged = Entry.As_single;
117
Added:
_;
118
Added:
}) ->
119
Added:
()
120
Added:
| _ -> Alcotest.fail "expected Delivery_mismatch" );
121
Added:
( "the prescribed pair, delivered as prescribed, is accepted",
122
Added:
`Quick,
123
Added:
fun () ->
124
Added:
Alcotest.(check bool)
125
Added:
"pec pair conforms" true
126
Added:
(Result.is_ok
127
Added:
(Entry.add_stimulus (fresh ())
128
Added:
(pre_exhaust
129
Added:
(move "dumbbell-flyes" 20. 9)
130
Added:
(move "incline-press" 60. 7)))) );
131
Added:
( "an allowed substitute is accepted in its own role",
132
Added:
`Quick,
133
Added:
fun () ->
134
Added:
let e =
135
Added:
ok
136
Added:
(Entry.add_stimulus (fresh ())
137
Added:
(pre_exhaust (move "pec-deck" 45. 9)
138
Added:
(move "incline-press" 60. 7)))
139
Added:
in
140
Added:
Alcotest.(check int) "recorded" 1 (List.length (Entry.stimuli e));
141
Added:
Alcotest.(check int) "slot filled" 3 (List.length (Entry.unperformed e))
142
Added:
);
143
Added:
( "a movement off the prescription's substitute list is refused",
144
Added:
`Quick,
145
Added:
fun () ->
146
Added:
(* Cable crossovers substitute for flyes in the catalog, but Day 1
147
Added:
permits only crossovers and pec deck — squats never. *)
148
Added:
match
149
Added:
Entry.add_stimulus (fresh ())
150
Added:
(pre_exhaust (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7))
151
Added:
with
152
Added:
| Error _ -> ()
153
Added:
| Ok _ -> Alcotest.fail "dips is not the prescribed pec compound" );
154
Added:
]
155
Added:
156
Added:
let volume_tests =
157
Added:
[
158
Added:
( "repeated work is recorded, and shows as more stimuli than slots",
159
Added:
`Quick,
160
Added:
fun () ->
161
Added:
(* HD1 forbids extra volume, but the log must still say what happened;
162
Added:
diagnosing it is Progression's job. *)
163
Added:
let e =
164
Added:
List.fold_left
165
Added:
(fun e s -> ok (Entry.add_stimulus e s))
166
Added:
(fresh ())
167
Added:
[ single "laterals" 12. 8; single "laterals" 12. 6 ]
168
Added:
in
169
Added:
Alcotest.(check int) "two stimuli" 2 (List.length (Entry.stimuli e));
170
Added:
Alcotest.(check int)
171
Added:
"still three slots outstanding" 3
172
Added:
(List.length (Entry.unperformed e)) );
173
Added:
( "unperformed shrinks as slots are answered",
174
Added:
`Quick,
175
Added:
fun () ->
176
Added:
let e = ok (Entry.add_stimulus (fresh ()) (single "laterals" 12. 8)) in
177
Added:
Alcotest.(check int) "three left" 3 (List.length (Entry.unperformed e));
178
Added:
let e = ok (Entry.add_stimulus e (single "bent-over-laterals" 10. 9)) in
179
Added:
Alcotest.(check int) "two left" 2 (List.length (Entry.unperformed e)) );
180
Added:
]
181
Added:
182
Added:
let clearance_tests =
183
Added:
[
184
Added:
( "an entry keeps the basis on which it was begun",
185
Added:
`Quick,
186
Added:
fun () ->
187
Added:
let recovering =
188
Added:
Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12)
189
Added:
~recommended:Routine.training_interval
190
Added:
in
191
Added:
let e =
192
Added:
Entry.start day_one
193
Added:
~clearance:(Recovery.override recovering ~reason:"away next week")
194
Added:
~started_at:(at 0)
195
Added:
in
196
Added:
match Recovery.basis (Entry.clearance e) with
197
Added:
| Recovery.Overridden { reason; _ } ->
198
Added:
Alcotest.(check string) "reason" "away next week" reason
199
Added:
| Recovery.Recovered -> Alcotest.fail "expected Overridden" );
200
Added:
]
201
Added:
202
Added:
let suite =
203
Added:
[
204
Added:
("entry.lifecycle", lifecycle_tests);
205
Added:
("entry.conformance", conformance_tests);
206
Added:
("entry.volume", volume_tests);
207
Added:
("entry.clearance", clearance_tests);
208
Added:
]
test/test_hito.ml
@@ -5,4 +5,5 @@
5
5
Alcotest.run "hito"
6
6
(Test_units.suite @ Test_muscle.suite @ Test_exercise.suite
7
7
@ Test_prescription.suite @ Test_workout_prescription.suite
8
Removed:
@ Test_routine.suite @ Test_stimulus.suite @ Test_recovery.suite)
8
Added:
@ Test_routine.suite @ Test_stimulus.suite @ Test_recovery.suite
9
Added:
@ Test_entry.suite)