1 (** Tests for the workout-import persistence operations on {!Test_repo}: 2 per-trainee isolation, deterministic ordering, that deleting a provisional 3 batch leaves promoted records, and that a promoted record is replaced by 4 workout id. *) 5 6 open Hito_app 7 module WI = Workout_import 8 9 let run = Lwt_main.run 10 11 let get id = 12 match Exercise.find_id id with 13 | Some e -> e 14 | None -> Alcotest.failf "catalog is missing %S" id 15 16 let at s = Recovery.timestamp_of_unix_seconds s 17 let ok = function Ok v -> v | Error _ -> Alcotest.fail "expected Ok" 18 let wid = WI.workout_id 19 20 (* A trainee id minted directly; the import operations never consult the 21 account table. *) 22 let trainee n = Trainee.id (Printf.sprintf "t%d" n) 23 24 let set ~name ~kind ~kg ~reps : WI.source_set = 25 { 26 row = 1; 27 exercise_name = name; 28 set_index = 1; 29 set_type = kind; 30 weight_kg = kg; 31 reps; 32 superset_id = None; 33 } 34 35 let batch ~id ~imported_at = 36 let sets = [ set ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8 ] in 37 let w = 38 ok 39 (WI.make_workout ~id:(wid "w1") ~title:"Legs" ~started_at:(at 10) 40 ~ended_at:(at 3_610) ~sets) 41 in 42 WI.make_batch ~id:(WI.batch_id id) ~source:"raw" ~fingerprint:"fp" 43 ~imported_at ~workouts:[ w ] ~warnings:[] 44 45 let record ~batch_id ~workout_id ~revision ~ended_at ~load : 46 Repository.imported_record = 47 let exercise = get "squats" in 48 let effort = 49 Result.get_ok 50 (Evidence.Stimulus.Effort.make ~exercise ~load ~reps:8 51 ~outcome:Evidence.Stimulus.Positive_failure) 52 in 53 let obs = 54 Evidence.Observation.make ~exercise ~effort ~performed_at:ended_at 55 in 56 { 57 batch_id = WI.batch_id batch_id; 58 workout_id = WI.workout_id workout_id; 59 revision; 60 title = "Legs"; 61 started_at = at 10; 62 ended_at; 63 observations = [ obs ]; 64 provenance = 65 { 66 WI.batch_id = WI.batch_id batch_id; 67 workout_id = WI.workout_id workout_id; 68 source_rows = [ 1 ]; 69 normal_confirmation = None; 70 revision; 71 }; 72 } 73 74 let batch_ids bs = 75 List.map (fun b -> WI.batch_id_to_string (WI.batch_identity b)) bs 76 77 let repository_tests = 78 [ 79 ( "batches and records are isolated per trainee", 80 `Quick, 81 fun () -> 82 let repo = Test_repo.create () in 83 let a = trainee 1 and b = trainee 2 in 84 run 85 (Test_repo.save_import_batch repo a 86 (batch ~id:"ba" ~imported_at:(at 100))); 87 run 88 (Test_repo.replace_imported_record repo a 89 (record ~batch_id:"ba" ~workout_id:"w1" ~revision:0 90 ~ended_at:(at 3_610) ~load:100.)); 91 Alcotest.(check int) 92 "b has no batches" 0 93 (List.length (run (Test_repo.import_batches repo b))); 94 Alcotest.(check int) 95 "b has no records" 0 96 (List.length (run (Test_repo.imported_records repo b))); 97 Alcotest.(check int) 98 "a has one batch" 1 99 (List.length (run (Test_repo.import_batches repo a))) ); 100 ( "batches list most recent imported_at first, ties by id descending", 101 `Quick, 102 fun () -> 103 let repo = Test_repo.create () in 104 let a = trainee 1 in 105 run 106 (Test_repo.save_import_batch repo a 107 (batch ~id:"b1" ~imported_at:(at 100))); 108 run 109 (Test_repo.save_import_batch repo a 110 (batch ~id:"b3" ~imported_at:(at 300))); 111 run 112 (Test_repo.save_import_batch repo a 113 (batch ~id:"b2a" ~imported_at:(at 200))); 114 run 115 (Test_repo.save_import_batch repo a 116 (batch ~id:"b2b" ~imported_at:(at 200))); 117 Alcotest.(check (list string)) 118 "newest first, id tie-break descending" 119 [ "b3"; "b2b"; "b2a"; "b1" ] 120 (batch_ids (run (Test_repo.import_batches repo a))) ); 121 ( "saving a batch with the same id replaces it", 122 `Quick, 123 fun () -> 124 let repo = Test_repo.create () in 125 let a = trainee 1 in 126 run 127 (Test_repo.save_import_batch repo a 128 (batch ~id:"b1" ~imported_at:(at 100))); 129 run 130 (Test_repo.save_import_batch repo a 131 (batch ~id:"b1" ~imported_at:(at 500))); 132 let bs = run (Test_repo.import_batches repo a) in 133 Alcotest.(check int) "still one batch" 1 (List.length bs); 134 Alcotest.(check int) 135 "imported_at updated" 500 136 (Recovery.timestamp_to_unix_seconds 137 (WI.batch_imported_at (List.hd bs))) ); 138 ( "find_import_batch returns the stored batch or none", 139 `Quick, 140 fun () -> 141 let repo = Test_repo.create () in 142 let a = trainee 1 in 143 run 144 (Test_repo.save_import_batch repo a 145 (batch ~id:"b1" ~imported_at:(at 100))); 146 Alcotest.(check bool) 147 "found" true 148 (Option.is_some 149 (run (Test_repo.find_import_batch repo a (WI.batch_id "b1")))); 150 Alcotest.(check bool) 151 "absent" false 152 (Option.is_some 153 (run (Test_repo.find_import_batch repo a (WI.batch_id "nope")))) ); 154 ( "deleting a batch leaves promoted records untouched", 155 `Quick, 156 fun () -> 157 let repo = Test_repo.create () in 158 let a = trainee 1 in 159 run 160 (Test_repo.save_import_batch repo a 161 (batch ~id:"b1" ~imported_at:(at 100))); 162 run 163 (Test_repo.replace_imported_record repo a 164 (record ~batch_id:"b1" ~workout_id:"w1" ~revision:0 165 ~ended_at:(at 3_610) ~load:100.)); 166 let deleted = 167 run (Test_repo.delete_import_batch repo a (WI.batch_id "b1")) 168 in 169 Alcotest.(check bool) "batch deleted" true deleted; 170 Alcotest.(check int) 171 "no batches remain" 0 172 (List.length (run (Test_repo.import_batches repo a))); 173 Alcotest.(check int) 174 "record survives" 1 175 (List.length (run (Test_repo.imported_records repo a))) ); 176 ( "deleting an absent batch reports false", 177 `Quick, 178 fun () -> 179 let repo = Test_repo.create () in 180 let a = trainee 1 in 181 Alcotest.(check bool) 182 "nothing to delete" false 183 (run (Test_repo.delete_import_batch repo a (WI.batch_id "ghost"))) ); 184 ( "a promoted record is replaced by workout id", 185 `Quick, 186 fun () -> 187 let repo = Test_repo.create () in 188 let a = trainee 1 in 189 run 190 (Test_repo.replace_imported_record repo a 191 (record ~batch_id:"b1" ~workout_id:"w1" ~revision:0 192 ~ended_at:(at 3_610) ~load:100.)); 193 run 194 (Test_repo.replace_imported_record repo a 195 (record ~batch_id:"b1" ~workout_id:"w1" ~revision:1 196 ~ended_at:(at 3_610) ~load:110.)); 197 let records = run (Test_repo.imported_records repo a) in 198 Alcotest.(check int) "still one record" 1 (List.length records); 199 Alcotest.(check int) 200 "revision advanced" 1 (List.hd records).Repository.revision; 201 let load = 202 Evidence.Stimulus.Effort.load 203 (Evidence.Observation.effort 204 (List.hd (List.hd records).Repository.observations)) 205 in 206 Alcotest.(check (float 0.001)) "load replaced" 110. load ); 207 ( "records list most recent ended_at first", 208 `Quick, 209 fun () -> 210 let repo = Test_repo.create () in 211 let a = trainee 1 in 212 run 213 (Test_repo.replace_imported_record repo a 214 (record ~batch_id:"b1" ~workout_id:"w1" ~revision:0 215 ~ended_at:(at 1_000) ~load:100.)); 216 run 217 (Test_repo.replace_imported_record repo a 218 (record ~batch_id:"b1" ~workout_id:"w2" ~revision:0 219 ~ended_at:(at 9_000) ~load:100.)); 220 run 221 (Test_repo.replace_imported_record repo a 222 (record ~batch_id:"b1" ~workout_id:"w3" ~revision:0 223 ~ended_at:(at 5_000) ~load:100.)); 224 let ended = 225 List.map 226 (fun r -> Recovery.timestamp_to_unix_seconds r.Repository.ended_at) 227 (run (Test_repo.imported_records repo a)) 228 in 229 Alcotest.(check (list int)) 230 "newest ended_at first" [ 9_000; 5_000; 1_000 ] ended ); 231 ] 232 233 let suite = [ ("import_repository", repository_tests) ] 234