[OCaml] High Intensity Training Online

chore reset to interface-only blank slate for fresh design

Strip every hito.core implementation back to a minimal failwith "TODO" stub, keeping the .mli files as the design surface to iterate on afresh. The prior implementation remains in history (387ac6e and earlier) if any piece is worth recovering. - All 11 core .ml modules reduced to compiling stubs; no domain logic remains. - The 12 test suites are kept and still type-check against the interfaces, but are unregistered from the runner (a trivial smoke test keeps `dune runtest` green); each is wired back in as its module is re-implemented. - ARCHITECTURE.md added as the current module map. - .kiro/settings/ (auto-generated local tooling config) gitignored. Verified: dune build, @check, @fmt, runtest all green.

Commit
ea1f7cd0e5992d9ca3c485830dfdcf95c0c59a07
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
.gitignore
index ad050bab..262064ea 100644..100644
@@ -7,6 +7,9 @@
7 7 # direnv cache
8 8 .direnv/
9 9
10 Added: # Local Kiro tooling state (auto-generated, not project config)
11 Added: .kiro/settings/
12 Added:
10 13 # Editor / OS noise
11 14 *~
12 15 .#*
ARCHITECTURE.md
index 00000000..ac9acef0 000000..100644
@@ -0,0 +1,119 @@
1 Added: # hito architecture
2 Added:
3 Added: A weightlifting tracker that encodes Mike Mentzer's Heavy Duty philosophy and enforces its invariants via the OCaml type system.
4 Added:
5 Added: ## Layers
6 Added:
7 Added: Three top-level libraries.
8 Added:
9 Added: ```
10 Added: hito.web Eliom application (pages, services) [stubs]
11 Added: |
12 Added: hito.app Repository port, Service functor, adapters [stubs]
13 Added: |
14 Added: hito.core pure domain — no framework, DB, or serialization
15 Added: ```
16 Added:
17 Added: `hito.core` is split into four sub-libraries with enforced, acyclic
18 Added: dependencies:
19 Added:
20 Added: ```
21 Added: vocabulary ← assessment ← prescription ← logbook
22 Added: ^______________|____________|___________|
23 Added: (everything depends on vocabulary)
24 Added: ```
25 Added:
26 Added: - **vocabulary** — the nouns. `Units`, `Exercise`, `Set`.
27 Added: - **assessment** — judging performance and time. `Progression`, `Recovery`.
28 Added: - **prescription** — the plan side. `Prescription`, `Set_group_prescription`,
29 Added: `Workout_prescription`, `Routine`.
30 Added: - **logbook** — the record side. `Set_group`, `Logbook`.
31 Added:
32 Added: `Set` lives in vocabulary (not logbook) because `Progression` reads
33 Added: `Set.Working.performance`; placing it in logbook would cycle assessment against
34 Added: logbook.
35 Added:
36 Added: ## Modules
37 Added:
38 Added: ### vocabulary
39 Added:
40 Added: - **Units** — `Weight` (kg, ≥0), `Reps` (>0), `Rep_range` (min≤max). Abstract,
41 Added: constructed only through validating smart constructors.
42 Added: - **Exercise** — the curated catalog. Exercises exist only in `catalog`;
43 Added: substitutions are limited to each exercise's author-specified whitelist.
44 Added: - **Set** — one bout. `Warm_up` and `Working` are distinct types: a working set
45 Added: always reaches failure, recording only *how* (`Positive_failure` or
46 Added: `Beyond_failure` via forced reps / negatives / rest-pause / static hold).
47 Added: Intensity is categorical, never a number.
48 Added:
49 Added: ### assessment
50 Added:
51 Added: - **Progression** — the only module that judges performance against a plan.
52 Added: `Progressing | Stalled`; classifies a performance against a rep band
53 Added: (`Below/In/Above_range`); prescribes the next target (add reps within the
54 Added: band, then add load); tracks volume as a diagnostic.
55 Added: - **Recovery** — time. `timestamp`, `duration`, `elapsed`, and a `readiness`
56 Added: reading (elapsed vs. a recommended window). Purely informational — it gates
57 Added: nothing.
58 Added:
59 Added: ### prescription (the plan — static, no history)
60 Added:
61 Added: - **Prescription** — one exercise's plan: movement, target rep band, permitted
62 Added: substitutes.
63 Added: - **Set_group_prescription** — how prescriptions are grouped:
64 Added: `Straight | Superset | Pre_exhaust`.
65 Added: - **Workout_prescription** — one workout (e.g. "Workout A"): an ordered list of
66 Added: set-group prescriptions, with an `id`.
67 Added: - **Routine** — a sequence of prescribed workouts cycled through over time.
68 Added: `workout_after` gives the next workout in the cycle. Ships the Ideal and
69 Added: Consolidation presets.
70 Added:
71 Added: ### logbook (the record — what happened)
72 Added:
73 Added: - **Set_group** — the performed counterpart to `Set_group_prescription`:
74 Added: `straight` / `superset` / `pre_exhaust` holding actual `Set.Working.t`s.
75 Added: - **Logbook** — the training diary. `Entry` wraps the `Workout_prescription` it
76 Added: was performed against plus start/end timestamps and logged set groups; it
77 Added: validates each logged set against the prescription, and reports guidance,
78 Added: unperformed exercises, and volume. The `Logbook` itself yields per-exercise
79 Added: `evidence`, the `last_prescription` (for rotation), and a `readiness` reading.
80 Added:
81 Added: ### hito.app (stubs)
82 Added:
83 Added: - **Repository** — persistence port (module type). Assigns identity
84 Added: (`routine_id`, `workout_id`); stores logbook entries as records.
85 Added: - **Memory_repo** — in-memory adapter, seeded with the presets.
86 Added: - **Service** — orchestration over a repository: prescribe the next workout,
87 Added: start logging, log a group, finish and persist, read history.
88 Added:
89 Added: ### hito.web (stubs)
90 Added:
91 Added: - **App** / **Pages** / **Services** — the Eliom application: choose a routine,
92 Added: log a workout, view history.
93 Added:
94 Added: ## Data flow
95 Added:
96 Added: ```
97 Added: Routine ──workout_after──▶ Workout_prescription
98 Added: │ start
99 Added: ▼
100 Added: Logbook.Entry ──add_group──▶ (validated against the prescription)
101 Added: │ finish
102 Added: ▼
103 Added: Logbook ──evidence──▶ Progression (guidance, next target)
104 Added: └──elapsed────▶ Recovery (readiness)
105 Added: ```
106 Added:
107 Added: Plan and record are distinct types with a one-way transition: a
108 Added: `Workout_prescription` is instantiated into a `Logbook.Entry` when logging
109 Added: begins. Prescriptions never know what was performed; the logbook never
110 Added: interprets — judging is `Progression`'s job alone.
111 Added:
112 Added: ## Guiding invariants
113 Added:
114 Added: - Illegal states are unrepresentable where practical; otherwise a smart
115 Added: constructor returns a module-specific `result` error.
116 Added: - One working set per exercise is the Heavy Duty norm; deviation is structural,
117 Added: not a silent flag.
118 Added: - Recovery is elapsed time read off the logbook, judged advisorily — never a
119 Added: gate.
lib/core/assessment/progression.ml
index a6cdafca..059799f5 100644..100644
@@ -1,95 +1,30 @@
1 Added: (* Blank slate: stub only. Interface (progression.mli) is the design surface. *)
2 Added:
1 3 type t = Progressing | Stalled
2 4
3 Removed: let equal a b = a = b
5 Added: let equal _ _ = failwith "TODO"
6 Added: let pp _ _ = failwith "TODO"
4 7
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 8 type sample = Set.Working.performance
10 9 type error = Insufficient_data
11 10
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
11 Added: let evaluate ~history:_ = failwith "TODO"
12 Added: let beats ~previous:_ ~current:_ = failwith "TODO"
20 13
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 14 type band = Below_range | In_range | Above_range
28 15
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
16 Added: let classify ~target_reps:_ _ = failwith "TODO"
34 17
35 18 type target =
36 19 | Add_reps of { load : Units.Weight.t; min_reps : Units.Reps.t }
37 20 | Add_load of { min_load : Units.Weight.t; reps : Units.Reps.t }
38 21
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
22 Added: type guidance = { band : band; next : target } [@@warning "-69"]
42 23
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 }
24 Added: let guide ~target_reps:_ _ = failwith "TODO"
61 25
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 26 type 'a prescribed = { value : 'a; evidence : sample list; status : t }
27 Added: [@@warning "-69"]
71 28
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
29 Added: let prescribe ~target_reps:_ ~evidence:_ = failwith "TODO"
30 Added: let volume _ = failwith "TODO"
lib/core/assessment/recovery.ml
index 7322f580..101ca57b 100644..100644
@@ -1,21 +1,20 @@
1 Added: (* Blank slate: stub only. Interface (recovery.mli) is the design surface. *)
2 Added:
1 3 type timestamp = int
2 4
3 Removed: let timestamp_of_unix_seconds s = s
4 Removed: let timestamp_to_unix_seconds t = t
5 Added: let timestamp_of_unix_seconds _ = failwith "TODO"
6 Added: let timestamp_to_unix_seconds _ = failwith "TODO"
5 7
6 8 type duration = int
7 9
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
10 Added: let hours _ = failwith "TODO"
11 Added: let days _ = failwith "TODO"
12 Added: let duration_to_seconds _ = failwith "TODO"
13 Added: let elapsed ~since:_ ~now:_ = failwith "TODO"
12 14
13 15 type readiness =
14 16 | Ready
15 17 | Recovering of { rested : duration; recommended : duration }
16 18
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
19 Added: let evaluate_readiness ~elapsed:_ ~recommended:_ = failwith "TODO"
20 Added: let is_ready _ = failwith "TODO"
lib/core/logbook/logbook.ml
index 8979573d..58d1c9b4 100644..100644
@@ -1,114 +1,32 @@
1 Removed: module Entry = struct
2 Removed: type t = {
3 Removed: prescription : Workout_prescription.t;
4 Removed: started_at : Recovery.timestamp;
5 Removed: ended_at : Recovery.timestamp option;
6 Removed: groups : Set_group.t list;
7 Removed: finished : bool;
8 Removed: }
1 Added: (* Blank slate: stub only. Interface (logbook.mli) is the design surface. *)
9 2
3 Added: module Entry = struct
4 Added: type t = unit
10 5 type error = Set_exercise_not_prescribed of Exercise.id | Already_finished
11 6
12 Removed: let start prescription ~started_at =
13 Removed: { prescription; started_at; ended_at = None; groups = []; finished = false }
14 Removed:
15 Removed: let prescribed_exercise_ids t =
16 Removed: Workout_prescription.set_groups t.prescription
17 Removed: |> List.concat_map Set_group_prescription.exercises
18 Removed: |> List.map Exercise.id
19 Removed:
20 Removed: let add_group t group =
21 Removed: if t.finished then Error Already_finished
22 Removed: else
23 Removed: let prescribed = prescribed_exercise_ids t in
24 Removed: let offending =
25 Removed: Set_group.working_sets group
26 Removed: |> List.map Set.Working.exercise
27 Removed: |> List.find_opt (fun ex -> not (List.mem (Exercise.id ex) prescribed))
28 Removed: in
29 Removed: match offending with
30 Removed: | Some ex -> Error (Set_exercise_not_prescribed (Exercise.id ex))
31 Removed: | None -> Ok { t with groups = t.groups @ [ group ] }
32 Removed:
33 Removed: let finish t ~ended_at = { t with ended_at = Some ended_at; finished = true }
34 Removed: let is_finished t = t.finished
35 Removed: let prescription t = t.prescription
36 Removed: let started_at t = t.started_at
37 Removed: let ended_at t = t.ended_at
38 Removed:
39 Removed: let duration t =
40 Removed: Option.map
41 Removed: (fun ended -> Recovery.elapsed ~since:t.started_at ~now:ended)
42 Removed: t.ended_at
43 Removed:
44 Removed: let groups t = t.groups
45 Removed: let working_sets t = List.concat_map Set_group.working_sets t.groups
46 Removed:
47 Removed: let performances t =
48 Removed: List.map
49 Removed: (fun s ->
50 Removed: (Exercise.id (Set.Working.exercise s), Set.Working.performance s))
51 Removed: (working_sets t)
52 Removed:
53 Removed: let prescription_for t exercise_id =
54 Removed: Workout_prescription.set_groups t.prescription
55 Removed: |> List.concat_map Set_group_prescription.prescriptions
56 Removed: |> List.find_opt (fun p ->
57 Removed: Exercise.id (Prescription.exercise p) = exercise_id)
58 Removed:
59 Removed: let guidance t =
60 Removed: List.filter_map
61 Removed: (fun (id, sample) ->
62 Removed: match prescription_for t id with
63 Removed: | None -> None
64 Removed: | Some p ->
65 Removed: Some
66 Removed: ( id,
67 Removed: Progression.guide
68 Removed: ~target_reps:(Prescription.target_reps p)
69 Removed: sample ))
70 Removed: (performances t)
71 Removed:
72 Removed: let unperformed t =
73 Removed: let performed_ids = List.map fst (performances t) in
74 Removed: Workout_prescription.set_groups t.prescription
75 Removed: |> List.concat_map Set_group_prescription.exercises
76 Removed: |> List.filter (fun ex -> not (List.mem (Exercise.id ex) performed_ids))
77 Removed:
78 Removed: let volume t = Progression.volume (List.map snd (performances t))
79 Removed:
80 Removed: let pp fmt t =
81 Removed: Format.fprintf fmt "%a (%d groups)" Workout_prescription.pp t.prescription
82 Removed: (List.length t.groups)
7 Added: let start _ ~started_at:_ = failwith "TODO"
8 Added: let add_group _ _ = failwith "TODO"
9 Added: let finish _ ~ended_at:_ = failwith "TODO"
10 Added: let is_finished _ = failwith "TODO"
11 Added: let prescription _ = failwith "TODO"
12 Added: let started_at _ = failwith "TODO"
13 Added: let ended_at _ = failwith "TODO"
14 Added: let duration _ = failwith "TODO"
15 Added: let groups _ = failwith "TODO"
16 Added: let working_sets _ = failwith "TODO"
17 Added: let performances _ = failwith "TODO"
18 Added: let guidance _ = failwith "TODO"
19 Added: let unperformed _ = failwith "TODO"
20 Added: let volume _ = failwith "TODO"
21 Added: let pp _ _ = failwith "TODO"
83 22 end
84 23
85 Removed: type t = Entry.t list
24 Added: type t = unit
86 25
87 Removed: let empty = []
88 Removed: let add t entry = entry :: t
89 Removed: let entries t = t
90 Removed:
91 Removed: let evidence t exercise_id =
92 Removed: List.concat_map
93 Removed: (fun entry ->
94 Removed: Entry.performances entry
95 Removed: |> List.filter_map (fun (id, sample) ->
96 Removed: if id = exercise_id then Some sample else None))
97 Removed: (List.rev t)
98 Removed:
99 Removed: let last_prescription = function
100 Removed: | [] -> None
101 Removed: | last :: _ -> Some (Entry.prescription last)
102 Removed:
103 Removed: let readiness t ~now ~recommended =
104 Removed: match t with
105 Removed: | [] -> Recovery.Ready
106 Removed: | last :: _ -> (
107 Removed: match Entry.ended_at last with
108 Removed: | None -> Recovery.Ready
109 Removed: | Some since ->
110 Removed: Recovery.evaluate_readiness
111 Removed: ~elapsed:(Recovery.elapsed ~since ~now)
112 Removed: ~recommended)
113 Removed:
114 Removed: let pp fmt t = Format.fprintf fmt "%d entries" (List.length t)
26 Added: let empty = ()
27 Added: let add _ _ = failwith "TODO"
28 Added: let entries _ = failwith "TODO"
29 Added: let evidence _ _ = failwith "TODO"
30 Added: let last_prescription _ = failwith "TODO"
31 Added: let readiness _ ~now:_ ~recommended:_ = failwith "TODO"
32 Added: let pp _ _ = failwith "TODO"
lib/core/logbook/set_group.ml
index a0f8c3b2..1673b1c6 100644..100644
@@ -1,3 +1,11 @@
1 Added: (* Blank slate: stub only. Interface (set_group.mli) is the design surface. *)
2 Added:
3 Added: type t = unit
4 Added:
5 Added: let straight ?warm_ups:_ ~working:_ () = failwith "TODO"
6 Added: let superset ?warm_ups:_ ~first:_ ~second:_ () = failwith "TODO"
7 Added: let pre_exhaust ?warm_ups:_ ~isolation:_ ~compound:_ () = failwith "TODO"
8 Added:
1 9 type view =
2 10 | Straight of { warm_ups : Set.Warm_up.t list; working : Set.Working.t }
3 11 | Superset of {
@@ -11,45 +19,7 @@
11 19 compound : Set.Working.t;
12 20 }
13 21
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
22 Added: let view _ = failwith "TODO"
23 Added: let working_sets _ = failwith "TODO"
24 Added: let warm_ups _ = failwith "TODO"
25 Added: let pp _ _ = failwith "TODO"
lib/core/prescription/prescription.ml
index fd057764..2a243fc4 100644..100644
@@ -1,23 +1,9 @@
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: }
1 Added: (* Blank slate: stub only. Interface (prescription.mli) is the design surface. *)
6 2
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
3 Added: type t = unit
16 4
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
5 Added: let make ~exercise:_ ~target_reps:_ ~allowed_substitutes:_ = failwith "TODO"
6 Added: let exercise _ = failwith "TODO"
7 Added: let target_reps _ = failwith "TODO"
8 Added: let allowed_substitutes _ = failwith "TODO"
9 Added: let pp _ _ = failwith "TODO"
lib/core/prescription/routine.ml
index 0972cf78..588eefd2 100644..100644
@@ -1,142 +1,16 @@
1 Removed: type t = {
2 Removed: name : string;
3 Removed: workouts : Workout_prescription.t list;
4 Removed: recovery_base : Recovery.duration;
5 Removed: }
1 Added: (* Blank slate: stub only. Interface (routine.mli) is the design surface. *)
6 2
3 Added: type t = unit
7 4 type error = Empty_routine
8 5
9 Removed: let make ~name ~workouts =
10 Removed: match workouts with
11 Removed: | [] -> Error Empty_routine
12 Removed: | _ -> Ok { name; workouts; recovery_base = Recovery.days 4 }
6 Added: let make ~name:_ ~workouts:_ = failwith "TODO"
7 Added: let name _ = failwith "TODO"
8 Added: let workouts _ = failwith "TODO"
9 Added: let workout_after _ _ = failwith "TODO"
10 Added: let recovery_base _ = failwith "TODO"
11 Added: let pp _ _ = failwith "TODO"
13 12
14 Removed: let name t = t.name
15 Removed: let workouts t = t.workouts
16 Removed:
17 Removed: let workout_after t w =
18 Removed: match t.workouts with
19 Removed: | [] -> invalid_arg "Routine.workout_after: empty routine"
20 Removed: | first :: _ -> (
21 Removed: let rec index i = function
22 Removed: | [] -> None
23 Removed: | x :: _ when Workout_prescription.equal x w -> Some i
24 Removed: | _ :: rest -> index (i + 1) rest
25 Removed: in
26 Removed: match index 0 t.workouts with
27 Removed: | None -> first
28 Removed: | Some i -> List.nth t.workouts ((i + 1) mod List.length t.workouts))
29 Removed:
30 Removed: let recovery_base t = t.recovery_base
31 Removed:
32 Removed: let pp fmt t =
33 Removed: Format.fprintf fmt "%s (%d workouts)" t.name (List.length t.workouts)
34 Removed:
35 Removed: (* {1 Heavy Duty presets} *)
36 Removed:
37 Removed: let by_name n =
38 Removed: match
39 Removed: List.find_opt (fun ex -> String.equal (Exercise.name ex) n) Exercise.catalog
40 Removed: with
41 Removed: | Some ex -> ex
42 Removed: | None -> invalid_arg (Printf.sprintf "no catalog exercise named %s" n)
43 Removed:
44 Removed: let ok = function
45 Removed: | Ok v -> v
46 Removed: | Error _ -> invalid_arg "invalid preset definition"
47 Removed:
48 Removed: let band lo hi =
49 Removed: ok
50 Removed: (Units.Rep_range.make
51 Removed: ~min:(ok (Units.Reps.of_int lo))
52 Removed: ~max:(ok (Units.Reps.of_int hi)))
53 Removed:
54 Removed: let prescribe ?(substitutes = []) exercise_name lo hi =
55 Removed: ok
56 Removed: (Prescription.make ~exercise:(by_name exercise_name)
57 Removed: ~target_reps:(band lo hi)
58 Removed: ~allowed_substitutes:(List.map by_name substitutes))
59 Removed:
60 Removed: let straight ?substitutes exercise_name lo hi =
61 Removed: Set_group_prescription.Straight (prescribe ?substitutes exercise_name lo hi)
62 Removed:
63 Removed: let superset (first_name, flo, fhi, fsub) (second_name, slo, shi, ssub) =
64 Removed: Set_group_prescription.Superset
65 Removed: {
66 Removed: first = prescribe ?substitutes:fsub first_name flo fhi;
67 Removed: second = prescribe ?substitutes:ssub second_name slo shi;
68 Removed: }
69 Removed:
70 Removed: let pre_exhaust (isolation_name, ilo, ihi, isub) (compound_name, clo, chi, csub)
71 Removed: =
72 Removed: Set_group_prescription.Pre_exhaust
73 Removed: {
74 Removed: isolation = prescribe ?substitutes:isub isolation_name ilo ihi;
75 Removed: compound = prescribe ?substitutes:csub compound_name clo chi;
76 Removed: }
77 Removed:
78 Removed: let workout ~id ~name set_groups =
79 Removed: ok (Workout_prescription.make ~id ~name ~set_groups)
80 Removed:
81 Removed: (* Mentzer's Ideal Routine: a three-way split built around pre-exhaustion
82 Removed: supersets — an isolation movement immediately preceding the compound for
83 Removed: the same target, so the larger muscle is the limiting factor. *)
84 Removed: let ideal_routine =
85 Removed: let workout_a =
86 Removed: workout ~id:"ideal_a" ~name:"Workout A: Chest, Shoulders, Triceps"
87 Removed: [
88 Removed: pre_exhaust ("Chest Flye", 6, 8, None)
89 Removed: ("Barbell Bench Press", 6, 8, Some [ "Dumbbell Bench Press" ]);
90 Removed: straight "Lateral Raise" 6 8;
91 Removed: straight ~substitutes:[ "Dumbbell Shoulder Press" ] "Overhead Press" 6 8;
92 Removed: straight ~substitutes:[ "Skullcrusher" ] "Triceps Pushdown" 6 8;
93 Removed: ]
94 Removed: in
95 Removed: let workout_b =
96 Removed: workout ~id:"ideal_b" ~name:"Workout B: Back, Biceps"
97 Removed: [
98 Removed: superset
99 Removed: ("Pulldown", 6, 8, Some [ "Pull-Up" ])
100 Removed: ("Barbell Row", 6, 8, Some [ "Dumbbell Row"; "Seated Cable Row" ]);
101 Removed: straight ~substitutes:[ "Dumbbell Curl" ] "Barbell Curl" 6 8;
102 Removed: ]
103 Removed: in
104 Removed: let workout_c =
105 Removed: workout ~id:"ideal_c" ~name:"Workout C: Legs"
106 Removed: [
107 Removed: pre_exhaust
108 Removed: ("Leg Extension", 6, 8, None)
109 Removed: ("Back Squat", 6, 8, Some [ "Leg Press" ]);
110 Removed: straight "Leg Curl" 6 8;
111 Removed: straight "Calf Raise" 6 8;
112 Removed: ]
113 Removed: in
114 Removed: {
115 Removed: name = "Ideal Routine";
116 Removed: workouts = [ workout_a; workout_b; workout_c ];
117 Removed: recovery_base = Recovery.days 4;
118 Removed: }
119 Removed:
120 Removed: (* The Consolidation Routine: the minimalist variant — a handful of compound
121 Removed: movements, one working set each, trained infrequently. *)
122 Removed: let consolidation_routine =
123 Removed: let workout_a =
124 Removed: workout ~id:"consolidation_a" ~name:"Workout A"
125 Removed: [
126 Removed: straight ~substitutes:[ "Leg Press" ] "Back Squat" 6 8;
127 Removed: straight "Pulldown" 6 8;
128 Removed: ]
129 Removed: in
130 Removed: let workout_b =
131 Removed: workout ~id:"consolidation_b" ~name:"Workout B"
132 Removed: [
133 Removed: straight ~substitutes:[ "Dumbbell Bench Press" ] "Barbell Bench Press" 6
134 Removed: 8;
135 Removed: straight "Deadlift" 6 8;
136 Removed: ]
137 Removed: in
138 Removed: {
139 Removed: name = "Consolidation Routine";
140 Removed: workouts = [ workout_a; workout_b ];
141 Removed: recovery_base = Recovery.days 7;
142 Removed: }
13 Added: (* Presets are values of type [t = unit]; kept as unit placeholders so the
14 Added: module loads without evaluating a [failwith]. *)
15 Added: let ideal_routine = ()
16 Added: let consolidation_routine = ()
lib/core/prescription/set_group_prescription.ml
index 256293ee..bb7dfa9e 100644..100644
@@ -1,16 +1,11 @@
1 Added: (* Blank slate: stub only. Interface (set_group_prescription.mli) is the design
2 Added: surface. *)
3 Added:
1 4 type t =
2 5 | Straight of Prescription.t
3 6 | Superset of { first : Prescription.t; second : Prescription.t }
4 7 | Pre_exhaust of { isolation : Prescription.t; compound : Prescription.t }
5 8
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)
9 Added: let prescriptions _ = failwith "TODO"
10 Added: let exercises _ = failwith "TODO"
11 Added: let pp _ _ = failwith "TODO"
lib/core/prescription/workout_prescription.ml
index a57c44eb..7c72f0a3 100644..100644
@@ -1,14 +1,13 @@
1 Added: (* Blank slate: stub only. Interface (workout_prescription.mli) is the design
2 Added: surface. *)
3 Added:
1 4 type id = string
2 Removed: type t = { id : id; name : string; set_groups : Set_group_prescription.t list }
5 Added: type t = unit
3 6 type error = Empty_workout
4 7
5 Removed: let make ~id ~name ~set_groups =
6 Removed: match set_groups with
7 Removed: | [] -> Error Empty_workout
8 Removed: | _ -> Ok { id; name; set_groups }
9 Removed:
10 Removed: let id t = t.id
11 Removed: let name t = t.name
12 Removed: let set_groups t = t.set_groups
13 Removed: let equal a b = String.equal a.id b.id
14 Removed: let pp fmt t = Format.pp_print_string fmt t.name
8 Added: let make ~id:_ ~name:_ ~set_groups:_ = failwith "TODO"
9 Added: let id _ = failwith "TODO"
10 Added: let name _ = failwith "TODO"
11 Added: let set_groups _ = failwith "TODO"
12 Added: let equal _ _ = failwith "TODO"
13 Added: let pp _ _ = failwith "TODO"
lib/core/vocabulary/exercise.ml
index b255071d..3e5db58e 100644..100644
@@ -1,102 +1,17 @@
1 Added: (* Blank slate: stub only. Interface (exercise.mli) is the design surface. *)
2 Added:
1 3 type id = string
4 Added: type t = unit
2 5
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: }
6 Added: let id _ = failwith "TODO"
7 Added: let name _ = failwith "TODO"
8 Added: let equal _ _ = failwith "TODO"
9 Added: let pp _ _ = failwith "TODO"
10 Added: let catalog = []
11 Added: let find _ = failwith "TODO"
9 12
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 13 type error = Not_permitted of { original : id; candidate : id }
93 14
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 })
15 Added: let permitted_substitutes _ = failwith "TODO"
16 Added: let may_substitute ~original:_ ~candidate:_ = failwith "TODO"
17 Added: let substitute ~original:_ ~candidate:_ = failwith "TODO"
lib/core/vocabulary/set.ml
index 779e08ed..dc55079e 100644..100644
@@ -1,46 +1,28 @@
1 Added: (* Blank slate: stub only. Interface (set.mli) is the design surface. *)
2 Added:
1 3 module Warm_up = struct
2 Removed: type t = { exercise : Exercise.t; load : Units.Weight.t; reps : Units.Reps.t }
4 Added: type t = unit
3 5
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
6 Added: let make ~exercise:_ ~load:_ ~reps:_ = failwith "TODO"
7 Added: let exercise _ = failwith "TODO"
8 Added: let load _ = failwith "TODO"
9 Added: let reps _ = failwith "TODO"
10 Added: let pp _ _ = failwith "TODO"
12 11 end
13 12
14 13 module Working = struct
15 14 type extension = Forced_reps | Negatives | Rest_pause | Static_hold
16 15 type outcome = Positive_failure | Beyond_failure of extension
16 Added: type t = unit
17 17
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: }
18 Added: let make ~exercise:_ ~load:_ ~reps:_ ~outcome:_ = failwith "TODO"
19 Added: let exercise _ = failwith "TODO"
20 Added: let load _ = failwith "TODO"
21 Added: let reps _ = failwith "TODO"
22 Added: let outcome _ = failwith "TODO"
23 Added: let pp _ _ = failwith "TODO"
24 24
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 25 type performance = { load : Units.Weight.t; reps : Units.Reps.t }
43 26
44 Removed: let performance (working : t) : performance =
45 Removed: { load = working.load; reps = working.reps }
27 Added: let performance _ = failwith "TODO"
46 28 end
lib/core/vocabulary/units.ml
index 5950a18c..4da6ef7b 100644..100644
@@ -1,49 +1,37 @@
1 Added: (* Blank slate: stub only. Interface (units.mli) is the design surface. *)
2 Added:
1 3 type error = Negative | Not_positive | Inverted_range
2 4
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"
5 Added: let pp_error _ _ = failwith "TODO"
8 6
9 7 module Weight = struct
10 8 type t = float
11 9
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
10 Added: let of_kg _ = failwith "TODO"
11 Added: let to_kg _ = failwith "TODO"
16 12 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
13 Added: let compare _ _ = failwith "TODO"
14 Added: let equal _ _ = failwith "TODO"
15 Added: let pp _ _ = failwith "TODO"
20 16 end
21 17
22 18 module Reps = struct
23 19 type t = int
24 20
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
21 Added: let of_int _ = failwith "TODO"
22 Added: let to_int _ = failwith "TODO"
23 Added: let compare _ _ = failwith "TODO"
24 Added: let equal _ _ = failwith "TODO"
25 Added: let pp _ _ = failwith "TODO"
30 26 end
31 27
32 28 module Rep_range = struct
33 29 type t = Reps.t * Reps.t
34 30
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)
31 Added: let make ~min:_ ~max:_ = failwith "TODO"
32 Added: let min _ = failwith "TODO"
33 Added: let max _ = failwith "TODO"
34 Added: let contains _ _ = failwith "TODO"
35 Added: let equal _ _ = failwith "TODO"
36 Added: let pp _ _ = failwith "TODO"
49 37 end
test/test_hito.ml
index 3ba775dc..31a5f810 100644..100644
@@ -1,10 +1,10 @@
1 Removed: (** Test harness entry point. Per-module suites are registered here as their
2 Removed: implementations land. *)
1 Added: (** Test harness entry point.
3 2
4 Removed: let () =
5 Removed: Alcotest.run "hito"
6 Removed: (Test_units.suite @ Test_exercise.suite @ Test_set.suite
7 Removed: @ Test_set_group.suite @ Test_prescription.suite
8 Removed: @ Test_set_group_prescription.suite @ Test_workout_prescription.suite
9 Removed: @ Test_routine.suite @ Test_progression.suite @ Test_recovery.suite
10 Removed: @ Test_logbook.suite)
3 Added: Blank-slate redesign: the per-module suites (test_units.ml, test_set.ml, …)
4 Added: are kept in the tree and still compile against the interfaces, but are not
5 Added: registered here while the implementations are stubs — each is wired back
6 Added: into [Alcotest.run] as its module is re-implemented. Until then a trivial
7 Added: smoke test keeps [dune runtest] green. *)
8 Added:
9 Added: let smoke = [ ("blank-slate", `Quick, fun () -> ()) ]
10 Added: let () = Alcotest.run "hito" [ ("harness", smoke) ]