[OCaml] High Intensity Training Online
refactor rename Plan to Workout_prescription, fold Workout into Logbook.Entry, split core into sub-libraries
Terminology: "Plan" was misleading — in HD1 a routine is a sequence of prescribed workouts (Workout A/B/C). Routine.Plan becomes a top-level Workout_prescription module, matching the *_prescription naming (Prescription, Set_group_prescription). Fold: the Workout module only bundled a prescription reference with start/end timestamps — which is exactly a logbook entry. Folded into Logbook.Entry; no Workout module remains. Mirrors the prior Pharo attempt (~/git/my-fitness-tracker: MFTWorkoutLog held prescription + start + finish). Rotation: switched from a completed-workout count to Routine.workout_after (find the last logged prescription, return the next in the cycle), per MFTRoutine>>workoutAfter: / MFTTrainee>>nextWorkoutPrescription. Dropped Routine.next_plan and Repository.completed_workouts. Sub-libraries: split lib/core into four dune libraries with enforced, acyclic dependencies, mirroring the earlier attempt's package tags (Base / Prescription / Logging): hito.core.vocabulary Units, Exercise, Set (leaf) hito.core.assessment Progression, Recovery -> vocabulary hito.core.prescription Prescription, Set_group_prescription, Workout_prescription, Routine -> vocabulary, assessment hito.core.logbook Set_group, Logbook -> the above Set lives in vocabulary (not logbook) because Progression consumes Set.Working.performance while Logbook consumes Progression — placing Set in logbook would cycle assessment against logbook. All four are (wrapped false) so modules keep their bare names across libraries; the Hito_core wrapper and its prefixes are gone. 62 tests green; opam lint clean.
Changed files
- bin/dune
- lib/app/dune
- lib/app/memory_repo.ml
- lib/app/repository.ml
- lib/app/repository.mli
- lib/app/service.ml
- lib/app/service.mli
- lib/core/assessment/dune
- lib/core/assessment/progression.ml
- lib/core/assessment/progression.mli
- lib/core/assessment/recovery.ml
- lib/core/assessment/recovery.mli
- lib/core/dune
- lib/core/exercise.ml
- lib/core/exercise.mli
- lib/core/logbook.ml
- lib/core/logbook.mli
- lib/core/logbook/dune
- lib/core/logbook/logbook.ml
- lib/core/logbook/logbook.mli
- lib/core/logbook/set_group.ml
- lib/core/logbook/set_group.mli
- lib/core/prescription.ml
- lib/core/prescription.mli
- lib/core/prescription/dune
- lib/core/prescription/prescription.ml
- lib/core/prescription/prescription.mli
- lib/core/prescription/routine.ml
- lib/core/prescription/routine.mli
- lib/core/prescription/set_group_prescription.ml
- lib/core/prescription/set_group_prescription.mli
- lib/core/prescription/workout_prescription.ml
- lib/core/prescription/workout_prescription.mli
- lib/core/progression.ml
- lib/core/progression.mli
- lib/core/recovery.ml
- lib/core/recovery.mli
- lib/core/routine.ml
- lib/core/routine.mli
- lib/core/set.ml
- lib/core/set.mli
- lib/core/set_group.ml
- lib/core/set_group.mli
- lib/core/set_group_prescription.ml
- lib/core/set_group_prescription.mli
- lib/core/units.ml
- lib/core/units.mli
- lib/core/vocabulary/dune
- lib/core/vocabulary/exercise.ml
- lib/core/vocabulary/exercise.mli
- lib/core/vocabulary/set.ml
- lib/core/vocabulary/set.mli
- lib/core/vocabulary/units.ml
- lib/core/vocabulary/units.mli
- lib/core/workout.ml
- lib/core/workout.mli
- lib/web/dune
- lib/web/pages.mli
- test/dune
- test/test_exercise.ml
- test/test_hito.ml
- test/test_logbook.ml
- test/test_prescription.ml
- test/test_progression.ml
- test/test_recovery.ml
- test/test_routine.ml
- test/test_set.ml
- test/test_set_group.ml
- test/test_set_group_prescription.ml
- test/test_units.ml
- test/test_workout.ml
- test/test_workout_prescription.ml
bin/dune
@@ -1,4 +1,4 @@
1
1
(executable
2
2
(public_name hito)
3
3
(name main)
4
Removed:
(libraries hito.core))
4
Added:
(libraries hito.core.vocabulary))
lib/app/dune
@@ -1,4 +1,8 @@
1
1
(library
2
2
(name hito_app)
3
3
(public_name hito.app)
4
Removed:
(libraries hito.core))
4
Added:
(libraries
5
Added:
hito.core.vocabulary
6
Added:
hito.core.assessment
7
Added:
hito.core.prescription
8
Added:
hito.core.logbook))
lib/app/memory_repo.ml
@@ -8,4 +8,3 @@
8
8
let save _ _ = failwith "TODO"
9
9
let logbook _ = failwith "TODO"
10
10
let history _ = failwith "TODO"
11
Removed:
let completed_workouts _ _ = failwith "TODO"
lib/app/repository.ml
@@ -6,16 +6,14 @@
6
6
let routine_id s = s
7
7
let workout_id s = s
8
8
9
Removed:
type record = { id : workout_id; entry : Hito_core.Logbook.Entry.t }
10
Removed:
[@@warning "-69"]
9
Added:
type record = { id : workout_id; entry : Logbook.Entry.t } [@@warning "-69"]
11
10
12
11
module type S = sig
13
12
type t
14
13
15
Removed:
val list_routines : t -> (routine_id * Hito_core.Routine.t) list
16
Removed:
val find_routine : t -> routine_id -> Hito_core.Routine.t option
14
Added:
val list_routines : t -> (routine_id * Routine.t) list
15
Added:
val find_routine : t -> routine_id -> Routine.t option
17
16
val save : t -> record -> unit
18
Removed:
val logbook : t -> Hito_core.Logbook.t
17
Added:
val logbook : t -> Logbook.t
19
18
val history : t -> record list
20
Removed:
val completed_workouts : t -> routine_id -> int
21
19
end
lib/app/repository.mli
@@ -7,24 +7,20 @@
7
7
val routine_id : string -> routine_id
8
8
val workout_id : string -> workout_id
9
9
10
Removed:
type record = { id : workout_id; entry : Hito_core.Logbook.Entry.t }
10
Added:
type record = { id : workout_id; entry : Logbook.Entry.t }
11
11
(** A stored logbook entry. The entry already knows when it finished and which
12
12
prescription it was performed against. *)
13
13
14
14
module type S = sig
15
15
type t
16
16
17
Removed:
val list_routines : t -> (routine_id * Hito_core.Routine.t) list
18
Removed:
val find_routine : t -> routine_id -> Hito_core.Routine.t option
17
Added:
val list_routines : t -> (routine_id * Routine.t) list
18
Added:
val find_routine : t -> routine_id -> Routine.t option
19
19
val save : t -> record -> unit
20
20
21
Removed:
val logbook : t -> Hito_core.Logbook.t
21
Added:
val logbook : t -> Logbook.t
22
22
(** The stored log, from which evidence is derived. *)
23
23
24
24
val history : t -> record list
25
25
(** Most recent first. *)
26
Removed:
27
Removed:
val completed_workouts : t -> routine_id -> int
28
Removed:
(** How many workouts of this routine have been logged; drives rotation via
29
Removed:
{!Hito_core.Routine.next_plan}. *)
30
26
end
lib/app/service.ml
@@ -9,7 +9,7 @@
9
9
type error = Unknown_routine
10
10
11
11
let prescribe _ ~routine:_ ~now:_ = failwith "TODO"
12
Removed:
let start _ = failwith "TODO"
12
Added:
let start _ ~started_at:_ = failwith "TODO"
13
13
let log_group _ _ = failwith "TODO"
14
14
let finish _ _ ~ended_at:_ = failwith "TODO"
15
15
let history _ = failwith "TODO"
lib/app/service.mli
@@ -3,8 +3,6 @@
3
3
Recovery gating is informational — the caller decides whether to proceed on
4
4
an early workout, since the core no longer gates it. *)
5
5
6
Removed:
open Hito_core
7
Removed:
8
6
module Make (R : Repository.S) : sig
9
7
type t
10
8
@@ -17,11 +15,13 @@
17
15
t ->
18
16
routine:Repository.routine_id ->
19
17
now:Recovery.timestamp ->
20
Removed:
(Workout.t * Recovery.readiness, error) result
21
Removed:
(** Today's workout — the routine's next plan by rotation — alongside current
22
Removed:
readiness so the caller can warn before logging begins. *)
18
Added:
(Workout_prescription.t * Recovery.readiness, error) result
19
Added:
(** The routine's next workout, selected by rotation from the stored logbook's
20
Added:
last prescription, alongside current readiness so the caller can warn
21
Added:
before logging begins. *)
23
22
24
Removed:
val start : Workout.t -> Logbook.Entry.t
23
Added:
val start :
24
Added:
Workout_prescription.t -> started_at:Recovery.timestamp -> Logbook.Entry.t
25
25
26
26
val log_group :
27
27
Logbook.Entry.t ->
lib/core/assessment/dune
@@ -0,0 +1,5 @@
1
Added:
(library
2
Added:
(name hito_assessment)
3
Added:
(public_name hito.core.assessment)
4
Added:
(libraries hito.core.vocabulary)
5
Added:
(wrapped false))
lib/core/assessment/progression.ml
@@ -0,0 +1,95 @@
1
Added:
type t = Progressing | Stalled
2
Added:
3
Added:
let equal a b = a = b
4
Added:
5
Added:
let pp fmt = function
6
Added:
| Progressing -> Format.pp_print_string fmt "Progressing"
7
Added:
| Stalled -> Format.pp_print_string fmt "Stalled"
8
Added:
9
Added:
type sample = Set.Working.performance
10
Added:
type error = Insufficient_data
11
Added:
12
Added:
let beats ~previous ~current =
13
Added:
let cmp =
14
Added:
Units.Weight.compare current.Set.Working.load previous.Set.Working.load
15
Added:
in
16
Added:
cmp > 0
17
Added:
|| cmp = 0
18
Added:
&& Units.Reps.to_int current.Set.Working.reps
19
Added:
> Units.Reps.to_int previous.Set.Working.reps
20
Added:
21
Added:
let evaluate ~history =
22
Added:
match List.rev history with
23
Added:
| current :: previous :: _ ->
24
Added:
Ok (if beats ~previous ~current then Progressing else Stalled)
25
Added:
| _ -> Error Insufficient_data
26
Added:
27
Added:
type band = Below_range | In_range | Above_range
28
Added:
29
Added:
let classify ~target_reps sample =
30
Added:
let reps = Units.Reps.to_int sample.Set.Working.reps in
31
Added:
let lo = Units.Reps.to_int (Units.Rep_range.min target_reps) in
32
Added:
let hi = Units.Reps.to_int (Units.Rep_range.max target_reps) in
33
Added:
if reps < lo then Below_range else if reps > hi then Above_range else In_range
34
Added:
35
Added:
type target =
36
Added:
| Add_reps of { load : Units.Weight.t; min_reps : Units.Reps.t }
37
Added:
| Add_load of { min_load : Units.Weight.t; reps : Units.Reps.t }
38
Added:
39
Added:
(* No universal load increment is prescribed by HD doctrine; 2.5 kg is the
40
Added:
smallest plate increment available in most gyms. *)
41
Added:
let load_increment_kg = 2.5
42
Added:
43
Added:
let next_target ~target_reps (sample : sample) =
44
Added:
let hi = Units.Rep_range.max target_reps in
45
Added:
if Units.Reps.to_int sample.reps < Units.Reps.to_int hi then
46
Added:
let min_reps =
47
Added:
match Units.Reps.of_int (Units.Reps.to_int sample.reps + 1) with
48
Added:
| Ok r -> r
49
Added:
| Error _ -> hi
50
Added:
in
51
Added:
Add_reps { load = sample.load; min_reps }
52
Added:
else
53
Added:
let min_load =
54
Added:
match
55
Added:
Units.Weight.of_kg (Units.Weight.to_kg sample.load +. load_increment_kg)
56
Added:
with
57
Added:
| Ok w -> w
58
Added:
| Error _ -> sample.load
59
Added:
in
60
Added:
Add_load { min_load; reps = Units.Rep_range.min target_reps }
61
Added:
62
Added:
type guidance = { band : band; next : target }
63
Added:
64
Added:
let guide ~target_reps sample =
65
Added:
{
66
Added:
band = classify ~target_reps sample;
67
Added:
next = next_target ~target_reps sample;
68
Added:
}
69
Added:
70
Added:
type 'a prescribed = { value : 'a; evidence : sample list; status : t }
71
Added:
72
Added:
let prescribe ~target_reps ~evidence =
73
Added:
let status =
74
Added:
match evaluate ~history:evidence with
75
Added:
| Ok s -> s
76
Added:
| Error Insufficient_data -> Progressing
77
Added:
in
78
Added:
let value =
79
Added:
match List.rev evidence with
80
Added:
| latest :: _ -> next_target ~target_reps latest
81
Added:
| [] ->
82
Added:
Add_reps
83
Added:
{
84
Added:
load = Units.Weight.zero;
85
Added:
min_reps = Units.Rep_range.min target_reps;
86
Added:
}
87
Added:
in
88
Added:
{ value; evidence; status }
89
Added:
90
Added:
let volume samples =
91
Added:
List.fold_left
92
Added:
(fun acc (s : sample) ->
93
Added:
acc
94
Added:
+. (Units.Weight.to_kg s.load *. float_of_int (Units.Reps.to_int s.reps)))
95
Added:
0.0 samples
lib/core/assessment/progression.mli
@@ -0,0 +1,56 @@
1
Added:
(** Assessment: what the logged evidence says, and what it prescribes next.
2
Added:
3
Added:
This is the only module that relates performance to plan. Prescriptions do
4
Added:
not judge, and the logbook does not interpret. *)
5
Added:
6
Added:
type t = Progressing | Stalled
7
Added:
8
Added:
val equal : t -> t -> bool
9
Added:
val pp : Format.formatter -> t -> unit
10
Added:
11
Added:
type sample = Set.Working.performance
12
Added:
(** One working set's performance — the unit of evidence. *)
13
Added:
14
Added:
type error = Insufficient_data
15
Added:
16
Added:
val evaluate : history:sample list -> (t, error) result
17
Added:
(** [history] oldest-first. *)
18
Added:
19
Added:
val beats : previous:sample -> current:sample -> bool
20
Added:
(** Progressive overload: heavier, or equal load for more reps. *)
21
Added:
22
Added:
(** {1 Judging a performance against a band} *)
23
Added:
24
Added:
type band =
25
Added:
| Below_range (** Load too heavy. *)
26
Added:
| In_range
27
Added:
| Above_range (** Load too light. *)
28
Added:
29
Added:
val classify : target_reps:Units.Rep_range.t -> sample -> band
30
Added:
31
Added:
(** What to aim for next. *)
32
Added:
type target =
33
Added:
| Add_reps of { load : Units.Weight.t; min_reps : Units.Reps.t }
34
Added:
| Add_load of { min_load : Units.Weight.t; reps : Units.Reps.t }
35
Added:
(** Band exceeded: raise load, reset to the band's bottom. *)
36
Added:
37
Added:
type guidance = { band : band; next : target }
38
Added:
(** How one performance landed, and what follows from it. *)
39
Added:
40
Added:
val guide : target_reps:Units.Rep_range.t -> sample -> guidance
41
Added:
42
Added:
(** {1 Prescribing from evidence}
43
Added:
44
Added:
Anything prescribed carries the evidence it came from and the status that
45
Added:
evidence showed. *)
46
Added:
47
Added:
type 'a prescribed = { value : 'a; evidence : sample list; status : t }
48
Added:
49
Added:
val prescribe :
50
Added:
target_reps:Units.Rep_range.t -> evidence:sample list -> target prescribed
51
Added:
52
Added:
(** {1 Metrics} *)
53
Added:
54
Added:
val volume : sample list -> float
55
Added:
(** Σ (load × reps), in kilogram-reps. A diagnostic, never a target: under Heavy
56
Added:
Duty rising volume is a warning, not an achievement. *)
lib/core/assessment/recovery.ml
@@ -0,0 +1,21 @@
1
Added:
type timestamp = int
2
Added:
3
Added:
let timestamp_of_unix_seconds s = s
4
Added:
let timestamp_to_unix_seconds t = t
5
Added:
6
Added:
type duration = int
7
Added:
8
Added:
let hours n = n * 3600
9
Added:
let days n = n * 86400
10
Added:
let duration_to_seconds d = d
11
Added:
let elapsed ~since ~now = now - since
12
Added:
13
Added:
type readiness =
14
Added:
| Ready
15
Added:
| Recovering of { rested : duration; recommended : duration }
16
Added:
17
Added:
let evaluate_readiness ~elapsed ~recommended =
18
Added:
if elapsed >= recommended then Ready
19
Added:
else Recovering { rested = elapsed; recommended }
20
Added:
21
Added:
let is_ready = function Ready -> true | Recovering _ -> false
lib/core/assessment/recovery.mli
@@ -0,0 +1,24 @@
1
Added:
(** Recovery is read off the logbook, not managed here: the elapsed time between
2
Added:
two workouts, judged against a recommended window. There is no session,
3
Added:
override, or evidence-based prescription — {!Logbook} owns that context and
4
Added:
decides what to do with a {!readiness} reading. *)
5
Added:
6
Added:
type timestamp = private int
7
Added:
8
Added:
val timestamp_of_unix_seconds : int -> timestamp
9
Added:
val timestamp_to_unix_seconds : timestamp -> int
10
Added:
11
Added:
type duration = private int
12
Added:
13
Added:
val hours : int -> duration
14
Added:
val days : int -> duration
15
Added:
val duration_to_seconds : duration -> int
16
Added:
val elapsed : since:timestamp -> now:timestamp -> duration
17
Added:
18
Added:
type readiness =
19
Added:
| Ready
20
Added:
| Recovering of { rested : duration; recommended : duration }
21
Added:
(** [rested] of [recommended] has passed. *)
22
Added:
23
Added:
val evaluate_readiness : elapsed:duration -> recommended:duration -> readiness
24
Added:
val is_ready : readiness -> bool
lib/core/dune
@@ -1,3 +0,0 @@
1
Removed:
(library
2
Removed:
(name hito_core)
3
Removed:
(public_name hito.core))
lib/core/exercise.ml
@@ -1,102 +0,0 @@
1
Removed:
type id = string
2
Removed:
3
Removed:
type t = {
4
Removed:
id : id;
5
Removed:
name : string;
6
Removed:
substitutes : id list;
7
Removed:
(** Whitelist, by id; resolved lazily against [catalog]. *)
8
Removed:
}
9
Removed:
10
Removed:
let id t = t.id
11
Removed:
let name t = t.name
12
Removed:
let equal a b = String.equal a.id b.id
13
Removed:
let pp fmt t = Format.pp_print_string fmt t.name
14
Removed:
15
Removed:
(* The curated catalog. Substitution whitelists group movements the author
16
Removed:
judges close enough in pattern and target to stand in for one another —
17
Removed:
e.g. a dumbbell press for a barbell press on the same plane. *)
18
Removed:
let catalog =
19
Removed:
[
20
Removed:
{
21
Removed:
id = "barbell_bench_press";
22
Removed:
name = "Barbell Bench Press";
23
Removed:
substitutes = [ "dumbbell_bench_press" ];
24
Removed:
};
25
Removed:
{
26
Removed:
id = "dumbbell_bench_press";
27
Removed:
name = "Dumbbell Bench Press";
28
Removed:
substitutes = [ "barbell_bench_press" ];
29
Removed:
};
30
Removed:
{ id = "incline_press"; name = "Incline Press"; substitutes = [] };
31
Removed:
{ id = "chest_flye"; name = "Chest Flye"; substitutes = [] };
32
Removed:
{
33
Removed:
id = "barbell_row";
34
Removed:
name = "Barbell Row";
35
Removed:
substitutes = [ "dumbbell_row"; "seated_cable_row" ];
36
Removed:
};
37
Removed:
{
38
Removed:
id = "dumbbell_row";
39
Removed:
name = "Dumbbell Row";
40
Removed:
substitutes = [ "barbell_row"; "seated_cable_row" ];
41
Removed:
};
42
Removed:
{
43
Removed:
id = "seated_cable_row";
44
Removed:
name = "Seated Cable Row";
45
Removed:
substitutes = [ "barbell_row"; "dumbbell_row" ];
46
Removed:
};
47
Removed:
{ id = "pulldown"; name = "Pulldown"; substitutes = [ "pull_up" ] };
48
Removed:
{ id = "pull_up"; name = "Pull-Up"; substitutes = [ "pulldown" ] };
49
Removed:
{
50
Removed:
id = "overhead_press";
51
Removed:
name = "Overhead Press";
52
Removed:
substitutes = [ "dumbbell_shoulder_press" ];
53
Removed:
};
54
Removed:
{
55
Removed:
id = "dumbbell_shoulder_press";
56
Removed:
name = "Dumbbell Shoulder Press";
57
Removed:
substitutes = [ "overhead_press" ];
58
Removed:
};
59
Removed:
{ id = "lateral_raise"; name = "Lateral Raise"; substitutes = [] };
60
Removed:
{
61
Removed:
id = "barbell_curl";
62
Removed:
name = "Barbell Curl";
63
Removed:
substitutes = [ "dumbbell_curl" ];
64
Removed:
};
65
Removed:
{
66
Removed:
id = "dumbbell_curl";
67
Removed:
name = "Dumbbell Curl";
68
Removed:
substitutes = [ "barbell_curl" ];
69
Removed:
};
70
Removed:
{
71
Removed:
id = "triceps_pushdown";
72
Removed:
name = "Triceps Pushdown";
73
Removed:
substitutes = [ "skullcrusher" ];
74
Removed:
};
75
Removed:
{
76
Removed:
id = "skullcrusher";
77
Removed:
name = "Skullcrusher";
78
Removed:
substitutes = [ "triceps_pushdown" ];
79
Removed:
};
80
Removed:
{ id = "back_squat"; name = "Back Squat"; substitutes = [ "leg_press" ] };
81
Removed:
{ id = "leg_press"; name = "Leg Press"; substitutes = [ "back_squat" ] };
82
Removed:
{ id = "leg_extension"; name = "Leg Extension"; substitutes = [] };
83
Removed:
{ id = "leg_curl"; name = "Leg Curl"; substitutes = [] };
84
Removed:
{ id = "deadlift"; name = "Deadlift"; substitutes = [ "leg_press" ] };
85
Removed:
{ id = "calf_raise"; name = "Calf Raise"; substitutes = [] };
86
Removed:
{ id = "crunch"; name = "Crunch"; substitutes = [] };
87
Removed:
]
88
Removed:
89
Removed:
let find target_id =
90
Removed:
List.find_opt (fun ex -> String.equal ex.id target_id) catalog
91
Removed:
92
Removed:
type error = Not_permitted of { original : id; candidate : id }
93
Removed:
94
Removed:
let permitted_substitutes t = List.filter_map find t.substitutes
95
Removed:
96
Removed:
let may_substitute ~original ~candidate =
97
Removed:
List.mem candidate.id original.substitutes
98
Removed:
99
Removed:
let substitute ~original ~candidate =
100
Removed:
if may_substitute ~original ~candidate then Ok candidate
101
Removed:
else
102
Removed:
Error (Not_permitted { original = original.id; candidate = candidate.id })
lib/core/exercise.mli
@@ -1,31 +0,0 @@
1
Removed:
(** Curated exercise catalog with author-specified substitution whitelists.
2
Removed:
3
Removed:
Users do not log arbitrary movements: every exercise comes from {!catalog}.
4
Removed:
Substitutions are limited to each exercise's author-specified whitelist. *)
5
Removed:
6
Removed:
type t
7
Removed:
(** Abstract catalog exercise; only obtainable via {!catalog} / {!find}. *)
8
Removed:
9
Removed:
type id = private string
10
Removed:
11
Removed:
val id : t -> id
12
Removed:
val name : t -> string
13
Removed:
val equal : t -> t -> bool
14
Removed:
val pp : Format.formatter -> t -> unit
15
Removed:
16
Removed:
(** {1 Catalog} *)
17
Removed:
18
Removed:
val catalog : t list
19
Removed:
(** The complete curated catalog; the only source of {!t} values. *)
20
Removed:
21
Removed:
val find : id -> t option
22
Removed:
23
Removed:
(** {1 Substitutions} *)
24
Removed:
25
Removed:
type error = Not_permitted of { original : id; candidate : id }
26
Removed:
27
Removed:
val permitted_substitutes : t -> t list
28
Removed:
val may_substitute : original:t -> candidate:t -> bool
29
Removed:
30
Removed:
val substitute : original:t -> candidate:t -> (t, error) result
31
Removed:
(** [Ok candidate] iff [candidate] is on [original]'s whitelist. *)
lib/core/logbook.ml
@@ -1,96 +0,0 @@
1
Removed:
module Entry = struct
2
Removed:
type t = { workout : Workout.t; groups : Set_group.t list; finished : bool }
3
Removed:
type error = Set_exercise_not_prescribed of Exercise.id | Already_finished
4
Removed:
5
Removed:
let start workout = { workout; groups = []; finished = false }
6
Removed:
7
Removed:
let prescribed_exercise_ids t =
8
Removed:
Routine.Plan.set_groups (Workout.plan t.workout)
9
Removed:
|> List.concat_map Set_group_prescription.exercises
10
Removed:
|> List.map Exercise.id
11
Removed:
12
Removed:
let add_group t group =
13
Removed:
if t.finished then Error Already_finished
14
Removed:
else
15
Removed:
let prescribed = prescribed_exercise_ids t in
16
Removed:
let offending =
17
Removed:
Set_group.working_sets group
18
Removed:
|> List.map Set.Working.exercise
19
Removed:
|> List.find_opt (fun ex -> not (List.mem (Exercise.id ex) prescribed))
20
Removed:
in
21
Removed:
match offending with
22
Removed:
| Some ex -> Error (Set_exercise_not_prescribed (Exercise.id ex))
23
Removed:
| None -> Ok { t with groups = t.groups @ [ group ] }
24
Removed:
25
Removed:
let finish t ~ended_at =
26
Removed:
{ t with workout = Workout.finish t.workout ~ended_at; finished = true }
27
Removed:
28
Removed:
let is_finished t = t.finished
29
Removed:
let workout t = t.workout
30
Removed:
let groups t = t.groups
31
Removed:
let working_sets t = List.concat_map Set_group.working_sets t.groups
32
Removed:
33
Removed:
let performances t =
34
Removed:
List.map
35
Removed:
(fun s ->
36
Removed:
(Exercise.id (Set.Working.exercise s), Set.Working.performance s))
37
Removed:
(working_sets t)
38
Removed:
39
Removed:
let prescription_for t exercise_id =
40
Removed:
Routine.Plan.set_groups (Workout.plan t.workout)
41
Removed:
|> List.concat_map Set_group_prescription.prescriptions
42
Removed:
|> List.find_opt (fun p ->
43
Removed:
Exercise.id (Prescription.exercise p) = exercise_id)
44
Removed:
45
Removed:
let guidance t =
46
Removed:
List.filter_map
47
Removed:
(fun (id, sample) ->
48
Removed:
match prescription_for t id with
49
Removed:
| None -> None
50
Removed:
| Some p ->
51
Removed:
Some
52
Removed:
( id,
53
Removed:
Progression.guide
54
Removed:
~target_reps:(Prescription.target_reps p)
55
Removed:
sample ))
56
Removed:
(performances t)
57
Removed:
58
Removed:
let unperformed t =
59
Removed:
let performed_ids = List.map fst (performances t) in
60
Removed:
Routine.Plan.set_groups (Workout.plan t.workout)
61
Removed:
|> List.concat_map Set_group_prescription.exercises
62
Removed:
|> List.filter (fun ex -> not (List.mem (Exercise.id ex) performed_ids))
63
Removed:
64
Removed:
let volume t = Progression.volume (List.map snd (performances t))
65
Removed:
66
Removed:
let pp fmt t =
67
Removed:
Format.fprintf fmt "%a (%d groups)" Workout.pp t.workout
68
Removed:
(List.length t.groups)
69
Removed:
end
70
Removed:
71
Removed:
type t = Entry.t list
72
Removed:
73
Removed:
let empty = []
74
Removed:
let add t entry = entry :: t
75
Removed:
let entries t = t
76
Removed:
77
Removed:
let evidence t exercise_id =
78
Removed:
List.concat_map
79
Removed:
(fun entry ->
80
Removed:
Entry.performances entry
81
Removed:
|> List.filter_map (fun (id, sample) ->
82
Removed:
if id = exercise_id then Some sample else None))
83
Removed:
(List.rev t)
84
Removed:
85
Removed:
let readiness t ~now ~recommended =
86
Removed:
match t with
87
Removed:
| [] -> Recovery.Ready
88
Removed:
| last :: _ -> (
89
Removed:
match Workout.ended_at (Entry.workout last) with
90
Removed:
| None -> Recovery.Ready
91
Removed:
| Some since ->
92
Removed:
Recovery.evaluate_readiness
93
Removed:
~elapsed:(Recovery.elapsed ~since ~now)
94
Removed:
~recommended)
95
Removed:
96
Removed:
let pp fmt t = Format.fprintf fmt "%d entries" (List.length t)
lib/core/logbook.mli
@@ -1,70 +0,0 @@
1
Removed:
(** The training log: what was actually performed.
2
Removed:
3
Removed:
Each entry wraps the {!Hito_core.Workout.t} it was performed against — a log
4
Removed:
without its plan is meaningless. The logbook is also the source of the
5
Removed:
evidence future prescriptions are calculated from, and of the elapsed time
6
Removed:
{!Hito_core.Recovery} judges. *)
7
Removed:
8
Removed:
(** One performed workout. *)
9
Removed:
module Entry : sig
10
Removed:
type t
11
Removed:
12
Removed:
type error =
13
Removed:
| Set_exercise_not_prescribed of Exercise.id
14
Removed:
(** A set's exercise matches no slot in the workout's plan. *)
15
Removed:
| Already_finished
16
Removed:
17
Removed:
val start : Workout.t -> t
18
Removed:
19
Removed:
val add_group : t -> Set_group.t -> (t, error) result
20
Removed:
(** Append a performed group. Each working set's exercise must match a slot in
21
Removed:
the plan's corresponding set group; a group may span exercises, so each
22
Removed:
set is checked individually. *)
23
Removed:
24
Removed:
val finish : t -> ended_at:Recovery.timestamp -> t
25
Removed:
val is_finished : t -> bool
26
Removed:
val workout : t -> Workout.t
27
Removed:
val groups : t -> Set_group.t list
28
Removed:
29
Removed:
val working_sets : t -> Set.Working.t list
30
Removed:
(** Every working set performed, in order. *)
31
Removed:
32
Removed:
val performances : t -> (Exercise.id * Progression.sample) list
33
Removed:
(** Each working set's performance, keyed by its own exercise. *)
34
Removed:
35
Removed:
val guidance : t -> (Exercise.id * Progression.guidance) list
36
Removed:
(** What was performed, judged against the prescription it was logged against.
37
Removed:
*)
38
Removed:
39
Removed:
val unperformed : t -> Exercise.t list
40
Removed:
(** Prescribed exercises with no logged working set. *)
41
Removed:
42
Removed:
val volume : t -> float
43
Removed:
(** Σ (load × reps). Diagnostic, not a target. *)
44
Removed:
45
Removed:
val pp : Format.formatter -> t -> unit
46
Removed:
end
47
Removed:
48
Removed:
type t
49
Removed:
(** A chronological log of finished entries. *)
50
Removed:
51
Removed:
val empty : t
52
Removed:
val add : t -> Entry.t -> t
53
Removed:
54
Removed:
val entries : t -> Entry.t list
55
Removed:
(** Most recent first. *)
56
Removed:
57
Removed:
val evidence : t -> Exercise.id -> Progression.sample list
58
Removed:
(** An exercise's past performances, oldest-first — the input to
59
Removed:
{!Hito_core.Progression.prescribe}. *)
60
Removed:
61
Removed:
val readiness :
62
Removed:
t ->
63
Removed:
now:Recovery.timestamp ->
64
Removed:
recommended:Recovery.duration ->
65
Removed:
Recovery.readiness
66
Removed:
(** Elapsed time since the most recent finished entry, judged against
67
Removed:
[recommended]. Informational: nothing in the logbook prevents starting the
68
Removed:
next workout regardless. *)
69
Removed:
70
Removed:
val pp : Format.formatter -> t -> unit
lib/core/logbook/dune
@@ -0,0 +1,5 @@
1
Added:
(library
2
Added:
(name hito_logbook)
3
Added:
(public_name hito.core.logbook)
4
Added:
(libraries hito.core.vocabulary hito.core.assessment hito.core.prescription)
5
Added:
(wrapped false))
lib/core/logbook/logbook.ml
@@ -0,0 +1,114 @@
1
Added:
module Entry = struct
2
Added:
type t = {
3
Added:
prescription : Workout_prescription.t;
4
Added:
started_at : Recovery.timestamp;
5
Added:
ended_at : Recovery.timestamp option;
6
Added:
groups : Set_group.t list;
7
Added:
finished : bool;
8
Added:
}
9
Added:
10
Added:
type error = Set_exercise_not_prescribed of Exercise.id | Already_finished
11
Added:
12
Added:
let start prescription ~started_at =
13
Added:
{ prescription; started_at; ended_at = None; groups = []; finished = false }
14
Added:
15
Added:
let prescribed_exercise_ids t =
16
Added:
Workout_prescription.set_groups t.prescription
17
Added:
|> List.concat_map Set_group_prescription.exercises
18
Added:
|> List.map Exercise.id
19
Added:
20
Added:
let add_group t group =
21
Added:
if t.finished then Error Already_finished
22
Added:
else
23
Added:
let prescribed = prescribed_exercise_ids t in
24
Added:
let offending =
25
Added:
Set_group.working_sets group
26
Added:
|> List.map Set.Working.exercise
27
Added:
|> List.find_opt (fun ex -> not (List.mem (Exercise.id ex) prescribed))
28
Added:
in
29
Added:
match offending with
30
Added:
| Some ex -> Error (Set_exercise_not_prescribed (Exercise.id ex))
31
Added:
| None -> Ok { t with groups = t.groups @ [ group ] }
32
Added:
33
Added:
let finish t ~ended_at = { t with ended_at = Some ended_at; finished = true }
34
Added:
let is_finished t = t.finished
35
Added:
let prescription t = t.prescription
36
Added:
let started_at t = t.started_at
37
Added:
let ended_at t = t.ended_at
38
Added:
39
Added:
let duration t =
40
Added:
Option.map
41
Added:
(fun ended -> Recovery.elapsed ~since:t.started_at ~now:ended)
42
Added:
t.ended_at
43
Added:
44
Added:
let groups t = t.groups
45
Added:
let working_sets t = List.concat_map Set_group.working_sets t.groups
46
Added:
47
Added:
let performances t =
48
Added:
List.map
49
Added:
(fun s ->
50
Added:
(Exercise.id (Set.Working.exercise s), Set.Working.performance s))
51
Added:
(working_sets t)
52
Added:
53
Added:
let prescription_for t exercise_id =
54
Added:
Workout_prescription.set_groups t.prescription
55
Added:
|> List.concat_map Set_group_prescription.prescriptions
56
Added:
|> List.find_opt (fun p ->
57
Added:
Exercise.id (Prescription.exercise p) = exercise_id)
58
Added:
59
Added:
let guidance t =
60
Added:
List.filter_map
61
Added:
(fun (id, sample) ->
62
Added:
match prescription_for t id with
63
Added:
| None -> None
64
Added:
| Some p ->
65
Added:
Some
66
Added:
( id,
67
Added:
Progression.guide
68
Added:
~target_reps:(Prescription.target_reps p)
69
Added:
sample ))
70
Added:
(performances t)
71
Added:
72
Added:
let unperformed t =
73
Added:
let performed_ids = List.map fst (performances t) in
74
Added:
Workout_prescription.set_groups t.prescription
75
Added:
|> List.concat_map Set_group_prescription.exercises
76
Added:
|> List.filter (fun ex -> not (List.mem (Exercise.id ex) performed_ids))
77
Added:
78
Added:
let volume t = Progression.volume (List.map snd (performances t))
79
Added:
80
Added:
let pp fmt t =
81
Added:
Format.fprintf fmt "%a (%d groups)" Workout_prescription.pp t.prescription
82
Added:
(List.length t.groups)
83
Added:
end
84
Added:
85
Added:
type t = Entry.t list
86
Added:
87
Added:
let empty = []
88
Added:
let add t entry = entry :: t
89
Added:
let entries t = t
90
Added:
91
Added:
let evidence t exercise_id =
92
Added:
List.concat_map
93
Added:
(fun entry ->
94
Added:
Entry.performances entry
95
Added:
|> List.filter_map (fun (id, sample) ->
96
Added:
if id = exercise_id then Some sample else None))
97
Added:
(List.rev t)
98
Added:
99
Added:
let last_prescription = function
100
Added:
| [] -> None
101
Added:
| last :: _ -> Some (Entry.prescription last)
102
Added:
103
Added:
let readiness t ~now ~recommended =
104
Added:
match t with
105
Added:
| [] -> Recovery.Ready
106
Added:
| last :: _ -> (
107
Added:
match Entry.ended_at last with
108
Added:
| None -> Recovery.Ready
109
Added:
| Some since ->
110
Added:
Recovery.evaluate_readiness
111
Added:
~elapsed:(Recovery.elapsed ~since ~now)
112
Added:
~recommended)
113
Added:
114
Added:
let pp fmt t = Format.fprintf fmt "%d entries" (List.length t)
lib/core/logbook/logbook.mli
@@ -0,0 +1,76 @@
1
Added:
(** The training log: what was actually performed.
2
Added:
3
Added:
Each entry wraps the {!Workout_prescription.t} it was performed against — a
4
Added:
log without its prescription is meaningless — and its start/end timestamps.
5
Added:
The logbook is also the source of the evidence future prescriptions are
6
Added:
calculated from, and of the elapsed time {!Recovery} judges. *)
7
Added:
8
Added:
(** One performed workout. *)
9
Added:
module Entry : sig
10
Added:
type t
11
Added:
12
Added:
type error =
13
Added:
| Set_exercise_not_prescribed of Exercise.id
14
Added:
(** A set's exercise matches no slot in the prescription. *)
15
Added:
| Already_finished
16
Added:
17
Added:
val start : Workout_prescription.t -> started_at:Recovery.timestamp -> t
18
Added:
19
Added:
val add_group : t -> Set_group.t -> (t, error) result
20
Added:
(** Append a performed group. Each working set's exercise must match a slot in
21
Added:
the prescription; a group may span exercises, so each set is checked. *)
22
Added:
23
Added:
val finish : t -> ended_at:Recovery.timestamp -> t
24
Added:
val is_finished : t -> bool
25
Added:
val prescription : t -> Workout_prescription.t
26
Added:
val started_at : t -> Recovery.timestamp
27
Added:
val ended_at : t -> Recovery.timestamp option
28
Added:
val duration : t -> Recovery.duration option
29
Added:
val groups : t -> Set_group.t list
30
Added:
31
Added:
val working_sets : t -> Set.Working.t list
32
Added:
(** Every working set performed, in order. *)
33
Added:
34
Added:
val performances : t -> (Exercise.id * Progression.sample) list
35
Added:
(** Each working set's performance, keyed by its own exercise. *)
36
Added:
37
Added:
val guidance : t -> (Exercise.id * Progression.guidance) list
38
Added:
(** What was performed, judged against the prescription it was logged against.
39
Added:
*)
40
Added:
41
Added:
val unperformed : t -> Exercise.t list
42
Added:
(** Prescribed exercises with no logged working set. *)
43
Added:
44
Added:
val volume : t -> float
45
Added:
(** Σ (load × reps). Diagnostic, not a target. *)
46
Added:
47
Added:
val pp : Format.formatter -> t -> unit
48
Added:
end
49
Added:
50
Added:
type t
51
Added:
(** A chronological log of finished entries. *)
52
Added:
53
Added:
val empty : t
54
Added:
val add : t -> Entry.t -> t
55
Added:
56
Added:
val entries : t -> Entry.t list
57
Added:
(** Most recent first. *)
58
Added:
59
Added:
val evidence : t -> Exercise.id -> Progression.sample list
60
Added:
(** An exercise's past performances, oldest-first — the input to
61
Added:
{!Progression.prescribe}. *)
62
Added:
63
Added:
val last_prescription : t -> Workout_prescription.t option
64
Added:
(** The prescription of the most recent entry; feeds {!Routine.workout_after}.
65
Added:
*)
66
Added:
67
Added:
val readiness :
68
Added:
t ->
69
Added:
now:Recovery.timestamp ->
70
Added:
recommended:Recovery.duration ->
71
Added:
Recovery.readiness
72
Added:
(** Elapsed time since the most recent finished entry, judged against
73
Added:
[recommended]. Informational: nothing here prevents starting the next
74
Added:
workout regardless. *)
75
Added:
76
Added:
val pp : Format.formatter -> t -> unit
lib/core/logbook/set_group.ml
@@ -0,0 +1,55 @@
1
Added:
type view =
2
Added:
| Straight of { warm_ups : Set.Warm_up.t list; working : Set.Working.t }
3
Added:
| Superset of {
4
Added:
warm_ups : Set.Warm_up.t list;
5
Added:
first : Set.Working.t;
6
Added:
second : Set.Working.t;
7
Added:
}
8
Added:
| Pre_exhaust of {
9
Added:
warm_ups : Set.Warm_up.t list;
10
Added:
isolation : Set.Working.t;
11
Added:
compound : Set.Working.t;
12
Added:
}
13
Added:
14
Added:
type t = view
15
Added:
16
Added:
let straight ?(warm_ups = []) ~working () = Straight { warm_ups; working }
17
Added:
18
Added:
let superset ?(warm_ups = []) ~first ~second () =
19
Added:
Superset { warm_ups; first; second }
20
Added:
21
Added:
let pre_exhaust ?(warm_ups = []) ~isolation ~compound () =
22
Added:
Pre_exhaust { warm_ups; isolation; compound }
23
Added:
24
Added:
let view t = t
25
Added:
26
Added:
let working_sets = function
27
Added:
| Straight { working; _ } -> [ working ]
28
Added:
| Superset { first; second; _ } -> [ first; second ]
29
Added:
| Pre_exhaust { isolation; compound; _ } -> [ isolation; compound ]
30
Added:
31
Added:
let warm_ups = function
32
Added:
| Straight { warm_ups; _ }
33
Added:
| Superset { warm_ups; _ }
34
Added:
| Pre_exhaust { warm_ups; _ } ->
35
Added:
warm_ups
36
Added:
37
Added:
let pp fmt t =
38
Added:
let pp_warm_ups fmt = function
39
Added:
| [] -> ()
40
Added:
| ws ->
41
Added:
Format.fprintf fmt "warm-up: %a; "
42
Added:
(Format.pp_print_list
43
Added:
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
44
Added:
Set.Warm_up.pp)
45
Added:
ws
46
Added:
in
47
Added:
match t with
48
Added:
| Straight { warm_ups; working } ->
49
Added:
Format.fprintf fmt "%a%a" pp_warm_ups warm_ups Set.Working.pp working
50
Added:
| Superset { warm_ups; first; second } ->
51
Added:
Format.fprintf fmt "%asuperset: %a + %a" pp_warm_ups warm_ups
52
Added:
Set.Working.pp first Set.Working.pp second
53
Added:
| Pre_exhaust { warm_ups; isolation; compound } ->
54
Added:
Format.fprintf fmt "%apre-exhaust: %a -> %a" pp_warm_ups warm_ups
55
Added:
Set.Working.pp isolation Set.Working.pp compound
lib/core/logbook/set_group.mli
@@ -0,0 +1,52 @@
1
Added:
(** How working sets are grouped and sequenced within a workout.
2
Added:
3
Added:
A group may span exercises (superset, pre-exhaust), so the exercise belongs
4
Added:
to each individual set, never to the group. Heavy Duty prescribes exactly
5
Added:
one working set per exercise and this model admits no exceptions — extra
6
Added:
volume is unrepresentable. *)
7
Added:
8
Added:
type t
9
Added:
10
Added:
val straight :
11
Added:
?warm_ups:Set.Warm_up.t list -> working:Set.Working.t -> unit -> t
12
Added:
(** One exercise: the working set, optionally preceded by a warm-up ramp. *)
13
Added:
14
Added:
val superset :
15
Added:
?warm_ups:Set.Warm_up.t list ->
16
Added:
first:Set.Working.t ->
17
Added:
second:Set.Working.t ->
18
Added:
unit ->
19
Added:
t
20
Added:
(** Two exercises' working sets, back-to-back. *)
21
Added:
22
Added:
val pre_exhaust :
23
Added:
?warm_ups:Set.Warm_up.t list ->
24
Added:
isolation:Set.Working.t ->
25
Added:
compound:Set.Working.t ->
26
Added:
unit ->
27
Added:
t
28
Added:
(** Isolation immediately followed by a compound — the signature HD technique.
29
Added:
*)
30
Added:
31
Added:
(** {1 Inspection} *)
32
Added:
33
Added:
type view =
34
Added:
| Straight of { warm_ups : Set.Warm_up.t list; working : Set.Working.t }
35
Added:
| Superset of {
36
Added:
warm_ups : Set.Warm_up.t list;
37
Added:
first : Set.Working.t;
38
Added:
second : Set.Working.t;
39
Added:
}
40
Added:
| Pre_exhaust of {
41
Added:
warm_ups : Set.Warm_up.t list;
42
Added:
isolation : Set.Working.t;
43
Added:
compound : Set.Working.t;
44
Added:
}
45
Added:
46
Added:
val view : t -> view
47
Added:
48
Added:
val working_sets : t -> Set.Working.t list
49
Added:
(** Every working set, in order. Each carries its own exercise. *)
50
Added:
51
Added:
val warm_ups : t -> Set.Warm_up.t list
52
Added:
val pp : Format.formatter -> t -> unit
lib/core/prescription.ml
@@ -1,23 +0,0 @@
1
Removed:
type t = {
2
Removed:
exercise : Exercise.t;
3
Removed:
target_reps : Units.Rep_range.t;
4
Removed:
allowed_substitutes : Exercise.t list;
5
Removed:
}
6
Removed:
7
Removed:
let make ~exercise ~target_reps ~allowed_substitutes =
8
Removed:
let rec check = function
9
Removed:
| [] -> Ok { exercise; target_reps; allowed_substitutes }
10
Removed:
| candidate :: rest -> (
11
Removed:
match Exercise.substitute ~original:exercise ~candidate with
12
Removed:
| Ok _ -> check rest
13
Removed:
| Error e -> Error e)
14
Removed:
in
15
Removed:
check allowed_substitutes
16
Removed:
17
Removed:
let exercise t = t.exercise
18
Removed:
let target_reps t = t.target_reps
19
Removed:
let allowed_substitutes t = t.allowed_substitutes
20
Removed:
21
Removed:
let pp fmt t =
22
Removed:
Format.fprintf fmt "%a (%a)" Exercise.pp t.exercise Units.Rep_range.pp
23
Removed:
t.target_reps
lib/core/prescription.mli
@@ -1,21 +0,0 @@
1
Removed:
(** One exercise's plan: the movement, the target rep band, and which
2
Removed:
substitutes are permitted. Heavy Duty prescribes a single working set, so
3
Removed:
that is implicit and not configurable.
4
Removed:
5
Removed:
Purely a plan — it knows nothing of what was performed. Judging performance
6
Removed:
against a prescription is {!Hito_core.Progression}'s job. *)
7
Removed:
8
Removed:
type t
9
Removed:
10
Removed:
val make :
11
Removed:
exercise:Exercise.t ->
12
Removed:
target_reps:Units.Rep_range.t ->
13
Removed:
allowed_substitutes:Exercise.t list ->
14
Removed:
(t, Exercise.error) result
15
Removed:
(** Substitutes must be on the exercise's catalog whitelist, so a prescription
16
Removed:
may only narrow the curated set. *)
17
Removed:
18
Removed:
val exercise : t -> Exercise.t
19
Removed:
val target_reps : t -> Units.Rep_range.t
20
Removed:
val allowed_substitutes : t -> Exercise.t list
21
Removed:
val pp : Format.formatter -> t -> unit
lib/core/prescription/dune
@@ -0,0 +1,5 @@
1
Added:
(library
2
Added:
(name hito_prescription)
3
Added:
(public_name hito.core.prescription)
4
Added:
(libraries hito.core.vocabulary hito.core.assessment)
5
Added:
(wrapped false))
lib/core/prescription/prescription.ml
@@ -0,0 +1,23 @@
1
Added:
type t = {
2
Added:
exercise : Exercise.t;
3
Added:
target_reps : Units.Rep_range.t;
4
Added:
allowed_substitutes : Exercise.t list;
5
Added:
}
6
Added:
7
Added:
let make ~exercise ~target_reps ~allowed_substitutes =
8
Added:
let rec check = function
9
Added:
| [] -> Ok { exercise; target_reps; allowed_substitutes }
10
Added:
| candidate :: rest -> (
11
Added:
match Exercise.substitute ~original:exercise ~candidate with
12
Added:
| Ok _ -> check rest
13
Added:
| Error e -> Error e)
14
Added:
in
15
Added:
check allowed_substitutes
16
Added:
17
Added:
let exercise t = t.exercise
18
Added:
let target_reps t = t.target_reps
19
Added:
let allowed_substitutes t = t.allowed_substitutes
20
Added:
21
Added:
let pp fmt t =
22
Added:
Format.fprintf fmt "%a (%a)" Exercise.pp t.exercise Units.Rep_range.pp
23
Added:
t.target_reps
lib/core/prescription/prescription.mli
@@ -0,0 +1,21 @@
1
Added:
(** One exercise's plan: the movement, the target rep band, and which
2
Added:
substitutes are permitted. Heavy Duty prescribes a single working set, so
3
Added:
that is implicit and not configurable.
4
Added:
5
Added:
Purely a plan — it knows nothing of what was performed. Judging performance
6
Added:
against a prescription is {!Progression}'s job. *)
7
Added:
8
Added:
type t
9
Added:
10
Added:
val make :
11
Added:
exercise:Exercise.t ->
12
Added:
target_reps:Units.Rep_range.t ->
13
Added:
allowed_substitutes:Exercise.t list ->
14
Added:
(t, Exercise.error) result
15
Added:
(** Substitutes must be on the exercise's catalog whitelist, so a prescription
16
Added:
may only narrow the curated set. *)
17
Added:
18
Added:
val exercise : t -> Exercise.t
19
Added:
val target_reps : t -> Units.Rep_range.t
20
Added:
val allowed_substitutes : t -> Exercise.t list
21
Added:
val pp : Format.formatter -> t -> unit
lib/core/prescription/routine.ml
@@ -0,0 +1,142 @@
1
Added:
type t = {
2
Added:
name : string;
3
Added:
workouts : Workout_prescription.t list;
4
Added:
recovery_base : Recovery.duration;
5
Added:
}
6
Added:
7
Added:
type error = Empty_routine
8
Added:
9
Added:
let make ~name ~workouts =
10
Added:
match workouts with
11
Added:
| [] -> Error Empty_routine
12
Added:
| _ -> Ok { name; workouts; recovery_base = Recovery.days 4 }
13
Added:
14
Added:
let name t = t.name
15
Added:
let workouts t = t.workouts
16
Added:
17
Added:
let workout_after t w =
18
Added:
match t.workouts with
19
Added:
| [] -> invalid_arg "Routine.workout_after: empty routine"
20
Added:
| first :: _ -> (
21
Added:
let rec index i = function
22
Added:
| [] -> None
23
Added:
| x :: _ when Workout_prescription.equal x w -> Some i
24
Added:
| _ :: rest -> index (i + 1) rest
25
Added:
in
26
Added:
match index 0 t.workouts with
27
Added:
| None -> first
28
Added:
| Some i -> List.nth t.workouts ((i + 1) mod List.length t.workouts))
29
Added:
30
Added:
let recovery_base t = t.recovery_base
31
Added:
32
Added:
let pp fmt t =
33
Added:
Format.fprintf fmt "%s (%d workouts)" t.name (List.length t.workouts)
34
Added:
35
Added:
(* {1 Heavy Duty presets} *)
36
Added:
37
Added:
let by_name n =
38
Added:
match
39
Added:
List.find_opt (fun ex -> String.equal (Exercise.name ex) n) Exercise.catalog
40
Added:
with
41
Added:
| Some ex -> ex
42
Added:
| None -> invalid_arg (Printf.sprintf "no catalog exercise named %s" n)
43
Added:
44
Added:
let ok = function
45
Added:
| Ok v -> v
46
Added:
| Error _ -> invalid_arg "invalid preset definition"
47
Added:
48
Added:
let band lo hi =
49
Added:
ok
50
Added:
(Units.Rep_range.make
51
Added:
~min:(ok (Units.Reps.of_int lo))
52
Added:
~max:(ok (Units.Reps.of_int hi)))
53
Added:
54
Added:
let prescribe ?(substitutes = []) exercise_name lo hi =
55
Added:
ok
56
Added:
(Prescription.make ~exercise:(by_name exercise_name)
57
Added:
~target_reps:(band lo hi)
58
Added:
~allowed_substitutes:(List.map by_name substitutes))
59
Added:
60
Added:
let straight ?substitutes exercise_name lo hi =
61
Added:
Set_group_prescription.Straight (prescribe ?substitutes exercise_name lo hi)
62
Added:
63
Added:
let superset (first_name, flo, fhi, fsub) (second_name, slo, shi, ssub) =
64
Added:
Set_group_prescription.Superset
65
Added:
{
66
Added:
first = prescribe ?substitutes:fsub first_name flo fhi;
67
Added:
second = prescribe ?substitutes:ssub second_name slo shi;
68
Added:
}
69
Added:
70
Added:
let pre_exhaust (isolation_name, ilo, ihi, isub) (compound_name, clo, chi, csub)
71
Added:
=
72
Added:
Set_group_prescription.Pre_exhaust
73
Added:
{
74
Added:
isolation = prescribe ?substitutes:isub isolation_name ilo ihi;
75
Added:
compound = prescribe ?substitutes:csub compound_name clo chi;
76
Added:
}
77
Added:
78
Added:
let workout ~id ~name set_groups =
79
Added:
ok (Workout_prescription.make ~id ~name ~set_groups)
80
Added:
81
Added:
(* Mentzer's Ideal Routine: a three-way split built around pre-exhaustion
82
Added:
supersets — an isolation movement immediately preceding the compound for
83
Added:
the same target, so the larger muscle is the limiting factor. *)
84
Added:
let ideal_routine =
85
Added:
let workout_a =
86
Added:
workout ~id:"ideal_a" ~name:"Workout A: Chest, Shoulders, Triceps"
87
Added:
[
88
Added:
pre_exhaust ("Chest Flye", 6, 8, None)
89
Added:
("Barbell Bench Press", 6, 8, Some [ "Dumbbell Bench Press" ]);
90
Added:
straight "Lateral Raise" 6 8;
91
Added:
straight ~substitutes:[ "Dumbbell Shoulder Press" ] "Overhead Press" 6 8;
92
Added:
straight ~substitutes:[ "Skullcrusher" ] "Triceps Pushdown" 6 8;
93
Added:
]
94
Added:
in
95
Added:
let workout_b =
96
Added:
workout ~id:"ideal_b" ~name:"Workout B: Back, Biceps"
97
Added:
[
98
Added:
superset
99
Added:
("Pulldown", 6, 8, Some [ "Pull-Up" ])
100
Added:
("Barbell Row", 6, 8, Some [ "Dumbbell Row"; "Seated Cable Row" ]);
101
Added:
straight ~substitutes:[ "Dumbbell Curl" ] "Barbell Curl" 6 8;
102
Added:
]
103
Added:
in
104
Added:
let workout_c =
105
Added:
workout ~id:"ideal_c" ~name:"Workout C: Legs"
106
Added:
[
107
Added:
pre_exhaust
108
Added:
("Leg Extension", 6, 8, None)
109
Added:
("Back Squat", 6, 8, Some [ "Leg Press" ]);
110
Added:
straight "Leg Curl" 6 8;
111
Added:
straight "Calf Raise" 6 8;
112
Added:
]
113
Added:
in
114
Added:
{
115
Added:
name = "Ideal Routine";
116
Added:
workouts = [ workout_a; workout_b; workout_c ];
117
Added:
recovery_base = Recovery.days 4;
118
Added:
}
119
Added:
120
Added:
(* The Consolidation Routine: the minimalist variant — a handful of compound
121
Added:
movements, one working set each, trained infrequently. *)
122
Added:
let consolidation_routine =
123
Added:
let workout_a =
124
Added:
workout ~id:"consolidation_a" ~name:"Workout A"
125
Added:
[
126
Added:
straight ~substitutes:[ "Leg Press" ] "Back Squat" 6 8;
127
Added:
straight "Pulldown" 6 8;
128
Added:
]
129
Added:
in
130
Added:
let workout_b =
131
Added:
workout ~id:"consolidation_b" ~name:"Workout B"
132
Added:
[
133
Added:
straight ~substitutes:[ "Dumbbell Bench Press" ] "Barbell Bench Press" 6
134
Added:
8;
135
Added:
straight "Deadlift" 6 8;
136
Added:
]
137
Added:
in
138
Added:
{
139
Added:
name = "Consolidation Routine";
140
Added:
workouts = [ workout_a; workout_b ];
141
Added:
recovery_base = Recovery.days 7;
142
Added:
}
lib/core/prescription/routine.mli
@@ -0,0 +1,26 @@
1
Added:
(** A routine is a sequence of prescribed workouts cycled through over time —
2
Added:
the Ideal Routine is a three-way split, Consolidation a two-way one. Purely
3
Added:
a template: no targets, no history. *)
4
Added:
5
Added:
type t
6
Added:
type error = Empty_routine
7
Added:
8
Added:
val make :
9
Added:
name:string -> workouts:Workout_prescription.t list -> (t, error) result
10
Added:
11
Added:
val name : t -> string
12
Added:
val workouts : t -> Workout_prescription.t list
13
Added:
14
Added:
val workout_after : t -> Workout_prescription.t -> Workout_prescription.t
15
Added:
(** The next workout in the cycle after the given one, wrapping around. Falls
16
Added:
back to the first workout if the argument is not part of this routine. *)
17
Added:
18
Added:
val recovery_base : t -> Recovery.duration
19
Added:
(** Nominal rest between workouts; Consolidation rests longer than Ideal. *)
20
Added:
21
Added:
val pp : Format.formatter -> t -> unit
22
Added:
23
Added:
(** {1 Heavy Duty presets} *)
24
Added:
25
Added:
val ideal_routine : t
26
Added:
val consolidation_routine : t
lib/core/prescription/set_group_prescription.ml
@@ -0,0 +1,16 @@
1
Added:
type t =
2
Added:
| Straight of Prescription.t
3
Added:
| Superset of { first : Prescription.t; second : Prescription.t }
4
Added:
| Pre_exhaust of { isolation : Prescription.t; compound : Prescription.t }
5
Added:
6
Added:
let prescriptions = function
7
Added:
| Straight p -> [ p ]
8
Added:
| Superset { first; second } -> [ first; second ]
9
Added:
| Pre_exhaust { isolation; compound } -> [ isolation; compound ]
10
Added:
11
Added:
let exercises t = List.map Prescription.exercise (prescriptions t)
12
Added:
13
Added:
let pp fmt t =
14
Added:
Format.pp_print_list
15
Added:
~pp_sep:(fun fmt () -> Format.fprintf fmt " + ")
16
Added:
Prescription.pp fmt (prescriptions t)
lib/core/prescription/set_group_prescription.mli
@@ -0,0 +1,16 @@
1
Added:
(** The prescribed counterpart to {!Set_group}: which exercises, in which
2
Added:
structure, with no performance data. A routine's workouts
3
Added:
({!Workout_prescription}) are built from these. *)
4
Added:
5
Added:
type t =
6
Added:
| Straight of Prescription.t
7
Added:
| Superset of { first : Prescription.t; second : Prescription.t }
8
Added:
| Pre_exhaust of { isolation : Prescription.t; compound : Prescription.t }
9
Added:
10
Added:
val prescriptions : t -> Prescription.t list
11
Added:
(** Every slot's prescription, in order. *)
12
Added:
13
Added:
val exercises : t -> Exercise.t list
14
Added:
(** The prescribed movements, in order. *)
15
Added:
16
Added:
val pp : Format.formatter -> t -> unit
lib/core/prescription/workout_prescription.ml
@@ -0,0 +1,14 @@
1
Added:
type id = string
2
Added:
type t = { id : id; name : string; set_groups : Set_group_prescription.t list }
3
Added:
type error = Empty_workout
4
Added:
5
Added:
let make ~id ~name ~set_groups =
6
Added:
match set_groups with
7
Added:
| [] -> Error Empty_workout
8
Added:
| _ -> Ok { id; name; set_groups }
9
Added:
10
Added:
let id t = t.id
11
Added:
let name t = t.name
12
Added:
let set_groups t = t.set_groups
13
Added:
let equal a b = String.equal a.id b.id
14
Added:
let pp fmt t = Format.pp_print_string fmt t.name
lib/core/prescription/workout_prescription.mli
@@ -0,0 +1,25 @@
1
Added:
(** A prescribed workout — one workout within a routine, e.g. HD1's "Workout A":
2
Added:
an ordered sequence of set-group prescriptions. Static: no targets, no
3
Added:
history. *)
4
Added:
5
Added:
type t
6
Added:
type id = private string
7
Added:
type error = Empty_workout
8
Added:
9
Added:
val make :
10
Added:
id:string ->
11
Added:
name:string ->
12
Added:
set_groups:Set_group_prescription.t list ->
13
Added:
(t, error) result
14
Added:
(** [Error Empty_workout] if [set_groups] is empty. *)
15
Added:
16
Added:
val id : t -> id
17
Added:
val name : t -> string
18
Added:
19
Added:
val set_groups : t -> Set_group_prescription.t list
20
Added:
(** In order; sequence matters for pre-exhaust pairings. *)
21
Added:
22
Added:
val equal : t -> t -> bool
23
Added:
(** By {!id}. *)
24
Added:
25
Added:
val pp : Format.formatter -> t -> unit
lib/core/progression.ml
@@ -1,95 +0,0 @@
1
Removed:
type t = Progressing | Stalled
2
Removed:
3
Removed:
let equal a b = a = b
4
Removed:
5
Removed:
let pp fmt = function
6
Removed:
| Progressing -> Format.pp_print_string fmt "Progressing"
7
Removed:
| Stalled -> Format.pp_print_string fmt "Stalled"
8
Removed:
9
Removed:
type sample = Set.Working.performance
10
Removed:
type error = Insufficient_data
11
Removed:
12
Removed:
let beats ~previous ~current =
13
Removed:
let cmp =
14
Removed:
Units.Weight.compare current.Set.Working.load previous.Set.Working.load
15
Removed:
in
16
Removed:
cmp > 0
17
Removed:
|| cmp = 0
18
Removed:
&& Units.Reps.to_int current.Set.Working.reps
19
Removed:
> Units.Reps.to_int previous.Set.Working.reps
20
Removed:
21
Removed:
let evaluate ~history =
22
Removed:
match List.rev history with
23
Removed:
| current :: previous :: _ ->
24
Removed:
Ok (if beats ~previous ~current then Progressing else Stalled)
25
Removed:
| _ -> Error Insufficient_data
26
Removed:
27
Removed:
type band = Below_range | In_range | Above_range
28
Removed:
29
Removed:
let classify ~target_reps sample =
30
Removed:
let reps = Units.Reps.to_int sample.Set.Working.reps in
31
Removed:
let lo = Units.Reps.to_int (Units.Rep_range.min target_reps) in
32
Removed:
let hi = Units.Reps.to_int (Units.Rep_range.max target_reps) in
33
Removed:
if reps < lo then Below_range else if reps > hi then Above_range else In_range
34
Removed:
35
Removed:
type target =
36
Removed:
| Add_reps of { load : Units.Weight.t; min_reps : Units.Reps.t }
37
Removed:
| Add_load of { min_load : Units.Weight.t; reps : Units.Reps.t }
38
Removed:
39
Removed:
(* No universal load increment is prescribed by HD doctrine; 2.5 kg is the
40
Removed:
smallest plate increment available in most gyms. *)
41
Removed:
let load_increment_kg = 2.5
42
Removed:
43
Removed:
let next_target ~target_reps (sample : sample) =
44
Removed:
let hi = Units.Rep_range.max target_reps in
45
Removed:
if Units.Reps.to_int sample.reps < Units.Reps.to_int hi then
46
Removed:
let min_reps =
47
Removed:
match Units.Reps.of_int (Units.Reps.to_int sample.reps + 1) with
48
Removed:
| Ok r -> r
49
Removed:
| Error _ -> hi
50
Removed:
in
51
Removed:
Add_reps { load = sample.load; min_reps }
52
Removed:
else
53
Removed:
let min_load =
54
Removed:
match
55
Removed:
Units.Weight.of_kg (Units.Weight.to_kg sample.load +. load_increment_kg)
56
Removed:
with
57
Removed:
| Ok w -> w
58
Removed:
| Error _ -> sample.load
59
Removed:
in
60
Removed:
Add_load { min_load; reps = Units.Rep_range.min target_reps }
61
Removed:
62
Removed:
type guidance = { band : band; next : target }
63
Removed:
64
Removed:
let guide ~target_reps sample =
65
Removed:
{
66
Removed:
band = classify ~target_reps sample;
67
Removed:
next = next_target ~target_reps sample;
68
Removed:
}
69
Removed:
70
Removed:
type 'a prescribed = { value : 'a; evidence : sample list; status : t }
71
Removed:
72
Removed:
let prescribe ~target_reps ~evidence =
73
Removed:
let status =
74
Removed:
match evaluate ~history:evidence with
75
Removed:
| Ok s -> s
76
Removed:
| Error Insufficient_data -> Progressing
77
Removed:
in
78
Removed:
let value =
79
Removed:
match List.rev evidence with
80
Removed:
| latest :: _ -> next_target ~target_reps latest
81
Removed:
| [] ->
82
Removed:
Add_reps
83
Removed:
{
84
Removed:
load = Units.Weight.zero;
85
Removed:
min_reps = Units.Rep_range.min target_reps;
86
Removed:
}
87
Removed:
in
88
Removed:
{ value; evidence; status }
89
Removed:
90
Removed:
let volume samples =
91
Removed:
List.fold_left
92
Removed:
(fun acc (s : sample) ->
93
Removed:
acc
94
Removed:
+. (Units.Weight.to_kg s.load *. float_of_int (Units.Reps.to_int s.reps)))
95
Removed:
0.0 samples
lib/core/progression.mli
@@ -1,56 +0,0 @@
1
Removed:
(** Assessment: what the logged evidence says, and what it prescribes next.
2
Removed:
3
Removed:
This is the only module that relates performance to plan. Prescriptions do
4
Removed:
not judge, and the logbook does not interpret. *)
5
Removed:
6
Removed:
type t = Progressing | Stalled
7
Removed:
8
Removed:
val equal : t -> t -> bool
9
Removed:
val pp : Format.formatter -> t -> unit
10
Removed:
11
Removed:
type sample = Set.Working.performance
12
Removed:
(** One working set's performance — the unit of evidence. *)
13
Removed:
14
Removed:
type error = Insufficient_data
15
Removed:
16
Removed:
val evaluate : history:sample list -> (t, error) result
17
Removed:
(** [history] oldest-first. *)
18
Removed:
19
Removed:
val beats : previous:sample -> current:sample -> bool
20
Removed:
(** Progressive overload: heavier, or equal load for more reps. *)
21
Removed:
22
Removed:
(** {1 Judging a performance against a band} *)
23
Removed:
24
Removed:
type band =
25
Removed:
| Below_range (** Load too heavy. *)
26
Removed:
| In_range
27
Removed:
| Above_range (** Load too light. *)
28
Removed:
29
Removed:
val classify : target_reps:Units.Rep_range.t -> sample -> band
30
Removed:
31
Removed:
(** What to aim for next. *)
32
Removed:
type target =
33
Removed:
| Add_reps of { load : Units.Weight.t; min_reps : Units.Reps.t }
34
Removed:
| Add_load of { min_load : Units.Weight.t; reps : Units.Reps.t }
35
Removed:
(** Band exceeded: raise load, reset to the band's bottom. *)
36
Removed:
37
Removed:
type guidance = { band : band; next : target }
38
Removed:
(** How one performance landed, and what follows from it. *)
39
Removed:
40
Removed:
val guide : target_reps:Units.Rep_range.t -> sample -> guidance
41
Removed:
42
Removed:
(** {1 Prescribing from evidence}
43
Removed:
44
Removed:
Anything prescribed carries the evidence it came from and the status that
45
Removed:
evidence showed. *)
46
Removed:
47
Removed:
type 'a prescribed = { value : 'a; evidence : sample list; status : t }
48
Removed:
49
Removed:
val prescribe :
50
Removed:
target_reps:Units.Rep_range.t -> evidence:sample list -> target prescribed
51
Removed:
52
Removed:
(** {1 Metrics} *)
53
Removed:
54
Removed:
val volume : sample list -> float
55
Removed:
(** Σ (load × reps), in kilogram-reps. A diagnostic, never a target: under Heavy
56
Removed:
Duty rising volume is a warning, not an achievement. *)
lib/core/recovery.ml
@@ -1,21 +0,0 @@
1
Removed:
type timestamp = int
2
Removed:
3
Removed:
let timestamp_of_unix_seconds s = s
4
Removed:
let timestamp_to_unix_seconds t = t
5
Removed:
6
Removed:
type duration = int
7
Removed:
8
Removed:
let hours n = n * 3600
9
Removed:
let days n = n * 86400
10
Removed:
let duration_to_seconds d = d
11
Removed:
let elapsed ~since ~now = now - since
12
Removed:
13
Removed:
type readiness =
14
Removed:
| Ready
15
Removed:
| Recovering of { rested : duration; recommended : duration }
16
Removed:
17
Removed:
let evaluate_readiness ~elapsed ~recommended =
18
Removed:
if elapsed >= recommended then Ready
19
Removed:
else Recovering { rested = elapsed; recommended }
20
Removed:
21
Removed:
let is_ready = function Ready -> true | Recovering _ -> false
lib/core/recovery.mli
@@ -1,24 +0,0 @@
1
Removed:
(** Recovery is read off the logbook, not managed here: the elapsed time between
2
Removed:
two workouts, judged against a recommended window. There is no session,
3
Removed:
override, or evidence-based prescription — {!Hito_core.Logbook} owns that
4
Removed:
context and decides what to do with a {!readiness} reading. *)
5
Removed:
6
Removed:
type timestamp = private int
7
Removed:
8
Removed:
val timestamp_of_unix_seconds : int -> timestamp
9
Removed:
val timestamp_to_unix_seconds : timestamp -> int
10
Removed:
11
Removed:
type duration = private int
12
Removed:
13
Removed:
val hours : int -> duration
14
Removed:
val days : int -> duration
15
Removed:
val duration_to_seconds : duration -> int
16
Removed:
val elapsed : since:timestamp -> now:timestamp -> duration
17
Removed:
18
Removed:
type readiness =
19
Removed:
| Ready
20
Removed:
| Recovering of { rested : duration; recommended : duration }
21
Removed:
(** [rested] of [recommended] has passed. *)
22
Removed:
23
Removed:
val evaluate_readiness : elapsed:duration -> recommended:duration -> readiness
24
Removed:
val is_ready : readiness -> bool
lib/core/routine.ml
@@ -1,152 +0,0 @@
1
Removed:
module Plan = struct
2
Removed:
type t = { name : string; set_groups : Set_group_prescription.t list }
3
Removed:
type error = Empty_plan
4
Removed:
5
Removed:
let make ~name ~set_groups =
6
Removed:
match set_groups with
7
Removed:
| [] -> Error Empty_plan
8
Removed:
| _ -> Ok { name; set_groups }
9
Removed:
10
Removed:
let name t = t.name
11
Removed:
let set_groups t = t.set_groups
12
Removed:
13
Removed:
let pp fmt t =
14
Removed:
Format.fprintf fmt "%s: %a" t.name
15
Removed:
(Format.pp_print_list
16
Removed:
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
17
Removed:
Set_group_prescription.pp)
18
Removed:
t.set_groups
19
Removed:
end
20
Removed:
21
Removed:
type t = {
22
Removed:
name : string;
23
Removed:
plans : Plan.t list;
24
Removed:
recovery_base : Recovery.duration;
25
Removed:
}
26
Removed:
27
Removed:
type error = Empty_routine
28
Removed:
29
Removed:
let make ~name ~plans =
30
Removed:
match plans with
31
Removed:
| [] -> Error Empty_routine
32
Removed:
| _ -> Ok { name; plans; recovery_base = Recovery.days 4 }
33
Removed:
34
Removed:
let name t = t.name
35
Removed:
let plans t = t.plans
36
Removed:
37
Removed:
let next_plan t ~completed_workouts =
38
Removed:
let n = List.length t.plans in
39
Removed:
List.nth t.plans (((completed_workouts mod n) + n) mod n)
40
Removed:
41
Removed:
let recovery_base t = t.recovery_base
42
Removed:
43
Removed:
let pp fmt t =
44
Removed:
Format.fprintf fmt "%s (%d workouts)" t.name (List.length t.plans)
45
Removed:
46
Removed:
(* {1 Heavy Duty presets} *)
47
Removed:
48
Removed:
let by_name n =
49
Removed:
match
50
Removed:
List.find_opt (fun ex -> String.equal (Exercise.name ex) n) Exercise.catalog
51
Removed:
with
52
Removed:
| Some ex -> ex
53
Removed:
| None -> invalid_arg (Printf.sprintf "no catalog exercise named %s" n)
54
Removed:
55
Removed:
let ok = function
56
Removed:
| Ok v -> v
57
Removed:
| Error _ -> invalid_arg "invalid preset definition"
58
Removed:
59
Removed:
let band lo hi =
60
Removed:
ok
61
Removed:
(Units.Rep_range.make
62
Removed:
~min:(ok (Units.Reps.of_int lo))
63
Removed:
~max:(ok (Units.Reps.of_int hi)))
64
Removed:
65
Removed:
let prescribe ?(substitutes = []) exercise_name lo hi =
66
Removed:
ok
67
Removed:
(Prescription.make ~exercise:(by_name exercise_name)
68
Removed:
~target_reps:(band lo hi)
69
Removed:
~allowed_substitutes:(List.map by_name substitutes))
70
Removed:
71
Removed:
let straight ?substitutes exercise_name lo hi =
72
Removed:
Set_group_prescription.Straight (prescribe ?substitutes exercise_name lo hi)
73
Removed:
74
Removed:
let superset (first_name, flo, fhi, fsub) (second_name, slo, shi, ssub) =
75
Removed:
Set_group_prescription.Superset
76
Removed:
{
77
Removed:
first = prescribe ?substitutes:fsub first_name flo fhi;
78
Removed:
second = prescribe ?substitutes:ssub second_name slo shi;
79
Removed:
}
80
Removed:
81
Removed:
let pre_exhaust (isolation_name, ilo, ihi, isub) (compound_name, clo, chi, csub)
82
Removed:
=
83
Removed:
Set_group_prescription.Pre_exhaust
84
Removed:
{
85
Removed:
isolation = prescribe ?substitutes:isub isolation_name ilo ihi;
86
Removed:
compound = prescribe ?substitutes:csub compound_name clo chi;
87
Removed:
}
88
Removed:
89
Removed:
let plan name set_groups = ok (Plan.make ~name ~set_groups)
90
Removed:
91
Removed:
(* Mentzer's Ideal Routine: a three-way split built around pre-exhaustion
92
Removed:
supersets — an isolation movement immediately preceding the compound for
93
Removed:
the same target, so the larger muscle is the limiting factor. *)
94
Removed:
let ideal_routine =
95
Removed:
let workout_a =
96
Removed:
plan "Workout A: Chest, Shoulders, Triceps"
97
Removed:
[
98
Removed:
pre_exhaust ("Chest Flye", 6, 8, None)
99
Removed:
("Barbell Bench Press", 6, 8, Some [ "Dumbbell Bench Press" ]);
100
Removed:
straight "Lateral Raise" 6 8;
101
Removed:
straight ~substitutes:[ "Dumbbell Shoulder Press" ] "Overhead Press" 6 8;
102
Removed:
straight ~substitutes:[ "Skullcrusher" ] "Triceps Pushdown" 6 8;
103
Removed:
]
104
Removed:
in
105
Removed:
let workout_b =
106
Removed:
plan "Workout B: Back, Biceps"
107
Removed:
[
108
Removed:
superset
109
Removed:
("Pulldown", 6, 8, Some [ "Pull-Up" ])
110
Removed:
("Barbell Row", 6, 8, Some [ "Dumbbell Row"; "Seated Cable Row" ]);
111
Removed:
straight ~substitutes:[ "Dumbbell Curl" ] "Barbell Curl" 6 8;
112
Removed:
]
113
Removed:
in
114
Removed:
let workout_c =
115
Removed:
plan "Workout C: Legs"
116
Removed:
[
117
Removed:
pre_exhaust
118
Removed:
("Leg Extension", 6, 8, None)
119
Removed:
("Back Squat", 6, 8, Some [ "Leg Press" ]);
120
Removed:
straight "Leg Curl" 6 8;
121
Removed:
straight "Calf Raise" 6 8;
122
Removed:
]
123
Removed:
in
124
Removed:
{
125
Removed:
name = "Ideal Routine";
126
Removed:
plans = [ workout_a; workout_b; workout_c ];
127
Removed:
recovery_base = Recovery.days 4;
128
Removed:
}
129
Removed:
130
Removed:
(* The Consolidation Routine: the minimalist variant — a handful of compound
131
Removed:
movements, one working set each, trained infrequently. *)
132
Removed:
let consolidation_routine =
133
Removed:
let workout_a =
134
Removed:
plan "Workout A"
135
Removed:
[
136
Removed:
straight ~substitutes:[ "Leg Press" ] "Back Squat" 6 8;
137
Removed:
straight "Pulldown" 6 8;
138
Removed:
]
139
Removed:
in
140
Removed:
let workout_b =
141
Removed:
plan "Workout B"
142
Removed:
[
143
Removed:
straight ~substitutes:[ "Dumbbell Bench Press" ] "Barbell Bench Press" 6
144
Removed:
8;
145
Removed:
straight "Deadlift" 6 8;
146
Removed:
]
147
Removed:
in
148
Removed:
{
149
Removed:
name = "Consolidation Routine";
150
Removed:
plans = [ workout_a; workout_b ];
151
Removed:
recovery_base = Recovery.days 7;
152
Removed:
}
lib/core/routine.mli
@@ -1,42 +0,0 @@
1
Removed:
(** A routine is a {e sequence of workouts} cycled through over time — the Ideal
2
Removed:
Routine is a three-way split, the Consolidation Routine a two-way one.
3
Removed:
4
Removed:
Purely a template: it carries no targets and no history. *)
5
Removed:
6
Removed:
(** One workout within a routine, e.g. Mentzer's "Workout A". *)
7
Removed:
module Plan : sig
8
Removed:
type t
9
Removed:
type error = Empty_plan
10
Removed:
11
Removed:
val make :
12
Removed:
name:string -> set_groups:Set_group_prescription.t list -> (t, error) result
13
Removed:
14
Removed:
val name : t -> string
15
Removed:
16
Removed:
val set_groups : t -> Set_group_prescription.t list
17
Removed:
(** In order; sequence matters for pre-exhaust pairings. *)
18
Removed:
19
Removed:
val pp : Format.formatter -> t -> unit
20
Removed:
end
21
Removed:
22
Removed:
type t
23
Removed:
(** A named, non-empty sequence of workouts. *)
24
Removed:
25
Removed:
type error = Empty_routine
26
Removed:
27
Removed:
val make : name:string -> plans:Plan.t list -> (t, error) result
28
Removed:
val name : t -> string
29
Removed:
val plans : t -> Plan.t list
30
Removed:
31
Removed:
val next_plan : t -> completed_workouts:int -> Plan.t
32
Removed:
(** The workout due next, cycling through {!plans}. *)
33
Removed:
34
Removed:
val recovery_base : t -> Recovery.duration
35
Removed:
(** Nominal rest between workouts; Consolidation rests longer than Ideal. *)
36
Removed:
37
Removed:
val pp : Format.formatter -> t -> unit
38
Removed:
39
Removed:
(** {1 Heavy Duty presets} *)
40
Removed:
41
Removed:
val ideal_routine : t
42
Removed:
val consolidation_routine : t
lib/core/set.ml
@@ -1,46 +0,0 @@
1
Removed:
module Warm_up = struct
2
Removed:
type t = { exercise : Exercise.t; load : Units.Weight.t; reps : Units.Reps.t }
3
Removed:
4
Removed:
let make ~exercise ~load ~reps = { exercise; load; reps }
5
Removed:
let exercise t = t.exercise
6
Removed:
let load t = t.load
7
Removed:
let reps t = t.reps
8
Removed:
9
Removed:
let pp fmt t =
10
Removed:
Format.fprintf fmt "%a: %a x %a" Exercise.pp t.exercise Units.Weight.pp
11
Removed:
t.load Units.Reps.pp t.reps
12
Removed:
end
13
Removed:
14
Removed:
module Working = struct
15
Removed:
type extension = Forced_reps | Negatives | Rest_pause | Static_hold
16
Removed:
type outcome = Positive_failure | Beyond_failure of extension
17
Removed:
18
Removed:
type t = {
19
Removed:
exercise : Exercise.t;
20
Removed:
load : Units.Weight.t;
21
Removed:
reps : Units.Reps.t;
22
Removed:
outcome : outcome;
23
Removed:
}
24
Removed:
25
Removed:
let make ~exercise ~load ~reps ~outcome = { exercise; load; reps; outcome }
26
Removed:
let exercise t = t.exercise
27
Removed:
let load t = t.load
28
Removed:
let reps t = t.reps
29
Removed:
let outcome t = t.outcome
30
Removed:
31
Removed:
let pp_outcome fmt = function
32
Removed:
| Positive_failure -> Format.pp_print_string fmt "positive failure"
33
Removed:
| Beyond_failure Forced_reps -> Format.pp_print_string fmt "forced reps"
34
Removed:
| Beyond_failure Negatives -> Format.pp_print_string fmt "negatives"
35
Removed:
| Beyond_failure Rest_pause -> Format.pp_print_string fmt "rest-pause"
36
Removed:
| Beyond_failure Static_hold -> Format.pp_print_string fmt "static hold"
37
Removed:
38
Removed:
let pp fmt t =
39
Removed:
Format.fprintf fmt "%a: %a x %a (%a)" Exercise.pp t.exercise Units.Weight.pp
40
Removed:
t.load Units.Reps.pp t.reps pp_outcome t.outcome
41
Removed:
42
Removed:
type performance = { load : Units.Weight.t; reps : Units.Reps.t }
43
Removed:
44
Removed:
let performance (working : t) : performance =
45
Removed:
{ load = working.load; reps = working.reps }
46
Removed:
end
lib/core/set.mli
@@ -1,55 +0,0 @@
1
Removed:
(** The individual set (invariant #1).
2
Removed:
3
Removed:
Warm-up and working sets are distinct, incompatible types. A working set
4
Removed:
always reaches failure — that is its definition — so the type records only
5
Removed:
{e how} failure was reached, never whether.
6
Removed:
7
Removed:
Intensity is therefore categorical, not a scalar: at failure a set is by
8
Removed:
definition maximal, and going further is expressed qualitatively as
9
Removed:
{!Working.Beyond_failure}. There is deliberately no numeric intensity
10
Removed:
metric. *)
11
Removed:
12
Removed:
(** A warm-up set: preparation, never taken to failure. *)
13
Removed:
module Warm_up : sig
14
Removed:
type t
15
Removed:
16
Removed:
val make :
17
Removed:
exercise:Exercise.t -> load:Units.Weight.t -> reps:Units.Reps.t -> t
18
Removed:
19
Removed:
val exercise : t -> Exercise.t
20
Removed:
val load : t -> Units.Weight.t
21
Removed:
val reps : t -> Units.Reps.t
22
Removed:
val pp : Format.formatter -> t -> unit
23
Removed:
end
24
Removed:
25
Removed:
(** A working set: always taken to failure. *)
26
Removed:
module Working : sig
27
Removed:
(** How failure was extended past positive failure, per HD1/HD2. *)
28
Removed:
type extension = Forced_reps | Negatives | Rest_pause | Static_hold
29
Removed:
30
Removed:
(** The failure mode of the set. *)
31
Removed:
type outcome =
32
Removed:
| Positive_failure (** Momentary positive failure: no further full rep. *)
33
Removed:
| Beyond_failure of extension
34
Removed:
(** Taken past failure via an {!extension}. *)
35
Removed:
36
Removed:
type t
37
Removed:
38
Removed:
val make :
39
Removed:
exercise:Exercise.t ->
40
Removed:
load:Units.Weight.t ->
41
Removed:
reps:Units.Reps.t ->
42
Removed:
outcome:outcome ->
43
Removed:
t
44
Removed:
45
Removed:
val exercise : t -> Exercise.t
46
Removed:
val load : t -> Units.Weight.t
47
Removed:
val reps : t -> Units.Reps.t
48
Removed:
val outcome : t -> outcome
49
Removed:
val pp : Format.formatter -> t -> unit
50
Removed:
51
Removed:
type performance = { load : Units.Weight.t; reps : Units.Reps.t }
52
Removed:
53
Removed:
val performance : t -> performance
54
Removed:
(** Figures {!Hito_core.Progression} compares. *)
55
Removed:
end
lib/core/set_group.ml
@@ -1,55 +0,0 @@
1
Removed:
type view =
2
Removed:
| Straight of { warm_ups : Set.Warm_up.t list; working : Set.Working.t }
3
Removed:
| Superset of {
4
Removed:
warm_ups : Set.Warm_up.t list;
5
Removed:
first : Set.Working.t;
6
Removed:
second : Set.Working.t;
7
Removed:
}
8
Removed:
| Pre_exhaust of {
9
Removed:
warm_ups : Set.Warm_up.t list;
10
Removed:
isolation : Set.Working.t;
11
Removed:
compound : Set.Working.t;
12
Removed:
}
13
Removed:
14
Removed:
type t = view
15
Removed:
16
Removed:
let straight ?(warm_ups = []) ~working () = Straight { warm_ups; working }
17
Removed:
18
Removed:
let superset ?(warm_ups = []) ~first ~second () =
19
Removed:
Superset { warm_ups; first; second }
20
Removed:
21
Removed:
let pre_exhaust ?(warm_ups = []) ~isolation ~compound () =
22
Removed:
Pre_exhaust { warm_ups; isolation; compound }
23
Removed:
24
Removed:
let view t = t
25
Removed:
26
Removed:
let working_sets = function
27
Removed:
| Straight { working; _ } -> [ working ]
28
Removed:
| Superset { first; second; _ } -> [ first; second ]
29
Removed:
| Pre_exhaust { isolation; compound; _ } -> [ isolation; compound ]
30
Removed:
31
Removed:
let warm_ups = function
32
Removed:
| Straight { warm_ups; _ }
33
Removed:
| Superset { warm_ups; _ }
34
Removed:
| Pre_exhaust { warm_ups; _ } ->
35
Removed:
warm_ups
36
Removed:
37
Removed:
let pp fmt t =
38
Removed:
let pp_warm_ups fmt = function
39
Removed:
| [] -> ()
40
Removed:
| ws ->
41
Removed:
Format.fprintf fmt "warm-up: %a; "
42
Removed:
(Format.pp_print_list
43
Removed:
~pp_sep:(fun fmt () -> Format.fprintf fmt ", ")
44
Removed:
Set.Warm_up.pp)
45
Removed:
ws
46
Removed:
in
47
Removed:
match t with
48
Removed:
| Straight { warm_ups; working } ->
49
Removed:
Format.fprintf fmt "%a%a" pp_warm_ups warm_ups Set.Working.pp working
50
Removed:
| Superset { warm_ups; first; second } ->
51
Removed:
Format.fprintf fmt "%asuperset: %a + %a" pp_warm_ups warm_ups
52
Removed:
Set.Working.pp first Set.Working.pp second
53
Removed:
| Pre_exhaust { warm_ups; isolation; compound } ->
54
Removed:
Format.fprintf fmt "%apre-exhaust: %a -> %a" pp_warm_ups warm_ups
55
Removed:
Set.Working.pp isolation Set.Working.pp compound
lib/core/set_group.mli
@@ -1,52 +0,0 @@
1
Removed:
(** How working sets are grouped and sequenced within a workout.
2
Removed:
3
Removed:
A group may span exercises (superset, pre-exhaust), so the exercise belongs
4
Removed:
to each individual set, never to the group. Heavy Duty prescribes exactly
5
Removed:
one working set per exercise and this model admits no exceptions — extra
6
Removed:
volume is unrepresentable. *)
7
Removed:
8
Removed:
type t
9
Removed:
10
Removed:
val straight :
11
Removed:
?warm_ups:Set.Warm_up.t list -> working:Set.Working.t -> unit -> t
12
Removed:
(** One exercise: the working set, optionally preceded by a warm-up ramp. *)
13
Removed:
14
Removed:
val superset :
15
Removed:
?warm_ups:Set.Warm_up.t list ->
16
Removed:
first:Set.Working.t ->
17
Removed:
second:Set.Working.t ->
18
Removed:
unit ->
19
Removed:
t
20
Removed:
(** Two exercises' working sets, back-to-back. *)
21
Removed:
22
Removed:
val pre_exhaust :
23
Removed:
?warm_ups:Set.Warm_up.t list ->
24
Removed:
isolation:Set.Working.t ->
25
Removed:
compound:Set.Working.t ->
26
Removed:
unit ->
27
Removed:
t
28
Removed:
(** Isolation immediately followed by a compound — the signature HD technique.
29
Removed:
*)
30
Removed:
31
Removed:
(** {1 Inspection} *)
32
Removed:
33
Removed:
type view =
34
Removed:
| Straight of { warm_ups : Set.Warm_up.t list; working : Set.Working.t }
35
Removed:
| Superset of {
36
Removed:
warm_ups : Set.Warm_up.t list;
37
Removed:
first : Set.Working.t;
38
Removed:
second : Set.Working.t;
39
Removed:
}
40
Removed:
| Pre_exhaust of {
41
Removed:
warm_ups : Set.Warm_up.t list;
42
Removed:
isolation : Set.Working.t;
43
Removed:
compound : Set.Working.t;
44
Removed:
}
45
Removed:
46
Removed:
val view : t -> view
47
Removed:
48
Removed:
val working_sets : t -> Set.Working.t list
49
Removed:
(** Every working set, in order. Each carries its own exercise. *)
50
Removed:
51
Removed:
val warm_ups : t -> Set.Warm_up.t list
52
Removed:
val pp : Format.formatter -> t -> unit
lib/core/set_group_prescription.ml
@@ -1,16 +0,0 @@
1
Removed:
type t =
2
Removed:
| Straight of Prescription.t
3
Removed:
| Superset of { first : Prescription.t; second : Prescription.t }
4
Removed:
| Pre_exhaust of { isolation : Prescription.t; compound : Prescription.t }
5
Removed:
6
Removed:
let prescriptions = function
7
Removed:
| Straight p -> [ p ]
8
Removed:
| Superset { first; second } -> [ first; second ]
9
Removed:
| Pre_exhaust { isolation; compound } -> [ isolation; compound ]
10
Removed:
11
Removed:
let exercises t = List.map Prescription.exercise (prescriptions t)
12
Removed:
13
Removed:
let pp fmt t =
14
Removed:
Format.pp_print_list
15
Removed:
~pp_sep:(fun fmt () -> Format.fprintf fmt " + ")
16
Removed:
Prescription.pp fmt (prescriptions t)
lib/core/set_group_prescription.mli
@@ -1,16 +0,0 @@
1
Removed:
(** The prescribed counterpart to {!Hito_core.Set_group}: which exercises, in
2
Removed:
which structure, with no performance data. A routine's
3
Removed:
{!Hito_core.Routine.Plan} is built from these. *)
4
Removed:
5
Removed:
type t =
6
Removed:
| Straight of Prescription.t
7
Removed:
| Superset of { first : Prescription.t; second : Prescription.t }
8
Removed:
| Pre_exhaust of { isolation : Prescription.t; compound : Prescription.t }
9
Removed:
10
Removed:
val prescriptions : t -> Prescription.t list
11
Removed:
(** Every slot's prescription, in order. *)
12
Removed:
13
Removed:
val exercises : t -> Exercise.t list
14
Removed:
(** The prescribed movements, in order. *)
15
Removed:
16
Removed:
val pp : Format.formatter -> t -> unit
lib/core/units.ml
@@ -1,49 +0,0 @@
1
Removed:
type error = Negative | Not_positive | Inverted_range
2
Removed:
3
Removed:
let pp_error fmt = function
4
Removed:
| Negative -> Format.pp_print_string fmt "must be non-negative and finite"
5
Removed:
| Not_positive -> Format.pp_print_string fmt "must be strictly positive"
6
Removed:
| Inverted_range ->
7
Removed:
Format.pp_print_string fmt "range's minimum exceeds its maximum"
8
Removed:
9
Removed:
module Weight = struct
10
Removed:
type t = float
11
Removed:
12
Removed:
let of_kg kg =
13
Removed:
if Float.is_finite kg && kg >= 0.0 then Ok kg else Error Negative
14
Removed:
15
Removed:
let to_kg t = t
16
Removed:
let zero = 0.0
17
Removed:
let compare = Float.compare
18
Removed:
let equal = Float.equal
19
Removed:
let pp fmt t = Format.fprintf fmt "%g kg" t
20
Removed:
end
21
Removed:
22
Removed:
module Reps = struct
23
Removed:
type t = int
24
Removed:
25
Removed:
let of_int n = if n > 0 then Ok n else Error Not_positive
26
Removed:
let to_int t = t
27
Removed:
let compare = Int.compare
28
Removed:
let equal = Int.equal
29
Removed:
let pp fmt t = Format.fprintf fmt "%d reps" t
30
Removed:
end
31
Removed:
32
Removed:
module Rep_range = struct
33
Removed:
type t = Reps.t * Reps.t
34
Removed:
35
Removed:
let make ~min ~max =
36
Removed:
if Reps.to_int min <= Reps.to_int max then Ok (min, max)
37
Removed:
else Error Inverted_range
38
Removed:
39
Removed:
let min (lo, _) = lo
40
Removed:
let max (_, hi) = hi
41
Removed:
42
Removed:
let contains (lo, hi) r =
43
Removed:
Reps.to_int lo <= Reps.to_int r && Reps.to_int r <= Reps.to_int hi
44
Removed:
45
Removed:
let equal (lo1, hi1) (lo2, hi2) = Reps.equal lo1 lo2 && Reps.equal hi1 hi2
46
Removed:
47
Removed:
let pp fmt (lo, hi) =
48
Removed:
Format.fprintf fmt "%d-%d reps" (Reps.to_int lo) (Reps.to_int hi)
49
Removed:
end
lib/core/units.mli
@@ -1,46 +0,0 @@
1
Removed:
(** Physical quantities recorded during training.
2
Removed:
3
Removed:
Every type here is abstract and constructible only through a smart
4
Removed:
constructor, so an invalid measurement cannot exist. *)
5
Removed:
6
Removed:
type error =
7
Removed:
| Negative (** A quantity that must be >= 0 was negative, or not finite. *)
8
Removed:
| Not_positive (** A quantity that must be > 0 was <= 0. *)
9
Removed:
| Inverted_range (** A range's lower bound exceeded its upper bound. *)
10
Removed:
11
Removed:
val pp_error : Format.formatter -> error -> unit
12
Removed:
13
Removed:
(** Load in kilograms. Nonnegative: body-weight movements are [zero]. *)
14
Removed:
module Weight : sig
15
Removed:
type t
16
Removed:
17
Removed:
val of_kg : float -> (t, error) result
18
Removed:
val to_kg : t -> float
19
Removed:
val zero : t
20
Removed:
val compare : t -> t -> int
21
Removed:
val equal : t -> t -> bool
22
Removed:
val pp : Format.formatter -> t -> unit
23
Removed:
end
24
Removed:
25
Removed:
(** A completed repetition count. Strictly positive. *)
26
Removed:
module Reps : sig
27
Removed:
type t
28
Removed:
29
Removed:
val of_int : int -> (t, error) result
30
Removed:
val to_int : t -> int
31
Removed:
val compare : t -> t -> int
32
Removed:
val equal : t -> t -> bool
33
Removed:
val pp : Format.formatter -> t -> unit
34
Removed:
end
35
Removed:
36
Removed:
(** An inclusive target rep band, such as Mentzer's canonical 6-8. *)
37
Removed:
module Rep_range : sig
38
Removed:
type t
39
Removed:
40
Removed:
val make : min:Reps.t -> max:Reps.t -> (t, error) result
41
Removed:
val min : t -> Reps.t
42
Removed:
val max : t -> Reps.t
43
Removed:
val contains : t -> Reps.t -> bool
44
Removed:
val equal : t -> t -> bool
45
Removed:
val pp : Format.formatter -> t -> unit
46
Removed:
end
lib/core/vocabulary/dune
@@ -0,0 +1,4 @@
1
Added:
(library
2
Added:
(name hito_vocabulary)
3
Added:
(public_name hito.core.vocabulary)
4
Added:
(wrapped false))
lib/core/vocabulary/exercise.ml
@@ -0,0 +1,102 @@
1
Added:
type id = string
2
Added:
3
Added:
type t = {
4
Added:
id : id;
5
Added:
name : string;
6
Added:
substitutes : id list;
7
Added:
(** Whitelist, by id; resolved lazily against [catalog]. *)
8
Added:
}
9
Added:
10
Added:
let id t = t.id
11
Added:
let name t = t.name
12
Added:
let equal a b = String.equal a.id b.id
13
Added:
let pp fmt t = Format.pp_print_string fmt t.name
14
Added:
15
Added:
(* The curated catalog. Substitution whitelists group movements the author
16
Added:
judges close enough in pattern and target to stand in for one another —
17
Added:
e.g. a dumbbell press for a barbell press on the same plane. *)
18
Added:
let catalog =
19
Added:
[
20
Added:
{
21
Added:
id = "barbell_bench_press";
22
Added:
name = "Barbell Bench Press";
23
Added:
substitutes = [ "dumbbell_bench_press" ];
24
Added:
};
25
Added:
{
26
Added:
id = "dumbbell_bench_press";
27
Added:
name = "Dumbbell Bench Press";
28
Added:
substitutes = [ "barbell_bench_press" ];
29
Added:
};
30
Added:
{ id = "incline_press"; name = "Incline Press"; substitutes = [] };
31
Added:
{ id = "chest_flye"; name = "Chest Flye"; substitutes = [] };
32
Added:
{
33
Added:
id = "barbell_row";
34
Added:
name = "Barbell Row";
35
Added:
substitutes = [ "dumbbell_row"; "seated_cable_row" ];
36
Added:
};
37
Added:
{
38
Added:
id = "dumbbell_row";
39
Added:
name = "Dumbbell Row";
40
Added:
substitutes = [ "barbell_row"; "seated_cable_row" ];
41
Added:
};
42
Added:
{
43
Added:
id = "seated_cable_row";
44
Added:
name = "Seated Cable Row";
45
Added:
substitutes = [ "barbell_row"; "dumbbell_row" ];
46
Added:
};
47
Added:
{ id = "pulldown"; name = "Pulldown"; substitutes = [ "pull_up" ] };
48
Added:
{ id = "pull_up"; name = "Pull-Up"; substitutes = [ "pulldown" ] };
49
Added:
{
50
Added:
id = "overhead_press";
51
Added:
name = "Overhead Press";
52
Added:
substitutes = [ "dumbbell_shoulder_press" ];
53
Added:
};
54
Added:
{
55
Added:
id = "dumbbell_shoulder_press";
56
Added:
name = "Dumbbell Shoulder Press";
57
Added:
substitutes = [ "overhead_press" ];
58
Added:
};
59
Added:
{ id = "lateral_raise"; name = "Lateral Raise"; substitutes = [] };
60
Added:
{
61
Added:
id = "barbell_curl";
62
Added:
name = "Barbell Curl";
63
Added:
substitutes = [ "dumbbell_curl" ];
64
Added:
};
65
Added:
{
66
Added:
id = "dumbbell_curl";
67
Added:
name = "Dumbbell Curl";
68
Added:
substitutes = [ "barbell_curl" ];
69
Added:
};
70
Added:
{
71
Added:
id = "triceps_pushdown";
72
Added:
name = "Triceps Pushdown";
73
Added:
substitutes = [ "skullcrusher" ];
74
Added:
};
75
Added:
{
76
Added:
id = "skullcrusher";
77
Added:
name = "Skullcrusher";
78
Added:
substitutes = [ "triceps_pushdown" ];
79
Added:
};
80
Added:
{ id = "back_squat"; name = "Back Squat"; substitutes = [ "leg_press" ] };
81
Added:
{ id = "leg_press"; name = "Leg Press"; substitutes = [ "back_squat" ] };
82
Added:
{ id = "leg_extension"; name = "Leg Extension"; substitutes = [] };
83
Added:
{ id = "leg_curl"; name = "Leg Curl"; substitutes = [] };
84
Added:
{ id = "deadlift"; name = "Deadlift"; substitutes = [ "leg_press" ] };
85
Added:
{ id = "calf_raise"; name = "Calf Raise"; substitutes = [] };
86
Added:
{ id = "crunch"; name = "Crunch"; substitutes = [] };
87
Added:
]
88
Added:
89
Added:
let find target_id =
90
Added:
List.find_opt (fun ex -> String.equal ex.id target_id) catalog
91
Added:
92
Added:
type error = Not_permitted of { original : id; candidate : id }
93
Added:
94
Added:
let permitted_substitutes t = List.filter_map find t.substitutes
95
Added:
96
Added:
let may_substitute ~original ~candidate =
97
Added:
List.mem candidate.id original.substitutes
98
Added:
99
Added:
let substitute ~original ~candidate =
100
Added:
if may_substitute ~original ~candidate then Ok candidate
101
Added:
else
102
Added:
Error (Not_permitted { original = original.id; candidate = candidate.id })
lib/core/vocabulary/exercise.mli
@@ -0,0 +1,31 @@
1
Added:
(** Curated exercise catalog with author-specified substitution whitelists.
2
Added:
3
Added:
Users do not log arbitrary movements: every exercise comes from {!catalog}.
4
Added:
Substitutions are limited to each exercise's author-specified whitelist. *)
5
Added:
6
Added:
type t
7
Added:
(** Abstract catalog exercise; only obtainable via {!catalog} / {!find}. *)
8
Added:
9
Added:
type id = private string
10
Added:
11
Added:
val id : t -> id
12
Added:
val name : t -> string
13
Added:
val equal : t -> t -> bool
14
Added:
val pp : Format.formatter -> t -> unit
15
Added:
16
Added:
(** {1 Catalog} *)
17
Added:
18
Added:
val catalog : t list
19
Added:
(** The complete curated catalog; the only source of {!t} values. *)
20
Added:
21
Added:
val find : id -> t option
22
Added:
23
Added:
(** {1 Substitutions} *)
24
Added:
25
Added:
type error = Not_permitted of { original : id; candidate : id }
26
Added:
27
Added:
val permitted_substitutes : t -> t list
28
Added:
val may_substitute : original:t -> candidate:t -> bool
29
Added:
30
Added:
val substitute : original:t -> candidate:t -> (t, error) result
31
Added:
(** [Ok candidate] iff [candidate] is on [original]'s whitelist. *)
lib/core/vocabulary/set.ml
@@ -0,0 +1,46 @@
1
Added:
module Warm_up = struct
2
Added:
type t = { exercise : Exercise.t; load : Units.Weight.t; reps : Units.Reps.t }
3
Added:
4
Added:
let make ~exercise ~load ~reps = { exercise; load; reps }
5
Added:
let exercise t = t.exercise
6
Added:
let load t = t.load
7
Added:
let reps t = t.reps
8
Added:
9
Added:
let pp fmt t =
10
Added:
Format.fprintf fmt "%a: %a x %a" Exercise.pp t.exercise Units.Weight.pp
11
Added:
t.load Units.Reps.pp t.reps
12
Added:
end
13
Added:
14
Added:
module Working = struct
15
Added:
type extension = Forced_reps | Negatives | Rest_pause | Static_hold
16
Added:
type outcome = Positive_failure | Beyond_failure of extension
17
Added:
18
Added:
type t = {
19
Added:
exercise : Exercise.t;
20
Added:
load : Units.Weight.t;
21
Added:
reps : Units.Reps.t;
22
Added:
outcome : outcome;
23
Added:
}
24
Added:
25
Added:
let make ~exercise ~load ~reps ~outcome = { exercise; load; reps; outcome }
26
Added:
let exercise t = t.exercise
27
Added:
let load t = t.load
28
Added:
let reps t = t.reps
29
Added:
let outcome t = t.outcome
30
Added:
31
Added:
let pp_outcome fmt = function
32
Added:
| Positive_failure -> Format.pp_print_string fmt "positive failure"
33
Added:
| Beyond_failure Forced_reps -> Format.pp_print_string fmt "forced reps"
34
Added:
| Beyond_failure Negatives -> Format.pp_print_string fmt "negatives"
35
Added:
| Beyond_failure Rest_pause -> Format.pp_print_string fmt "rest-pause"
36
Added:
| Beyond_failure Static_hold -> Format.pp_print_string fmt "static hold"
37
Added:
38
Added:
let pp fmt t =
39
Added:
Format.fprintf fmt "%a: %a x %a (%a)" Exercise.pp t.exercise Units.Weight.pp
40
Added:
t.load Units.Reps.pp t.reps pp_outcome t.outcome
41
Added:
42
Added:
type performance = { load : Units.Weight.t; reps : Units.Reps.t }
43
Added:
44
Added:
let performance (working : t) : performance =
45
Added:
{ load = working.load; reps = working.reps }
46
Added:
end
lib/core/vocabulary/set.mli
@@ -0,0 +1,55 @@
1
Added:
(** The individual set (invariant #1).
2
Added:
3
Added:
Warm-up and working sets are distinct, incompatible types. A working set
4
Added:
always reaches failure — that is its definition — so the type records only
5
Added:
{e how} failure was reached, never whether.
6
Added:
7
Added:
Intensity is therefore categorical, not a scalar: at failure a set is by
8
Added:
definition maximal, and going further is expressed qualitatively as
9
Added:
{!Working.Beyond_failure}. There is deliberately no numeric intensity
10
Added:
metric. *)
11
Added:
12
Added:
(** A warm-up set: preparation, never taken to failure. *)
13
Added:
module Warm_up : sig
14
Added:
type t
15
Added:
16
Added:
val make :
17
Added:
exercise:Exercise.t -> load:Units.Weight.t -> reps:Units.Reps.t -> t
18
Added:
19
Added:
val exercise : t -> Exercise.t
20
Added:
val load : t -> Units.Weight.t
21
Added:
val reps : t -> Units.Reps.t
22
Added:
val pp : Format.formatter -> t -> unit
23
Added:
end
24
Added:
25
Added:
(** A working set: always taken to failure. *)
26
Added:
module Working : sig
27
Added:
(** How failure was extended past positive failure, per HD1/HD2. *)
28
Added:
type extension = Forced_reps | Negatives | Rest_pause | Static_hold
29
Added:
30
Added:
(** The failure mode of the set. *)
31
Added:
type outcome =
32
Added:
| Positive_failure (** Momentary positive failure: no further full rep. *)
33
Added:
| Beyond_failure of extension
34
Added:
(** Taken past failure via an {!extension}. *)
35
Added:
36
Added:
type t
37
Added:
38
Added:
val make :
39
Added:
exercise:Exercise.t ->
40
Added:
load:Units.Weight.t ->
41
Added:
reps:Units.Reps.t ->
42
Added:
outcome:outcome ->
43
Added:
t
44
Added:
45
Added:
val exercise : t -> Exercise.t
46
Added:
val load : t -> Units.Weight.t
47
Added:
val reps : t -> Units.Reps.t
48
Added:
val outcome : t -> outcome
49
Added:
val pp : Format.formatter -> t -> unit
50
Added:
51
Added:
type performance = { load : Units.Weight.t; reps : Units.Reps.t }
52
Added:
53
Added:
val performance : t -> performance
54
Added:
(** Figures {!Progression} compares. *)
55
Added:
end
lib/core/vocabulary/units.ml
@@ -0,0 +1,49 @@
1
Added:
type error = Negative | Not_positive | Inverted_range
2
Added:
3
Added:
let pp_error fmt = function
4
Added:
| Negative -> Format.pp_print_string fmt "must be non-negative and finite"
5
Added:
| Not_positive -> Format.pp_print_string fmt "must be strictly positive"
6
Added:
| Inverted_range ->
7
Added:
Format.pp_print_string fmt "range's minimum exceeds its maximum"
8
Added:
9
Added:
module Weight = struct
10
Added:
type t = float
11
Added:
12
Added:
let of_kg kg =
13
Added:
if Float.is_finite kg && kg >= 0.0 then Ok kg else Error Negative
14
Added:
15
Added:
let to_kg t = t
16
Added:
let zero = 0.0
17
Added:
let compare = Float.compare
18
Added:
let equal = Float.equal
19
Added:
let pp fmt t = Format.fprintf fmt "%g kg" t
20
Added:
end
21
Added:
22
Added:
module Reps = struct
23
Added:
type t = int
24
Added:
25
Added:
let of_int n = if n > 0 then Ok n else Error Not_positive
26
Added:
let to_int t = t
27
Added:
let compare = Int.compare
28
Added:
let equal = Int.equal
29
Added:
let pp fmt t = Format.fprintf fmt "%d reps" t
30
Added:
end
31
Added:
32
Added:
module Rep_range = struct
33
Added:
type t = Reps.t * Reps.t
34
Added:
35
Added:
let make ~min ~max =
36
Added:
if Reps.to_int min <= Reps.to_int max then Ok (min, max)
37
Added:
else Error Inverted_range
38
Added:
39
Added:
let min (lo, _) = lo
40
Added:
let max (_, hi) = hi
41
Added:
42
Added:
let contains (lo, hi) r =
43
Added:
Reps.to_int lo <= Reps.to_int r && Reps.to_int r <= Reps.to_int hi
44
Added:
45
Added:
let equal (lo1, hi1) (lo2, hi2) = Reps.equal lo1 lo2 && Reps.equal hi1 hi2
46
Added:
47
Added:
let pp fmt (lo, hi) =
48
Added:
Format.fprintf fmt "%d-%d reps" (Reps.to_int lo) (Reps.to_int hi)
49
Added:
end
lib/core/vocabulary/units.mli
@@ -0,0 +1,46 @@
1
Added:
(** Physical quantities recorded during training.
2
Added:
3
Added:
Every type here is abstract and constructible only through a smart
4
Added:
constructor, so an invalid measurement cannot exist. *)
5
Added:
6
Added:
type error =
7
Added:
| Negative (** A quantity that must be >= 0 was negative, or not finite. *)
8
Added:
| Not_positive (** A quantity that must be > 0 was <= 0. *)
9
Added:
| Inverted_range (** A range's lower bound exceeded its upper bound. *)
10
Added:
11
Added:
val pp_error : Format.formatter -> error -> unit
12
Added:
13
Added:
(** Load in kilograms. Nonnegative: body-weight movements are [zero]. *)
14
Added:
module Weight : sig
15
Added:
type t
16
Added:
17
Added:
val of_kg : float -> (t, error) result
18
Added:
val to_kg : t -> float
19
Added:
val zero : t
20
Added:
val compare : t -> t -> int
21
Added:
val equal : t -> t -> bool
22
Added:
val pp : Format.formatter -> t -> unit
23
Added:
end
24
Added:
25
Added:
(** A completed repetition count. Strictly positive. *)
26
Added:
module Reps : sig
27
Added:
type t
28
Added:
29
Added:
val of_int : int -> (t, error) result
30
Added:
val to_int : t -> int
31
Added:
val compare : t -> t -> int
32
Added:
val equal : t -> t -> bool
33
Added:
val pp : Format.formatter -> t -> unit
34
Added:
end
35
Added:
36
Added:
(** An inclusive target rep band, such as Mentzer's canonical 6-8. *)
37
Added:
module Rep_range : sig
38
Added:
type t
39
Added:
40
Added:
val make : min:Reps.t -> max:Reps.t -> (t, error) result
41
Added:
val min : t -> Reps.t
42
Added:
val max : t -> Reps.t
43
Added:
val contains : t -> Reps.t -> bool
44
Added:
val equal : t -> t -> bool
45
Added:
val pp : Format.formatter -> t -> unit
46
Added:
end
lib/core/workout.ml
@@ -1,20 +0,0 @@
1
Removed:
type t = {
2
Removed:
plan : Routine.Plan.t;
3
Removed:
started_at : Recovery.timestamp;
4
Removed:
ended_at : Recovery.timestamp option;
5
Removed:
}
6
Removed:
7
Removed:
let create ~plan ~started_at = { plan; started_at; ended_at = None }
8
Removed:
let finish t ~ended_at = { t with ended_at = Some ended_at }
9
Removed:
let plan t = t.plan
10
Removed:
let started_at t = t.started_at
11
Removed:
let ended_at t = t.ended_at
12
Removed:
13
Removed:
let duration t =
14
Removed:
Option.map
15
Removed:
(fun ended -> Recovery.elapsed ~since:t.started_at ~now:ended)
16
Removed:
t.ended_at
17
Removed:
18
Removed:
let pp fmt t =
19
Removed:
Format.fprintf fmt "%a starting at %d" Routine.Plan.pp t.plan
20
Removed:
(Recovery.timestamp_to_unix_seconds t.started_at)
lib/core/workout.mli
@@ -1,17 +0,0 @@
1
Removed:
(** A workout in progress or finished: a routine's plan, anchored to when it
2
Removed:
started and (once finished) ended. No targets, no recovery — those are
3
Removed:
{!Hito_core.Progression} and {!Hito_core.Recovery}'s concerns, applied by
4
Removed:
whoever reads the {!Hito_core.Logbook}. *)
5
Removed:
6
Removed:
type t
7
Removed:
8
Removed:
val create : plan:Routine.Plan.t -> started_at:Recovery.timestamp -> t
9
Removed:
10
Removed:
val finish : t -> ended_at:Recovery.timestamp -> t
11
Removed:
(** Fixes the workout's end. Calling this again replaces the previous end. *)
12
Removed:
13
Removed:
val plan : t -> Routine.Plan.t
14
Removed:
val started_at : t -> Recovery.timestamp
15
Removed:
val ended_at : t -> Recovery.timestamp option
16
Removed:
val duration : t -> Recovery.duration option
17
Removed:
val pp : Format.formatter -> t -> unit
lib/web/dune
@@ -1,6 +1,12 @@
1
1
(library
2
2
(name hito_web)
3
3
(public_name hito.web)
4
Removed:
(libraries hito.core hito.app eliom.server)
4
Added:
(libraries
5
Added:
hito.core.vocabulary
6
Added:
hito.core.assessment
7
Added:
hito.core.prescription
8
Added:
hito.core.logbook
9
Added:
hito.app
10
Added:
eliom.server)
5
11
(preprocess
6
12
(pps eliom.ppx.server)))
lib/web/pages.mli
@@ -4,18 +4,17 @@
4
4
open Hito_app
5
5
6
6
val choose_routine :
7
Removed:
routines:(Repository.routine_id * Hito_core.Routine.t) list ->
7
Added:
routines:(Repository.routine_id * Routine.t) list ->
8
8
Html_types.html Eliom_content.Html.elt
9
9
10
10
val log_workout :
11
Removed:
entry:Hito_core.Logbook.Entry.t -> Html_types.html Eliom_content.Html.elt
11
Added:
entry:Logbook.Entry.t -> Html_types.html Eliom_content.Html.elt
12
12
(** The active-logging page for the entry in progress. *)
13
13
14
14
val history :
15
15
records:Repository.record list -> Html_types.html Eliom_content.Html.elt
16
16
17
17
val recovery_notice :
18
Removed:
readiness:Hito_core.Recovery.readiness ->
19
Removed:
Html_types.html Eliom_content.Html.elt
18
Added:
readiness:Recovery.readiness -> Html_types.html Eliom_content.Html.elt
20
19
(** Informational: shown alongside {!log_workout} when the trainee has not fully
21
20
rested. Never blocks logging. *)
test/dune
@@ -1,3 +1,8 @@
1
1
(test
2
2
(name test_hito)
3
Removed:
(libraries hito.core alcotest))
3
Added:
(libraries
4
Added:
hito.core.vocabulary
5
Added:
hito.core.assessment
6
Added:
hito.core.prescription
7
Added:
hito.core.logbook
8
Added:
alcotest))
test/test_exercise.ml
@@ -1,10 +1,8 @@
1
Removed:
(** Unit tests for {!Hito_core.Exercise}, authored against exercise.mli.
1
Added:
(** Unit tests for {!Exercise}, authored against exercise.mli.
2
2
3
3
NOTE: Not yet registered in the main runner (see test_units.ml for the
4
4
rationale); wired in during implementation (Task 8). exercise.mli is the
5
5
source of truth over these assertions. *)
6
Removed:
7
Removed:
open Hito_core
8
6
9
7
let get = function Some v -> v | None -> Alcotest.fail "expected Some"
10
8
test/test_hito.ml
@@ -5,6 +5,6 @@
5
5
Alcotest.run "hito"
6
6
(Test_units.suite @ Test_exercise.suite @ Test_set.suite
7
7
@ Test_set_group.suite @ Test_prescription.suite
8
Removed:
@ Test_set_group_prescription.suite @ Test_routine.suite
9
Removed:
@ Test_progression.suite @ Test_recovery.suite @ Test_workout.suite
8
Added:
@ Test_set_group_prescription.suite @ Test_workout_prescription.suite
9
Added:
@ Test_routine.suite @ Test_progression.suite @ Test_recovery.suite
10
10
@ Test_logbook.suite)
test/test_logbook.ml
@@ -1,20 +1,18 @@
1
Removed:
(** Unit tests for {!Hito_core.Logbook}, authored against logbook.mli.
1
Added:
(** Unit tests for {!Logbook}, authored against logbook.mli.
2
2
3
Removed:
Under test: an entry accepts sets matching its plan's prescriptions and
4
Removed:
rejects others; the logbook derives per-exercise evidence and an
5
Removed:
informational readiness reading from finished entries. *)
3
Added:
Under test: an entry accepts sets matching its prescription and rejects
4
Added:
others; the logbook derives per-exercise evidence and an informational
5
Added:
readiness reading from finished entries. *)
6
6
7
Removed:
open Hito_core
8
Removed:
9
7
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
10
8
let ts = Recovery.timestamp_of_unix_seconds
11
9
let mk_w kg = ok (Units.Weight.of_kg kg)
12
10
let mk_r n = ok (Units.Reps.of_int n)
13
Removed:
let plan = List.hd (Routine.plans Routine.consolidation_routine)
11
Added:
let prescription = List.hd (Routine.workouts Routine.consolidation_routine)
14
12
(* Consolidation Workout A: Back Squat (straight), Pulldown (straight). *)
15
13
16
14
let prescribed_exercises =
17
Removed:
Routine.Plan.set_groups plan
15
Added:
Workout_prescription.set_groups prescription
18
16
|> List.concat_map Set_group_prescription.exercises
19
17
20
18
let squat = List.hd prescribed_exercises
@@ -28,12 +26,14 @@
28
26
Set.Working.make ~exercise ~load:(mk_w load) ~reps:(mk_r reps)
29
27
~outcome:Set.Working.Positive_failure
30
28
29
Added:
let start () = Logbook.Entry.start prescription ~started_at:(ts 0)
30
Added:
31
31
let entry_tests =
32
32
[
33
33
( "a set for a prescribed exercise is accepted",
34
34
`Quick,
35
35
fun () ->
36
Removed:
let e = Logbook.Entry.start (Workout.create ~plan ~started_at:(ts 0)) in
36
Added:
let e = start () in
37
37
let group = Set_group.straight ~working:(working squat 100.0 6) () in
38
38
Alcotest.(check bool)
39
39
"accepted" true
@@ -41,7 +41,7 @@
41
41
( "a set for an unprescribed exercise is rejected",
42
42
`Quick,
43
43
fun () ->
44
Removed:
let e = Logbook.Entry.start (Workout.create ~plan ~started_at:(ts 0)) in
44
Added:
let e = start () in
45
45
let group =
46
46
Set_group.straight ~working:(working unprescribed 20.0 12) ()
47
47
in
@@ -51,8 +51,7 @@
51
51
( "a finished entry rejects further groups",
52
52
`Quick,
53
53
fun () ->
54
Removed:
let e = Logbook.Entry.start (Workout.create ~plan ~started_at:(ts 0)) in
55
Removed:
let e = Logbook.Entry.finish e ~ended_at:(ts 100) in
54
Added:
let e = Logbook.Entry.finish (start ()) ~ended_at:(ts 100) in
56
55
let group = Set_group.straight ~working:(working squat 100.0 6) () in
57
56
Alcotest.(check bool)
58
57
"rejected" true
@@ -60,14 +59,14 @@
60
59
( "unperformed lists prescribed exercises with no logged set",
61
60
`Quick,
62
61
fun () ->
63
Removed:
let e = Logbook.Entry.start (Workout.create ~plan ~started_at:(ts 0)) in
62
Added:
let e = start () in
64
63
Alcotest.(check int)
65
64
"both unperformed" 2
66
65
(List.length (Logbook.Entry.unperformed e)) );
67
66
( "logging one exercise leaves the other unperformed",
68
67
`Quick,
69
68
fun () ->
70
Removed:
let e = Logbook.Entry.start (Workout.create ~plan ~started_at:(ts 0)) in
69
Added:
let e = start () in
71
70
let group = Set_group.straight ~working:(working squat 100.0 6) () in
72
71
let e = ok (Logbook.Entry.add_group e group) in
73
72
Alcotest.(check int)
@@ -87,9 +86,7 @@
87
86
`Quick,
88
87
fun () ->
89
88
let make_entry started load =
90
Removed:
let e =
91
Removed:
Logbook.Entry.start (Workout.create ~plan ~started_at:(ts started))
92
Removed:
in
89
Added:
let e = Logbook.Entry.start prescription ~started_at:(ts started) in
93
90
let group = Set_group.straight ~working:(working squat load 6) () in
94
91
Logbook.Entry.finish
95
92
(ok (Logbook.Entry.add_group e group))
@@ -103,6 +100,17 @@
103
100
Alcotest.(check (float 0.0001))
104
101
"oldest first" 80.0
105
102
(Units.Weight.to_kg (List.hd ev).Set.Working.load) );
103
Added:
( "last_prescription is the most recent entry's",
104
Added:
`Quick,
105
Added:
fun () ->
106
Added:
let e = Logbook.Entry.finish (start ()) ~ended_at:(ts 10) in
107
Added:
let book = Logbook.add Logbook.empty e in
108
Added:
match Logbook.last_prescription book with
109
Added:
| Some p ->
110
Added:
Alcotest.(check bool)
111
Added:
"matches" true
112
Added:
(Workout_prescription.equal p prescription)
113
Added:
| None -> Alcotest.fail "expected Some" );
106
114
( "an empty logbook is always Ready",
107
115
`Quick,
108
116
fun () ->
test/test_prescription.ml
@@ -1,9 +1,7 @@
1
Removed:
(** Unit tests for {!Hito_core.Prescription}, authored against prescription.mli.
1
Added:
(** Unit tests for {!Prescription}, authored against prescription.mli.
2
2
3
3
Under test: a prescription may only narrow the exercise's catalog whitelist,
4
4
never widen it. *)
5
Removed:
6
Removed:
open Hito_core
7
5
8
6
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
9
7
test/test_progression.ml
@@ -1,12 +1,10 @@
1
Removed:
(** Unit tests for {!Hito_core.Progression}, authored against progression.mli.
1
Added:
(** Unit tests for {!Progression}, authored against progression.mli.
2
2
3
3
NOTE: Not yet registered in the main runner; wired in during implementation
4
4
(Task 8). progression.mli is the source of truth over these assertions.
5
5
6
6
Under test: an improving history is [Progressing]; a flat/declining history
7
7
is [Stalled]; the [beats] relation captures progressive overload. *)
8
Removed:
9
Removed:
open Hito_core
10
8
11
9
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
12
10
test/test_recovery.ml
@@ -1,10 +1,8 @@
1
Removed:
(** Unit tests for {!Hito_core.Recovery}, authored against recovery.mli.
1
Added:
(** Unit tests for {!Recovery}, authored against recovery.mli.
2
2
3
3
Recovery is now just time primitives plus a readiness judgment; sessions,
4
Removed:
overrides, and evidence-based prescription moved to {!Hito_core.Logbook}
4
Added:
overrides, and evidence-based prescription moved to {!Logbook}
5
5
(informational gating) and were dropped from this module entirely. *)
6
Removed:
7
Removed:
open Hito_core
8
6
9
7
let ts = Recovery.timestamp_of_unix_seconds
10
8
test/test_routine.ml
@@ -1,13 +1,8 @@
1
Removed:
(** Unit tests for {!Hito_core.Routine}, authored against routine.mli.
1
Added:
(** Unit tests for {!Routine}, authored against routine.mli.
2
2
3
Removed:
NOTE: Not yet registered in the main runner; wired in during implementation.
4
Removed:
routine.mli is the source of truth over these assertions.
3
Added:
A routine is a sequence of prescribed workouts rotated through, not a flat
4
Added:
list of exercises. *)
5
5
6
Removed:
A routine is a sequence of workouts rotated through, not a flat list of
7
Removed:
exercises. *)
8
Removed:
9
Removed:
open Hito_core
10
Removed:
11
6
let preset_tests =
12
7
[
13
8
( "ideal routine cycles several workouts",
@@ -15,32 +10,40 @@
15
10
fun () ->
16
11
Alcotest.(check bool)
17
12
"more than one workout" true
18
Removed:
(List.length (Routine.plans Routine.ideal_routine) > 1) );
13
Added:
(List.length (Routine.workouts Routine.ideal_routine) > 1) );
19
14
( "consolidation routine has workouts",
20
15
`Quick,
21
16
fun () ->
22
17
Alcotest.(check bool)
23
18
"non-empty" true
24
Removed:
(List.length (Routine.plans Routine.consolidation_routine) > 0) );
19
Added:
(List.length (Routine.workouts Routine.consolidation_routine) > 0) );
25
20
( "every workout prescribes at least one set group",
26
21
`Quick,
27
22
fun () ->
28
23
List.iter
29
Removed:
(fun plan ->
24
Added:
(fun w ->
30
25
Alcotest.(check bool)
31
Removed:
"plan non-empty" true
32
Removed:
(List.length (Routine.Plan.set_groups plan) > 0))
33
Removed:
(Routine.plans Routine.ideal_routine) );
34
Removed:
( "rotation wraps around the cycle",
26
Added:
"workout non-empty" true
27
Added:
(List.length (Workout_prescription.set_groups w) > 0))
28
Added:
(Routine.workouts Routine.ideal_routine) );
29
Added:
( "rotation advances then wraps around the cycle",
35
30
`Quick,
36
31
fun () ->
37
32
let r = Routine.ideal_routine in
38
Removed:
let n = List.length (Routine.plans r) in
39
Removed:
let first = Routine.next_plan r ~completed_workouts:0 in
40
Removed:
let wrapped = Routine.next_plan r ~completed_workouts:n in
41
Removed:
Alcotest.(check string)
42
Removed:
"same workout after a full cycle" (Routine.Plan.name first)
43
Removed:
(Routine.Plan.name wrapped) );
33
Added:
let workouts = Routine.workouts r in
34
Added:
let first = List.hd workouts in
35
Added:
let second = Routine.workout_after r first in
36
Added:
Alcotest.(check bool)
37
Added:
"advances" false
38
Added:
(Workout_prescription.equal first second);
39
Added:
(* Stepping through the whole cycle returns to the first. *)
40
Added:
let n = List.length workouts in
41
Added:
let rec step w i =
42
Added:
if i = 0 then w else step (Routine.workout_after r w) (i - 1)
43
Added:
in
44
Added:
Alcotest.(check bool)
45
Added:
"wraps after a full cycle" true
46
Added:
(Workout_prescription.equal first (step first n)) );
44
47
]
45
48
46
49
let make_tests =
@@ -50,14 +53,7 @@
50
53
fun () ->
51
54
Alcotest.(check bool)
52
55
"empty rejected" true
53
Removed:
(Result.is_error (Routine.make ~name:"Empty" ~plans:[])) );
54
Removed:
( "empty workout rejected",
55
Removed:
`Quick,
56
Removed:
fun () ->
57
Removed:
Alcotest.(check bool)
58
Removed:
"empty rejected" true
59
Removed:
(Result.is_error (Routine.Plan.make ~name:"Workout A" ~set_groups:[]))
60
Removed:
);
56
Added:
(Result.is_error (Routine.make ~name:"Empty" ~workouts:[])) );
61
57
]
62
58
63
59
let suite = [ ("routine.presets", preset_tests); ("routine.make", make_tests) ]
test/test_set.ml
@@ -1,4 +1,4 @@
1
Removed:
(** Unit tests for {!Hito_core.Set}, authored against set.mli.
1
Added:
(** Unit tests for {!Set}, authored against set.mli.
2
2
3
3
NOTE: Not yet registered in the main runner; wired in during implementation
4
4
(Task 8). set.mli is the source of truth over these assertions.
@@ -6,8 +6,6 @@
6
6
Warm-up and working sets are distinct types (mismatch is a compile error,
7
7
not a runtime assertion). A working set always reaches failure — the type
8
8
only records how. *)
9
Removed:
10
Removed:
open Hito_core
11
9
12
10
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
13
11
let mk_w kg = ok (Units.Weight.of_kg kg)
test/test_set_group.ml
@@ -1,9 +1,7 @@
1
Removed:
(** Unit tests for {!Hito_core.Set_group}, authored against set_group.mli.
1
Added:
(** Unit tests for {!Set_group}, authored against set_group.mli.
2
2
3
3
Under test: each shape retains its working sets and warm-ups; the shape
4
4
admits no more or fewer working sets than Heavy Duty prescribes. *)
5
Removed:
6
Removed:
open Hito_core
7
5
8
6
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
9
7
let mk_w kg = ok (Units.Weight.of_kg kg)
test/test_set_group_prescription.ml
@@ -1,10 +1,8 @@
1
Removed:
(** Unit tests for {!Hito_core.Set_group_prescription}, authored against
1
Added:
(** Unit tests for {!Set_group_prescription}, authored against
2
2
set_group_prescription.mli.
3
3
4
4
Under test: each shape exposes its slots' exercises in order — the
5
Removed:
prescribed counterpart to {!Hito_core.Set_group}. *)
6
Removed:
7
Removed:
open Hito_core
5
Added:
prescribed counterpart to {!Set_group}. *)
8
6
9
7
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
10
8
test/test_units.ml
@@ -1,4 +1,4 @@
1
Removed:
(** Unit tests for {!Hito_core.Units}, authored against the units.mli contract.
1
Added:
(** Unit tests for {!Units}, authored against the units.mli contract.
2
2
3
3
NOTE: These tests exercise real behaviour and therefore only pass once the
4
4
implementation is filled in (Task 8). They are intentionally NOT yet
@@ -8,8 +8,6 @@
8
8
9
9
Per project policy, units.mli is the source of truth: if any assertion here
10
10
ever contradicts the interface, the interface wins and the test is fixed. *)
11
Removed:
12
Removed:
open Hito_core
13
11
14
12
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
15
13
test/test_workout.ml
@@ -1,40 +0,0 @@
1
Removed:
(** Unit tests for {!Hito_core.Workout}, authored against workout.mli.
2
Removed:
3
Removed:
A workout is just a plan reference plus timestamps; under test: creation,
4
Removed:
finishing, and the resulting duration. *)
5
Removed:
6
Removed:
open Hito_core
7
Removed:
8
Removed:
let ts = Recovery.timestamp_of_unix_seconds
9
Removed:
let plan = List.hd (Routine.plans Routine.consolidation_routine)
10
Removed:
11
Removed:
let tests =
12
Removed:
[
13
Removed:
( "a fresh workout has no end",
14
Removed:
`Quick,
15
Removed:
fun () ->
16
Removed:
let w = Workout.create ~plan ~started_at:(ts 0) in
17
Removed:
Alcotest.(check bool)
18
Removed:
"no end" true
19
Removed:
(Option.is_none (Workout.ended_at w)) );
20
Removed:
( "finishing fixes the end and duration",
21
Removed:
`Quick,
22
Removed:
fun () ->
23
Removed:
let w = Workout.create ~plan ~started_at:(ts 1000) in
24
Removed:
let w = Workout.finish w ~ended_at:(ts 1900) in
25
Removed:
Alcotest.(check (option int))
26
Removed:
"900s" (Some 900)
27
Removed:
(Option.map Recovery.duration_to_seconds (Workout.duration w)) );
28
Removed:
( "plan and started_at round-trip",
29
Removed:
`Quick,
30
Removed:
fun () ->
31
Removed:
let w = Workout.create ~plan ~started_at:(ts 42) in
32
Removed:
Alcotest.(check int)
33
Removed:
"started_at" 42
34
Removed:
(Recovery.timestamp_to_unix_seconds (Workout.started_at w));
35
Removed:
Alcotest.(check string)
36
Removed:
"plan" (Routine.Plan.name plan)
37
Removed:
(Routine.Plan.name (Workout.plan w)) );
38
Removed:
]
39
Removed:
40
Removed:
let suite = [ ("workout", tests) ]
test/test_workout_prescription.ml
@@ -0,0 +1,61 @@
1
Added:
(** Unit tests for {!Workout_prescription}, authored against its interface. *)
2
Added:
3
Added:
let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
4
Added:
5
Added:
let by_name n =
6
Added:
match
7
Added:
List.find_opt (fun ex -> String.equal (Exercise.name ex) n) Exercise.catalog
8
Added:
with
9
Added:
| Some ex -> ex
10
Added:
| None -> Alcotest.failf "no exercise named %s" n
11
Added:
12
Added:
let band lo hi =
13
Added:
ok
14
Added:
(Units.Rep_range.make
15
Added:
~min:(ok (Units.Reps.of_int lo))
16
Added:
~max:(ok (Units.Reps.of_int hi)))
17
Added:
18
Added:
let group name =
19
Added:
Set_group_prescription.Straight
20
Added:
(ok
21
Added:
(Prescription.make ~exercise:(by_name name) ~target_reps:(band 6 8)
22
Added:
~allowed_substitutes:[]))
23
Added:
24
Added:
let tests =
25
Added:
[
26
Added:
( "make rejects an empty workout",
27
Added:
`Quick,
28
Added:
fun () ->
29
Added:
Alcotest.(check bool)
30
Added:
"empty rejected" true
31
Added:
(Result.is_error
32
Added:
(Workout_prescription.make ~id:"x" ~name:"X" ~set_groups:[])) );
33
Added:
( "make accepts a non-empty workout and round-trips its fields",
34
Added:
`Quick,
35
Added:
fun () ->
36
Added:
let w =
37
Added:
ok
38
Added:
(Workout_prescription.make ~id:"a" ~name:"Workout A"
39
Added:
~set_groups:[ group "Back Squat"; group "Pulldown" ])
40
Added:
in
41
Added:
Alcotest.(check string) "name" "Workout A" (Workout_prescription.name w);
42
Added:
Alcotest.(check int)
43
Added:
"set groups" 2
44
Added:
(List.length (Workout_prescription.set_groups w)) );
45
Added:
( "equal compares by id",
46
Added:
`Quick,
47
Added:
fun () ->
48
Added:
let mk id =
49
Added:
ok
50
Added:
(Workout_prescription.make ~id ~name:"n"
51
Added:
~set_groups:[ group "Deadlift" ])
52
Added:
in
53
Added:
Alcotest.(check bool)
54
Added:
"same id equal" true
55
Added:
(Workout_prescription.equal (mk "a") (mk "a"));
56
Added:
Alcotest.(check bool)
57
Added:
"diff id unequal" false
58
Added:
(Workout_prescription.equal (mk "a") (mk "b")) );
59
Added:
]
60
Added:
61
Added:
let suite = [ ("workout_prescription", tests) ]