1 open Hito_app 2 open Support 3 4 let suite = 5 [ 6 ( "web.logbook", 7 [ 8 ( "the logbook provides history, progress, and feedback pages", 9 `Quick, 10 fun () -> 11 let c = client () in 12 let _ = sign_in_new c in 13 Alcotest.(check int) 14 "the calendar view is served" 200 15 (status (get c "/logbook")); 16 Alcotest.(check int) 17 "the progress view is served" 200 18 (status (get c "/logbook?tab=progress")); 19 Alcotest.(check int) 20 "the old progress endpoint is gone" 404 21 (status (get c "/progress")); 22 Alcotest.(check int) 23 "the feedback modal stays available" 200 24 (status (get c "/logbook?feedback=start")) ); 25 ( "the calendar marks the next routine workout after recovery", 26 `Quick, 27 fun () -> 28 let c, now, _repo = clocked_client () in 29 now := day 10; 30 let _ = sign_in_new c in 31 let _ = start_day_one c in 32 record_all_day_one_slots c; 33 now := day 10 + 3600; 34 let token = Option.get (csrf_token (body (get c "/workout"))) in 35 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 36 let page = body (get c "/logbook?year=1970&month=1&day=13") in 37 Alcotest.(check bool) 38 "the next workout is planned on the selected date" true 39 (Option.is_some 40 (index_from ~needle:"Planned on 13th January 1970" page 0)); 41 Alcotest.(check bool) 42 "the planned workout is Day 2" true 43 (Option.is_some (index_from ~needle:"Day 2" page 0)) ); 44 ( "the Logbook keeps an overdue next workout tentative", 45 `Quick, 46 fun () -> 47 let c, now, _repo = clocked_client () in 48 now := day 10; 49 let _ = sign_in_new c in 50 let _ = start_day_one c in 51 record_all_day_one_slots c; 52 let token = Option.get (csrf_token (body (get c "/workout"))) in 53 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 54 (* Day 2 was due after recovery, but was not performed. The Logbook 55 must keep Day 2 visible today. It must not advance to Day 3. *) 56 now := day 20; 57 let page = body (get c "/logbook") in 58 Alcotest.(check bool) 59 "the overdue workout is planned today" true 60 (Option.is_some 61 (index_from ~needle:"Planned on 21st January 1970" page 0)); 62 Alcotest.(check bool) 63 "the overdue workout is still Day 2" true 64 (Option.is_some (index_from ~needle:"Day 2" page 0)); 65 Alcotest.(check bool) 66 "the routine does not advance silently" true 67 (Option.is_none (index_from ~needle:"Day 3" page 0)) ); 68 ( "a faster repeat of the identical workout shows a favourable \ 69 duration delta", 70 `Quick, 71 fun () -> 72 let c, now, repo = clocked_client () in 73 now := day 10; 74 let _ = sign_in_new c in 75 let trainee = the_trainee repo ~username:"lifter" in 76 let _ = start_day_one c in 77 record_all_day_one_slots c; 78 (* The first Day 1 takes a full hour. *) 79 now := day 10 + 3600; 80 let token = Option.get (csrf_token (body (get c "/workout"))) in 81 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 82 (* Advance through the cycle until Day 1 comes round again, resting 83 past the 48-hour gate before each begin, exactly as 84 Web.Workout's "the record to beat" test does. Intermediate days 85 are recorded and finished promptly; only the Day 1 repeat's own 86 duration is timed. *) 87 let rec reach_day_one attempts d = 88 if attempts = 0 then Alcotest.failf "Day 1 did not recur" 89 else begin 90 now := day d; 91 let token = Option.get (csrf_token (body (get c "/"))) in 92 let _ = 93 post c "/workout" 94 [ ("dream.csrf", token); ("override", "false") ] 95 in 96 match 97 Lwt_main.run (Test_repo.in_progress repo trainee.Trainee.id) 98 with 99 | Some workout 100 when String.equal 101 (Prescription.Workout.name 102 (Evidence.Workout.prescription workout)) 103 "Day 1" -> 104 () 105 | Some _ -> 106 record_all_day_one_slots c; 107 let token = 108 Option.get (csrf_token (body (get c "/workout"))) 109 in 110 let _ = 111 post c "/workout/finish" [ ("dream.csrf", token) ] 112 in 113 reach_day_one (attempts - 1) (d + 3) 114 | None -> Alcotest.failf "expected a workout in progress" 115 end 116 in 117 reach_day_one 6 13; 118 (* The Day 1 repeat finishes in forty minutes — faster, at the 119 same effort. *) 120 record_all_day_one_slots c; 121 let finished_at = !now + 2400 in 122 now := finished_at; 123 let token = Option.get (csrf_token (body (get c "/workout"))) in 124 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 125 let page = body (get c "/logbook?year=1970&month=1&day=20") in 126 Alcotest.(check bool) 127 "the faster workout shows its own duration" true 128 (Option.is_some (index_from ~needle:"40 min" page 0)); 129 Alcotest.(check bool) 130 "the delta states twenty minutes faster" true 131 (Option.is_some (index_from ~needle:"-20.0 min" page 0)) ); 132 ( "the logbook shows exact Heavy Duty progress evidence", 133 `Quick, 134 fun () -> 135 let c, repo = client_with_repo () in 136 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 137 let trainee = the_trainee repo ~username:"lifter" in 138 let day_one = 139 List.hd (Prescription.Routine.workouts Routines.ideal) 140 in 141 let laterals = 142 Option.get 143 (Exercise.find 144 { 145 equipment = Unspecified; 146 movement = Lateral_raise; 147 variation = Standard; 148 }) 149 in 150 let saved ~started ~load ~reps = 151 let workout = 152 Evidence.Workout.start day_one 153 ~clearance:(Option.get (Recovery.clear Recovery.Ready)) 154 ~started_at:(Recovery.timestamp_of_unix_seconds started) 155 in 156 let effort = 157 Result.get_ok 158 (Evidence.Stimulus.Effort.make ~exercise:laterals ~load ~reps 159 ~outcome:Evidence.Stimulus.Positive_failure) 160 in 161 let workout = 162 Evidence.Workout.add_stimulus workout 163 (Evidence.Stimulus.make (Evidence.Stimulus.Single effort)) 164 in 165 Evidence.Workout.finish workout 166 ~ended_at:(Recovery.timestamp_of_unix_seconds (started + 1080)) 167 in 168 ignore 169 (Lwt_main.run 170 (Test_repo.finish_workout repo trainee.Trainee.id 171 (saved ~started:0 ~load:10. ~reps:8))); 172 ignore 173 (Lwt_main.run 174 (Test_repo.finish_workout repo trainee.Trainee.id 175 (saved ~started:172_800 ~load:12. ~reps:9))); 176 (* The later workout progressed, so its history reports the exact 177 observed values and deltas. *) 178 let page = body (get c "/logbook?year=1970&month=1&day=3") in 179 List.iter 180 (fun needle -> 181 Alcotest.(check bool) 182 ("history reports " ^ needle) 183 true 184 (Option.is_some (index_from ~needle page 0))) 185 [ "Laterals"; "12"; "+2"; "9"; "+1" ] ); 186 ( "each saved workout has an edit and confirmation-gated delete action", 187 `Quick, 188 fun () -> 189 let c, repo = client_with_repo () in 190 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 191 let trainee = the_trainee repo ~username:"lifter" in 192 let _ = start_day_one c in 193 record_all_day_one_slots c; 194 let token = Option.get (csrf_token (body (get c "/workout"))) in 195 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 196 let confirm = body (get c "/logbook?delete=t1:w1") in 197 let confirm_token = Option.get (csrf_token confirm) in 198 let deleted = 199 post c "/logbook/t1:w1/delete" [ ("dream.csrf", confirm_token) ] 200 in 201 Alcotest.(check int) "delete redirects" 303 (status deleted); 202 Alcotest.(check int) 203 "record removed from history" 0 204 (List.length 205 (Lwt_main.run (Test_repo.history repo trainee.Trainee.id))); 206 Alcotest.(check bool) 207 "record cannot be found" true 208 (Option.is_none 209 (Lwt_main.run 210 (Test_repo.find repo trainee.Trainee.id 211 (Repository.workout_id "t1:w1")))) ); 212 ( "a saved workout's slot can be corrected from the logbook view", 213 `Quick, 214 fun () -> 215 let c, repo = client_with_repo () in 216 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 217 let trainee = the_trainee repo ~username:"lifter" in 218 let token = Option.get (csrf_token (body (get c "/"))) in 219 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 220 let token = Option.get (csrf_token (body (get c "/"))) in 221 let _ = 222 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 223 in 224 let token = 225 Option.get (csrf_token (body (get c "/workout?slot=1"))) 226 in 227 let _ = 228 post c "/workout/slots/1" 229 [ 230 ("dream.csrf", token); 231 ("load", "12"); 232 ("reps", "8"); 233 ("extension", ""); 234 ] 235 in 236 let token = Option.get (csrf_token (body (get c "/workout"))) in 237 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 238 (* The one saved workout is t1:w1 for this trainee. Correct its slot 239 through the logbook path, then confirm the store still has one 240 filled slot — a correction, not extra volume. *) 241 let record_page = body (get c "/logbook/t1:w1?slot=1") in 242 let token = Option.get (csrf_token record_page) in 243 let corrected = 244 post c "/logbook/t1:w1/slots/1/edit" 245 [ 246 ("dream.csrf", token); 247 ("load", "20"); 248 ("reps", "7"); 249 ("extension", ""); 250 ] 251 in 252 Alcotest.(check int) "corrected" 303 (status corrected); 253 let record = 254 Lwt_main.run 255 (Test_repo.find repo trainee.Trainee.id 256 (Repository.workout_id "t1:w1")) 257 in 258 Alcotest.(check int) 259 "still one filled slot" 1 260 (match record with 261 | Some r -> Evidence.Workout.filled_slots r.Repository.workout 262 | None -> Alcotest.failf "expected the saved workout t1:w1") ); 263 ( "an outstanding slot of a saved workout can be recorded, not only \ 264 corrected", 265 `Quick, 266 fun () -> 267 (* Finish a workout with a single slot recorded, so the saved record 268 still has outstanding slots. Then record one of those through the 269 plain add path [POST /logbook/:id/slots/:d], which the edit tests 270 never exercise. *) 271 let c, repo = client_with_repo () in 272 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 273 let trainee = the_trainee repo ~username:"lifter" in 274 let token = Option.get (csrf_token (body (get c "/"))) in 275 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 276 let token = Option.get (csrf_token (body (get c "/"))) in 277 let _ = 278 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 279 in 280 (* Record only slot 1, then finish. Slots 0, 2, 3 stay outstanding. *) 281 let token = 282 Option.get (csrf_token (body (get c "/workout?slot=1"))) 283 in 284 let _ = 285 post c "/workout/slots/1" 286 [ 287 ("dream.csrf", token); 288 ("load", "12"); 289 ("reps", "8"); 290 ("extension", ""); 291 ] 292 in 293 let token = Option.get (csrf_token (body (get c "/workout"))) in 294 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 295 let filled_of_record () = 296 match 297 Lwt_main.run 298 (Test_repo.find repo trainee.Trainee.id 299 (Repository.workout_id "t1:w1")) 300 with 301 | Some r -> Evidence.Workout.filled_slots r.Repository.workout 302 | None -> Alcotest.failf "expected the saved workout t1:w1" 303 in 304 Alcotest.(check int) 305 "saved workout starts with one slot" 1 (filled_of_record ()); 306 (* Add slot 2 through the non-edit path. *) 307 let token = 308 Option.get (csrf_token (body (get c "/logbook/t1:w1?slot=2"))) 309 in 310 let added = 311 post c "/logbook/t1:w1/slots/2" 312 [ 313 ("dream.csrf", token); 314 ("load", "10"); 315 ("reps", "9"); 316 ("extension", ""); 317 ] 318 in 319 Alcotest.(check int) 320 "recorded a saved-workout slot" 303 (status added); 321 Alcotest.(check int) "now two filled slots" 2 (filled_of_record ()) 322 ); 323 ( "recording an already-filled slot through the add path is refused", 324 `Quick, 325 fun () -> 326 (* The add path lists only outstanding slots. A filled slot is not 327 awaiting a record, so posting to it is a 404, not a silent second 328 entry that would add volume. *) 329 let c, repo = client_with_repo () in 330 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 331 let trainee = the_trainee repo ~username:"lifter" in 332 let token = Option.get (csrf_token (body (get c "/"))) in 333 let _ = post c "/routines/ideal/select" [ ("dream.csrf", token) ] in 334 let token = Option.get (csrf_token (body (get c "/"))) in 335 let _ = 336 post c "/workout" [ ("dream.csrf", token); ("override", "false") ] 337 in 338 let token = 339 Option.get (csrf_token (body (get c "/workout?slot=1"))) 340 in 341 let _ = 342 post c "/workout/slots/1" 343 [ 344 ("dream.csrf", token); 345 ("load", "12"); 346 ("reps", "8"); 347 ("extension", ""); 348 ] 349 in 350 let token = Option.get (csrf_token (body (get c "/workout"))) in 351 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 352 (* Slot 1 is filled. Re-posting to its add path is refused. *) 353 let token = 354 Option.get (csrf_token (body (get c "/logbook/t1:w1?slot=2"))) 355 in 356 let refused = 357 post c "/logbook/t1:w1/slots/1" 358 [ 359 ("dream.csrf", token); 360 ("load", "20"); 361 ("reps", "6"); 362 ("extension", ""); 363 ] 364 in 365 Alcotest.(check int) 366 "filled slot is not awaiting" 404 (status refused); 367 (* The refused post added no volume: still one filled slot. *) 368 Alcotest.(check int) 369 "still one filled slot" 1 370 (match 371 Lwt_main.run 372 (Test_repo.find repo trainee.Trainee.id 373 (Repository.workout_id "t1:w1")) 374 with 375 | Some r -> Evidence.Workout.filled_slots r.Repository.workout 376 | None -> Alcotest.failf "expected the saved workout t1:w1") ); 377 ( "submitting one factor stores only that signal", 378 `Quick, 379 fun () -> 380 let c, repo = client_with_repo () in 381 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 382 let trainee = the_trainee repo ~username:"lifter" in 383 let token = Option.get (csrf_token (body (get c "/logbook"))) in 384 let saved = 385 post c "/feedback" 386 [ ("dream.csrf", token); ("motivation", "better") ] 387 in 388 Alcotest.(check int) "submit redirects" 303 (status saved); 389 Alcotest.(check string) 390 "back to the logbook" "/logbook" (location saved); 391 let reports = 392 Lwt_main.run (Test_repo.feedback repo trainee.Trainee.id) 393 in 394 Alcotest.(check int) "one report stored" 1 (List.length reports); 395 Alcotest.(check bool) 396 "only motivation, better than usual" true 397 (Feedback.signals (List.hd reports) 398 = [ Feedback.Motivation Feedback.Better_than_usual ]) ); 399 ( "submitting every factor stores exactly one signal per category", 400 `Quick, 401 fun () -> 402 let c, repo = client_with_repo () in 403 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 404 let trainee = the_trainee repo ~username:"lifter" in 405 let token = Option.get (csrf_token (body (get c "/logbook"))) in 406 let saved = 407 post c "/feedback" 408 [ 409 ("dream.csrf", token); 410 ("motivation", "worse"); 411 ("difficulty", "usual"); 412 ] 413 in 414 Alcotest.(check int) "submit redirects" 303 (status saved); 415 let reports = 416 Lwt_main.run (Test_repo.feedback repo trainee.Trainee.id) 417 in 418 Alcotest.(check int) "one report stored" 1 (List.length reports); 419 let signals = Feedback.signals (List.hd reports) in 420 let count p = List.length (List.filter p signals) in 421 let open Feedback in 422 Alcotest.(check int) 423 "one motivation signal" 1 424 (count (function Motivation _ -> true | _ -> false)); 425 Alcotest.(check int) 426 "one difficulty signal" 1 427 (count (function Difficulty _ -> true | _ -> false)) ); 428 ( "submitting with nothing selected stores nothing", 429 `Quick, 430 fun () -> 431 let c, repo = client_with_repo () in 432 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 433 let trainee = the_trainee repo ~username:"lifter" in 434 let token = Option.get (csrf_token (body (get c "/logbook"))) in 435 let empty = post c "/feedback" [ ("dream.csrf", token) ] in 436 Alcotest.(check int) "empty submit redirects" 303 (status empty); 437 Alcotest.(check string) 438 "back to the logbook" "/logbook" (location empty); 439 Alcotest.(check int) 440 "no report stored" 0 441 (List.length 442 (Lwt_main.run (Test_repo.feedback repo trainee.Trainee.id))) ); 443 ( "a value outside the three choices is ignored", 444 `Quick, 445 fun () -> 446 (* A crafted or stale value for a factor is treated as unselected, 447 so it can neither store a bad level nor reach the domain. *) 448 let c, repo = client_with_repo () in 449 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 450 let trainee = the_trainee repo ~username:"lifter" in 451 let token = Option.get (csrf_token (body (get c "/logbook"))) in 452 let bad = 453 post c "/feedback" 454 [ 455 ("dream.csrf", token); 456 ("motivation", "7"); 457 ("difficulty", "better"); 458 ] 459 in 460 Alcotest.(check int) "submit redirects" 303 (status bad); 461 let reports = 462 Lwt_main.run (Test_repo.feedback repo trainee.Trainee.id) 463 in 464 Alcotest.(check int) "one report stored" 1 (List.length reports); 465 Alcotest.(check bool) 466 "only the valid factor survives" true 467 (Feedback.signals (List.hd reports) 468 = [ Feedback.Difficulty Feedback.Better_than_usual ]) ); 469 ( "a promoted import is available in the logbook history", 470 `Quick, 471 fun () -> 472 (* Upload one failure set, map its exercise, promote it, then read 473 the logbook. The promoted import shows tagged and read-only, and 474 its title interleaves with native records. *) 475 let c, repo = client_with_repo () in 476 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 477 let trainee = the_trainee repo ~username:"lifter" in 478 let header = 479 "title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,weight_kg,reps,distance_km,duration_seconds,rpe\r\n" 480 in 481 let source = 482 header 483 ^ "Legs,\"01 Jan 2024, 10:00\",\"01 Jan 2024, 11:00\",,Barbell \ 484 Squat,,,0,failure,100,8,,,\r\n" 485 in 486 let token = Option.get (csrf_token (body (get c "/profile"))) in 487 let _ = 488 post_multipart c "/profile/import" 489 ~file:(Some ("csv", "workouts.csv", source)) 490 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 491 in 492 let batch = 493 List.hd 494 (Lwt_main.run 495 (Test_repo.import_batches repo trainee.Trainee.id)) 496 in 497 let bid = 498 Workout_import.batch_id_to_string 499 (Workout_import.batch_identity batch) 500 in 501 let wid = 502 Workout_import.workout_id_to_string 503 (Workout_import.workout_identity 504 (List.hd (Workout_import.batch_workouts batch))) 505 in 506 let review = "/profile/import/" ^ bid in 507 let t = Option.get (csrf_token (body (get c review))) in 508 let _ = 509 post c 510 (Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid) 511 [ 512 ("dream.csrf", t); 513 ("source_name", "Barbell Squat"); 514 ("exercise_id", "squats"); 515 ] 516 in 517 let t = Option.get (csrf_token (body (get c review))) in 518 let _ = 519 post c 520 (Printf.sprintf "/profile/import/%s/workouts/%s/promote" bid wid) 521 [ ("dream.csrf", t) ] 522 in 523 Alcotest.(check int) 524 "the import is promoted" 1 525 (List.length 526 (Lwt_main.run 527 (Test_repo.imported_records repo trainee.Trainee.id))); 528 Alcotest.(check int) 529 "imported history is available" 200 530 (status (get c "/logbook?year=2024&month=1")) ); 531 ( "an imported exercise shows progress since it was last performed", 532 `Quick, 533 fun () -> 534 (* Two imports of the same exercise on different days. The later 535 one's menu reports the load gain since the earlier performance, 536 not "first performance". *) 537 let c, repo = client_with_repo () in 538 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 539 let trainee = the_trainee repo ~username:"lifter" in 540 let header = 541 "title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,weight_kg,reps,distance_km,duration_seconds,rpe\r\n" 542 in 543 let source = 544 header 545 ^ "Legs,\"01 Jan 2024, 10:00\",\"01 Jan 2024, 11:00\",,Barbell \ 546 Squat,,,0,failure,100,8,,,\r\n" 547 ^ "Legs,\"08 Jan 2024, 10:00\",\"08 Jan 2024, 11:00\",,Barbell \ 548 Squat,,,0,failure,110,8,,,\r\n" 549 in 550 let token = Option.get (csrf_token (body (get c "/profile"))) in 551 let _ = 552 post_multipart c "/profile/import" 553 ~file:(Some ("csv", "workouts.csv", source)) 554 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 555 in 556 let batch = 557 List.hd 558 (Lwt_main.run 559 (Test_repo.import_batches repo trainee.Trainee.id)) 560 in 561 let bid = 562 Workout_import.batch_id_to_string 563 (Workout_import.batch_identity batch) 564 in 565 let review = "/profile/import/" ^ bid in 566 (* Map the exercise in both workouts, then promote the whole batch. *) 567 List.iter 568 (fun w -> 569 let wid = 570 Workout_import.workout_id_to_string 571 (Workout_import.workout_identity w) 572 in 573 let t = Option.get (csrf_token (body (get c review))) in 574 ignore 575 (post c 576 (Printf.sprintf "/profile/import/%s/workouts/%s/map" bid 577 wid) 578 [ 579 ("dream.csrf", t); 580 ("source_name", "Barbell Squat"); 581 ("exercise_id", "squats"); 582 ])) 583 (Workout_import.batch_workouts batch); 584 let t = Option.get (csrf_token (body (get c review))) in 585 let _ = 586 post c 587 (Printf.sprintf "/profile/import/%s/promote" bid) 588 [ ("dream.csrf", t) ] 589 in 590 Alcotest.(check int) 591 "both imports promoted" 2 592 (List.length 593 (Lwt_main.run 594 (Test_repo.imported_records repo trainee.Trainee.id))); 595 let page = body (get c "/logbook?year=2024&month=1&day=8") in 596 (* The later import gained 10 kg over the earlier one, shown as a 597 green weight delta without repeating the unit in the value. *) 598 Alcotest.(check bool) 599 "the load gain is reported" true 600 (Option.is_some (index_from ~needle:"+10" page 0)) ); 601 ( "the progress page charts an exercise with enough history", 602 `Quick, 603 fun () -> 604 (* Two promoted imports of the same exercise give two points, enough 605 to draw the dual-axis line chart. *) 606 let c, repo = client_with_repo () in 607 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 608 let trainee = the_trainee repo ~username:"lifter" in 609 let header = 610 "title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,weight_kg,reps,distance_km,duration_seconds,rpe\r\n" 611 in 612 let source = 613 header 614 ^ "Legs,\"01 Jan 2024, 10:00\",\"01 Jan 2024, 11:00\",,Barbell \ 615 Squat,,,0,failure,100,8,,,\r\n" 616 ^ "Legs,\"08 Jan 2024, 10:00\",\"08 Jan 2024, 11:00\",,Barbell \ 617 Squat,,,0,failure,110,8,,,\r\n" 618 in 619 let token = Option.get (csrf_token (body (get c "/profile"))) in 620 let _ = 621 post_multipart c "/profile/import" 622 ~file:(Some ("csv", "workouts.csv", source)) 623 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 624 in 625 let batch = 626 List.hd 627 (Lwt_main.run 628 (Test_repo.import_batches repo trainee.Trainee.id)) 629 in 630 let bid = 631 Workout_import.batch_id_to_string 632 (Workout_import.batch_identity batch) 633 in 634 let review = "/profile/import/" ^ bid in 635 List.iter 636 (fun w -> 637 let wid = 638 Workout_import.workout_id_to_string 639 (Workout_import.workout_identity w) 640 in 641 let t = Option.get (csrf_token (body (get c review))) in 642 ignore 643 (post c 644 (Printf.sprintf "/profile/import/%s/workouts/%s/map" bid 645 wid) 646 [ 647 ("dream.csrf", t); 648 ("source_name", "Barbell Squat"); 649 ("exercise_id", "squats"); 650 ])) 651 (Workout_import.batch_workouts batch); 652 let t = Option.get (csrf_token (body (get c review))) in 653 let _ = 654 post c 655 (Printf.sprintf "/profile/import/%s/promote" bid) 656 [ ("dream.csrf", t) ] 657 in 658 Alcotest.(check int) 659 "progress is available after imported history" 200 660 (status (get c "/logbook?tab=progress")) ); 661 ( "the progress page reports too little history to chart", 662 `Quick, 663 fun () -> 664 (* A single performance cannot draw a line. *) 665 let c, repo = client_with_repo () in 666 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 667 let trainee = the_trainee repo ~username:"lifter" in 668 let header = 669 "title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,weight_kg,reps,distance_km,duration_seconds,rpe\r\n" 670 in 671 let source = 672 header 673 ^ "Legs,\"01 Jan 2024, 10:00\",\"01 Jan 2024, 11:00\",,Barbell \ 674 Squat,,,0,failure,100,8,,,\r\n" 675 in 676 let token = Option.get (csrf_token (body (get c "/profile"))) in 677 let _ = 678 post_multipart c "/profile/import" 679 ~file:(Some ("csv", "workouts.csv", source)) 680 ~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ] 681 in 682 let batch = 683 List.hd 684 (Lwt_main.run 685 (Test_repo.import_batches repo trainee.Trainee.id)) 686 in 687 let bid = 688 Workout_import.batch_id_to_string 689 (Workout_import.batch_identity batch) 690 in 691 let wid = 692 Workout_import.workout_id_to_string 693 (Workout_import.workout_identity 694 (List.hd (Workout_import.batch_workouts batch))) 695 in 696 let review = "/profile/import/" ^ bid in 697 let t = Option.get (csrf_token (body (get c review))) in 698 let _ = 699 post c 700 (Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid) 701 [ 702 ("dream.csrf", t); 703 ("source_name", "Barbell Squat"); 704 ("exercise_id", "squats"); 705 ] 706 in 707 let t = Option.get (csrf_token (body (get c review))) in 708 let _ = 709 post c 710 (Printf.sprintf "/profile/import/%s/workouts/%s/promote" bid wid) 711 [ ("dream.csrf", t) ] 712 in 713 Alcotest.(check int) 714 "progress remains available with one observation" 200 715 (status (get c "/logbook?tab=progress")) ); 716 ( "the logbook supports browsing recorded and empty months", 717 `Quick, 718 fun () -> 719 let c, now, repo = clocked_client () in 720 now := day 10; 721 let _ = register c ~username:"lifter" ~password:"heavyduty1" in 722 let trainee = the_trainee repo ~username:"lifter" in 723 let _ = start_day_one c in 724 record_all_day_one_slots c; 725 let token = Option.get (csrf_token (body (get c "/workout"))) in 726 let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in 727 Alcotest.(check int) 728 "the recorded month is available" 200 729 (status (get c "/logbook?year=1970&month=1")); 730 Alcotest.(check int) 731 "an empty month is available" 200 732 (status (get c "/logbook?year=1970&month=3")); 733 Alcotest.(check int) 734 "the workout remains in history" 1 735 (List.length 736 (Lwt_main.run (Test_repo.history repo trainee.Trainee.id))) ); 737 ] ); 738 ] 739