[OCaml] High Intensity Training Online
feat validate efforts in the core, not only at the form
Evidence.Stimulus.Effort.make now returns a result and is the only constructor. It refuses a load that is not finite or is negative, a rep count below one, and an extension that counts zero. Zero load stays valid: it is a bodyweight movement. The rule lived only in the web form decoder, so an import, a stored record, or a direct construction could mint an effort the doctrine cannot read. Holding the invariant in the core makes that state unrepresentable everywhere. Each boundary now answers the core's refusal in its own terms. The form decoder maps it onto the field it concerns. The stored-record codecs report a malformed record. Restoring an import snapshot yields a typed Invalid_effort. The Hevy adapter applies the same rule at the trust boundary, so a row with zero reps or a negative weight becomes a warning rather than a rejected effort later.
Changed files
- lib/app/workout_import.ml
- lib/app/workout_import.mli
- lib/core/evidence.ml
- lib/core/evidence.mli
- lib/import/hevy_csv.ml
- lib/persistence/codec.ml
- lib/persistence/import_codec.ml
- lib/web/decode.ml
- test/test_codec.ml
- test/test_evidence.ml
- test/test_hevy_csv.ml
- test/test_import_codec.ml
- test/test_import_repo.ml
- test/test_import_sqlite.ml
- test/test_progression.ml
- test/test_service.ml
- test/test_sqlite_repo.ml
- test/web/logbook.ml
lib/app/workout_import.ml
@@ -236,8 +236,15 @@
236
236
assert false
237
237
in
238
238
let effort =
239
Removed:
Evidence.Stimulus.Effort.make ~exercise ~load:s.weight_kg ~reps:s.reps
240
Removed:
~outcome:Evidence.Stimulus.Positive_failure
239
Added:
match
240
Added:
Evidence.Stimulus.Effort.make ~exercise ~load:s.weight_kg ~reps:s.reps
241
Added:
~outcome:Evidence.Stimulus.Positive_failure
242
Added:
with
243
Added:
| Ok effort -> effort
244
Added:
| Error _ ->
245
Added:
(* Unreachable: the adapter admits only a finite nonnegative load and at
246
Added:
least one rep, the same rule [Effort.make] enforces. *)
247
Added:
assert false
241
248
in
242
249
Evidence.Observation.make ~exercise ~effort ~performed_at:w.ended_at
243
250
@@ -345,7 +352,12 @@
345
352
warnings : warning list;
346
353
}
347
354
348
Removed:
type restore_error = Unknown_exercise of string | Invalid_time
355
Added:
type restore_error =
356
Added:
| Unknown_exercise of string
357
Added:
| Invalid_time
358
Added:
| Invalid_effort of Evidence.Stimulus.Effort.error
359
Added:
(** A stored observation the core refuses: a nonsensical load or rep
360
Added:
count. The snapshot is corrupt, not merely stale. *)
349
361
350
362
(* A promoted observation is always a single failure effort, so its snapshot
351
363
drops the delivery and the outcome. *)
@@ -416,9 +428,11 @@
416
428
=
417
429
let restore_observation (o : observation_snapshot) =
418
430
let* exercise = resolve find_exercise o.exercise_id in
419
Removed:
let effort =
420
Removed:
Evidence.Stimulus.Effort.make ~exercise ~load:o.load ~reps:o.reps
421
Removed:
~outcome:Evidence.Stimulus.Positive_failure
431
Added:
let* effort =
432
Added:
Result.map_error
433
Added:
(fun e -> Invalid_effort e)
434
Added:
(Evidence.Stimulus.Effort.make ~exercise ~load:o.load ~reps:o.reps
435
Added:
~outcome:Evidence.Stimulus.Positive_failure)
422
436
in
423
437
Ok
424
438
(Evidence.Observation.make ~exercise ~effort ~performed_at:o.performed_at)
lib/app/workout_import.mli
@@ -255,6 +255,9 @@
255
255
| Unknown_exercise of string
256
256
(** A stored exercise id is not in the catalog. *)
257
257
| Invalid_time (** A stored [ended_at] precedes its [started_at]. *)
258
Added:
| Invalid_effort of Evidence.Stimulus.Effort.error
259
Added:
(** A stored observation the core refuses: a nonsensical load or rep
260
Added:
count. The snapshot is corrupt, not merely stale. *)
258
261
259
262
val snapshot : batch -> snapshot
260
263
(** A serialization-neutral view of the batch, including any prior promotion. *)
lib/core/evidence.ml
@@ -22,7 +22,39 @@
22
22
outcome : outcome;
23
23
}
24
24
25
Removed:
let make ~exercise ~load ~reps ~outcome = { exercise; load; reps; outcome }
25
Added:
type error =
26
Added:
| Load_not_finite
27
Added:
| Negative_load of float
28
Added:
| No_reps of int
29
Added:
| Empty_extension of extension
30
Added:
31
Added:
let pp_error ppf = function
32
Added:
| Load_not_finite -> Format.pp_print_string ppf "load is not a number"
33
Added:
| Negative_load load -> Format.fprintf ppf "negative load %g kg" load
34
Added:
| No_reps reps ->
35
Added:
Format.fprintf ppf "%d reps: a set has at least one" reps
36
Added:
| Empty_extension e ->
37
Added:
Format.fprintf ppf "%a: an extension counts at least one" pp_extension
38
Added:
e
39
Added:
40
Added:
(* An extension past failure is a count of work done, so it is at least
41
Added:
one. Zero forced reps is no extension at all. *)
42
Added:
let extension_count = function
43
Added:
| Forced_reps n | Negatives n | Static_hold n -> n
44
Added:
45
Added:
let make ~exercise ~load ~reps ~outcome =
46
Added:
if not (Float.is_finite load) then Error Load_not_finite
47
Added:
else if load < 0. then Error (Negative_load load)
48
Added:
else if reps < 1 then Error (No_reps reps)
49
Added:
else
50
Added:
match
51
Added:
List.find_opt
52
Added:
(fun e -> extension_count e < 1)
53
Added:
(extensions_of_outcome outcome)
54
Added:
with
55
Added:
| Some e -> Error (Empty_extension e)
56
Added:
| None -> Ok { exercise; load; reps; outcome }
57
Added:
26
58
let exercise t = t.exercise
27
59
let load t = t.load
28
60
let reps t = t.reps
lib/core/evidence.mli
@@ -22,8 +22,26 @@
22
22
module Effort : sig
23
23
type t
24
24
25
Added:
type error =
26
Added:
| Load_not_finite
27
Added:
| Negative_load of float
28
Added:
| No_reps of int (** A set taken to failure has at least one rep. *)
29
Added:
| Empty_extension of extension
30
Added:
(** An extension counts work done past failure, so it is at least one.
31
Added:
Zero forced reps is no extension. *)
32
Added:
33
Added:
val pp_error : Format.formatter -> error -> unit
34
Added:
25
35
val make :
26
Removed:
exercise:Exercise.t -> load:float -> reps:int -> outcome:outcome -> t
36
Added:
exercise:Exercise.t ->
37
Added:
load:float ->
38
Added:
reps:int ->
39
Added:
outcome:outcome ->
40
Added:
(t, error) result
41
Added:
(** The only constructor. Load is finite and nonnegative — zero is a
42
Added:
bodyweight movement — and reps is at least one. This holds the invariant
43
Added:
in the core, so no boundary (form, import, stored record) can produce an
44
Added:
effort the doctrine cannot read. *)
27
45
28
46
val exercise : t -> Exercise.t
29
47
val load : t -> float
lib/import/hevy_csv.ml
@@ -197,11 +197,24 @@
197
197
| Some f when Float.is_finite f -> Some f
198
198
| _ -> None
199
199
200
Added:
(* A load: finite and nonnegative. Zero is a bodyweight movement. This is the
201
Added:
rule {!Evidence.Stimulus.Effort.make} enforces, applied at the trust
202
Added:
boundary so a bad row becomes a warning, never a rejected effort later. *)
203
Added:
let load_opt s =
204
Added:
match finite_float_opt s with Some f when f >= 0. -> Some f | _ -> None
205
Added:
200
206
let nonneg_int_opt s =
201
207
match int_of_string_opt (String.trim s) with
202
208
| Some i when i >= 0 -> Some i
203
209
| _ -> None
204
210
211
Added:
(* A rep count: at least one. A set taken to failure has at least one rep,
212
Added:
which is the rule {!Evidence.Stimulus.Effort.make} enforces. *)
213
Added:
let reps_opt s =
214
Added:
match int_of_string_opt (String.trim s) with
215
Added:
| Some i when i >= 1 -> Some i
216
Added:
| _ -> None
217
Added:
205
218
(* The grouping key: the exact triple that identifies a workout. *)
206
219
type key = string * string * string
207
220
@@ -255,12 +268,13 @@
255
268
in
256
269
match
257
270
( nonneg_int_opt (get "set_index"),
258
Removed:
finite_float_opt (get "weight_kg"),
259
Removed:
nonneg_int_opt (get "reps") )
271
Added:
load_opt (get "weight_kg"),
272
Added:
reps_opt (get "reps") )
260
273
with
261
274
| None, _, _ -> warn "invalid set_index"
262
Removed:
| _, None, _ -> warn "missing or non-finite weight_kg"
263
Removed:
| _, _, None -> warn "missing or negative reps"
275
Added:
| _, None, _ ->
276
Added:
warn "missing, negative, or non-finite weight_kg"
277
Added:
| _, _, None -> warn "missing reps or fewer than one"
264
278
| Some set_index, Some weight_kg, Some reps ->
265
279
let set : WI.source_set =
266
280
{
lib/persistence/codec.ml
@@ -92,7 +92,12 @@
92
92
match (float_of_string_opt load, int_of_string_opt reps) with
93
93
| Some load, Some reps ->
94
94
let* outcome = decode_outcome outcome in
95
Removed:
Ok (Evidence.Stimulus.Effort.make ~exercise ~load ~reps ~outcome)
95
Added:
Result.map_error
96
Added:
(fun e ->
97
Added:
Malformed
98
Added:
(Format.asprintf "effort %a"
99
Added:
Evidence.Stimulus.Effort.pp_error e))
100
Added:
(Evidence.Stimulus.Effort.make ~exercise ~load ~reps ~outcome)
96
101
| _ -> Error (Malformed "effort load/reps")))
97
102
| _ -> Error (Malformed "effort arity")
98
103
lib/persistence/import_codec.ml
@@ -309,6 +309,9 @@
309
309
let restore_error : WI.restore_error -> error = function
310
310
| WI.Unknown_exercise id -> Unknown_exercise id
311
311
| WI.Invalid_time -> Invalid_time
312
Added:
| WI.Invalid_effort e ->
313
Added:
Malformed
314
Added:
(Format.asprintf "observation %a" Evidence.Stimulus.Effort.pp_error e)
312
315
313
316
let decode_snapshot ~find_exercise text =
314
317
match Reader.run text read_snapshot with
@@ -365,8 +368,16 @@
365
368
let reps = Reader.int r in
366
369
let performed_at = Reader.timestamp r in
367
370
let effort =
368
Removed:
Evidence.Stimulus.Effort.make ~exercise ~load ~reps
369
Removed:
~outcome:Evidence.Stimulus.Positive_failure
371
Added:
match
372
Added:
Evidence.Stimulus.Effort.make ~exercise ~load ~reps
373
Added:
~outcome:Evidence.Stimulus.Positive_failure
374
Added:
with
375
Added:
| Ok effort -> effort
376
Added:
| Error e ->
377
Added:
raise
378
Added:
(Reader.Bad
379
Added:
(Format.asprintf "observation %a"
380
Added:
Evidence.Stimulus.Effort.pp_error e))
370
381
in
371
382
Evidence.Observation.make ~exercise ~effort ~performed_at)
372
383
r
lib/web/decode.ml
@@ -57,6 +57,25 @@
57
57
and+ extension = ending in
58
58
Pair { iso_load; iso_reps; comp_load; comp_reps; extension }
59
59
60
Added:
(* Lift the core's refusal of an effort into a form error on the field it
61
Added:
concerns. The field validators above already enforce the same rules, so this
62
Added:
path is a safety net: if the core ever tightens its rule, the form reports it
63
Added:
rather than crashing. *)
64
Added:
let effort_error ~load_field ~reps_field = function
65
Added:
| Evidence.Stimulus.Effort.Load_not_finite
66
Added:
| Evidence.Stimulus.Effort.Negative_load _ ->
67
Added:
(load_field, "error.load")
68
Added:
| Evidence.Stimulus.Effort.No_reps _ -> (reps_field, "error.reps")
69
Added:
| Evidence.Stimulus.Effort.Empty_extension _ ->
70
Added:
("extension_amount", "error.reps")
71
Added:
72
Added:
let effort ~load_field ~reps_field ~exercise ~load ~reps ~outcome =
73
Added:
match Evidence.Stimulus.Effort.make ~exercise ~load ~reps ~outcome with
74
Added:
| Ok e -> Form.ok e
75
Added:
| Error e ->
76
Added:
let field, key = effort_error ~load_field ~reps_field e in
77
Added:
Form.error field key
78
Added:
60
79
let stimulus prescription =
61
80
let open Form in
62
81
let* values = fields prescription in
@@ -67,10 +86,11 @@
67
86
| None -> Evidence.Stimulus.Positive_failure
68
87
| Some extension -> Evidence.Stimulus.Beyond_failure (extension, [])
69
88
in
70
Removed:
ok
71
Removed:
(Evidence.Stimulus.make
72
Removed:
(Evidence.Stimulus.Single
73
Removed:
(Evidence.Stimulus.Effort.make ~exercise ~load ~reps ~outcome)))
89
Added:
let* e =
90
Added:
effort ~load_field:"load" ~reps_field:"reps" ~exercise ~load ~reps
91
Added:
~outcome
92
Added:
in
93
Added:
ok (Evidence.Stimulus.make (Evidence.Stimulus.Single e))
74
94
| ( Prescription.Stimulus.Pre_exhaust { isolation; compound },
75
95
Pair { iso_load; iso_reps; comp_load; comp_reps; extension } ) ->
76
96
let second_outcome =
@@ -78,13 +98,15 @@
78
98
| None -> Evidence.Stimulus.Positive_failure
79
99
| Some extension -> Evidence.Stimulus.Beyond_failure (extension, [])
80
100
in
81
Removed:
let first =
82
Removed:
Evidence.Stimulus.Effort.make ~exercise:isolation ~load:iso_load
83
Removed:
~reps:iso_reps ~outcome:Evidence.Stimulus.Positive_failure
101
Added:
let* first =
102
Added:
effort ~load_field:"iso_load" ~reps_field:"iso_reps" ~exercise:isolation
103
Added:
~load:iso_load ~reps:iso_reps
104
Added:
~outcome:Evidence.Stimulus.Positive_failure
84
105
in
85
Removed:
let second =
86
Removed:
Evidence.Stimulus.Effort.make ~exercise:compound ~load:comp_load
87
Removed:
~reps:comp_reps ~outcome:second_outcome
106
Added:
let* second =
107
Added:
effort ~load_field:"comp_load" ~reps_field:"comp_reps"
108
Added:
~exercise:compound ~load:comp_load ~reps:comp_reps
109
Added:
~outcome:second_outcome
88
110
in
89
111
ok (Evidence.Stimulus.make (Evidence.Stimulus.Pair { first; second }))
90
112
| _ -> assert false
test/test_codec.ml
@@ -16,7 +16,7 @@
16
16
let find_routine = Catalog.find_by_name
17
17
18
18
let move ?(outcome = Stimulus.Positive_failure) id load reps =
19
Removed:
Stimulus.Effort.make ~exercise:(get id) ~load ~reps ~outcome
19
Added:
Result.get_ok (Stimulus.Effort.make ~exercise:(get id) ~load ~reps ~outcome)
20
20
21
21
let single id load reps = Stimulus.make (Stimulus.Single (move id load reps))
22
22
let pair ~first ~second = Stimulus.make (Stimulus.Pair { first; second })
test/test_evidence.ml
@@ -18,8 +18,9 @@
18
18
let day n = at (n * 86_400)
19
19
20
20
let move ?(outcome = Stimulus.Positive_failure) id load_kg rep_count =
21
Removed:
Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg)
22
Removed:
~reps:(reps rep_count) ~outcome
21
Added:
Result.get_ok
22
Added:
(Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg)
23
Added:
~reps:(reps rep_count) ~outcome)
23
24
24
25
let single id load r = Stimulus.make (Stimulus.Single (move id load r))
25
26
let pair first second = Stimulus.make (Stimulus.Pair { first; second })
@@ -584,8 +585,66 @@
584
585
Alcotest.(check int) "two signals" 2 (List.length (signals feedback)) );
585
586
]
586
587
588
Added:
(* {1 Effort construction}
589
Added:
590
Added:
The core holds the effort invariant itself, so no boundary can mint an effort
591
Added:
the doctrine cannot read. *)
592
Added:
let effort_tests =
593
Added:
let mk ?(outcome = Stimulus.Positive_failure) load reps =
594
Added:
Stimulus.Effort.make ~exercise:(get "laterals") ~load ~reps ~outcome
595
Added:
in
596
Added:
let refuses name expected r =
597
Added:
Alcotest.(check bool)
598
Added:
name true
599
Added:
(match r with Error e -> e = expected | Ok _ -> false)
600
Added:
in
601
Added:
[
602
Added:
( "a finite nonnegative load with at least one rep is an effort",
603
Added:
`Quick,
604
Added:
fun () -> ignore (ok (mk 60. 8)) );
605
Added:
( "zero load is a bodyweight movement, not an error",
606
Added:
`Quick,
607
Added:
fun () -> ignore (ok (mk 0. 12)) );
608
Added:
( "a NaN load is refused",
609
Added:
`Quick,
610
Added:
fun () -> refuses "nan" Stimulus.Effort.Load_not_finite (mk Float.nan 8)
611
Added:
);
612
Added:
( "an infinite load is refused",
613
Added:
`Quick,
614
Added:
fun () ->
615
Added:
refuses "inf" Stimulus.Effort.Load_not_finite (mk Float.infinity 8) );
616
Added:
( "a negative load is refused",
617
Added:
`Quick,
618
Added:
fun () ->
619
Added:
refuses "negative" (Stimulus.Effort.Negative_load (-5.)) (mk (-5.) 8) );
620
Added:
( "zero reps is refused: a set to failure has at least one",
621
Added:
`Quick,
622
Added:
fun () -> refuses "zero reps" (Stimulus.Effort.No_reps 0) (mk 60. 0) );
623
Added:
( "negative reps is refused",
624
Added:
`Quick,
625
Added:
fun () ->
626
Added:
refuses "negative reps" (Stimulus.Effort.No_reps (-2)) (mk 60. (-2)) );
627
Added:
( "an extension counting zero is refused",
628
Added:
`Quick,
629
Added:
fun () ->
630
Added:
refuses "empty extension"
631
Added:
(Stimulus.Effort.Empty_extension (Stimulus.Forced_reps 0))
632
Added:
(mk
633
Added:
~outcome:(Stimulus.Beyond_failure (Stimulus.Forced_reps 0, []))
634
Added:
60. 8) );
635
Added:
( "an extension counting one is accepted",
636
Added:
`Quick,
637
Added:
fun () ->
638
Added:
ignore
639
Added:
(ok
640
Added:
(mk
641
Added:
~outcome:(Stimulus.Beyond_failure (Stimulus.Negatives 1, []))
642
Added:
60. 8)) );
643
Added:
]
644
Added:
587
645
let suite =
588
646
[
647
Added:
("evidence.stimulus.effort", effort_tests);
589
648
("evidence.stimulus.outcome", outcome_tests);
590
649
("evidence.stimulus.delivery", stimulus_delivery_tests);
591
650
("evidence.workout.lifecycle", lifecycle_tests);
test/test_hevy_csv.ml
@@ -271,9 +271,22 @@
271
271
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
272
272
let w = List.hd (WI.batch_warnings b) in
273
273
Alcotest.(check string)
274
Removed:
"reason names weight" "missing or non-finite weight_kg"
274
Added:
"reason names weight" "missing, negative, or non-finite weight_kg"
275
275
(warning_reason w) )
276
276
277
Added:
let unsupported_negative_load =
278
Added:
( "a row with a negative weight becomes an Unsupported_row warning",
279
Added:
`Quick,
280
Added:
fun () ->
281
Added:
(* The adapter applies the effort rule at the trust boundary: a load is
282
Added:
finite and nonnegative. A negative load is not evidence. *)
283
Added:
let b = doc [ mk ~weight_kg:"-20" () ] |> parse in
284
Added:
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
285
Added:
let w = List.hd (WI.batch_warnings b) in
286
Added:
Alcotest.(check string)
287
Added:
"reason names weight" "missing, negative, or non-finite weight_kg"
288
Added:
(warning_reason w) )
289
Added:
277
290
let unsupported_missing_reps =
278
291
( "a row with empty reps becomes an Unsupported_row warning",
279
292
`Quick,
@@ -281,8 +294,22 @@
281
294
let b = doc [ mk ~reps:"" () ] |> parse in
282
295
let w = List.hd (WI.batch_warnings b) in
283
296
Alcotest.(check string)
284
Removed:
"reason names reps" "missing or negative reps" (warning_reason w) )
297
Added:
"reason names reps" "missing reps or fewer than one" (warning_reason w)
298
Added:
)
285
299
300
Added:
let unsupported_zero_reps =
301
Added:
( "a row with zero reps becomes an Unsupported_row warning",
302
Added:
`Quick,
303
Added:
fun () ->
304
Added:
(* A set taken to failure has at least one rep. Zero reps is not a
305
Added:
performance, so it is not evidence. *)
306
Added:
let b = doc [ mk ~reps:"0" () ] |> parse in
307
Added:
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
308
Added:
let w = List.hd (WI.batch_warnings b) in
309
Added:
Alcotest.(check string)
310
Added:
"reason names reps" "missing reps or fewer than one" (warning_reason w)
311
Added:
)
312
Added:
286
313
let unsupported_distance_only =
287
314
( "a distance/time row with empty weight and reps is an Unsupported_row",
288
315
`Quick,
@@ -440,7 +467,9 @@
440
467
timezone_offset;
441
468
warmup_dropped;
442
469
unsupported_missing_load;
470
Added:
unsupported_negative_load;
443
471
unsupported_missing_reps;
472
Added:
unsupported_zero_reps;
444
473
unsupported_distance_only;
445
474
unknown_set_type;
446
475
dropset_parsed_then_discarded;
test/test_import_codec.ml
@@ -176,8 +176,9 @@
176
176
(fun (o : WI.observation_snapshot) ->
177
177
let exercise = get (o.exercise_id :> string) in
178
178
let effort =
179
Removed:
Evidence.Stimulus.Effort.make ~exercise ~load:o.load ~reps:o.reps
180
Removed:
~outcome:Evidence.Stimulus.Positive_failure
179
Added:
Result.get_ok
180
Added:
(Evidence.Stimulus.Effort.make ~exercise ~load:o.load
181
Added:
~reps:o.reps ~outcome:Evidence.Stimulus.Positive_failure)
181
182
in
182
183
Evidence.Observation.make ~exercise ~effort
183
184
~performed_at:o.performed_at)
test/test_import_repo.ml
@@ -46,8 +46,9 @@
46
46
Repository.imported_record =
47
47
let exercise = get "squats" in
48
48
let effort =
49
Removed:
Evidence.Stimulus.Effort.make ~exercise ~load ~reps:8
50
Removed:
~outcome:Evidence.Stimulus.Positive_failure
49
Added:
Result.get_ok
50
Added:
(Evidence.Stimulus.Effort.make ~exercise ~load ~reps:8
51
Added:
~outcome:Evidence.Stimulus.Positive_failure)
51
52
in
52
53
let obs =
53
54
Evidence.Observation.make ~exercise ~effort ~performed_at:ended_at
test/test_import_sqlite.ml
@@ -181,8 +181,9 @@
181
181
let mk revision load : Repository.imported_record =
182
182
let exercise = get "squats" in
183
183
let effort =
184
Removed:
Evidence.Stimulus.Effort.make ~exercise ~load ~reps:8
185
Removed:
~outcome:Evidence.Stimulus.Positive_failure
184
Added:
Result.get_ok
185
Added:
(Evidence.Stimulus.Effort.make ~exercise ~load ~reps:8
186
Added:
~outcome:Evidence.Stimulus.Positive_failure)
186
187
in
187
188
let obs =
188
189
Evidence.Observation.make ~exercise ~effort
@@ -230,8 +231,9 @@
230
231
let record : Repository.imported_record =
231
232
let exercise = get "squats" in
232
233
let effort =
233
Removed:
Evidence.Stimulus.Effort.make ~exercise ~load:100. ~reps:8
234
Removed:
~outcome:Evidence.Stimulus.Positive_failure
234
Added:
Result.get_ok
235
Added:
(Evidence.Stimulus.Effort.make ~exercise ~load:100. ~reps:8
236
Added:
~outcome:Evidence.Stimulus.Positive_failure)
235
237
in
236
238
let obs =
237
239
Evidence.Observation.make ~exercise ~effort
test/test_progression.ml
@@ -20,8 +20,9 @@
20
20
21
21
let move ?(outcome = Stimulus.Positive_failure) ?(id = "laterals") load_kg
22
22
rep_count =
23
Removed:
Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg)
24
Removed:
~reps:(reps rep_count) ~outcome
23
Added:
Result.get_ok
24
Added:
(Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg)
25
Added:
~reps:(reps rep_count) ~outcome)
25
26
26
27
(* An observation is the canonical unit Progress judges. *)
27
28
let seen ~on load r : Evidence.Observation.t =
test/test_service.ml
@@ -30,8 +30,9 @@
30
30
(s, trainee.Trainee.id)
31
31
32
32
let move id load_kg rep_count =
33
Removed:
Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg)
34
Removed:
~reps:(reps rep_count) ~outcome:Stimulus.Positive_failure
33
Added:
Result.get_ok
34
Added:
(Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg)
35
Added:
~reps:(reps rep_count) ~outcome:Stimulus.Positive_failure)
35
36
36
37
let single id load r = Stimulus.make (Stimulus.Single (move id load r))
37
38
let pair ~first ~second = Stimulus.make (Stimulus.Pair { first; second })
test/test_sqlite_repo.ml
@@ -22,8 +22,9 @@
22
22
let single id load reps =
23
23
Stimulus.make
24
24
(Stimulus.Single
25
Removed:
(Stimulus.Effort.make ~exercise:(get id) ~load ~reps
26
Removed:
~outcome:Stimulus.Positive_failure))
25
Added:
(Result.get_ok
26
Added:
(Stimulus.Effort.make ~exercise:(get id) ~load ~reps
27
Added:
~outcome:Stimulus.Positive_failure)))
27
28
28
29
(* A unique temp database file per test; SQLite is a plain file. *)
29
30
let temp_uri () =
test/web/logbook.ml
@@ -81,8 +81,9 @@
81
81
~started_at:(Recovery.timestamp_of_unix_seconds started)
82
82
in
83
83
let effort =
84
Removed:
Evidence.Stimulus.Effort.make ~exercise:laterals ~load ~reps
85
Removed:
~outcome:Evidence.Stimulus.Positive_failure
84
Added:
Result.get_ok
85
Added:
(Evidence.Stimulus.Effort.make ~exercise:laterals ~load ~reps
86
Added:
~outcome:Evidence.Stimulus.Positive_failure)
86
87
in
87
88
let workout =
88
89
Evidence.Workout.add_stimulus workout