1 (** Tests for {!Hito_app.Service}'s workout-import integration: storing and 2 cleaning batches, promoting them into canonical 3 {!Repository.imported_record} evidence, and how that evidence feeds 4 progression and recovery without ever advancing the routine cycle. Authored 5 against service.mli. *) 6 7 open Hito_app 8 module S = Service.Make (Test_repo) (Test_hash) 9 module WI = Workout_import 10 11 let run = Lwt_main.run 12 let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok" 13 14 let get id = 15 match Exercise.find_id id with 16 | Some e -> e 17 | None -> Alcotest.failf "catalog is missing %S" id 18 19 let at s = Recovery.timestamp_of_unix_seconds s 20 let day n = at (n * 86_400) 21 let hours n = n * 3_600 22 let ideal = Repository.routine_id "ideal" 23 24 let fixture () = 25 let s = S.make ~repo:(Test_repo.create ()) in 26 let trainee = 27 ok (run (S.register s ~username:"lifter" ~password:"heavyduty1")) 28 in 29 (s, trainee.Trainee.id) 30 31 (* An imported source set. Defaults to a failure set so promotion needs no 32 acknowledgement unless a test asks for a normal set. *) 33 let set ?(row = 0) ?(set_index = 1) ?(kind = WI.Failure) ~name ~kg ~reps () : 34 WI.source_set = 35 { 36 row; 37 exercise_name = name; 38 set_index; 39 set_type = kind; 40 weight_kg = kg; 41 reps; 42 superset_id = None; 43 } 44 45 let workout ~id ~title ~started_at ~ended_at ~sets = 46 ok (WI.make_workout ~id:(WI.workout_id id) ~title ~started_at ~ended_at ~sets) 47 48 (* A batch whose identity, fingerprint, and imported time are all explicit, so 49 duplicate detection can be exercised precisely. *) 50 let batch ?(source = "raw,csv") ?(fingerprint = "fp") ?(imported_at = at 5_000) 51 ~id workouts = 52 WI.make_batch ~id:(WI.batch_id id) ~source ~fingerprint ~imported_at ~workouts 53 ~warnings:[] 54 55 (* Map [source_name] to [exercise] for a workout in a stored batch. *) 56 let map s t ~batch:bid ~workout:wid ~name exercise = 57 ok 58 (run 59 (S.map_import_exercise s t ~batch:(WI.batch_id bid) 60 ~workout:(WI.workout_id wid) ~source_name:name exercise)) 61 62 (* Store a batch with a single mapped squats failure set, ready to promote. *) 63 let ready_batch s t ~id ~ended_at = 64 let w = 65 workout ~id:(id ^ "-w") ~title:"Legs" ~started_at:(at 0) ~ended_at 66 ~sets:[ set ~row:1 ~name:"Barbell Squat" ~kg:100. ~reps:8 () ] 67 in 68 ok (run (S.store_import_batch s t (batch ~id [ w ]))); 69 ignore 70 (map s t ~batch:id ~workout:(id ^ "-w") ~name:"Barbell Squat" (get "squats")); 71 id 72 73 let store_tests = 74 [ 75 ( "a duplicate fingerprint is refused, override accepts it", 76 `Quick, 77 fun () -> 78 let s, t = fixture () in 79 let w id = 80 workout ~id ~title:"Legs" ~started_at:(at 0) ~ended_at:(at 3_600) 81 ~sets:[ set ~name:"Barbell Squat" ~kg:100. ~reps:8 () ] 82 in 83 ok 84 (run 85 (S.store_import_batch s t 86 (batch ~id:"b1" ~fingerprint:"same" [ w "w1" ]))); 87 (match 88 run 89 (S.store_import_batch s t 90 (batch ~id:"b2" ~fingerprint:"same" [ w "w2" ])) 91 with 92 | Error S.Duplicate_source -> () 93 | _ -> Alcotest.fail "expected Duplicate_source"); 94 ok 95 (run 96 (S.store_import_batch s t ~allow_duplicate:() 97 (batch ~id:"b2" ~fingerprint:"same" [ w "w2" ]))); 98 Alcotest.(check int) 99 "both batches stored" 2 100 (List.length (run (S.import_batches s t))) ); 101 ( "re-storing the same batch id is a replacement, not a duplicate", 102 `Quick, 103 fun () -> 104 let s, t = fixture () in 105 let w = 106 workout ~id:"w1" ~title:"Legs" ~started_at:(at 0) ~ended_at:(at 3_600) 107 ~sets:[ set ~name:"Barbell Squat" ~kg:100. ~reps:8 () ] 108 in 109 ok 110 (run 111 (S.store_import_batch s t 112 (batch ~id:"b1" ~fingerprint:"same" [ w ]))); 113 ok 114 (run 115 (S.store_import_batch s t 116 (batch ~id:"b1" ~fingerprint:"same" [ w ]))); 117 Alcotest.(check int) 118 "still one batch" 1 119 (List.length (run (S.import_batches s t))) ); 120 ( "mapping and confirmation persist on the stored batch", 121 `Quick, 122 fun () -> 123 let s, t = fixture () in 124 let w = 125 workout ~id:"w1" ~title:"Legs" ~started_at:(at 0) ~ended_at:(at 3_600) 126 ~sets: 127 [ 128 set ~row:1 ~name:"Barbell Squat" ~kind:WI.Normal ~kg:100. 129 ~reps:8 (); 130 ] 131 in 132 ok (run (S.store_import_batch s t (batch ~id:"b1" [ w ]))); 133 ignore 134 (map s t ~batch:"b1" ~workout:"w1" ~name:"Barbell Squat" 135 (get "squats")); 136 ignore 137 (ok 138 (run 139 (S.confirm_import_normal_sets s t ~batch:(WI.batch_id "b1") 140 ~workout:(WI.workout_id "w1") ~acknowledgement:"to failure"))); 141 let reloaded = 142 Option.get (run (S.find_import_batch s t (WI.batch_id "b1"))) 143 in 144 let w' = Option.get (WI.find_workout reloaded (WI.workout_id "w1")) in 145 Alcotest.(check bool) 146 "mapping persisted" true 147 (Option.is_some (WI.workout_mapping w' ~source_name:"Barbell Squat")); 148 Alcotest.(check (option string)) 149 "acknowledgement persisted" (Some "to failure") 150 (WI.workout_acknowledgement w'); 151 Alcotest.(check int) 152 "no blockers remain" 0 153 (List.length (WI.blockers w')) ); 154 ] 155 156 let promotion_tests = 157 [ 158 ( "a blocked workout stays stored; an eligible sibling promotes via batch", 159 `Quick, 160 fun () -> 161 let s, t = fixture () in 162 let w1 = 163 workout ~id:"w1" ~title:"Legs" ~started_at:(at 0) ~ended_at:(at 3_600) 164 ~sets:[ set ~row:1 ~name:"Barbell Squat" ~kg:100. ~reps:8 () ] 165 in 166 let w2 = 167 workout ~id:"w2" ~title:"Delts" ~started_at:(at 0) 168 ~ended_at:(at 3_600) 169 ~sets:[ set ~row:2 ~name:"Side Raise" ~kg:12. ~reps:9 () ] 170 in 171 ok (run (S.store_import_batch s t (batch ~id:"b1" [ w1; w2 ]))); 172 ignore 173 (map s t ~batch:"b1" ~workout:"w1" ~name:"Barbell Squat" 174 (get "squats")); 175 let result = 176 ok (run (S.promote_import_batch s t ~batch:(WI.batch_id "b1"))) 177 in 178 Alcotest.(check int) 179 "one workout promoted" 1 180 (List.length result.WI.promoted); 181 Alcotest.(check int) 182 "one workout blocked" 1 183 (List.length result.WI.blocked); 184 Alcotest.(check int) 185 "one imported record written" 1 186 (List.length (run (S.imported_records s t))); 187 let reloaded = 188 Option.get (run (S.find_import_batch s t (WI.batch_id "b1"))) 189 in 190 Alcotest.(check bool) 191 "blocked workout retained" true 192 (Option.is_some (WI.find_workout reloaded (WI.workout_id "w2"))) ); 193 ( "promoting a workout writes one record with all its observations", 194 `Quick, 195 fun () -> 196 let s, t = fixture () in 197 let w = 198 workout ~id:"w1" ~title:"Legs" ~started_at:(at 0) ~ended_at:(at 3_600) 199 ~sets: 200 [ 201 set ~row:1 ~name:"Barbell Squat" ~kg:100. ~reps:8 (); 202 set ~row:2 ~set_index:2 ~name:"Barbell Squat" ~kg:100. ~reps:6 203 (); 204 ] 205 in 206 ok (run (S.store_import_batch s t (batch ~id:"b1" [ w ]))); 207 ignore 208 (map s t ~batch:"b1" ~workout:"w1" ~name:"Barbell Squat" 209 (get "squats")); 210 let _ = 211 ok 212 (run 213 (S.promote_import_workout s t ~batch:(WI.batch_id "b1") 214 ~workout:(WI.workout_id "w1"))) 215 in 216 (match run (S.imported_records s t) with 217 | [ record ] -> 218 Alcotest.(check int) 219 "both observations in one record" 2 220 (List.length record.Repository.observations) 221 | records -> 222 Alcotest.failf "expected one record, got %d" (List.length records)); 223 let again = 224 ok 225 (run 226 (S.promote_import_workout s t ~batch:(WI.batch_id "b1") 227 ~workout:(WI.workout_id "w1"))) 228 in 229 (match again with 230 | WI.Already_promoted _ -> () 231 | _ -> Alcotest.fail "expected Already_promoted on repeat"); 232 Alcotest.(check int) 233 "still one record, no duplication" 1 234 (List.length (run (S.imported_records s t))); 235 match run (S.imported_records s t) with 236 | [ record ] -> 237 Alcotest.(check int) 238 "still two observations" 2 239 (List.length record.Repository.observations) 240 | _ -> Alcotest.fail "expected one record" ); 241 ( "deleting a batch leaves its promoted record", 242 `Quick, 243 fun () -> 244 let s, t = fixture () in 245 let _ = ready_batch s t ~id:"b1" ~ended_at:(at 3_600) in 246 let _ = 247 ok 248 (run 249 (S.promote_import_workout s t ~batch:(WI.batch_id "b1") 250 ~workout:(WI.workout_id "b1-w"))) 251 in 252 Alcotest.(check bool) 253 "batch deleted" true 254 (run (S.delete_import_batch s t (WI.batch_id "b1"))); 255 Alcotest.(check bool) 256 "batch gone" true 257 (Option.is_none (run (S.find_import_batch s t (WI.batch_id "b1")))); 258 Alcotest.(check int) 259 "record survives" 1 260 (List.length (run (S.imported_records s t))) ); 261 ] 262 263 (* Build, map, and promote a one-set squats workout at [ended_at]. *) 264 let promote_squats s t ~id ~ended_at ~kg ~reps = 265 let w = 266 workout ~id:(id ^ "-w") ~title:"Legs" ~started_at:ended_at ~ended_at 267 ~sets:[ set ~row:1 ~name:"Barbell Squat" ~kg ~reps () ] 268 in 269 ok (run (S.store_import_batch s t (batch ~id ~fingerprint:id [ w ]))); 270 ignore 271 (map s t ~batch:id ~workout:(id ^ "-w") ~name:"Barbell Squat" (get "squats")); 272 ignore 273 (run 274 (S.promote_import_workout s t ~batch:(WI.batch_id id) 275 ~workout:(WI.workout_id (id ^ "-w")))) 276 277 let progression_tests = 278 [ 279 ( "two imported observations turn insufficient data into a verdict", 280 `Quick, 281 fun () -> 282 let s, t = fixture () in 283 promote_squats s t ~id:"b1" ~ended_at:(day 1) ~kg:100. ~reps:8; 284 (match run (S.progress s t (get "squats")) with 285 | Error Progress.Insufficient_data -> () 286 | _ -> Alcotest.fail "one observation should be insufficient"); 287 promote_squats s t ~id:"b2" ~ended_at:(day 3) ~kg:105. ~reps:8; 288 Alcotest.(check bool) 289 "progressing on two imports" true 290 (run (S.progress s t (get "squats")) = Ok Progress.Progressing) ); 291 ( "a flat fortnight of imports reads as a stall", 292 `Quick, 293 fun () -> 294 let s, t = fixture () in 295 promote_squats s t ~id:"b1" ~ended_at:(day 10) ~kg:110. ~reps:8; 296 (match run (S.progress s t (get "squats")) with 297 | Error Progress.Insufficient_data -> () 298 | _ -> Alcotest.fail "one observation should be insufficient"); 299 promote_squats s t ~id:"b2" ~ended_at:(day 25) ~kg:110. ~reps:8; 300 Alcotest.(check bool) 301 "stalled after a flat fortnight" true 302 (run (S.progress s t (get "squats")) = Ok Progress.Stalled) ); 303 ( "imported records for another exercise are excluded", 304 `Quick, 305 fun () -> 306 let s, t = fixture () in 307 promote_squats s t ~id:"b1" ~ended_at:(day 1) ~kg:100. ~reps:8; 308 promote_squats s t ~id:"b2" ~ended_at:(day 3) ~kg:105. ~reps:8; 309 match run (S.progress s t (get "laterals")) with 310 | Error Progress.Insufficient_data -> () 311 | _ -> Alcotest.fail "laterals should have no evidence" ); 312 ] 313 314 let recovery_tests = 315 [ 316 ( "the latest promoted import gates recovery for 48h, then ready", 317 `Quick, 318 fun () -> 319 let s, t = fixture () in 320 promote_squats s t ~id:"b1" ~ended_at:(day 10) ~kg:100. ~reps:8; 321 let early = 322 ok 323 (run 324 (S.readiness s t ~routine:ideal 325 ~now:(at ((10 * 86_400) + hours 24)))) 326 in 327 Alcotest.(check bool) 328 "recovering at 24h" false (Recovery.is_ready early); 329 let late = 330 ok 331 (run 332 (S.readiness s t ~routine:ideal 333 ~now:(at ((10 * 86_400) + hours 48)))) 334 in 335 Alcotest.(check bool) "ready at 48h" true (Recovery.is_ready late) ); 336 ( "an imported promotion never advances the routine cycle", 337 `Quick, 338 fun () -> 339 let s, t = fixture () in 340 let before = ok (run (S.next_workout s t ~routine:ideal)) in 341 promote_squats s t ~id:"b1" ~ended_at:(day 1) ~kg:100. ~reps:8; 342 let after = ok (run (S.next_workout s t ~routine:ideal)) in 343 Alcotest.(check string) 344 "next workout unchanged by an import" 345 (Prescription.Workout.name before) 346 (Prescription.Workout.name after) ); 347 ( "native later than imported controls recovery", 348 `Quick, 349 fun () -> 350 let s, t = fixture () in 351 promote_squats s t ~id:"b1" ~ended_at:(day 1) ~kg:100. ~reps:8; 352 let _ = 353 ok (run (S.begin_workout s t ~routine:ideal ~now:(day 10) ())) 354 in 355 let _ = run (S.finish s t ~ended_at:(day 10)) in 356 let r = 357 ok 358 (run 359 (S.readiness s t ~routine:ideal 360 ~now:(at ((10 * 86_400) + hours 24)))) 361 in 362 Alcotest.(check bool) 363 "native end governs, still recovering" false (Recovery.is_ready r) ); 364 ( "imported later than native controls recovery", 365 `Quick, 366 fun () -> 367 let s, t = fixture () in 368 let _ = ok (run (S.begin_workout s t ~routine:ideal ~now:(day 1) ())) in 369 let _ = run (S.finish s t ~ended_at:(day 1)) in 370 promote_squats s t ~id:"b1" ~ended_at:(day 10) ~kg:100. ~reps:8; 371 let recovering = 372 ok 373 (run 374 (S.readiness s t ~routine:ideal 375 ~now:(at ((10 * 86_400) + hours 24)))) 376 in 377 Alcotest.(check bool) 378 "import end governs, still recovering" false 379 (Recovery.is_ready recovering); 380 let ready = 381 ok 382 (run 383 (S.readiness s t ~routine:ideal 384 ~now:(at ((10 * 86_400) + hours 48)))) 385 in 386 Alcotest.(check bool) 387 "ready 48h after the governing import" true (Recovery.is_ready ready) 388 ); 389 ] 390 391 let diagnostics_tests = 392 [ 393 ( "diagnostics exclude imports", 394 `Quick, 395 fun () -> 396 let s, t = fixture () in 397 promote_squats s t ~id:"b1" ~ended_at:(day 1) ~kg:100. ~reps:8; 398 promote_squats s t ~id:"b2" ~ended_at:(day 3) ~kg:105. ~reps:8; 399 Alcotest.(check int) 400 "no diagnostics from imports alone" 0 401 (List.length (run (S.diagnostics s t))) ); 402 ] 403 404 let suite = 405 [ 406 ("import_service.store", store_tests); 407 ("import_service.promotion", promotion_tests); 408 ("import_service.progression", progression_tests); 409 ("import_service.recovery", recovery_tests); 410 ("import_service.diagnostics", diagnostics_tests); 411 ] 412