feat implement Warm_up and Working

Both are plain records; the invariant that matters here is the type split itself (a warm-up cannot carry an outcome), not field validation, so there is nothing for a smart constructor to check.

Commit
9a271fec390f9a08f4f3b675759bb618d02c2d19
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
lib/core/set.ml
index 54175099..779e08ed 100644..100644
@@ -1,28 +1,46 @@
1 Removed: (* Minimal stubs only; implementation deferred until after the review gate. *)
2 Removed:
3 1 module Warm_up = struct
4 Removed: type t = unit
2 Added: type t = { exercise : Exercise.t; load : Units.Weight.t; reps : Units.Reps.t }
5 3
6 Removed: let make ~exercise:_ ~load:_ ~reps:_ = failwith "TODO"
7 Removed: let exercise _ = failwith "TODO"
8 Removed: let load _ = failwith "TODO"
9 Removed: let reps _ = failwith "TODO"
10 Removed: let pp _ _ = failwith "TODO"
4 Added: let make ~exercise ~load ~reps = { exercise; load; reps }
5 Added: let exercise t = t.exercise
6 Added: let load t = t.load
7 Added: let reps t = t.reps
8 Added:
9 Added: let pp fmt t =
10 Added: Format.fprintf fmt "%a: %a x %a" Exercise.pp t.exercise Units.Weight.pp
11 Added: t.load Units.Reps.pp t.reps
11 12 end
12 13
13 14 module Working = struct
14 15 type extension = Forced_reps | Negatives | Rest_pause | Static_hold
15 16 type outcome = Positive_failure | Beyond_failure of extension
16 Removed: type t = unit
17 17
18 Removed: let make ~exercise:_ ~load:_ ~reps:_ ~outcome:_ = failwith "TODO"
19 Removed: let exercise _ = failwith "TODO"
20 Removed: let load _ = failwith "TODO"
21 Removed: let reps _ = failwith "TODO"
22 Removed: let outcome _ = failwith "TODO"
23 Removed: let pp _ _ = failwith "TODO"
18 Added: type t = {
19 Added: exercise : Exercise.t;
20 Added: load : Units.Weight.t;
21 Added: reps : Units.Reps.t;
22 Added: outcome : outcome;
23 Added: }
24 24
25 Added: let make ~exercise ~load ~reps ~outcome = { exercise; load; reps; outcome }
26 Added: let exercise t = t.exercise
27 Added: let load t = t.load
28 Added: let reps t = t.reps
29 Added: let outcome t = t.outcome
30 Added:
31 Added: let pp_outcome fmt = function
32 Added: | Positive_failure -> Format.pp_print_string fmt "positive failure"
33 Added: | Beyond_failure Forced_reps -> Format.pp_print_string fmt "forced reps"
34 Added: | Beyond_failure Negatives -> Format.pp_print_string fmt "negatives"
35 Added: | Beyond_failure Rest_pause -> Format.pp_print_string fmt "rest-pause"
36 Added: | Beyond_failure Static_hold -> Format.pp_print_string fmt "static hold"
37 Added:
38 Added: let pp fmt t =
39 Added: Format.fprintf fmt "%a: %a x %a (%a)" Exercise.pp t.exercise Units.Weight.pp
40 Added: t.load Units.Reps.pp t.reps pp_outcome t.outcome
41 Added:
25 42 type performance = { load : Units.Weight.t; reps : Units.Reps.t }
26 43
27 Removed: let performance _ = failwith "TODO"
44 Added: let performance (working : t) : performance =
45 Added: { load = working.load; reps = working.reps }
28 46 end
test/test_hito.ml
index 0eb391ec..c83189e6 100644..100644
@@ -1,4 +1,5 @@
1 1 (** Test harness entry point. Per-module suites are registered here as their
2 2 implementations land. *)
3 3
4 Removed: let () = Alcotest.run "hito" (Test_units.suite @ Test_exercise.suite)
4 Added: let () =
5 Added: Alcotest.run "hito" (Test_units.suite @ Test_exercise.suite @ Test_set.suite)