1 (** Unit tests for {!Workout_import}, authored against the workout_import.mli 2 contract. 3 4 The import use case must feed the core only confirmed, catalogued, 5 failure-defined evidence. These tests exercise that gate: failure sets 6 promote after mapping, normal sets wait for one acknowledgement, dropsets 7 block the whole workout, blockers are deterministic, promotion is atomic per 8 workout and partial per batch, and a promoted workout has its own revisioned 9 lifecycle. *) 10 11 open Hito_app 12 module WI = Workout_import 13 module Observation = Evidence.Observation 14 module Effort = Evidence.Stimulus.Effort 15 16 let get id = 17 match Exercise.find_id id with 18 | Some e -> e 19 | None -> Alcotest.failf "catalog is missing %S" id 20 21 let at s = Recovery.timestamp_of_unix_seconds s 22 let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok" 23 24 let set ?(row = 0) ?(set_index = 1) ?(superset_id = None) ~name ~kind ~kg ~reps 25 () : WI.source_set = 26 { 27 row; 28 exercise_name = name; 29 set_index; 30 set_type = kind; 31 weight_kg = kg; 32 reps; 33 superset_id; 34 } 35 36 let workout ~id ~sets = 37 ok 38 (WI.make_workout ~id:(WI.workout_id id) ~title:"Chest" 39 ~started_at:(at 1_000) ~ended_at:(at 4_600) ~sets) 40 41 let batch ?(warnings = []) workouts = 42 WI.make_batch ~id:(WI.batch_id "b1") ~source:"raw,csv,text" ~fingerprint:"fp" 43 ~imported_at:(at 5_000) ~workouts ~warnings 44 45 (* A blocker rendered as a stable string, so tests can assert order and 46 content without depending on structural equality. *) 47 let show_blocker : WI.blocker -> string = function 48 | No_sets -> "no_sets" 49 | Unmapped_exercise name -> "unmapped:" ^ name 50 | Normal_sets_unconfirmed -> "normal_unconfirmed" 51 52 let blocker_list = Alcotest.(list string) 53 let blockers_of w = List.map show_blocker (WI.blockers w) 54 let wid = WI.workout_id 55 56 (* {1 Failure sets promote after mapping, without acknowledgement} *) 57 58 let failure_promotes_without_acknowledgement = 59 ( "a failure set promotes after mapping, no acknowledgement needed", 60 `Quick, 61 fun () -> 62 let s = 63 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 () 64 in 65 let b = batch [ workout ~id:"w1" ~sets:[ s ] ] in 66 let b = 67 ok 68 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 69 (get "squats")) 70 in 71 let w = Option.get (WI.find_workout b (wid "w1")) in 72 Alcotest.(check blocker_list) "no blockers" [] (blockers_of w); 73 let _, result = ok (WI.promote_workout b (wid "w1")) in 74 match result with 75 | WI.Promoted p -> 76 Alcotest.(check int) "one observation" 1 (List.length p.observations); 77 Alcotest.(check (option string)) 78 "no normal confirmation" None p.provenance.normal_confirmation 79 | _ -> Alcotest.fail "expected Promoted" ) 80 81 (* {1 Normal sets block until a workout-level acknowledgement} *) 82 83 let normal_blocks_until_confirmed = 84 ( "a normal set blocks until the workout-level acknowledgement", 85 `Quick, 86 fun () -> 87 let s = 88 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Normal ~kg:100. ~reps:8 () 89 in 90 let b = batch [ workout ~id:"w1" ~sets:[ s ] ] in 91 let b = 92 ok 93 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 94 (get "squats")) 95 in 96 let w = Option.get (WI.find_workout b (wid "w1")) in 97 Alcotest.(check blocker_list) 98 "blocked on confirmation" [ "normal_unconfirmed" ] (blockers_of w); 99 (match WI.promote_workout b (wid "w1") with 100 | Ok (_, WI.Blocked _) -> () 101 | _ -> Alcotest.fail "expected Blocked before confirmation"); 102 let b = 103 ok 104 (WI.confirm_normal_sets b ~workout:(wid "w1") 105 ~acknowledgement:"I confirm these were to failure") 106 in 107 let w = Option.get (WI.find_workout b (wid "w1")) in 108 Alcotest.(check blocker_list) 109 "no blockers after confirmation" [] (blockers_of w); 110 Alcotest.(check (option string)) 111 "exact acknowledgement retained" 112 (Some "I confirm these were to failure") 113 (WI.workout_acknowledgement w); 114 let _, result = ok (WI.promote_workout b (wid "w1")) in 115 match result with 116 | WI.Promoted p -> 117 Alcotest.(check (option string)) 118 "confirmation recorded in provenance" 119 (Some "I confirm these were to failure") 120 p.provenance.normal_confirmation 121 | _ -> Alcotest.fail "expected Promoted after confirmation" ) 122 123 let empty_acknowledgement_rejected = 124 ( "a whitespace-only acknowledgement is rejected", 125 `Quick, 126 fun () -> 127 let s = set ~name:"Barbell Squat" ~kind:WI.Normal ~kg:100. ~reps:8 () in 128 let b = batch [ workout ~id:"w1" ~sets:[ s ] ] in 129 match 130 WI.confirm_normal_sets b ~workout:(wid "w1") ~acknowledgement:" " 131 with 132 | Error WI.Empty_acknowledgement -> () 133 | _ -> Alcotest.fail "expected Empty_acknowledgement" ) 134 135 (* {1 A dropset is discarded, never a blocker} *) 136 137 let dropset_discarded_failure_promotes = 138 ( "a dropset is discarded; the failure set beside it promotes", 139 `Quick, 140 fun () -> 141 let good = 142 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 () 143 in 144 (* A drop set for a second, deliberately unmapped exercise. It must not 145 block: it is discarded like a warmup, so its exercise never needs a 146 mapping. *) 147 let drop = 148 set ~row:2 ~name:"Leg Press" ~kind:WI.Dropset ~kg:200. ~reps:12 () 149 in 150 let b = batch [ workout ~id:"w1" ~sets:[ good; drop ] ] in 151 let b = 152 ok 153 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 154 (get "squats")) 155 in 156 let w = Option.get (WI.find_workout b (wid "w1")) in 157 Alcotest.(check blocker_list) 158 "no blocker from a discarded dropset" [] (blockers_of w); 159 match WI.promote_workout b (wid "w1") with 160 | Ok (_, WI.Promoted p) -> 161 Alcotest.(check int) 162 "only the failure set is observed" 1 163 (List.length p.observations); 164 Alcotest.(check (list int)) 165 "provenance keeps only the failure row" [ 1 ] 166 p.provenance.source_rows 167 | _ -> Alcotest.fail "expected Promoted with the dropset discarded" ) 168 169 let dropset_only_workout_has_no_sets = 170 ( "a workout of only drop sets reduces to No_sets", 171 `Quick, 172 fun () -> 173 let drop = 174 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Dropset ~kg:100. ~reps:8 () 175 in 176 let b = batch [ workout ~id:"w1" ~sets:[ drop ] ] in 177 let w = Option.get (WI.find_workout b (wid "w1")) in 178 Alcotest.(check blocker_list) "no_sets" [ "no_sets" ] (blockers_of w) ) 179 180 (* {1 No sets is its own blocker} *) 181 182 let no_sets_blocker = 183 ( "a workout with no sets reports No_sets", 184 `Quick, 185 fun () -> 186 let w = workout ~id:"w1" ~sets:[] in 187 Alcotest.(check blocker_list) "no_sets" [ "no_sets" ] (blockers_of w) ) 188 189 (* {1 Mapping is by name and covers all matching sets} *) 190 191 let mapping_covers_all_matching_sets = 192 ( "one mapping covers every set that shares the source name", 193 `Quick, 194 fun () -> 195 let s1 = 196 set ~row:1 ~set_index:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. 197 ~reps:8 () 198 in 199 let s2 = 200 set ~row:2 ~set_index:2 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. 201 ~reps:6 () 202 in 203 let b = batch [ workout ~id:"w1" ~sets:[ s1; s2 ] ] in 204 (* Before mapping, the single distinct name is the only blocker. *) 205 let w = Option.get (WI.find_workout b (wid "w1")) in 206 Alcotest.(check blocker_list) 207 "one unmapped name" 208 [ "unmapped:Barbell Squat" ] 209 (blockers_of w); 210 let b = 211 ok 212 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 213 (get "squats")) 214 in 215 let w = Option.get (WI.find_workout b (wid "w1")) in 216 Alcotest.(check blocker_list) 217 "both sets covered by one mapping" [] (blockers_of w); 218 let _, result = ok (WI.promote_workout b (wid "w1")) in 219 match result with 220 | WI.Promoted p -> 221 Alcotest.(check int) 222 "two observations from two sets" 2 223 (List.length p.observations) 224 | _ -> Alcotest.fail "expected Promoted" ) 225 226 let every_distinct_name_must_be_mapped = 227 ( "every distinct source name must be mapped before promotion", 228 `Quick, 229 fun () -> 230 let s1 = 231 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 () 232 in 233 let s2 = 234 set ~row:2 ~name:"Leg Press" ~kind:WI.Failure ~kg:200. ~reps:10 () 235 in 236 let b = batch [ workout ~id:"w1" ~sets:[ s1; s2 ] ] in 237 let b = 238 ok 239 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 240 (get "squats")) 241 in 242 let w = Option.get (WI.find_workout b (wid "w1")) in 243 Alcotest.(check blocker_list) 244 "still blocked on the unmapped name" [ "unmapped:Leg Press" ] 245 (blockers_of w) ) 246 247 (* {1 Deterministic blocker order} *) 248 249 let deterministic_blocker_order = 250 ( "blockers appear in unmapped (first appearance) then normal order", 251 `Quick, 252 fun () -> 253 (* A discarded dropset contributes no blocker, not even an unmapped one 254 for its exercise. *) 255 let drop = 256 set ~row:3 ~name:"Leg Press" ~kind:WI.Dropset ~kg:200. ~reps:12 () 257 in 258 let normal = 259 set ~row:1 ~name:"Bench Press" ~kind:WI.Normal ~kg:80. ~reps:8 () 260 in 261 let other = 262 set ~row:2 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:6 () 263 in 264 (* Order of sets fixes first-appearance order of names. *) 265 let w = workout ~id:"w1" ~sets:[ normal; other; drop ] in 266 Alcotest.(check blocker_list) 267 "names by first appearance, then normal; the dropset is absent" 268 [ 269 "unmapped:Bench Press"; "unmapped:Barbell Squat"; "normal_unconfirmed"; 270 ] 271 (blockers_of w) ) 272 273 (* {1 Promotion is atomic per workout and partial per batch} *) 274 275 let batch_promotes_partially = 276 ( "a blocked workout does not prevent another from promoting", 277 `Quick, 278 fun () -> 279 let good = 280 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 () 281 in 282 let drop = 283 set ~row:2 ~name:"Leg Press" ~kind:WI.Dropset ~kg:200. ~reps:12 () 284 in 285 let b = 286 batch 287 [ workout ~id:"w1" ~sets:[ good ]; workout ~id:"w2" ~sets:[ drop ] ] 288 in 289 let b = 290 ok 291 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 292 (get "squats")) 293 in 294 let b = 295 ok 296 (WI.map_exercise b ~workout:(wid "w2") ~source_name:"Leg Press" 297 (get "leg-presses")) 298 in 299 let _, result = WI.promote_batch b in 300 Alcotest.(check int) "one promoted" 1 (List.length result.promoted); 301 Alcotest.(check int) "one blocked" 1 (List.length result.blocked); 302 Alcotest.(check string) 303 "w1 promoted" "w1" 304 (WI.workout_id_to_string (fst (List.hd result.promoted))); 305 Alcotest.(check string) 306 "w2 blocked" "w2" 307 (WI.workout_id_to_string (fst (List.hd result.blocked))) ) 308 309 let blocked_workout_promotes_after_cleaning = 310 ( "a blocked workout stays provisional and promotes after later cleaning", 311 `Quick, 312 fun () -> 313 let s = 314 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Normal ~kg:100. ~reps:8 () 315 in 316 let b = batch [ workout ~id:"w1" ~sets:[ s ] ] in 317 let b = 318 ok 319 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 320 (get "squats")) 321 in 322 (* Still blocked: the normal set is unconfirmed. *) 323 let b, result = WI.promote_batch b in 324 Alcotest.(check int) 325 "blocked before confirmation" 1 326 (List.length result.blocked); 327 let b = 328 ok 329 (WI.confirm_normal_sets b ~workout:(wid "w1") 330 ~acknowledgement:"confirmed") 331 in 332 let _, result = WI.promote_batch b in 333 Alcotest.(check int) 334 "promoted after confirmation" 1 335 (List.length result.promoted) ) 336 337 (* {1 A promoted workout has its own revisioned lifecycle} *) 338 339 let repeated_promotion_is_already_promoted = 340 ( "promoting an unchanged workout twice yields Already_promoted", 341 `Quick, 342 fun () -> 343 let s = 344 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 () 345 in 346 let b = batch [ workout ~id:"w1" ~sets:[ s ] ] in 347 let b = 348 ok 349 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 350 (get "squats")) 351 in 352 let b, first = ok (WI.promote_workout b (wid "w1")) in 353 (match first with 354 | WI.Promoted _ -> () 355 | _ -> Alcotest.fail "expected Promoted on first promotion"); 356 let _, second = ok (WI.promote_workout b (wid "w1")) in 357 match second with 358 | WI.Already_promoted _ -> () 359 | _ -> Alcotest.fail "expected Already_promoted on repeat" ) 360 361 let editing_increments_revision_and_replaces = 362 ( "editing a mapping increments the revision and re-promotes a replacement", 363 `Quick, 364 fun () -> 365 let s = 366 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 () 367 in 368 let b = batch [ workout ~id:"w1" ~sets:[ s ] ] in 369 let b = 370 ok 371 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 372 (get "squats")) 373 in 374 let rev0 = 375 WI.workout_revision (Option.get (WI.find_workout b (wid "w1"))) 376 in 377 let b, _ = ok (WI.promote_workout b (wid "w1")) in 378 (* Re-map the same name to a different exercise: a real change. *) 379 let b = 380 ok 381 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 382 (get "leg-presses")) 383 in 384 let rev1 = 385 WI.workout_revision (Option.get (WI.find_workout b (wid "w1"))) 386 in 387 Alcotest.(check bool) "revision advanced" true (rev1 > rev0); 388 let _, result = ok (WI.promote_workout b (wid "w1")) in 389 match result with 390 | WI.Promoted p -> 391 Alcotest.(check int) 392 "replacement carries the new revision" rev1 p.provenance.revision; 393 Alcotest.(check string) 394 "replacement observation uses the new exercise" "Leg Presses" 395 (Exercise.name (Observation.exercise (List.hd p.observations))) 396 | _ -> Alcotest.fail "expected a re-promoted replacement" ) 397 398 let idempotent_mapping_keeps_revision = 399 ( "re-confirming the same mapping does not increment the revision", 400 `Quick, 401 fun () -> 402 let s = 403 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 () 404 in 405 let b = batch [ workout ~id:"w1" ~sets:[ s ] ] in 406 let b = 407 ok 408 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 409 (get "squats")) 410 in 411 let rev0 = 412 WI.workout_revision (Option.get (WI.find_workout b (wid "w1"))) 413 in 414 let b = 415 ok 416 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 417 (get "squats")) 418 in 419 let rev1 = 420 WI.workout_revision (Option.get (WI.find_workout b (wid "w1"))) 421 in 422 Alcotest.(check int) "revision unchanged" rev0 rev1 ) 423 424 (* {1 Promoted observations carry the expected effort} *) 425 426 let observations_carry_expected_effort = 427 ( "each observation carries the mapped exercise, load, reps, failure, and end", 428 `Quick, 429 fun () -> 430 let s = 431 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:102.5 ~reps:9 () 432 in 433 let b = batch [ workout ~id:"w1" ~sets:[ s ] ] in 434 let b = 435 ok 436 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 437 (get "squats")) 438 in 439 let _, result = ok (WI.promote_workout b (wid "w1")) in 440 match result with 441 | WI.Promoted p -> 442 let obs = List.hd p.observations in 443 let effort = Observation.effort obs in 444 Alcotest.(check string) 445 "exercise" "Squats" 446 (Exercise.name (Observation.exercise obs)); 447 Alcotest.(check (float 0.001)) "load" 102.5 (Effort.load effort); 448 Alcotest.(check int) "reps" 9 (Effort.reps effort); 449 Alcotest.(check bool) 450 "outcome is positive failure" true 451 (match Effort.outcome effort with 452 | Evidence.Stimulus.Positive_failure -> true 453 | _ -> false); 454 Alcotest.(check int) 455 "performed at the workout end" 456 (Recovery.timestamp_to_unix_seconds (at 4_600)) 457 (Recovery.timestamp_to_unix_seconds (Observation.performed_at obs)) 458 | _ -> Alcotest.fail "expected Promoted" ) 459 460 (* {1 The raw source and warnings are immutable and retained} *) 461 462 let source_and_warnings_retained = 463 ( "the raw source and warnings survive cleaning unchanged", 464 `Quick, 465 fun () -> 466 let warnings : WI.warning list = 467 [ 468 { row = 5; exercise_name = Some "Warmup"; kind = WI.Warmup_dropped }; 469 { 470 row = 6; 471 exercise_name = None; 472 kind = WI.Unsupported_row "blank line"; 473 }; 474 ] 475 in 476 let s = 477 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 () 478 in 479 let b = batch ~warnings [ workout ~id:"w1" ~sets:[ s ] ] in 480 let b = 481 ok 482 (WI.map_exercise b ~workout:(wid "w1") ~source_name:"Barbell Squat" 483 (get "squats")) 484 in 485 let b, _ = WI.promote_batch b in 486 Alcotest.(check string) 487 "raw source unchanged" "raw,csv,text" (WI.batch_source b); 488 Alcotest.(check int) 489 "warnings retained" 2 490 (List.length (WI.batch_warnings b)); 491 Alcotest.(check bool) 492 "a warmup warning is present" true 493 (List.exists 494 (fun (w : WI.warning) -> w.kind = WI.Warmup_dropped) 495 (WI.batch_warnings b)) ) 496 497 let unknown_workout_is_an_error = 498 ( "operations on an unknown workout return Unknown_workout", 499 `Quick, 500 fun () -> 501 let b = batch [] in 502 match WI.promote_workout b (wid "nope") with 503 | Error (WI.Unknown_workout _) -> () 504 | _ -> Alcotest.fail "expected Unknown_workout" ) 505 506 let invalid_time_rejected = 507 ( "a workout whose end precedes its start is rejected", 508 `Quick, 509 fun () -> 510 match 511 WI.make_workout ~id:(wid "w1") ~title:"Chest" ~started_at:(at 4_600) 512 ~ended_at:(at 1_000) ~sets:[] 513 with 514 | Error WI.Invalid_time -> () 515 | _ -> Alcotest.fail "expected Invalid_time" ) 516 517 let suite = 518 [ 519 ( "Workout_import", 520 [ 521 failure_promotes_without_acknowledgement; 522 normal_blocks_until_confirmed; 523 empty_acknowledgement_rejected; 524 dropset_discarded_failure_promotes; 525 dropset_only_workout_has_no_sets; 526 no_sets_blocker; 527 mapping_covers_all_matching_sets; 528 every_distinct_name_must_be_mapped; 529 deterministic_blocker_order; 530 batch_promotes_partially; 531 blocked_workout_promotes_after_cleaning; 532 repeated_promotion_is_already_promoted; 533 editing_increments_revision_and_replaces; 534 idempotent_mapping_keeps_revision; 535 observations_carry_expected_effort; 536 source_and_warnings_retained; 537 unknown_workout_is_an_error; 538 invalid_time_rejected; 539 ] ); 540 ] 541