[OCaml] High Intensity Training Online

Initial domain interfaces for hito

Type-first design of a Mentzer Heavy Duty weightlifting tracker. All .mli files are the source of truth; .ml files are minimal compiling stubs (failwith "TODO") pending implementation approval. Three libraries: - hito.core pure domain, no framework/DB/serialization dependencies - hito.app Repository port, Service functor, in-memory adapter - hito.web Eliom application, pages, services Heavy Duty philosophy encoded in the type system: - A working set always reaches failure; the type records only how (positive failure, or beyond via forced reps/negatives/rest-pause/ static hold). Warm-up and working sets are distinct, incompatible types. - Recovery is systemic and time-based, advisory but never silently bypassed: starting early requires an explicit acknowledgement that is retained on the session. - Progressive overload drives prescription: add reps within the target band, then add load once the band is exceeded. - Volume beyond a single working set is possible but never silent; extra sets require an acknowledgement. - Prescribed and logged workouts are distinct types with a one-way transition, so a plan cannot be mistaken for a record. - Exercises come from a curated catalog; substitutions are limited to author-specified whitelists, which a routine may only narrow. Verified: dune build, @check, @fmt, and runtest all green.

Commit
d6190479749d7970025c313d48574e7a7afb8f14
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
.envrc
index 00000000..6ad35d90 000000..100644
@@ -0,0 +1,1 @@
1 Added: eval "$(opam env --switch="$PWD" --set-switch)"
.gitignore
index 00000000..ad050bab 000000..100644
@@ -0,0 +1,14 @@
1 Added: # Dune build artifacts
2 Added: _build/
3 Added:
4 Added: # Local opam switch
5 Added: _opam/
6 Added:
7 Added: # direnv cache
8 Added: .direnv/
9 Added:
10 Added: # Editor / OS noise
11 Added: *~
12 Added: .#*
13 Added: \#*#
14 Added: .DS_Store
.ocamlformat
index 00000000..de9ec727 000000..100644
@@ -0,0 +1,2 @@
1 Added: version = 0.29.0
2 Added: profile = default
bin/dune
index 00000000..a6c87c01 000000..100644
@@ -0,0 +1,4 @@
1 Added: (executable
2 Added: (public_name hito)
3 Added: (name main)
4 Added: (libraries hito.core))
bin/main.ml
index 00000000..f961aad8 000000..100644
@@ -0,0 +1,1 @@
1 Added: let () = Printf.printf "hito %s\n" Hito_core.Version.version
dune-project
index 00000000..7e01d86d 000000..100644
@@ -0,0 +1,26 @@
1 Added: (lang dune 3.20)
2 Added:
3 Added: (name hito)
4 Added:
5 Added: (generate_opam_files true)
6 Added:
7 Added: (source
8 Added: (github username/reponame))
9 Added:
10 Added: (authors "Author Name <author@example.com>")
11 Added:
12 Added: (maintainers "Maintainer Name <maintainer@example.com>")
13 Added:
14 Added: (license LICENSE)
15 Added:
16 Added: (documentation https://url/to/documentation)
17 Added:
18 Added: (package
19 Added: (name hito)
20 Added: (synopsis "A short synopsis")
21 Added: (description "A longer description")
22 Added: (depends ocaml)
23 Added: (tags
24 Added: ("add topics" "to describe" your project)))
25 Added:
26 Added: ; See the complete stanza docs at https://dune.readthedocs.io/en/stable/reference/dune-project/index.html
hito.opam
index 00000000..a43bbcb1 000000..100644
@@ -0,0 +1,32 @@
1 Added: # This file is generated by dune, edit dune-project instead
2 Added: opam-version: "2.0"
3 Added: synopsis: "A short synopsis"
4 Added: description: "A longer description"
5 Added: maintainer: ["Maintainer Name <maintainer@example.com>"]
6 Added: authors: ["Author Name <author@example.com>"]
7 Added: license: "LICENSE"
8 Added: tags: ["add topics" "to describe" "your" "project"]
9 Added: homepage: "https://github.com/username/reponame"
10 Added: doc: "https://url/to/documentation"
11 Added: bug-reports: "https://github.com/username/reponame/issues"
12 Added: depends: [
13 Added: "dune" {>= "3.20"}
14 Added: "ocaml"
15 Added: "odoc" {with-doc}
16 Added: ]
17 Added: build: [
18 Added: ["dune" "subst"] {dev}
19 Added: [
20 Added: "dune"
21 Added: "build"
22 Added: "-p"
23 Added: name
24 Added: "-j"
25 Added: jobs
26 Added: "@install"
27 Added: "@runtest" {with-test}
28 Added: "@doc" {with-doc}
29 Added: ]
30 Added: ]
31 Added: dev-repo: "git+https://github.com/username/reponame.git"
32 Added: x-maintenance-intent: ["(latest)"]
lib/app/dune
index 00000000..84d5f5a0 000000..100644
@@ -0,0 +1,4 @@
1 Added: (library
2 Added: (name hito_app)
3 Added: (public_name hito.app)
4 Added: (libraries hito.core))
lib/app/memory_repo.ml
index 00000000..ed009d8a 000000..100644
@@ -0,0 +1,10 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: type t = unit
4 Added:
5 Added: let create () = failwith "TODO"
6 Added: let list_routines _ = failwith "TODO"
7 Added: let find_routine _ _ = failwith "TODO"
8 Added: let save_workout _ _ = failwith "TODO"
9 Added: let history _ = failwith "TODO"
10 Added: let last_workout_at _ = failwith "TODO"
lib/app/memory_repo.mli
index 00000000..74647f55 000000..100644
@@ -0,0 +1,6 @@
1 Added: (** In-memory {!Repository.S} adapter for development and tests. *)
2 Added:
3 Added: include Repository.S
4 Added:
5 Added: val create : unit -> t
6 Added: (** A fresh repository seeded with the Heavy Duty preset routines. *)
lib/app/repository.ml
index 00000000..6cc93926 000000..100644
@@ -0,0 +1,24 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: type routine_id = string
4 Added: type workout_id = string
5 Added:
6 Added: let routine_id s = s
7 Added: let workout_id s = s
8 Added:
9 Added: type record = {
10 Added: id : workout_id;
11 Added: workout : Hito_core.Workout.Logged.t;
12 Added: finished_at : Hito_core.Recovery.timestamp;
13 Added: }
14 Added: [@@warning "-69"]
15 Added:
16 Added: module type S = sig
17 Added: type t
18 Added:
19 Added: val list_routines : t -> (routine_id * Hito_core.Routine.t) list
20 Added: val find_routine : t -> routine_id -> Hito_core.Routine.t option
21 Added: val save_workout : t -> record -> unit
22 Added: val history : t -> record list
23 Added: val last_workout_at : t -> Hito_core.Recovery.timestamp option
24 Added: end
lib/app/repository.mli
index 00000000..8821776f 000000..100644
@@ -0,0 +1,25 @@
1 Added: (** Persistence port for the application layer. Pure module type: no database,
2 Added: no Eliom. Identity for routines and finished workouts is assigned here,
3 Added: since the pure core does not carry persistence ids. *)
4 Added:
5 Added: type routine_id = private string
6 Added: type workout_id = private string
7 Added:
8 Added: val routine_id : string -> routine_id
9 Added: val workout_id : string -> workout_id
10 Added:
11 Added: type record = {
12 Added: id : workout_id;
13 Added: workout : Hito_core.Workout.Logged.t;
14 Added: finished_at : Hito_core.Recovery.timestamp;
15 Added: }
16 Added:
17 Added: module type S = sig
18 Added: type t
19 Added:
20 Added: val list_routines : t -> (routine_id * Hito_core.Routine.t) list
21 Added: val find_routine : t -> routine_id -> Hito_core.Routine.t option
22 Added: val save_workout : t -> record -> unit
23 Added: val history : t -> record list
24 Added: val last_workout_at : t -> Hito_core.Recovery.timestamp option
25 Added: end
lib/app/service.ml
index 00000000..99464e04 000000..100644
@@ -0,0 +1,22 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: module Make (R : Repository.S) = struct
4 Added: type t = { repo : R.t; clock : (module Hito_core.Recovery.CLOCK) }
5 Added: [@@warning "-69"]
6 Added:
7 Added: let make ~repo ~clock = { repo; clock }
8 Added: let list_routines _ = failwith "TODO"
9 Added:
10 Added: type start_outcome =
11 Added: | Started of Hito_core.Workout.Logged.t
12 Added: | Recovery_warning of Hito_core.Recovery.error
13 Added:
14 Added: let start_workout _ ~routine:_ ~recommended:_ = failwith "TODO"
15 Added:
16 Added: let start_overriding _ ~routine:_ ~recommended:_ ~acknowledged:_ =
17 Added: failwith "TODO"
18 Added:
19 Added: let log_group _ _ = failwith "TODO"
20 Added: let finish_workout _ _ = failwith "TODO"
21 Added: let history _ = failwith "TODO"
22 Added: end
lib/app/service.mli
index 00000000..6a51adc7 000000..100644
@@ -0,0 +1,35 @@
1 Added: (** Application service: orchestrates the core over a {!Repository.S} and a
2 Added: clock. The API the web (and future native) layer calls; no Eliom or
3 Added: serialization concerns. *)
4 Added:
5 Added: module Make (R : Repository.S) : sig
6 Added: type t
7 Added:
8 Added: val make : repo:R.t -> clock:(module Hito_core.Recovery.CLOCK) -> t
9 Added: val list_routines : t -> (Repository.routine_id * Hito_core.Routine.t) list
10 Added:
11 Added: type start_outcome =
12 Added: | Started of Hito_core.Workout.Logged.t
13 Added: | Recovery_warning of Hito_core.Recovery.error
14 Added:
15 Added: val start_workout :
16 Added: t ->
17 Added: routine:Repository.routine_id ->
18 Added: recommended:Hito_core.Recovery.duration ->
19 Added: (start_outcome, [ `Unknown_routine ]) result
20 Added:
21 Added: val start_overriding :
22 Added: t ->
23 Added: routine:Repository.routine_id ->
24 Added: recommended:Hito_core.Recovery.duration ->
25 Added: acknowledged:string ->
26 Added: (Hito_core.Workout.Logged.t, [ `Unknown_routine ]) result
27 Added:
28 Added: val log_group :
29 Added: Hito_core.Workout.Logged.t ->
30 Added: Hito_core.Set_group.t ->
31 Added: (Hito_core.Workout.Logged.t, Hito_core.Workout.Logged.error) result
32 Added:
33 Added: val finish_workout : t -> Hito_core.Workout.Logged.t -> Repository.record
34 Added: val history : t -> Repository.record list
35 Added: end
lib/core/dune
index 00000000..f29fc773 000000..100644
@@ -0,0 +1,3 @@
1 Added: (library
2 Added: (name hito_core)
3 Added: (public_name hito.core))
lib/core/exercise.ml
index 00000000..91f8e452 000000..100644
@@ -0,0 +1,17 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: type id = string
4 Added: type t = unit
5 Added:
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"
12 Added:
13 Added: type error = Not_permitted of { original : id; candidate : id }
14 Added:
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/exercise.mli
index 00000000..e3fc5206 000000..100644
@@ -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/progression.ml
index 00000000..cd8a2caf 000000..100644
@@ -0,0 +1,22 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: type t = Progressing | Stalled
4 Added:
5 Added: let equal _ _ = failwith "TODO"
6 Added: let pp _ _ = failwith "TODO"
7 Added:
8 Added: type sample = Set.Working.performance
9 Added: type error = Insufficient_data
10 Added:
11 Added: let evaluate ~history:_ = failwith "TODO"
12 Added: let beats ~previous:_ ~current:_ = failwith "TODO"
13 Added:
14 Added: type band = Below_range | In_range | Above_range
15 Added:
16 Added: let classify ~target_reps:_ _ = failwith "TODO"
17 Added:
18 Added: type target =
19 Added: | Add_reps of { load : Units.Weight.t; min_reps : Units.Reps.t }
20 Added: | Add_load of { min_load : Units.Weight.t; reps : Units.Reps.t }
21 Added:
22 Added: let next_target ~target_reps:_ ~previous:_ = failwith "TODO"
lib/core/progression.mli
index 00000000..f331caac 000000..100644
@@ -0,0 +1,33 @@
1 Added: (** Progression: an observation about past working-set performance, distinct
2 Added: from {!Hito_core.Routine.Prescription}. Encodes the HD imperative — beat the
3 Added: last session; add reps within the prescribed band, then add load. *)
4 Added:
5 Added: type t = Progressing | Stalled
6 Added:
7 Added: val equal : t -> t -> bool
8 Added: val pp : Format.formatter -> t -> unit
9 Added:
10 Added: type sample = Set.Working.performance
11 Added: type error = Insufficient_data
12 Added:
13 Added: val evaluate : history:sample list -> (t, error) result
14 Added: (** [history] oldest-first. *)
15 Added:
16 Added: val beats : previous:sample -> current:sample -> bool
17 Added: (** Progressive overload: heavier, or equal load for more reps. *)
18 Added:
19 Added: (** Where a performance fell relative to the prescribed band. *)
20 Added: type band =
21 Added: | Below_range (** Load too heavy. *)
22 Added: | In_range
23 Added: | Above_range (** Load too light. *)
24 Added:
25 Added: val classify : target_reps:Units.Rep_range.t -> sample -> band
26 Added:
27 Added: (** What to aim for next. *)
28 Added: type target =
29 Added: | Add_reps of { load : Units.Weight.t; min_reps : Units.Reps.t }
30 Added: | Add_load of { min_load : Units.Weight.t; reps : Units.Reps.t }
31 Added: (** Band exceeded: raise load, reset to the band's bottom. *)
32 Added:
33 Added: val next_target : target_reps:Units.Rep_range.t -> previous:sample -> target
lib/core/recovery.ml
index 00000000..d07628bf 000000..100644
@@ -0,0 +1,37 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: type timestamp = int
4 Added:
5 Added: let timestamp_of_unix_seconds _ = failwith "TODO"
6 Added: let timestamp_to_unix_seconds _ = failwith "TODO"
7 Added:
8 Added: type duration = int
9 Added:
10 Added: let hours _ = failwith "TODO"
11 Added: let days _ = failwith "TODO"
12 Added: let recommended_recovery ~base:_ ~progression:_ = failwith "TODO"
13 Added:
14 Added: module type CLOCK = sig
15 Added: val now : unit -> timestamp
16 Added: end
17 Added:
18 Added: type readiness =
19 Added: | Ready
20 Added: | Recovering of { elapsed : duration; recommended : duration }
21 Added:
22 Added: let evaluate_readiness ~now:_ ~last_workout:_ ~recommended:_ = failwith "TODO"
23 Added: let is_ready _ = failwith "TODO"
24 Added:
25 Added: type override_reason = { note : string; readiness_at_start : readiness }
26 Added: type session = unit
27 Added: type error = Not_recovered of { readiness : readiness }
28 Added:
29 Added: let start_session _ ~last_workout:_ ~recommended:_ = failwith "TODO"
30 Added:
31 Added: let start_session_overriding_recovery _ ~last_workout:_ ~recommended:_
32 Added: ~acknowledged:_ =
33 Added: failwith "TODO"
34 Added:
35 Added: let started_at _ = failwith "TODO"
36 Added: let overridden_recovery _ = failwith "TODO"
37 Added: let pp_session _ _ = failwith "TODO"
lib/core/recovery.mli
index 00000000..062a5f58 000000..100644
@@ -0,0 +1,67 @@
1 Added: (** The recovery model (invariant #2).
2 Added:
3 Added: Recovery is systemic and time-based: training is a whole-body stressor, so a
4 Added: heavy workout gates the next one regardless of which movements it targeted.
5 Added: Gating is advisory, not inviolable — {!start_session} warns when the window
6 Added: has not elapsed, and only {!start_session_overriding_recovery} proceeds
7 Added: anyway, recording the override. Time is injected via {!CLOCK}. *)
8 Added:
9 Added: (** {1 Time} *)
10 Added:
11 Added: type timestamp = private int
12 Added:
13 Added: val timestamp_of_unix_seconds : int -> timestamp
14 Added: val timestamp_to_unix_seconds : timestamp -> int
15 Added:
16 Added: type duration = private int
17 Added:
18 Added: val hours : int -> duration
19 Added: val days : int -> duration
20 Added:
21 Added: val recommended_recovery :
22 Added: base:duration -> progression:Progression.t -> duration
23 Added: (** Adaptive window: a stall lengthens rest (fuller recovery, not more work). *)
24 Added:
25 Added: module type CLOCK = sig
26 Added: val now : unit -> timestamp
27 Added: end
28 Added:
29 Added: (** {1 Readiness} *)
30 Added:
31 Added: type readiness =
32 Added: | Ready
33 Added: | Recovering of { elapsed : duration; recommended : duration }
34 Added:
35 Added: val evaluate_readiness :
36 Added: now:timestamp -> last_workout:timestamp -> recommended:duration -> readiness
37 Added:
38 Added: val is_ready : readiness -> bool
39 Added:
40 Added: (** {1 Sessions and gating} *)
41 Added:
42 Added: type override_reason = { note : string; readiness_at_start : readiness }
43 Added: type session
44 Added: type error = Not_recovered of { readiness : readiness }
45 Added:
46 Added: val start_session :
47 Added: (module CLOCK) ->
48 Added: last_workout:timestamp option ->
49 Added: recommended:duration ->
50 Added: (session, error) result
51 Added: (** [Ok] iff recovered; [last_workout] is [None] for the very first workout
52 Added: (always ready). *)
53 Added:
54 Added: val start_session_overriding_recovery :
55 Added: (module CLOCK) ->
56 Added: last_workout:timestamp option ->
57 Added: recommended:duration ->
58 Added: acknowledged:string ->
59 Added: session
60 Added: (** Always succeeds; records an {!override_reason}. *)
61 Added:
62 Added: val started_at : session -> timestamp
63 Added:
64 Added: val overridden_recovery : session -> override_reason option
65 Added: (** [Some _] iff the session was started early. *)
66 Added:
67 Added: val pp_session : Format.formatter -> session -> unit
lib/core/routine.ml
index 00000000..4f690702 000000..100644
@@ -0,0 +1,37 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: type set_scheme = Single_working_set | Working_sets of int
4 Added:
5 Added: let is_high_intensity_compliant _ = failwith "TODO"
6 Added:
7 Added: module Prescription = struct
8 Added: type t = unit
9 Added:
10 Added: let make ~exercise:_ ~target_reps:_ ~set_scheme:_ ~allowed_substitutes:_ =
11 Added: failwith "TODO"
12 Added:
13 Added: let exercise _ = failwith "TODO"
14 Added: let target_reps _ = failwith "TODO"
15 Added: let set_scheme _ = failwith "TODO"
16 Added: let allowed_substitutes _ = failwith "TODO"
17 Added:
18 Added: type guidance = {
19 Added: band : Progression.band;
20 Added: next : Progression.target;
21 Added: compliant : bool;
22 Added: }
23 Added: [@@warning "-69"]
24 Added:
25 Added: let evaluate _ ~performance:_ ~compliant:_ = failwith "TODO"
26 Added: let pp _ _ = failwith "TODO"
27 Added: end
28 Added:
29 Added: type t = unit
30 Added: type error = Empty_routine
31 Added:
32 Added: let make ~name:_ ~prescriptions:_ = failwith "TODO"
33 Added: let name _ = failwith "TODO"
34 Added: let prescriptions _ = failwith "TODO"
35 Added: let pp _ _ = failwith "TODO"
36 Added: let ideal_routine = ()
37 Added: let consolidation_routine = ()
lib/core/routine.mli
index 00000000..abd8b8c1 000000..100644
@@ -0,0 +1,59 @@
1 Added: (** Routines and prescriptions.
2 Added:
3 Added: A prescription is the plan for one exercise (movement, target reps, set
4 Added: scheme, allowed substitutes); a routine is an ordered list of them. Kept
5 Added: separate from {!Hito_core.Workout} (plan vs performed) and
6 Added: {!Hito_core.Progression} (plan vs observation). Substitutes must be on the
7 Added: exercise's catalog whitelist, so a routine can only narrow the curated set.
8 Added: *)
9 Added:
10 Added: type set_scheme = Single_working_set | Working_sets of int
11 Added:
12 Added: val is_high_intensity_compliant : set_scheme -> bool
13 Added: (** [true] only for [Single_working_set]: Heavy Duty holds that volume beyond
14 Added: the minimum interferes with recovery, so [Working_sets n] is an explicit,
15 Added: visible deviation. *)
16 Added:
17 Added: module Prescription : sig
18 Added: type t
19 Added:
20 Added: val make :
21 Added: exercise:Exercise.t ->
22 Added: target_reps:Units.Rep_range.t ->
23 Added: set_scheme:set_scheme ->
24 Added: allowed_substitutes:Exercise.t list ->
25 Added: (t, Exercise.error) result
26 Added:
27 Added: val exercise : t -> Exercise.t
28 Added: val target_reps : t -> Units.Rep_range.t
29 Added: val set_scheme : t -> set_scheme
30 Added: val allowed_substitutes : t -> Exercise.t list
31 Added:
32 Added: type guidance = {
33 Added: band : Progression.band;
34 Added: next : Progression.target;
35 Added: compliant : bool; (** Whether prescribed volume was respected. *)
36 Added: }
37 Added: (** Guidance from comparing a performance to this prescription. *)
38 Added:
39 Added: val evaluate :
40 Added: t -> performance:Progression.sample -> compliant:bool -> guidance
41 Added: (** Judge a performed working set against the plan. *)
42 Added:
43 Added: val pp : Format.formatter -> t -> unit
44 Added: end
45 Added:
46 Added: type t
47 Added: (** Abstract routine: a named, non-empty, ordered list of prescriptions. *)
48 Added:
49 Added: type error = Empty_routine
50 Added:
51 Added: val make : name:string -> prescriptions:Prescription.t list -> (t, error) result
52 Added: val name : t -> string
53 Added: val prescriptions : t -> Prescription.t list
54 Added: val pp : Format.formatter -> t -> unit
55 Added:
56 Added: (** {1 Heavy Duty presets} *)
57 Added:
58 Added: val ideal_routine : t
59 Added: val consolidation_routine : t
lib/core/set.ml
index 00000000..54175099 000000..100644
@@ -0,0 +1,28 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: module Warm_up = struct
4 Added: type t = unit
5 Added:
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"
11 Added: end
12 Added:
13 Added: module Working = struct
14 Added: type extension = Forced_reps | Negatives | Rest_pause | Static_hold
15 Added: type outcome = Positive_failure | Beyond_failure of extension
16 Added: type t = unit
17 Added:
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 Added:
25 Added: type performance = { load : Units.Weight.t; reps : Units.Reps.t }
26 Added:
27 Added: let performance _ = failwith "TODO"
28 Added: end
lib/core/set.mli
index 00000000..2cccfa40 000000..100644
@@ -0,0 +1,50 @@
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: (** A warm-up set: preparation, never taken to failure. *)
8 Added: module Warm_up : sig
9 Added: type t
10 Added:
11 Added: val make :
12 Added: exercise:Exercise.t -> load:Units.Weight.t -> reps:Units.Reps.t -> t
13 Added:
14 Added: val exercise : t -> Exercise.t
15 Added: val load : t -> Units.Weight.t
16 Added: val reps : t -> Units.Reps.t
17 Added: val pp : Format.formatter -> t -> unit
18 Added: end
19 Added:
20 Added: (** A working set: always taken to failure. *)
21 Added: module Working : sig
22 Added: (** How failure was extended past positive failure, per HD1/HD2. *)
23 Added: type extension = Forced_reps | Negatives | Rest_pause | Static_hold
24 Added:
25 Added: (** The failure mode of the set. *)
26 Added: type outcome =
27 Added: | Positive_failure (** Momentary positive failure: no further full rep. *)
28 Added: | Beyond_failure of extension
29 Added: (** Taken past failure via an {!extension}. *)
30 Added:
31 Added: type t
32 Added:
33 Added: val make :
34 Added: exercise:Exercise.t ->
35 Added: load:Units.Weight.t ->
36 Added: reps:Units.Reps.t ->
37 Added: outcome:outcome ->
38 Added: t
39 Added:
40 Added: val exercise : t -> Exercise.t
41 Added: val load : t -> Units.Weight.t
42 Added: val reps : t -> Units.Reps.t
43 Added: val outcome : t -> outcome
44 Added: val pp : Format.formatter -> t -> unit
45 Added:
46 Added: type performance = { load : Units.Weight.t; reps : Units.Reps.t }
47 Added:
48 Added: val performance : t -> performance
49 Added: (** Figures {!Hito_core.Progression} compares. *)
50 Added: end
lib/core/set_group.ml
index 00000000..8c9eae8a 000000..100644
@@ -0,0 +1,24 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: type t = unit
4 Added: type extra_volume = { sets : Set.Working.t list; acknowledged : string }
5 Added:
6 Added: let straight ?warm_up:_ ?extra:_ ~working:_ () = failwith "TODO"
7 Added: let superset ~first:_ ~second:_ ?rest:_ () = failwith "TODO"
8 Added: let pre_exhaust ~isolation:_ ~compound:_ = failwith "TODO"
9 Added:
10 Added: type view =
11 Added: | Straight of {
12 Added: warm_up : Set.Warm_up.t option;
13 Added: working : Set.Working.t;
14 Added: extra : extra_volume option;
15 Added: }
16 Added: | Superset of Set.Working.t list
17 Added: | Pre_exhaust of { isolation : Set.Working.t; compound : Set.Working.t }
18 Added:
19 Added: let view _ = failwith "TODO"
20 Added: let working_sets _ = failwith "TODO"
21 Added: let exercises _ = failwith "TODO"
22 Added: let extra_volume _ = failwith "TODO"
23 Added: let is_high_intensity_compliant _ = failwith "TODO"
24 Added: let pp _ _ = failwith "TODO"
lib/core/set_group.mli
index 00000000..91c04473 000000..100644
@@ -0,0 +1,52 @@
1 Added: (** How working sets are grouped and sequenced within a workout. Each shape is
2 Added: enforced by construction, so every constructor returns a plain group. *)
3 Added:
4 Added: type t
5 Added:
6 Added: type extra_volume = { sets : Set.Working.t list; acknowledged : string }
7 Added: (** Heavy Duty prescribes a single working set. Extra sets are possible but
8 Added: never silent — they must be acknowledged, as an early workout must be. *)
9 Added:
10 Added: val straight :
11 Added: ?warm_up:Set.Warm_up.t ->
12 Added: ?extra:extra_volume ->
13 Added: working:Set.Working.t ->
14 Added: unit ->
15 Added: t
16 Added: (** One exercise: the working set, optionally warmed up and extended. *)
17 Added:
18 Added: val superset :
19 Added: first:Set.Working.t ->
20 Added: second:Set.Working.t ->
21 Added: ?rest:Set.Working.t list ->
22 Added: unit ->
23 Added: t
24 Added: (** Working sets across exercises, back-to-back. *)
25 Added:
26 Added: val pre_exhaust : isolation:Set.Working.t -> compound:Set.Working.t -> t
27 Added: (** Isolation immediately followed by a compound — the signature HD technique.
28 Added: *)
29 Added:
30 Added: (** {1 Inspection} *)
31 Added:
32 Added: type view =
33 Added: | Straight of {
34 Added: warm_up : Set.Warm_up.t option;
35 Added: working : Set.Working.t;
36 Added: extra : extra_volume option;
37 Added: }
38 Added: | Superset of Set.Working.t list
39 Added: | Pre_exhaust of { isolation : Set.Working.t; compound : Set.Working.t }
40 Added:
41 Added: val view : t -> view
42 Added:
43 Added: val working_sets : t -> Set.Working.t list
44 Added: (** Every working set, in order. *)
45 Added:
46 Added: val exercises : t -> Exercise.t list
47 Added: val extra_volume : t -> extra_volume option
48 Added:
49 Added: val is_high_intensity_compliant : t -> bool
50 Added: (** [true] iff the group carries no extra volume. *)
51 Added:
52 Added: val pp : Format.formatter -> t -> unit
lib/core/units.ml
index 00000000..d5d8abda 000000..100644
@@ -0,0 +1,42 @@
1 Added: (* Minimal stubs only. Real implementation is deferred until the .mli review
2 Added: gate (Task 7) is passed. The types are given concrete-but-placeholder
3 Added: definitions so the module type-checks against units.mli. *)
4 Added:
5 Added: type error =
6 Added: | Negative of string
7 Added: | Not_positive of string
8 Added: | Inverted_range of string
9 Added:
10 Added: let pp_error _ _ = failwith "TODO"
11 Added:
12 Added: module Weight = struct
13 Added: type t = float
14 Added:
15 Added: let of_kg _ = failwith "TODO"
16 Added: let to_kg _ = failwith "TODO"
17 Added: let zero = 0.0
18 Added: let compare _ _ = failwith "TODO"
19 Added: let equal _ _ = failwith "TODO"
20 Added: let pp _ _ = failwith "TODO"
21 Added: end
22 Added:
23 Added: module Reps = struct
24 Added: type t = int
25 Added:
26 Added: let of_int _ = failwith "TODO"
27 Added: let to_int _ = failwith "TODO"
28 Added: let compare _ _ = failwith "TODO"
29 Added: let equal _ _ = failwith "TODO"
30 Added: let pp _ _ = failwith "TODO"
31 Added: end
32 Added:
33 Added: module Rep_range = struct
34 Added: type t = Reps.t * Reps.t
35 Added:
36 Added: let make ~min:_ ~max:_ = failwith "TODO"
37 Added: let min _ = failwith "TODO"
38 Added: let max _ = failwith "TODO"
39 Added: let contains _ _ = failwith "TODO"
40 Added: let equal _ _ = failwith "TODO"
41 Added: let pp _ _ = failwith "TODO"
42 Added: end
lib/core/units.mli
index 00000000..9089302d 000000..100644
@@ -0,0 +1,105 @@
1 Added: (** Core measurement types for hito.
2 Added:
3 Added: These types model the physical quantities recorded during training: the load
4 Added: on the bar ({!Weight}), the number of repetitions performed ({!Reps}), and a
5 Added: prescribed target repetition band ({!Rep_range}, e.g. Mentzer's 6-8).
6 Added:
7 Added: Every type in this module is [abstract]: values can only be created through
8 Added: smart constructors that reject nonsensical inputs (negative loads, zero or
9 Added: negative reps, inverted ranges). Once you hold a value of one of these
10 Added: types, it is guaranteed to be valid — illegal measurements are
11 Added: unrepresentable.
12 Added:
13 Added: This module is part of the pure domain core: it has no dependency on any web
14 Added: framework, database, or serialization library. *)
15 Added:
16 Added: (** A validation error explaining why a smart constructor rejected its input.
17 Added: Rendered for developers and, where appropriate, surfaced to users. *)
18 Added: type error =
19 Added: | Negative of string (** A quantity that must be >= 0 was negative. *)
20 Added: | Not_positive of string (** A quantity that must be > 0 was <= 0. *)
21 Added: | Inverted_range of string
22 Added: (** A range whose lower bound exceeded its upper bound. *)
23 Added:
24 Added: val pp_error : Format.formatter -> error -> unit
25 Added: (** [pp_error fmt e] pretty-prints a human-readable description of [e]. *)
26 Added:
27 Added: (** Barbell / dumbbell load, stored internally in kilograms.
28 Added:
29 Added: Weight is a nonnegative quantity: a body-weight movement may legitimately
30 Added: carry a load of [0.0], but a negative load is never valid. *)
31 Added: module Weight : sig
32 Added: type t
33 Added: (** An abstract, always-valid weight. *)
34 Added:
35 Added: val of_kg : float -> (t, error) result
36 Added: (** [of_kg kg] is [Ok w] when [kg] is finite and [>= 0.0], otherwise
37 Added: [Error (Negative _)]. *)
38 Added:
39 Added: val to_kg : t -> float
40 Added: (** [to_kg w] is the load of [w] expressed in kilograms. *)
41 Added:
42 Added: val zero : t
43 Added: (** [zero] is a load of [0.0] kg, for body-weight movements. *)
44 Added:
45 Added: val compare : t -> t -> int
46 Added: (** Total ordering by kilograms. *)
47 Added:
48 Added: val equal : t -> t -> bool
49 Added: (** [equal a b] is [true] when [a] and [b] denote the same load. *)
50 Added:
51 Added: val pp : Format.formatter -> t -> unit
52 Added: (** Pretty-prints a weight, e.g. ["60.0 kg"]. *)
53 Added: end
54 Added:
55 Added: (** A count of completed repetitions.
56 Added:
57 Added: Reps are a strictly positive whole number: a logged set has at least one
58 Added: rep. (An abandoned attempt is modelled elsewhere, not as zero reps.) *)
59 Added: module Reps : sig
60 Added: type t
61 Added: (** An abstract, always-valid repetition count. *)
62 Added:
63 Added: val of_int : int -> (t, error) result
64 Added: (** [of_int n] is [Ok r] when [n > 0], otherwise [Error (Not_positive _)]. *)
65 Added:
66 Added: val to_int : t -> int
67 Added: (** [to_int r] is the underlying repetition count. *)
68 Added:
69 Added: val compare : t -> t -> int
70 Added: (** Total ordering by count. *)
71 Added:
72 Added: val equal : t -> t -> bool
73 Added: (** [equal a b] is [true] when [a] and [b] denote the same count. *)
74 Added:
75 Added: val pp : Format.formatter -> t -> unit
76 Added: (** Pretty-prints a rep count, e.g. ["8 reps"]. *)
77 Added: end
78 Added:
79 Added: (** An inclusive target repetition band, such as Mentzer's canonical 6-8.
80 Added:
81 Added: A range is valid when its lower bound is [<=] its upper bound; both bounds
82 Added: are themselves valid {!Reps.t} values (hence strictly positive). *)
83 Added: module Rep_range : sig
84 Added: type t
85 Added: (** An abstract, always-valid inclusive rep range. *)
86 Added:
87 Added: val make : min:Reps.t -> max:Reps.t -> (t, error) result
88 Added: (** [make ~min ~max] is [Ok range] when [min <= max], otherwise
89 Added: [Error (Inverted_range _)]. *)
90 Added:
91 Added: val min : t -> Reps.t
92 Added: (** The inclusive lower bound. *)
93 Added:
94 Added: val max : t -> Reps.t
95 Added: (** The inclusive upper bound. *)
96 Added:
97 Added: val contains : t -> Reps.t -> bool
98 Added: (** [contains range r] is [true] when [r] falls within [range] inclusive. *)
99 Added:
100 Added: val equal : t -> t -> bool
101 Added: (** [equal a b] is [true] when [a] and [b] have equal bounds. *)
102 Added:
103 Added: val pp : Format.formatter -> t -> unit
104 Added: (** Pretty-prints a range, e.g. ["6-8 reps"]. *)
105 Added: end
lib/core/version.ml
index 00000000..40403c67 000000..100644
@@ -0,0 +1,1 @@
1 Added: let version = "0.1.0-dev"
lib/core/version.mli
index 00000000..31b9b94a 000000..100644
@@ -0,0 +1,5 @@
1 Added: (** Library metadata. A trivial module used to validate the build and test
2 Added: harness during Task 1. *)
3 Added:
4 Added: val version : string
5 Added: (** The current version string of the hito core library. *)
lib/core/workout.ml
index 00000000..ef4f398f 000000..100644
@@ -0,0 +1,35 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: module Prescribed = struct
4 Added: type t = unit
5 Added:
6 Added: type item = {
7 Added: prescription : Routine.Prescription.t;
8 Added: exercise : Exercise.t;
9 Added: target : Progression.target option;
10 Added: }
11 Added: [@@warning "-69"]
12 Added:
13 Added: type error = Not_substitutable of Exercise.error
14 Added:
15 Added: let create ~routine:_ ~substitutions:_ ~history:_ = failwith "TODO"
16 Added: let routine _ = failwith "TODO"
17 Added: let items _ = failwith "TODO"
18 Added: let pp _ _ = failwith "TODO"
19 Added: end
20 Added:
21 Added: module Logged = struct
22 Added: type t = unit
23 Added: type error = Exercise_not_prescribed of Exercise.id | Already_finished
24 Added:
25 Added: let start ~prescribed:_ ~session:_ = failwith "TODO"
26 Added: let add_group _ _ = failwith "TODO"
27 Added: let finish _ = failwith "TODO"
28 Added: let is_finished _ = failwith "TODO"
29 Added: let prescribed _ = failwith "TODO"
30 Added: let session _ = failwith "TODO"
31 Added: let groups _ = failwith "TODO"
32 Added: let guidance _ = failwith "TODO"
33 Added: let unperformed _ = failwith "TODO"
34 Added: let pp _ _ = failwith "TODO"
35 Added: end
lib/core/workout.mli
index 00000000..d0d613db 000000..100644
@@ -0,0 +1,57 @@
1 Added: (** A workout in its two states: {!Prescribed} (this session's plan) and
2 Added: {!Logged} (what happened). Distinct types with a one-way transition, so a
3 Added: plan can never be mistaken for a record. *)
4 Added:
5 Added: (** This session's plan: a routine instantiated with concrete targets. *)
6 Added: module Prescribed : sig
7 Added: type t
8 Added:
9 Added: type item = {
10 Added: prescription : Routine.Prescription.t;
11 Added: exercise : Exercise.t;
12 Added: (** The prescribed movement, or a chosen substitute. *)
13 Added: target : Progression.target option; (** [None] with nothing to beat yet. *)
14 Added: }
15 Added: (** One exercise's plan for this session. *)
16 Added:
17 Added: type error = Not_substitutable of Exercise.error
18 Added:
19 Added: val create :
20 Added: routine:Routine.t ->
21 Added: substitutions:(Exercise.id * Exercise.t) list ->
22 Added: history:(Exercise.id * Progression.sample) list ->
23 Added: (t, error) result
24 Added: (** Instantiate [routine] for this session, deriving targets from [history].
25 Added: *)
26 Added:
27 Added: val routine : t -> Routine.t
28 Added: val items : t -> item list
29 Added: val pp : Format.formatter -> t -> unit
30 Added: end
31 Added:
32 Added: (** The record of a performed session. *)
33 Added: module Logged : sig
34 Added: type t
35 Added: type error = Exercise_not_prescribed of Exercise.id | Already_finished
36 Added:
37 Added: val start : prescribed:Prescribed.t -> session:Recovery.session -> t
38 Added:
39 Added: val add_group : t -> Set_group.t -> (t, error) result
40 Added: (** Append a performed set group. *)
41 Added:
42 Added: val finish : t -> t
43 Added: (** Complete the workout; further groups are rejected. *)
44 Added:
45 Added: val is_finished : t -> bool
46 Added: val prescribed : t -> Prescribed.t
47 Added: val session : t -> Recovery.session
48 Added: val groups : t -> Set_group.t list
49 Added:
50 Added: val guidance : t -> (Exercise.t * Routine.Prescription.guidance) list
51 Added: (** What was performed, judged against the plan. *)
52 Added:
53 Added: val unperformed : t -> Exercise.t list
54 Added: (** Prescribed exercises with no logged set group. *)
55 Added:
56 Added: val pp : Format.formatter -> t -> unit
57 Added: end
lib/web/app.ml
index 00000000..00978acc 000000..100644
@@ -0,0 +1,7 @@
1 Added: (* The Eliom application. APP_PARAM (installed Eliom 12.1.0) requires
2 Added: application_name and global_data_path. *)
3 Added:
4 Added: include Eliom_registration.App (struct
5 Added: let application_name = "hito"
6 Added: let global_data_path = None
7 Added: end)
lib/web/app.mli
index 00000000..a5e875d8 000000..100644
@@ -0,0 +1,3 @@
1 Added: (** The Eliom client-server application instance for hito. *)
2 Added:
3 Added: include Eliom_registration.APP
lib/web/dune
index 00000000..e4507ab7 000000..100644
@@ -0,0 +1,6 @@
1 Added: (library
2 Added: (name hito_web)
3 Added: (public_name hito.web)
4 Added: (libraries hito.core hito.app eliom.server)
5 Added: (preprocess
6 Added: (pps eliom.ppx.server)))
lib/web/pages.ml
index 00000000..239ca2b2 000000..100644
@@ -0,0 +1,6 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Added:
3 Added: let choose_routine ~routines:_ = failwith "TODO"
4 Added: let log_workout ~workout:_ = failwith "TODO"
5 Added: let history ~records:_ = failwith "TODO"
6 Added: let recovery_warning ~error:_ = failwith "TODO"
lib/web/pages.mli
index 00000000..7a8661f1 000000..100644
@@ -0,0 +1,17 @@
1 Added: (** Page rendering. Pure view functions returning Eliom HTML; domain access goes
2 Added: through {!Hito_app.Service}. *)
3 Added:
4 Added: open Hito_app
5 Added:
6 Added: val choose_routine :
7 Added: routines:(Repository.routine_id * Hito_core.Routine.t) list ->
8 Added: Html_types.html Eliom_content.Html.elt
9 Added:
10 Added: val log_workout :
11 Added: workout:Hito_core.Workout.Logged.t -> Html_types.html Eliom_content.Html.elt
12 Added:
13 Added: val history :
14 Added: records:Repository.record list -> Html_types.html Eliom_content.Html.elt
15 Added:
16 Added: val recovery_warning :
17 Added: error:Hito_core.Recovery.error -> Html_types.html Eliom_content.Html.elt
lib/web/services.ml
index 00000000..7c170192 000000..100644
@@ -0,0 +1,52 @@
1 Added: (* Minimal stubs only; implementation deferred until after the review gate.
2 Added:
3 Added: Service *values* are declared here (so the routes exist and type-check), but
4 Added: handler registration is a no-op stub until the interfaces are approved. The
5 Added: .mli exposes only [register]. *)
6 Added:
7 Added: open Hito_app
8 Added:
9 Added: (* Domain identifiers cross the URL boundary via user_type. *)
10 Added: let routine_id_param =
11 Added: Eliom_parameter.user_type ~of_string:Repository.routine_id
12 Added: ~to_string:(fun (id : Repository.routine_id) -> (id :> string))
13 Added: "routine"
14 Added:
15 Added: (* GET / — choose a routine. *)
16 Added: let home =
17 Added: Eliom_service.create ~path:(Eliom_service.Path [ "" ])
18 Added: ~meth:(Eliom_service.Get Eliom_parameter.unit) ()
19 Added:
20 Added: (* GET /history — the workout history log. *)
21 Added: let history =
22 Added: Eliom_service.create ~path:(Eliom_service.Path [ "history" ])
23 Added: ~meth:(Eliom_service.Get Eliom_parameter.unit) ()
24 Added:
25 Added: (* POST — start the chosen routine's first workout (recovery-gated). *)
26 Added: let start_workout =
27 Added: Eliom_service.create ~path:Eliom_service.No_path
28 Added: ~meth:(Eliom_service.Post (Eliom_parameter.unit, routine_id_param))
29 Added: ()
30 Added:
31 Added: (* POST — append a set group to the in-progress workout. *)
32 Added: let log_group =
33 Added: Eliom_service.create ~path:Eliom_service.No_path
34 Added: ~meth:(Eliom_service.Post (Eliom_parameter.unit, Eliom_parameter.unit))
35 Added: ()
36 Added:
37 Added: (* POST — finish and persist; redirects to history. *)
38 Added: let finish_workout =
39 Added: Eliom_service.create ~path:Eliom_service.No_path
40 Added: ~meth:(Eliom_service.Post (Eliom_parameter.unit, Eliom_parameter.unit))
41 Added: ()
42 Added:
43 Added: let register () =
44 Added: (* Stub: real handler registration (App.register ~service ...) is deferred
45 Added: until the interfaces are approved. Reference the service values so the
46 Added: routes are retained. *)
47 Added: ignore home;
48 Added: ignore history;
49 Added: ignore start_workout;
50 Added: ignore log_group;
51 Added: ignore finish_workout;
52 Added: ()
lib/web/services.mli
index 00000000..aae1ccc7 000000..100644
@@ -0,0 +1,8 @@
1 Added: (** Eliom services for the single-user HD flow: choose routine -> log workout ->
2 Added: view history. GET services are bookmarkable read pages; POST services are
3 Added: side-effecting actions. In-progress workout state is held in a
4 Added: session-scoped {!Eliom_reference}. Only [register] is exposed — the service
5 Added: values' phantom types are an implementation detail. *)
6 Added:
7 Added: val register : unit -> unit
8 Added: (** Register all service handlers. Called once at module load. *)
test/dune
index 00000000..82c3e593 000000..100644
@@ -0,0 +1,3 @@
1 Added: (test
2 Added: (name test_hito)
3 Added: (libraries hito.core alcotest))
test/test_exercise.ml
index 00000000..61d7ff85 000000..100644
@@ -0,0 +1,63 @@
1 Added: (** Unit tests for {!Hito_core.Exercise}, authored against exercise.mli.
2 Added:
3 Added: NOTE: Not yet registered in the main runner (see test_units.ml for the
4 Added: rationale); wired in during implementation (Task 8). exercise.mli is the
5 Added: source of truth over these assertions. *)
6 Added:
7 Added: open Hito_core
8 Added:
9 Added: let get = function Some v -> v | None -> Alcotest.fail "expected Some"
10 Added:
11 Added: let catalog_tests =
12 Added: [
13 Added: ( "catalog is non-empty",
14 Added: `Quick,
15 Added: fun () ->
16 Added: Alcotest.(check bool)
17 Added: "has exercises" true
18 Added: (List.length Exercise.catalog > 0) );
19 Added: ( "every catalog exercise is findable by its id",
20 Added: `Quick,
21 Added: fun () ->
22 Added: List.iter
23 Added: (fun ex ->
24 Added: let looked_up = get (Exercise.find (Exercise.id ex)) in
25 Added: Alcotest.(check bool)
26 Added: "round-trips" true
27 Added: (Exercise.equal ex looked_up))
28 Added: Exercise.catalog );
29 Added: ]
30 Added:
31 Added: let substitution_tests =
32 Added: [
33 Added: ( "permitted substitute is accepted",
34 Added: `Quick,
35 Added: fun () ->
36 Added: (* Find any exercise that declares at least one permitted substitute. *)
37 Added: match
38 Added: List.find_opt
39 Added: (fun ex -> Exercise.permitted_substitutes ex <> [])
40 Added: Exercise.catalog
41 Added: with
42 Added: | None -> ()
43 Added: | Some original ->
44 Added: let candidate = List.hd (Exercise.permitted_substitutes original) in
45 Added: Alcotest.(check bool)
46 Added: "swap permitted" true
47 Added: (Result.is_ok (Exercise.substitute ~original ~candidate)) );
48 Added: ( "non-whitelisted substitute is rejected",
49 Added: `Quick,
50 Added: fun () ->
51 Added: match Exercise.catalog with
52 Added: | a :: b :: _
53 Added: when not (Exercise.may_substitute ~original:a ~candidate:b) ->
54 Added: Alcotest.(check bool)
55 Added: "swap rejected" true
56 Added: (Result.is_error (Exercise.substitute ~original:a ~candidate:b))
57 Added: | _ -> () );
58 Added: ]
59 Added:
60 Added: let suite =
61 Added: [
62 Added: ("exercise.catalog", catalog_tests); ("exercise.subst", substitution_tests);
63 Added: ]
test/test_hito.ml
index 00000000..682b382e 000000..100644
@@ -0,0 +1,13 @@
1 Added: (** Test harness entry point for hito.
2 Added:
3 Added: As the project grows, per-module test suites are registered here. For Task 1
4 Added: this contains a single trivial test proving the Alcotest harness is wired
5 Added: correctly. *)
6 Added:
7 Added: let test_version_is_nonempty () =
8 Added: Alcotest.(check bool)
9 Added: "version string is non-empty" true
10 Added: (String.length Hito_core.Version.version > 0)
11 Added:
12 Added: let harness_suite = [ ("version", `Quick, test_version_is_nonempty) ]
13 Added: let () = Alcotest.run "hito" [ ("harness", harness_suite) ]
test/test_progression.ml
index 00000000..dadc6d65 000000..100644
@@ -0,0 +1,48 @@
1 Added: (** Unit tests for {!Hito_core.Progression}, authored against progression.mli.
2 Added:
3 Added: NOTE: Not yet registered in the main runner; wired in during implementation
4 Added: (Task 8). progression.mli is the source of truth over these assertions.
5 Added:
6 Added: Under test: an improving history is [Progressing]; a flat/declining history
7 Added: is [Stalled]; the [beats] relation captures progressive overload. *)
8 Added:
9 Added: open Hito_core
10 Added:
11 Added: let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
12 Added:
13 Added: let sample kg reps : Progression.sample =
14 Added: { load = ok (Units.Weight.of_kg kg); reps = ok (Units.Reps.of_int reps) }
15 Added:
16 Added: let progression_tests =
17 Added: [
18 Added: ( "increasing weight progresses",
19 Added: `Quick,
20 Added: fun () ->
21 Added: let history = [ sample 80.0 6; sample 82.5 6 ] in
22 Added: Alcotest.(check bool)
23 Added: "progressing" true
24 Added: (Progression.evaluate ~history = Ok Progressing) );
25 Added: ( "more reps at same weight progresses",
26 Added: `Quick,
27 Added: fun () ->
28 Added: Alcotest.(check bool)
29 Added: "beats" true
30 Added: (Progression.beats ~previous:(sample 80.0 6) ~current:(sample 80.0 7))
31 Added: );
32 Added: ( "flat performance stalls",
33 Added: `Quick,
34 Added: fun () ->
35 Added: let history = [ sample 80.0 6; sample 80.0 6 ] in
36 Added: Alcotest.(check bool)
37 Added: "stalled" true
38 Added: (Progression.evaluate ~history = Ok Stalled) );
39 Added: ( "insufficient data is an error, not a status",
40 Added: `Quick,
41 Added: fun () ->
42 Added: Alcotest.(check bool)
43 Added: "single sample errors" true
44 Added: (Progression.evaluate ~history:[ sample 80.0 6 ]
45 Added: = Error Progression.Insufficient_data) );
46 Added: ]
47 Added:
48 Added: let suite = [ ("progression.evaluate", progression_tests) ]
test/test_recovery.ml
index 00000000..66dde9d2 000000..100644
@@ -0,0 +1,77 @@
1 Added: (** Unit tests for {!Hito_core.Recovery}, authored against recovery.mli.
2 Added:
3 Added: NOTE: Not yet registered in the main runner; wired in during implementation
4 Added: (Task 8). recovery.mli is the source of truth over these assertions.
5 Added:
6 Added: Under test: time-based (systemic) readiness via an injected fake clock, that
7 Added: an unrecovered state blocks the ordinary start, and that the override path
8 Added: always succeeds while recording the early-training fact. *)
9 Added:
10 Added: open Hito_core
11 Added:
12 Added: let fake_clock at : (module Recovery.CLOCK) =
13 Added: (module struct
14 Added: let now () = Recovery.timestamp_of_unix_seconds at
15 Added: end)
16 Added:
17 Added: let readiness_tests =
18 Added: [
19 Added: ( "fully elapsed window is Ready",
20 Added: `Quick,
21 Added: fun () ->
22 Added: let now = Recovery.timestamp_of_unix_seconds 1_000_000 in
23 Added: let last = Recovery.timestamp_of_unix_seconds 0 in
24 Added: let r =
25 Added: Recovery.evaluate_readiness ~now ~last_workout:last
26 Added: ~recommended:(Recovery.days 4)
27 Added: in
28 Added: Alcotest.(check bool) "ready" true (Recovery.is_ready r) );
29 Added: ( "within window is not Ready",
30 Added: `Quick,
31 Added: fun () ->
32 Added: let now = Recovery.timestamp_of_unix_seconds 3600 in
33 Added: let last = Recovery.timestamp_of_unix_seconds 0 in
34 Added: let r =
35 Added: Recovery.evaluate_readiness ~now ~last_workout:last
36 Added: ~recommended:(Recovery.days 4)
37 Added: in
38 Added: Alcotest.(check bool) "not ready" false (Recovery.is_ready r) );
39 Added: ]
40 Added:
41 Added: let gating_tests =
42 Added: [
43 Added: ( "unrecovered blocks ordinary start",
44 Added: `Quick,
45 Added: fun () ->
46 Added: let clock = fake_clock 3600 in
47 Added: let last = Some (Recovery.timestamp_of_unix_seconds 0) in
48 Added: let result =
49 Added: Recovery.start_session clock ~last_workout:last
50 Added: ~recommended:(Recovery.days 4)
51 Added: in
52 Added: Alcotest.(check bool) "blocked" true (Result.is_error result) );
53 Added: ( "first workout (no last) is always ready",
54 Added: `Quick,
55 Added: fun () ->
56 Added: let clock = fake_clock 3600 in
57 Added: let result =
58 Added: Recovery.start_session clock ~last_workout:None
59 Added: ~recommended:(Recovery.days 4)
60 Added: in
61 Added: Alcotest.(check bool) "allowed" true (Result.is_ok result) );
62 Added: ( "override always succeeds and records the reason",
63 Added: `Quick,
64 Added: fun () ->
65 Added: let clock = fake_clock 3600 in
66 Added: let last = Some (Recovery.timestamp_of_unix_seconds 0) in
67 Added: let session =
68 Added: Recovery.start_session_overriding_recovery clock ~last_workout:last
69 Added: ~recommended:(Recovery.days 4) ~acknowledged:"felt strong today"
70 Added: in
71 Added: Alcotest.(check bool)
72 Added: "override recorded" true
73 Added: (Option.is_some (Recovery.overridden_recovery session)) );
74 Added: ]
75 Added:
76 Added: let suite =
77 Added: [ ("recovery.readiness", readiness_tests); ("recovery.gating", gating_tests) ]
test/test_routine.ml
index 00000000..15ab9fa6 000000..100644
@@ -0,0 +1,39 @@
1 Added: (** Unit tests for {!Hito_core.Routine}, authored against routine.mli.
2 Added:
3 Added: NOTE: Not yet registered in the main runner; wired in during implementation
4 Added: (Task 8). routine.mli is the source of truth over these assertions.
5 Added:
6 Added: Under test: the HD presets build and are non-empty, a routine derives its
7 Added: trained muscle groups, and a prescription cannot widen the catalog's
8 Added: substitution whitelist. *)
9 Added:
10 Added: open Hito_core
11 Added:
12 Added: let preset_tests =
13 Added: [
14 Added: ( "ideal routine has prescriptions",
15 Added: `Quick,
16 Added: fun () ->
17 Added: Alcotest.(check bool)
18 Added: "non-empty" true
19 Added: (List.length (Routine.prescriptions Routine.ideal_routine) > 0) );
20 Added: ( "consolidation routine has prescriptions",
21 Added: `Quick,
22 Added: fun () ->
23 Added: Alcotest.(check bool)
24 Added: "non-empty" true
25 Added: (List.length (Routine.prescriptions Routine.consolidation_routine) > 0)
26 Added: );
27 Added: ]
28 Added:
29 Added: let make_tests =
30 Added: [
31 Added: ( "empty routine rejected",
32 Added: `Quick,
33 Added: fun () ->
34 Added: Alcotest.(check bool)
35 Added: "empty rejected" true
36 Added: (Result.is_error (Routine.make ~name:"Empty" ~prescriptions:[])) );
37 Added: ]
38 Added:
39 Added: let suite = [ ("routine.presets", preset_tests); ("routine.make", make_tests) ]
test/test_set.ml
index 00000000..7c1976cf 000000..100644
@@ -0,0 +1,59 @@
1 Added: (** Unit tests for {!Hito_core.Set}, authored against set.mli.
2 Added:
3 Added: NOTE: Not yet registered in the main runner; wired in during implementation
4 Added: (Task 8). set.mli is the source of truth over these assertions.
5 Added:
6 Added: Warm-up and working sets are distinct types (mismatch is a compile error,
7 Added: not a runtime assertion). A working set always reaches failure — the type
8 Added: only records how. *)
9 Added:
10 Added: open Hito_core
11 Added:
12 Added: let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
13 Added: let mk_w kg = ok (Units.Weight.of_kg kg)
14 Added: let mk_r n = ok (Units.Reps.of_int n)
15 Added:
16 Added: let some_exercise () =
17 Added: match Exercise.catalog with
18 Added: | ex :: _ -> ex
19 Added: | [] -> Alcotest.fail "catalog is empty"
20 Added:
21 Added: let set_tests =
22 Added: [
23 Added: ( "warm-up records load and reps",
24 Added: `Quick,
25 Added: fun () ->
26 Added: let w =
27 Added: Set.Warm_up.make ~exercise:(some_exercise ()) ~load:(mk_w 40.0)
28 Added: ~reps:(mk_r 10)
29 Added: in
30 Added: Alcotest.(check (float 0.0001))
31 Added: "load" 40.0
32 Added: (Units.Weight.to_kg (Set.Warm_up.load w)) );
33 Added: ( "working set exposes performance",
34 Added: `Quick,
35 Added: fun () ->
36 Added: let s =
37 Added: Set.Working.make ~exercise:(some_exercise ()) ~load:(mk_w 80.0)
38 Added: ~reps:(mk_r 7) ~outcome:Set.Working.Positive_failure
39 Added: in
40 Added: let p = Set.Working.performance s in
41 Added: Alcotest.(check (float 0.0001))
42 Added: "perf load" 80.0
43 Added: (Units.Weight.to_kg p.load) );
44 Added: ( "beyond-failure outcome is recorded",
45 Added: `Quick,
46 Added: fun () ->
47 Added: let s =
48 Added: Set.Working.make ~exercise:(some_exercise ()) ~load:(mk_w 80.0)
49 Added: ~reps:(mk_r 6)
50 Added: ~outcome:(Set.Working.Beyond_failure Set.Working.Rest_pause)
51 Added: in
52 Added: Alcotest.(check bool)
53 Added: "outcome is beyond-failure" true
54 Added: (match Set.Working.outcome s with
55 Added: | Set.Working.Beyond_failure _ -> true
56 Added: | _ -> false) );
57 Added: ]
58 Added:
59 Added: let suite = [ ("set", set_tests) ]
test/test_units.ml
index 00000000..bfada04c 000000..100644
@@ -0,0 +1,86 @@
1 Added: (** Unit tests for {!Hito_core.Units}, authored against the units.mli contract.
2 Added:
3 Added: NOTE: These tests exercise real behaviour and therefore only pass once the
4 Added: implementation is filled in (Task 8). They are intentionally NOT yet
5 Added: registered in the main test runner ([test_hito.ml]) so that [dune runtest]
6 Added: stays green during the interface-design phase. The [suite] value below is
7 Added: wired into the runner as part of the implementation task.
8 Added:
9 Added: Per project policy, units.mli is the source of truth: if any assertion here
10 Added: ever contradicts the interface, the interface wins and the test is fixed. *)
11 Added:
12 Added: open Hito_core
13 Added:
14 Added: let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok"
15 Added:
16 Added: let weight_tests =
17 Added: [
18 Added: ( "of_kg rejects negative",
19 Added: `Quick,
20 Added: fun () ->
21 Added: Alcotest.(check bool)
22 Added: "negative rejected" true
23 Added: (Result.is_error (Units.Weight.of_kg (-1.0))) );
24 Added: ( "of_kg accepts zero (bodyweight)",
25 Added: `Quick,
26 Added: fun () ->
27 Added: Alcotest.(check bool)
28 Added: "zero accepted" true
29 Added: (Result.is_ok (Units.Weight.of_kg 0.0)) );
30 Added: ( "round-trips kilograms",
31 Added: `Quick,
32 Added: fun () ->
33 Added: let w = ok (Units.Weight.of_kg 60.0) in
34 Added: Alcotest.(check (float 0.0001)) "60kg" 60.0 (Units.Weight.to_kg w) );
35 Added: ]
36 Added:
37 Added: let reps_tests =
38 Added: [
39 Added: ( "of_int rejects zero",
40 Added: `Quick,
41 Added: fun () ->
42 Added: Alcotest.(check bool)
43 Added: "zero rejected" true
44 Added: (Result.is_error (Units.Reps.of_int 0)) );
45 Added: ( "of_int rejects negative",
46 Added: `Quick,
47 Added: fun () ->
48 Added: Alcotest.(check bool)
49 Added: "negative rejected" true
50 Added: (Result.is_error (Units.Reps.of_int (-3))) );
51 Added: ( "of_int accepts positive",
52 Added: `Quick,
53 Added: fun () ->
54 Added: Alcotest.(check bool)
55 Added: "positive accepted" true
56 Added: (Result.is_ok (Units.Reps.of_int 8)) );
57 Added: ]
58 Added:
59 Added: let rep_range_tests =
60 Added: [
61 Added: ( "make rejects inverted range",
62 Added: `Quick,
63 Added: fun () ->
64 Added: let lo = ok (Units.Reps.of_int 8) in
65 Added: let hi = ok (Units.Reps.of_int 6) in
66 Added: Alcotest.(check bool)
67 Added: "inverted rejected" true
68 Added: (Result.is_error (Units.Rep_range.make ~min:lo ~max:hi)) );
69 Added: ( "make accepts 6-8 and contains 7",
70 Added: `Quick,
71 Added: fun () ->
72 Added: let lo = ok (Units.Reps.of_int 6) in
73 Added: let hi = ok (Units.Reps.of_int 8) in
74 Added: let seven = ok (Units.Reps.of_int 7) in
75 Added: let r = ok (Units.Rep_range.make ~min:lo ~max:hi) in
76 Added: Alcotest.(check bool)
77 Added: "contains 7" true
78 Added: (Units.Rep_range.contains r seven) );
79 Added: ]
80 Added:
81 Added: let suite =
82 Added: [
83 Added: ("units.weight", weight_tests);
84 Added: ("units.reps", reps_tests);
85 Added: ("units.rep_range", rep_range_tests);
86 Added: ]