[OCaml] High Intensity Training Online
refactor Remove warm-up tracking
Warm-up sets do not provide evidence for progression. Remove their\ncore model, service operation, web flow, and tests.
Changed files
lib/app/service.ml
@@ -88,16 +88,6 @@
88
88
Format.pp_print_string ppf "no workout in progress"
89
89
| Rejected e -> Evidence.Workout.pp_error ppf e
90
90
91
Removed:
let add_warm_up t warm_up =
92
Removed:
match t.current with
93
Removed:
| None -> Error No_workout_in_progress
94
Removed:
| Some workout -> (
95
Removed:
match Evidence.Workout.add_warm_up workout warm_up with
96
Removed:
| Error error -> Error (Rejected error)
97
Removed:
| Ok updated ->
98
Removed:
t.current <- Some updated;
99
Removed:
Ok updated)
100
Removed:
101
91
let log t stimulus =
102
92
match t.current with
103
93
| None -> Error No_workout_in_progress
lib/app/service.mli
@@ -60,10 +60,6 @@
60
60
61
61
val pp_log_error : Format.formatter -> log_error -> unit
62
62
63
Removed:
val add_warm_up :
64
Removed:
t -> Evidence.Stimulus.Warm_up.t -> (Evidence.Workout.t, log_error) result
65
Removed:
(** Record preparation before the first working stimulus. *)
66
Removed:
67
63
val log : t -> Evidence.Stimulus.t -> (Evidence.Workout.t, log_error) result
68
64
(** Record a stimulus against the workout in progress. *)
69
65
lib/core/evidence.ml
@@ -17,23 +17,6 @@
17
17
| Rest_pause -> "rest-pause"
18
18
| Static_hold -> "static hold")
19
19
20
Removed:
module Warm_up = struct
21
Removed:
type t = {
22
Removed:
exercise : Exercise.t;
23
Removed:
load : Units.Weight.t;
24
Removed:
reps : Units.Reps.t;
25
Removed:
}
26
Removed:
27
Removed:
let make ~exercise ~load ~reps = { exercise; load; reps }
28
Removed:
let exercise t = t.exercise
29
Removed:
let load t = t.load
30
Removed:
let reps t = t.reps
31
Removed:
32
Removed:
let pp ppf t =
33
Removed:
Format.fprintf ppf "%a %a x %a" Exercise.pp t.exercise Units.Weight.pp
34
Removed:
t.load Units.Reps.pp t.reps
35
Removed:
end
36
Removed:
37
20
module Movement = struct
38
21
type t = {
39
22
exercise : Exercise.t;
@@ -154,7 +137,6 @@
154
137
prescribed : shape;
155
138
logged : shape;
156
139
}
157
Removed:
| Warm_ups_after_working_stimulus
158
140
| Not_finished
159
141
160
142
type t = {
@@ -163,7 +145,6 @@
163
145
started_at : Recovery.timestamp;
164
146
ended_at : Recovery.timestamp option;
165
147
feedback : Feedback.t option;
166
Removed:
warm_ups : Stimulus.Warm_up.t list;
167
148
performed : (int * Stimulus.t) list;
168
149
}
169
150
@@ -179,8 +160,6 @@
179
160
Format.fprintf ppf "%s is prescribed as %a but was logged as %a"
180
161
(exercise :> string)
181
162
pp_shape prescribed pp_shape logged
182
Removed:
| Warm_ups_after_working_stimulus ->
183
Removed:
Format.pp_print_string ppf "warm-ups belong only before working stimuli"
184
163
| Not_finished -> Format.pp_print_string ppf "this workout is not finished"
185
164
186
165
let start prescription ~clearance ~started_at =
@@ -190,7 +169,6 @@
190
169
started_at;
191
170
ended_at = None;
192
171
feedback = None;
193
Removed:
warm_ups = [];
194
172
performed = [];
195
173
}
196
174
@@ -200,7 +178,6 @@
200
178
let ended_at t = t.ended_at
201
179
let is_finished t = Option.is_some t.ended_at
202
180
let feedback t = t.feedback
203
Removed:
let warm_ups t = List.rev t.warm_ups
204
181
let stimuli t = List.map snd (List.rev t.performed)
205
182
206
183
let duration t =
@@ -247,10 +224,6 @@
247
224
248
225
let unperformed t = List.map snd (outstanding t)
249
226
let completeness t = if outstanding t = [] then Complete else Incomplete
250
Removed:
251
Removed:
let add_warm_up t warm_up =
252
Removed:
if t.performed <> [] then Error Warm_ups_after_working_stimulus
253
Removed:
else Ok { t with warm_ups = warm_up :: t.warm_ups }
254
227
255
228
let add_stimulus t s =
256
229
let candidates = List.filter (fun (_, p) -> mentions p s) (indexed t) in
lib/core/evidence.mli
@@ -12,19 +12,6 @@
12
12
val extensions_of_outcome : outcome -> extension list
13
13
val pp_extension : Format.formatter -> extension -> unit
14
14
15
Removed:
(** Preparation; it has no failure outcome. *)
16
Removed:
module Warm_up : sig
17
Removed:
type t
18
Removed:
19
Removed:
val make :
20
Removed:
exercise:Exercise.t -> load:Units.Weight.t -> reps:Units.Reps.t -> t
21
Removed:
22
Removed:
val exercise : t -> Exercise.t
23
Removed:
val load : t -> Units.Weight.t
24
Removed:
val reps : t -> Units.Reps.t
25
Removed:
val pp : Format.formatter -> t -> unit
26
Removed:
end
27
Removed:
28
15
module Movement : sig
29
16
type t
30
17
@@ -121,7 +108,6 @@
121
108
prescribed : shape;
122
109
logged : shape;
123
110
}
124
Removed:
| Warm_ups_after_working_stimulus
125
111
| Not_finished
126
112
127
113
val pp_error : Format.formatter -> error -> unit
@@ -132,11 +118,8 @@
132
118
started_at:Recovery.timestamp ->
133
119
t
134
120
135
Removed:
val add_warm_up : t -> Stimulus.Warm_up.t -> (t, error) result
136
Removed:
(** Preparation is allowed only before working stimuli. *)
137
Removed:
138
121
val add_stimulus : t -> Stimulus.t -> (t, error) result
139
Removed:
(** Warm-ups are allowed only on the first recorded stimulus. *)
122
Added:
(** Records a working stimulus. *)
140
123
141
124
val finish : t -> ended_at:Recovery.timestamp -> t
142
125
(** Sets [ended_at] once; later calls retain the first value. *)
@@ -152,7 +135,6 @@
152
135
val duration : t -> Recovery.duration option
153
136
val completeness : t -> completeness
154
137
val feedback : t -> Feedback.t option
155
Removed:
val warm_ups : t -> Stimulus.Warm_up.t list
156
138
157
139
val stimuli : t -> Stimulus.t list
158
140
(** Performance order. *)
lib/web/pages.ml
@@ -242,45 +242,6 @@
242
242
();
243
243
]
244
244
245
Removed:
let preparation_form exercise =
246
Removed:
Form.post_form ~service:Routes.warm_up
247
Removed:
(fun (exercise_name, (load_name, reps_name)) ->
248
Removed:
[
249
Removed:
fieldset
250
Removed:
~legend:(legend [ txt "Preparation" ])
251
Removed:
[
252
Removed:
p
253
Removed:
[
254
Removed:
txt
255
Removed:
("Warm up for the workout with " ^ Exercise.name exercise
256
Removed:
^ ".");
257
Removed:
];
258
Removed:
Form.input ~input_type:`Hidden ~name:exercise_name
259
Removed:
~value:(Exercise.id exercise :> string)
260
Removed:
Form.string;
261
Removed:
div
262
Removed:
~a:[ a_class [ "row" ] ]
263
Removed:
[
264
Removed:
div
265
Removed:
[
266
Removed:
label [ txt "Load (kg)" ];
267
Removed:
Form.input
268
Removed:
~a:[ a_step (Some 0.5); a_required () ]
269
Removed:
~input_type:`Number ~name:load_name Form.float;
270
Removed:
];
271
Removed:
div
272
Removed:
[
273
Removed:
label [ txt "Reps" ];
274
Removed:
Form.input
275
Removed:
~a:[ a_required () ]
276
Removed:
~input_type:`Number ~name:reps_name Form.int;
277
Removed:
];
278
Removed:
];
279
Removed:
Form.input ~input_type:`Submit ~value:"Record warm-up" Form.string;
280
Removed:
];
281
Removed:
])
282
Removed:
()
283
Removed:
284
245
let single_form ~workout_id ~slot ~prescription =
285
246
Form.post_form ~service:Routes.log_single
286
247
(fun ( workout_name,
@@ -403,19 +364,7 @@
403
364
let prescription = Evidence.Workout.prescription workout in
404
365
let workout_id = Option.value ~default:"" record_id in
405
366
let performed = Evidence.Workout.stimuli workout in
406
Removed:
let warm_ups = Evidence.Workout.warm_ups workout in
407
367
let outstanding = Evidence.Workout.outstanding workout in
408
Removed:
let preparation =
409
Removed:
match (record_id, performed, Prescription.Workout.stimuli prescription) with
410
Removed:
| None, [], first :: _ ->
411
Removed:
let exercise =
412
Removed:
match Prescription.Stimulus.delivery first with
413
Removed:
| Prescription.Stimulus.Single exercise -> exercise
414
Removed:
| Prescription.Stimulus.Pre_exhaust { isolation; _ } -> isolation
415
Removed:
in
416
Removed:
[ preparation_form exercise ]
417
Removed:
| _ -> []
418
Removed:
in
419
368
let override_note =
420
369
match Recovery.basis (Evidence.Workout.clearance workout) with
421
370
| Recovery.Recovered -> []
@@ -438,22 +387,6 @@
438
387
(List.length (Prescription.Workout.stimuli prescription)));
439
388
];
440
389
]
441
Removed:
@ preparation
442
Removed:
@ (if warm_ups = [] then []
443
Removed:
else
444
Removed:
[
445
Removed:
h2 [ txt "Preparation recorded" ];
446
Removed:
ul
447
Removed:
(List.map
448
Removed:
(fun warm_up ->
449
Removed:
li
450
Removed:
[
451
Removed:
txt
452
Removed:
(Format.asprintf "%a" Evidence.Stimulus.Warm_up.pp
453
Removed:
warm_up);
454
Removed:
])
455
Removed:
warm_ups);
456
Removed:
])
457
390
@ (if performed = [] then []
458
391
else
459
392
[
lib/web/routes.ml
@@ -70,15 +70,6 @@
70
70
** string "extension" ** string "note") ))
71
71
()
72
72
73
Removed:
(* POST /warm-up — one preparatory movement before working stimuli. *)
74
Removed:
let warm_up =
75
Removed:
Eliom_service.create ~path:(Eliom_service.Path [ "warm-up" ])
76
Removed:
~meth:
77
Removed:
(Eliom_service.Post
78
Removed:
( Eliom_parameter.unit,
79
Removed:
Eliom_parameter.(string "exercise" ** float "load" ** int "reps") ))
80
Removed:
()
81
Removed:
82
73
(* POST /log-pair — an isolation carried into a compound, no pause between. *)
83
74
let log_pair =
84
75
Eliom_service.create ~path:(Eliom_service.Path [ "log-pair" ])
lib/web/services.ml
@@ -187,31 +187,6 @@
187
187
List.assoc_opt slot (Evidence.Workout.outstanding workout)
188
188
|> Option.map (fun p -> (record_id, p))
189
189
in
190
Removed:
let warm_ups_of_text ~exercise text =
191
Removed:
let warm_up line =
192
Removed:
match String.split_on_char ',' (String.trim line) with
193
Removed:
| [ load; reps ] -> (
194
Removed:
try
195
Removed:
let load = float_of_string (String.trim load) in
196
Removed:
let reps = int_of_string (String.trim reps) in
197
Removed:
match (Units.Weight.of_kg load, Units.Reps.of_int reps) with
198
Removed:
| Ok load, Ok reps ->
199
Removed:
Ok (Evidence.Stimulus.Warm_up.make ~exercise ~load ~reps)
200
Removed:
| Error error, _ | _, Error error ->
201
Removed:
Error (Format.asprintf "%a" Units.pp_error error)
202
Removed:
with Failure _ -> Error "Each warm-up must be load,reps.")
203
Removed:
| _ -> Error "Each warm-up must be load,reps."
204
Removed:
in
205
Removed:
List.fold_right
206
Removed:
(fun line result ->
207
Removed:
if String.trim line = "" then result
208
Removed:
else
209
Removed:
match (warm_up line, result) with
210
Removed:
| Ok warm_up, Ok warm_ups -> Ok (warm_up :: warm_ups)
211
Removed:
| Error error, _ | _, Error error -> Error error)
212
Removed:
(String.split_on_char '\n' text)
213
Removed:
(Ok [])
214
Removed:
in
215
190
let save_stimulus record_id stimulus =
216
191
match record_id with
217
192
| None ->
@@ -238,32 +213,6 @@
238
213
Pages.problem ~title:"That is not what was prescribed"
239
214
~detail:(Format.asprintf "%a" Evidence.Workout.pp_error error))
240
215
in
241
Removed:
242
Removed:
Eliom_registration.Html.register ~service:Routes.warm_up
243
Removed:
(fun () (exercise_id, (load, reps)) ->
244
Removed:
match Exercise.find exercise_id with
245
Removed:
| None ->
246
Removed:
Lwt.return
247
Removed:
(Pages.problem ~title:"Unknown warm-up exercise"
248
Removed:
~detail:"Choose an exercise from the workout.")
249
Removed:
| Some exercise -> (
250
Removed:
match
251
Removed:
warm_ups_of_text ~exercise (Printf.sprintf "%g,%d" load reps)
252
Removed:
with
253
Removed:
| Error detail ->
254
Removed:
Lwt.return (Pages.problem ~title:"Unusable figures" ~detail)
255
Removed:
| Ok [ warm_up ] ->
256
Removed:
Lwt.return
257
Removed:
(match Service.add_warm_up service warm_up with
258
Removed:
| Ok workout -> Pages.log_workout ~record_id:None ~workout
259
Removed:
| Error Service.No_workout_in_progress ->
260
Removed:
Pages.problem ~title:"No workout in progress"
261
Removed:
~detail:"Choose a routine to begin one."
262
Removed:
| Error (Service.Rejected error) ->
263
Removed:
Pages.problem ~title:"Preparation is closed"
264
Removed:
~detail:
265
Removed:
(Format.asprintf "%a" Evidence.Workout.pp_error error))
266
Removed:
| Ok _ -> assert false));
267
216
268
217
Eliom_registration.Html.register ~service:Routes.log_single
269
218
(fun () (workout_id, (slot, (load, (reps, (extension, note))))) ->
test/test_evidence.ml
@@ -450,27 +450,6 @@
450
450
451
451
let completion_feedback_tests =
452
452
[
453
Removed:
( "warm-ups belong to the workout and precede working stimuli",
454
Removed:
`Quick,
455
Removed:
fun () ->
456
Removed:
let warm_up load count =
457
Removed:
Stimulus.Warm_up.make ~exercise:(get "dumbbell-flyes") ~load:(kg load)
458
Removed:
~reps:(reps count)
459
Removed:
in
460
Removed:
let workout =
461
Removed:
fresh () |> fun workout ->
462
Removed:
ok (Workout.add_warm_up workout (warm_up 10. 12)) |> fun workout ->
463
Removed:
ok (Workout.add_warm_up workout (warm_up 15. 8))
464
Removed:
in
465
Removed:
Alcotest.(check int)
466
Removed:
"two workout warm-ups" 2
467
Removed:
(List.length (Workout.warm_ups workout));
468
Removed:
let workout =
469
Removed:
ok (Workout.add_stimulus workout (List.hd day_one_stimuli))
470
Removed:
in
471
Removed:
match Workout.add_warm_up workout (warm_up 20. 6) with
472
Removed:
| Error Workout.Warm_ups_after_working_stimulus -> ()
473
Removed:
| _ -> Alcotest.fail "expected preparation ordering rejection" );
474
453
( "notes are retained on working stimuli",
475
454
`Quick,
476
455
fun () ->
test/test_service.ml
@@ -162,23 +162,6 @@
162
162
Alcotest.(check bool)
163
163
"slot cleared" true
164
164
(Option.is_none (S.in_progress s)) );
165
Removed:
( "preparation is recorded before, but refused after, a working stimulus",
166
Removed:
`Quick,
167
Removed:
fun () ->
168
Removed:
let s = service () in
169
Removed:
ignore (ok (S.begin_workout s ~routine:ideal ~now:(day 1) ()));
170
Removed:
let warm_up =
171
Removed:
Stimulus.Warm_up.make ~exercise:(get "dumbbell-flyes") ~load:(kg 10.)
172
Removed:
~reps:(reps 12)
173
Removed:
in
174
Removed:
let workout = ok (S.add_warm_up s warm_up) in
175
Removed:
Alcotest.(check int)
176
Removed:
"one warm-up" 1
177
Removed:
(List.length (Workout.warm_ups workout));
178
Removed:
ignore (ok (S.log s (List.hd day_one_stimuli)));
179
Removed:
match S.add_warm_up s warm_up with
180
Removed:
| Error (S.Rejected Workout.Warm_ups_after_working_stimulus) -> ()
181
Removed:
| _ -> Alcotest.fail "expected preparation ordering rejection" );
182
165
( "history returns the finished workout",
183
166
`Quick,
184
167
fun () ->