1 (** Unit tests for {!Evidence}, authored against the evidence.mli contract. *) 2 3 module Stimulus = Evidence.Stimulus 4 module Workout = Evidence.Workout 5 module Feedback = Evidence.Feedback 6 module Log = Evidence.Log 7 8 let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok" 9 10 let get id = 11 match Exercise.find_id id with 12 | Some e -> e 13 | None -> Alcotest.failf "catalog is missing %S" id 14 15 let load n = n 16 let reps n = n 17 let at s = Recovery.timestamp_of_unix_seconds s 18 let day n = at (n * 86_400) 19 20 let move ?(outcome = Stimulus.Positive_failure) id load_kg rep_count = 21 Stimulus.Effort.make ~exercise:(get id) ~load:(load load_kg) 22 ~reps:(reps rep_count) ~outcome 23 24 let single id load r = Stimulus.make (Stimulus.Single (move id load r)) 25 let pair first second = Stimulus.make (Stimulus.Pair { first; second }) 26 27 let invalid_error f = 28 try 29 let _ = f () in 30 None 31 with Workout.Invalid error -> Some error 32 33 (* {1 One stimulus} *) 34 35 let outcome_tests = 36 [ 37 ( "positive failure used no extension", 38 `Quick, 39 fun () -> 40 Alcotest.(check (list string)) 41 "none" [] 42 (List.map 43 (Format.asprintf "%a" Stimulus.pp_extension) 44 (Stimulus.extensions_of_outcome Stimulus.Positive_failure)) ); 45 ( "extensions stack in the order applied", 46 `Quick, 47 fun () -> 48 let o = 49 Stimulus.Beyond_failure (Stimulus.Forced_reps, [ Stimulus.Negatives ]) 50 in 51 Alcotest.(check (list string)) 52 "forced reps then negatives" 53 [ "forced reps"; "negatives" ] 54 (List.map 55 (Format.asprintf "%a" Stimulus.pp_extension) 56 (Stimulus.extensions_of_outcome o)) ); 57 ] 58 59 let stimulus_delivery_tests = 60 [ 61 ( "a single movement is one stimulus", 62 `Quick, 63 fun () -> 64 let s = single "curls" 40. 8 in 65 Alcotest.(check int) "one effort" 1 (List.length (Stimulus.efforts s)); 66 Alcotest.(check bool) "not extended" false (Stimulus.is_extended s) ); 67 ( "a pre-exhaust pair is one stimulus, isolation first", 68 `Quick, 69 fun () -> 70 let s = 71 pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7) 72 in 73 Alcotest.(check int) 74 "two movements" 2 75 (List.length (Stimulus.efforts s)); 76 Alcotest.(check (list string)) 77 "isolation leads" 78 [ "Dumbbell Flyes"; "Incline Presses" ] 79 (List.map Exercise.name (Stimulus.exercises s)) ); 80 ( "an unrelated pair is recorded as performed", 81 `Quick, 82 fun () -> 83 let s = 84 Stimulus.make 85 (Stimulus.Pair 86 { 87 first = move "dumbbell-flyes" 20. 9; 88 second = move "squats" 100. 8; 89 }) 90 in 91 Alcotest.(check (list string)) 92 "both movements" 93 [ "Dumbbell Flyes"; "Squats" ] 94 (List.map Exercise.name (Stimulus.exercises s)) ); 95 ( "extensions are gathered across a pre-exhaust's movements", 96 `Quick, 97 fun () -> 98 let s = 99 pair 100 (move "lying-french-press" 30. 9) 101 (move 102 ~outcome: 103 (Stimulus.Beyond_failure 104 (Stimulus.Forced_reps, [ Stimulus.Negatives ])) 105 "dips" 0. 6) 106 in 107 Alcotest.(check bool) "extended" true (Stimulus.is_extended s); 108 Alcotest.(check int) 109 "two extensions" 2 110 (List.length (Stimulus.extensions s)) ); 111 ] 112 113 (* {1 One performed workout} *) 114 115 let routine = Prescription.Routine.ideal 116 let prescribed n = List.nth (Prescription.Routine.workouts routine) n 117 let day_one = prescribed 0 118 let cleared = Option.get (Recovery.clear Recovery.Ready) 119 let fresh () = Workout.start day_one ~clearance:cleared ~started_at:(at 0) 120 121 (* HD1's Day 1, in the order it lists. *) 122 let day_one_stimuli = 123 [ 124 pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7); 125 single "laterals" 12. 8; 126 single "bent-over-laterals" 10. 9; 127 pair (move "lying-french-press" 30. 8) (move "dips" 0. 6); 128 ] 129 130 let perform stimuli = 131 List.fold_left (fun w s -> Workout.add_stimulus w s) (fresh ()) stimuli 132 133 let lifecycle_tests = 134 [ 135 ( "a fresh workout has performed nothing and answers its prescription", 136 `Quick, 137 fun () -> 138 let w = fresh () in 139 Alcotest.(check string) 140 "prescription" "Day 1" 141 (Prescription.Workout.name (Workout.prescription w)); 142 Alcotest.(check int) "no stimuli" 0 (List.length (Workout.stimuli w)); 143 Alcotest.(check int) 144 "four slots outstanding" 4 145 (List.length (Workout.unperformed w)); 146 Alcotest.(check bool) "unfinished" false (Workout.is_finished w); 147 Alcotest.(check bool) 148 "no duration" true 149 (Option.is_none (Workout.duration w)) ); 150 ( "HD1's Day 1 can be logged end to end", 151 `Quick, 152 fun () -> 153 let w = perform day_one_stimuli in 154 Alcotest.(check int) "four stimuli" 4 (List.length (Workout.stimuli w)); 155 Alcotest.(check int) 156 "nothing outstanding" 0 157 (List.length (Workout.unperformed w)); 158 let finished = Workout.finish w ~ended_at:(at 2400) in 159 Alcotest.(check bool) "finished" true (Workout.is_finished finished); 160 Alcotest.(check (option int)) 161 "40 minutes" (Some 2400) 162 (Option.map Recovery.duration_to_seconds (Workout.duration finished)) 163 ); 164 ( "stimuli come back in the order performed", 165 `Quick, 166 fun () -> 167 let w = 168 perform [ single "laterals" 12. 8; single "bent-over-laterals" 10. 9 ] 169 in 170 Alcotest.(check (list string)) 171 "as performed" 172 [ "Laterals"; "Bent-over Dumbbell Laterals" ] 173 (List.map 174 (fun s -> Exercise.name (List.hd (Stimulus.exercises s))) 175 (Workout.stimuli w)) ); 176 ( "a finished workout remains editable and retains its end time", 177 `Quick, 178 fun () -> 179 let w = Workout.finish (fresh ()) ~ended_at:(at 60) in 180 let w = Workout.add_stimulus w (single "laterals" 12. 8) in 181 let w = Workout.finish w ~ended_at:(at 120) in 182 Alcotest.(check int) 183 "original end" 60 184 (Recovery.timestamp_to_unix_seconds (Option.get (Workout.ended_at w))); 185 Alcotest.(check int) "one recorded" 1 (List.length (Workout.stimuli w)) 186 ); 187 ] 188 189 let conformance_tests = 190 [ 191 ( "an unprescribed movement is refused", 192 `Quick, 193 fun () -> 194 match 195 invalid_error (fun () -> 196 Workout.add_stimulus (fresh ()) (single "shrugs" 80. 10)) 197 with 198 | Some (Workout.Not_prescribed id) -> 199 Alcotest.(check string) "shrugs" "shrugs" (id :> string) 200 | _ -> Alcotest.fail "expected Not_prescribed" ); 201 ( "a lone set where a pre-exhaust was prescribed is refused", 202 `Quick, 203 fun () -> 204 match 205 invalid_error (fun () -> 206 Workout.add_stimulus (fresh ()) (single "dumbbell-flyes" 20. 9)) 207 with 208 | Some 209 (Workout.Delivery_mismatch 210 { prescribed = Workout.As_pair; logged = Workout.As_single; _ }) 211 -> 212 () 213 | _ -> Alcotest.fail "expected Delivery_mismatch" ); 214 ( "the prescribed pair, delivered as prescribed, is accepted", 215 `Quick, 216 fun () -> 217 ignore 218 (Workout.add_stimulus (fresh ()) 219 (pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7))) 220 ); 221 ( "an allowed substitute is accepted in its own role", 222 `Quick, 223 fun () -> 224 let w = 225 Workout.add_stimulus (fresh ()) 226 (pair (move "pec-deck" 45. 9) (move "incline-press" 60. 7)) 227 in 228 Alcotest.(check int) "recorded" 1 (List.length (Workout.stimuli w)); 229 Alcotest.(check int) 230 "slot filled" 3 231 (List.length (Workout.unperformed w)) ); 232 ( "a movement off the prescription's substitute list is refused", 233 `Quick, 234 fun () -> 235 (* Cable crossovers substitute for flyes in the catalog, but Day 1 236 permits only crossovers and pec deck — dips is never the pec 237 compound. *) 238 match 239 invalid_error (fun () -> 240 Workout.add_stimulus (fresh ()) 241 (pair (move "dumbbell-flyes" 20. 9) (move "dips" 0. 7))) 242 with 243 | Some _ -> () 244 | None -> Alcotest.fail "dips is not the prescribed pec compound" ); 245 ] 246 247 let volume_tests = 248 [ 249 ( "repeated work is recorded, and shows as more stimuli than slots", 250 `Quick, 251 fun () -> 252 (* HD1 forbids extra volume, but the log must still say what happened; 253 diagnosing it is Progression's job. *) 254 let w = perform [ single "laterals" 12. 8; single "laterals" 12. 6 ] in 255 Alcotest.(check int) "two stimuli" 2 (List.length (Workout.stimuli w)); 256 Alcotest.(check int) 257 "still three slots outstanding" 3 258 (List.length (Workout.unperformed w)) ); 259 ( "unperformed shrinks as slots are answered", 260 `Quick, 261 fun () -> 262 let w = perform [ single "laterals" 12. 8 ] in 263 Alcotest.(check int) 264 "three left" 3 265 (List.length (Workout.unperformed w)); 266 let w = Workout.add_stimulus w (single "bent-over-laterals" 10. 9) in 267 Alcotest.(check int) "two left" 2 (List.length (Workout.unperformed w)) 268 ); 269 ] 270 271 let editing_tests = 272 [ 273 ( "replace_stimulus corrects a slot in place without adding volume", 274 `Quick, 275 fun () -> 276 let w = perform [ single "laterals" 12. 8 ] in 277 Alcotest.(check int) "one filled slot" 1 (Workout.filled_slots w); 278 let w = Workout.replace_stimulus w ~slot:1 (single "laterals" 14. 7) in 279 Alcotest.(check int) "still one filled slot" 1 (Workout.filled_slots w); 280 Alcotest.(check int) 281 "still one stimulus" 1 282 (List.length (Workout.stimuli w)); 283 match Workout.stimuli w with 284 | [ s ] -> 285 Alcotest.(check (float 0.001)) 286 "corrected load" 14. 287 (Stimulus.Effort.load (List.hd (Stimulus.efforts s))) 288 | _ -> Alcotest.fail "expected one stimulus" ); 289 ( "replace_stimulus fills an empty slot as its first record", 290 `Quick, 291 fun () -> 292 let w = 293 Workout.replace_stimulus (fresh ()) ~slot:1 (single "laterals" 12. 8) 294 in 295 Alcotest.(check int) "one filled slot" 1 (Workout.filled_slots w); 296 Alcotest.(check int) 297 "three slots still outstanding" 3 298 (List.length (Workout.unperformed w)) ); 299 ( "replace_stimulus rejects an unknown slot", 300 `Quick, 301 fun () -> 302 match 303 invalid_error (fun () -> 304 Workout.replace_stimulus (fresh ()) ~slot:9 305 (single "laterals" 12. 8)) 306 with 307 | Some (Workout.No_such_slot 9) -> () 308 | _ -> Alcotest.fail "expected No_such_slot" ); 309 ( "replace_stimulus rejects a stimulus the slot does not call for", 310 `Quick, 311 fun () -> 312 (* Slot 0 is the pre-exhaust pair; a lone set does not fit its shape. *) 313 match 314 invalid_error (fun () -> 315 Workout.replace_stimulus (fresh ()) ~slot:0 316 (single "dumbbell-flyes" 20. 9)) 317 with 318 | Some (Workout.Delivery_mismatch _) -> () 319 | Some _ | None -> Alcotest.fail "expected Delivery_mismatch" ); 320 ( "filled_slots never exceeds the prescription despite extra volume", 321 `Quick, 322 fun () -> 323 let w = perform [ single "laterals" 12. 8; single "laterals" 12. 6 ] in 324 Alcotest.(check int) 325 "two stimuli recorded" 2 326 (List.length (Workout.stimuli w)); 327 Alcotest.(check int) "but one slot filled" 1 (Workout.filled_slots w) ); 328 ( "record_at appends at a slot, preserving prior fills", 329 `Quick, 330 fun () -> 331 let w = 332 Workout.record_at (fresh ()) ~slot:1 (single "laterals" 12. 8) 333 in 334 let w = Workout.record_at w ~slot:1 (single "laterals" 12. 6) in 335 Alcotest.(check int) 336 "two records at the slot" 2 337 (List.length (Workout.performed w)); 338 Alcotest.(check int) 339 "still one distinct slot" 1 (Workout.filled_slots w) ); 340 ( "performed pairs each stimulus with its slot", 341 `Quick, 342 fun () -> 343 let w = 344 perform [ single "laterals" 12. 8; single "bent-over-laterals" 10. 9 ] 345 in 346 Alcotest.(check (list int)) 347 "slots 1 then 2" [ 1; 2 ] 348 (List.map fst (Workout.performed w)) ); 349 ] 350 351 let clearance_tests = 352 [ 353 ( "a workout keeps the basis on which it was begun", 354 `Quick, 355 fun () -> 356 let recovering = 357 Recovery.evaluate_readiness ~elapsed:(Recovery.hours 12) 358 ~recommended:Prescription.Routine.training_interval 359 in 360 let w = 361 Workout.start day_one 362 ~clearance:(Recovery.override recovering) 363 ~started_at:(at 0) 364 in 365 match Recovery.basis (Workout.clearance w) with 366 | Recovery.Overridden _ -> () 367 | Recovery.Recovered -> Alcotest.fail "expected Overridden" ); 368 ] 369 370 (* {1 The log} *) 371 372 (* A finished workout: Day n of the Ideal Routine, with stimuli logged. *) 373 let logged ~workout:p ~on ~stimuli = 374 let w = 375 List.fold_left 376 (fun w s -> Workout.add_stimulus w s) 377 (Workout.start p ~clearance:cleared ~started_at:on) 378 stimuli 379 in 380 Workout.finish w ~ended_at:on 381 382 let laterals load r = single "laterals" load r 383 384 let log_basic_tests = 385 [ 386 ( "an empty log knows nothing", 387 `Quick, 388 fun () -> 389 Alcotest.(check int) 390 "no workouts" 0 391 (List.length (Log.workouts Log.empty)); 392 Alcotest.(check bool) 393 "no last prescription" true 394 (Option.is_none (Log.last_prescription Log.empty)) ); 395 ( "workouts come back most recent first, however they were added", 396 `Quick, 397 fun () -> 398 let book = 399 ( Log.empty |> fun b -> 400 Log.add b (logged ~workout:(prescribed 1) ~on:(day 3) ~stimuli:[]) 401 ) 402 |> fun b -> 403 Log.add b (logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[]) 404 in 405 Alcotest.(check (list string)) 406 "newest first" [ "Day 2"; "Day 1" ] 407 (List.map 408 (fun w -> Prescription.Workout.name (Workout.prescription w)) 409 (Log.workouts book)) ); 410 ( "the last prescription is what the cycle should advance from", 411 `Quick, 412 fun () -> 413 let book = 414 Log.add Log.empty 415 (logged ~workout:(prescribed 1) ~on:(day 1) ~stimuli:[]) 416 in 417 let last = Option.get (Log.last_prescription book) in 418 Alcotest.(check string) 419 "performed Day 2" "Day 2" 420 (Prescription.Workout.name last); 421 Alcotest.(check string) 422 "so Day 3 is next" "Day 3" 423 (Prescription.Workout.name 424 (Prescription.Routine.workout_after routine last)) ); 425 ] 426 427 let observation_tests = 428 [ 429 ( "observations for a movement come back oldest first", 430 `Quick, 431 fun () -> 432 let book = 433 ( Log.empty |> fun b -> 434 Log.add b 435 (logged ~workout:(prescribed 0) ~on:(day 5) 436 ~stimuli:[ laterals 14. 7 ]) ) 437 |> fun b -> 438 Log.add b 439 (logged ~workout:(prescribed 0) ~on:(day 1) 440 ~stimuli:[ laterals 12. 8 ]) 441 in 442 let history = Log.observations book (get "laterals") in 443 Alcotest.(check int) "two observations" 2 (List.length history); 444 Alcotest.(check (list (float 0.001))) 445 "12kg then 14kg" [ 12.; 14. ] 446 (List.map 447 (fun (o : Log.observation) -> Stimulus.Effort.load o.effort) 448 history) ); 449 ( "observations are dated, so a stall can be measured", 450 `Quick, 451 fun () -> 452 let book = 453 Log.add Log.empty 454 (logged ~workout:(prescribed 0) ~on:(day 2) 455 ~stimuli:[ laterals 12. 8 ]) 456 in 457 match Log.observations book (get "laterals") with 458 | [ o ] -> 459 Alcotest.(check int) 460 "day 2" 172_800 461 (Recovery.timestamp_to_unix_seconds o.performed_at) 462 | _ -> Alcotest.fail "expected one observation" ); 463 ( "a movement never performed has no observations", 464 `Quick, 465 fun () -> 466 let book = 467 Log.add Log.empty 468 (logged ~workout:(prescribed 0) ~on:(day 1) 469 ~stimuli:[ laterals 12. 8 ]) 470 in 471 Alcotest.(check int) 472 "none" 0 473 (List.length (Log.observations book (get "squats"))) ); 474 ( "both halves of a pre-exhaust are recorded separately", 475 `Quick, 476 fun () -> 477 let pair = 478 pair (move "dumbbell-flyes" 20. 9) (move "incline-press" 60. 7) 479 in 480 let book = 481 Log.add Log.empty 482 (logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[ pair ]) 483 in 484 Alcotest.(check int) 485 "isolation" 1 486 (List.length (Log.observations book (get "dumbbell-flyes"))); 487 Alcotest.(check int) 488 "compound" 1 489 (List.length (Log.observations book (get "incline-press"))) ); 490 ] 491 492 let readiness_tests = 493 [ 494 ( "an empty log is ready: nothing to recover from", 495 `Quick, 496 fun () -> 497 Alcotest.(check bool) 498 "ready" true 499 (Recovery.is_ready 500 (Log.readiness Log.empty ~now:(day 1) 501 ~recommended:Prescription.Routine.training_interval)) ); 502 ( "readiness is measured from the last finished workout", 503 `Quick, 504 fun () -> 505 let book = 506 Log.add Log.empty 507 (logged ~workout:(prescribed 0) ~on:(day 1) ~stimuli:[]) 508 in 509 Alcotest.(check bool) 510 "one day later, still recovering" false 511 (Recovery.is_ready 512 (Log.readiness book ~now:(day 2) 513 ~recommended:Prescription.Routine.training_interval)); 514 Alcotest.(check bool) 515 "two days later, ready" true 516 (Recovery.is_ready 517 (Log.readiness book ~now:(day 3) 518 ~recommended:Prescription.Routine.training_interval)) ); 519 ( "an unfinished workout leaves nothing to recover from", 520 `Quick, 521 fun () -> 522 let unfinished = 523 Workout.start (prescribed 0) ~clearance:cleared ~started_at:(day 1) 524 in 525 let book = Log.add Log.empty unfinished in 526 Alcotest.(check bool) 527 "ready" true 528 (Recovery.is_ready 529 (Log.readiness book ~now:(day 1) 530 ~recommended:Prescription.Routine.training_interval)) ); 531 ] 532 533 let completion_feedback_tests = 534 [ 535 ( "feedback rejects duplicate signal categories", 536 `Quick, 537 fun () -> 538 let open Feedback in 539 match 540 try 541 ignore (make ~reported_at:(at 60) [ Sleep Poor; Sleep Good ]); 542 None 543 with Invalid error -> Some error 544 with 545 | Some (Duplicate_signal (Sleep Good)) -> () 546 | _ -> Alcotest.fail "expected duplicate sleep rejection" ); 547 ( "feedback retains its report time and signals", 548 `Quick, 549 fun () -> 550 let open Feedback in 551 let feedback = 552 make ~reported_at:(at 60) 553 [ 554 Sleep Good; 555 Appetite Fair; 556 Readiness Good; 557 Motivation Good; 558 Difficulty Fair; 559 Preparation_insufficient; 560 ] 561 in 562 Alcotest.(check int) 563 "report time" 60 564 (Recovery.timestamp_to_unix_seconds (reported_at feedback)); 565 Alcotest.(check int) "six signals" 6 (List.length (signals feedback)) ); 566 ] 567 568 let suite = 569 [ 570 ("evidence.stimulus.outcome", outcome_tests); 571 ("evidence.stimulus.delivery", stimulus_delivery_tests); 572 ("evidence.workout.lifecycle", lifecycle_tests); 573 ("evidence.workout.conformance", conformance_tests); 574 ("evidence.workout.volume", volume_tests); 575 ("evidence.workout.editing", editing_tests); 576 ("evidence.workout.clearance", clearance_tests); 577 ("evidence.workout.completion_feedback", completion_feedback_tests); 578 ("evidence.log.basics", log_basic_tests); 579 ("evidence.log.observations", observation_tests); 580 ("evidence.log.readiness", readiness_tests); 581 ] 582