1 (** Tests for the workout-import operations on {!Sqlite_repo}: a batch's full 2 state — mappings, acknowledgement, revision, and prior promotion — survives 3 a reconnect, a re-promotion after reconnect is {!Already_promoted}, edits 4 persist, promoted records replace by workout id, deleting a batch leaves its 5 records, and trainees stay isolated. *) 6 7 open Hito_app 8 open Hito_persistence 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 wid = WI.workout_id 21 let trainee n = Trainee.id (Printf.sprintf "t%d" n) 22 23 let temp_uri () = 24 let path = Filename.temp_file "hito-import-" ".sqlite" in 25 Sys.remove path; 26 (path, "sqlite3:" ^ path) 27 28 let connect uri = ok (run (Sqlite_repo.connect uri)) 29 30 let cleanup path = 31 List.iter 32 (fun suffix -> try Sys.remove (path ^ suffix) with Sys_error _ -> ()) 33 [ ""; "-wal"; "-shm" ] 34 35 let set ~name ~kind ~kg ~reps : WI.source_set = 36 { 37 row = 1; 38 exercise_name = name; 39 set_index = 1; 40 set_type = kind; 41 weight_kg = kg; 42 reps; 43 superset_id = None; 44 } 45 46 (* A batch with one failure set and one normal set, so promotion needs both a 47 mapping and an acknowledgement. *) 48 let sample_batch () = 49 let sets = 50 [ 51 set ~name:"Barbell Squat" ~kind:WI.Failure ~kg:100. ~reps:8; 52 set ~name:"Barbell Squat" ~kind:WI.Normal ~kg:60. ~reps:10; 53 ] 54 in 55 let w = 56 ok 57 (WI.make_workout ~id:(wid "w1") ~title:"Legs" ~started_at:(at 10) 58 ~ended_at:(at 3_610) ~sets) 59 in 60 WI.make_batch ~id:(WI.batch_id "b1") ~source:"raw,source\ntext" 61 ~fingerprint:"fp" ~imported_at:(at 5_000) ~workouts:[ w ] ~warnings:[] 62 63 (* Fully clean and promote the sample batch. *) 64 let cleaned_and_promoted () = 65 let b = sample_batch () 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 b = 72 ok 73 (WI.confirm_normal_sets b ~workout:(wid "w1") 74 ~acknowledgement:"all taken to failure") 75 in 76 let b, _ = ok (WI.promote_workout b (wid "w1")) in 77 b 78 79 let with_file f = 80 let path, uri = temp_uri () in 81 Fun.protect ~finally:(fun () -> cleanup path) (fun () -> f uri) 82 83 let tests = 84 [ 85 ( "a full batch state survives a reconnect", 86 `Quick, 87 fun () -> 88 with_file (fun uri -> 89 (let repo = connect uri in 90 run 91 (Sqlite_repo.save_import_batch repo (trainee 1) 92 (cleaned_and_promoted ()))); 93 (* Reconnect to the same file with a fresh repo value. *) 94 let repo = connect uri in 95 let b = 96 Option.get 97 (run 98 (Sqlite_repo.find_import_batch repo (trainee 1) 99 (WI.batch_id "b1"))) 100 in 101 let w = Option.get (WI.find_workout b (wid "w1")) in 102 Alcotest.(check string) 103 "source survives" "raw,source\ntext" (WI.batch_source b); 104 Alcotest.(check bool) 105 "mapping survives" true 106 (Option.is_some 107 (WI.workout_mapping w ~source_name:"Barbell Squat")); 108 Alcotest.(check (option string)) 109 "acknowledgement survives" (Some "all taken to failure") 110 (WI.workout_acknowledgement w); 111 Alcotest.(check (list string)) 112 "no blockers" [] 113 (List.map (fun _ -> "blocker") (WI.blockers w))) ); 114 ( "a repeated promotion after reconnect is Already_promoted", 115 `Quick, 116 fun () -> 117 with_file (fun uri -> 118 (let repo = connect uri in 119 run 120 (Sqlite_repo.save_import_batch repo (trainee 1) 121 (cleaned_and_promoted ()))); 122 let repo = connect uri in 123 let b = 124 Option.get 125 (run 126 (Sqlite_repo.find_import_batch repo (trainee 1) 127 (WI.batch_id "b1"))) 128 in 129 let _, result = ok (WI.promote_workout b (wid "w1")) in 130 match result with 131 | WI.Already_promoted p -> 132 Alcotest.(check int) 133 "two observations" 2 134 (List.length p.observations) 135 | WI.Promoted _ -> Alcotest.fail "expected Already_promoted" 136 | WI.Blocked _ -> 137 Alcotest.fail "expected Already_promoted, not Blocked") ); 138 ( "an edited batch (re-mapped, re-promoted) persists across reconnect", 139 `Quick, 140 fun () -> 141 with_file (fun uri -> 142 (let repo = connect uri in 143 let b = cleaned_and_promoted () in 144 (* Edit: re-map to a different exercise, which bumps the revision 145 and makes the stored promotion stale. Re-promote at the new 146 revision, then save. *) 147 let b = 148 ok 149 (WI.map_exercise b ~workout:(wid "w1") 150 ~source_name:"Barbell Squat" (get "leg-presses")) 151 in 152 let b, result = ok (WI.promote_workout b (wid "w1")) in 153 (match result with 154 | WI.Promoted _ -> () 155 | _ -> Alcotest.fail "expected a fresh promotion after the edit"); 156 run (Sqlite_repo.save_import_batch repo (trainee 1) b)); 157 let repo = connect uri in 158 let b = 159 Option.get 160 (run 161 (Sqlite_repo.find_import_batch repo (trainee 1) 162 (WI.batch_id "b1"))) 163 in 164 let w = Option.get (WI.find_workout b (wid "w1")) in 165 (match WI.workout_mapping w ~source_name:"Barbell Squat" with 166 | Some e -> 167 Alcotest.(check bool) 168 "re-mapped exercise persists" true 169 (Exercise.equal e (get "leg-presses")) 170 | None -> Alcotest.fail "expected the edited mapping to survive"); 171 let _, result = ok (WI.promote_workout b (wid "w1")) in 172 match result with 173 | WI.Already_promoted _ -> () 174 | _ -> 175 Alcotest.fail 176 "expected the edited promotion to be Already_promoted") ); 177 ( "a promoted record persists and is replaced by workout id", 178 `Quick, 179 fun () -> 180 with_file (fun uri -> 181 let mk revision load : Repository.imported_record = 182 let exercise = get "squats" in 183 let effort = 184 Result.get_ok 185 (Evidence.Stimulus.Effort.make ~exercise ~load ~reps:8 186 ~outcome:Evidence.Stimulus.Positive_failure) 187 in 188 let obs = 189 Evidence.Observation.make ~exercise ~effort 190 ~performed_at:(at 3_610) 191 in 192 { 193 batch_id = WI.batch_id "b1"; 194 workout_id = wid "w1"; 195 revision; 196 title = "Legs"; 197 started_at = at 10; 198 ended_at = at 3_610; 199 observations = [ obs ]; 200 provenance = 201 { 202 WI.batch_id = WI.batch_id "b1"; 203 workout_id = wid "w1"; 204 source_rows = [ 1 ]; 205 normal_confirmation = None; 206 revision; 207 }; 208 } 209 in 210 (let repo = connect uri in 211 run 212 (Sqlite_repo.replace_imported_record repo (trainee 1) (mk 0 100.)); 213 run 214 (Sqlite_repo.replace_imported_record repo (trainee 1) (mk 1 110.))); 215 let repo = connect uri in 216 let records = run (Sqlite_repo.imported_records repo (trainee 1)) in 217 Alcotest.(check int) 218 "one record after replace" 1 (List.length records); 219 Alcotest.(check int) 220 "revision advanced" 1 (List.hd records).Repository.revision; 221 let load = 222 Evidence.Stimulus.Effort.load 223 (Evidence.Observation.effort 224 (List.hd (List.hd records).Repository.observations)) 225 in 226 Alcotest.(check (float 0.001)) "load replaced" 110. load) ); 227 ( "deleting a batch leaves its promoted record", 228 `Quick, 229 fun () -> 230 with_file (fun uri -> 231 let record : Repository.imported_record = 232 let exercise = get "squats" in 233 let effort = 234 Result.get_ok 235 (Evidence.Stimulus.Effort.make ~exercise ~load:100. ~reps:8 236 ~outcome:Evidence.Stimulus.Positive_failure) 237 in 238 let obs = 239 Evidence.Observation.make ~exercise ~effort 240 ~performed_at:(at 3_610) 241 in 242 { 243 batch_id = WI.batch_id "b1"; 244 workout_id = wid "w1"; 245 revision = 0; 246 title = "Legs"; 247 started_at = at 10; 248 ended_at = at 3_610; 249 observations = [ obs ]; 250 provenance = 251 { 252 WI.batch_id = WI.batch_id "b1"; 253 workout_id = wid "w1"; 254 source_rows = [ 1 ]; 255 normal_confirmation = None; 256 revision = 0; 257 }; 258 } 259 in 260 let repo = connect uri in 261 run 262 (Sqlite_repo.save_import_batch repo (trainee 1) (sample_batch ())); 263 run (Sqlite_repo.replace_imported_record repo (trainee 1) record); 264 let deleted = 265 run 266 (Sqlite_repo.delete_import_batch repo (trainee 1) 267 (WI.batch_id "b1")) 268 in 269 Alcotest.(check bool) "batch deleted" true deleted; 270 Alcotest.(check int) 271 "no batch remains" 0 272 (List.length (run (Sqlite_repo.import_batches repo (trainee 1)))); 273 Alcotest.(check int) 274 "record survives" 1 275 (List.length 276 (run (Sqlite_repo.imported_records repo (trainee 1))))) ); 277 ( "batches and records stay isolated per trainee", 278 `Quick, 279 fun () -> 280 with_file (fun uri -> 281 let repo = connect uri in 282 run 283 (Sqlite_repo.save_import_batch repo (trainee 1) (sample_batch ())); 284 Alcotest.(check int) 285 "other trainee has no batches" 0 286 (List.length (run (Sqlite_repo.import_batches repo (trainee 2)))); 287 Alcotest.(check int) 288 "owner has one batch" 1 289 (List.length (run (Sqlite_repo.import_batches repo (trainee 1))))) 290 ); 291 ] 292 293 let suite = [ ("import_sqlite_repo", tests) ] 294