View raw

1 (** Unit tests for {!Hevy_csv}, authored against the hevy_csv.mli contract. 2 3 The adapter turns untrusted native Hevy CSV text into a 4 {!Workout_import.batch}. These tests exercise the strict native schema: the 5 exact 14-column header in any order, RFC4180 quoting, workout grouping by 6 the datetime triple, deterministic workout ids, the local-to-UTC offset, and 7 the full family of dropped-row warnings. They also confirm the source text 8 is retained byte for byte and that a dropset parses to a set for provenance, 9 which the app layer then discards rather than promoting. *) 10 11 open Hito_app 12 module WI = Workout_import 13 module Hevy_csv = Hito_import.Hevy_csv 14 15 (* The verified native header, 14 columns in canonical order. *) 16 let header = 17 "title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,weight_kg,reps,distance_km,duration_seconds,rpe" 18 19 let bid = WI.batch_id "b1" 20 let at s = Recovery.timestamp_of_unix_seconds s 21 22 let parse ?(utc_offset_seconds = 0) source = 23 match 24 Hevy_csv.parse ~batch_id:bid ~fingerprint:"fp" ~imported_at:(at 5_000) 25 ~utc_offset_seconds source 26 with 27 | Ok b -> b 28 | Error e -> Alcotest.failf "expected Ok, got %a" Hevy_csv.pp_error e 29 30 let parse_err ?(utc_offset_seconds = 0) source = 31 match 32 Hevy_csv.parse ~batch_id:bid ~fingerprint:"fp" ~imported_at:(at 5_000) 33 ~utc_offset_seconds source 34 with 35 | Ok _ -> Alcotest.fail "expected Error" 36 | Error e -> e 37 38 (* Howard Hinnant's civil-to-days, mirrored here so the timezone test can state 39 its own expected UTC second independently of the adapter. *) 40 let days_from_civil y m d = 41 let y = if m <= 2 then y - 1 else y in 42 let era = (if y >= 0 then y else y - 399) / 400 in 43 let yoe = y - (era * 400) in 44 let doy = (((153 * if m > 2 then m - 3 else m + 9) + 2) / 5) + d - 1 in 45 let doe = (yoe * 365) + (yoe / 4) - (yoe / 100) + doy in 46 (era * 146097) + doe - 719468 47 48 let utc_of ~y ~m ~d ~hh ~mm ~offset = 49 (days_from_civil y m d * 86_400) + (hh * 3_600) + (mm * 60) - offset 50 51 let show_blocker : WI.blocker -> string = function 52 | No_sets -> "no_sets" 53 | Unmapped_exercise name -> "unmapped:" ^ name 54 | Normal_sets_unconfirmed -> "normal_unconfirmed" 55 56 let warning_reason (w : WI.warning) = 57 match w.kind with 58 | WI.Warmup_dropped -> "warmup" 59 | WI.Unsupported_row reason -> reason 60 61 (* A workout row using quoted datetimes, so the embedded comma in the Hevy 62 datetime does not split a field. Callers override any field. *) 63 let mk ?(title = "Push A") ?(start_time = "01 Jan 2025, 08:00") 64 ?(end_time = "01 Jan 2025, 09:00") ?(description = "") 65 ?(exercise_title = "Bench Press") ?(superset_id = "") ?(exercise_notes = "") 66 ?(set_index = "0") ?(set_type = "normal") ?(weight_kg = "60") ?(reps = "8") 67 ?(distance_km = "") ?(duration_seconds = "") ?(rpe = "") () = 68 let q s = "\"" ^ s ^ "\"" in 69 String.concat "," 70 [ 71 title; 72 q start_time; 73 q end_time; 74 description; 75 exercise_title; 76 superset_id; 77 exercise_notes; 78 set_index; 79 set_type; 80 weight_kg; 81 reps; 82 distance_km; 83 duration_seconds; 84 rpe; 85 ] 86 87 let doc rows = header ^ "\n" ^ String.concat "\n" rows ^ "\n" 88 89 (* {1 A real sample header and row parse into one set} *) 90 91 let real_sample_parses = 92 ( "the verified header and a real data row yield one workout with one set", 93 `Quick, 94 fun () -> 95 let b = doc [ mk () ] |> parse in 96 let workouts = WI.batch_workouts b in 97 Alcotest.(check int) "one workout" 1 (List.length workouts); 98 let w = List.hd workouts in 99 Alcotest.(check string) "title" "Push A" (WI.workout_title w); 100 let sets = WI.workout_sets w in 101 Alcotest.(check int) "one set" 1 (List.length sets); 102 let s = List.hd sets in 103 Alcotest.(check int) "set row is 2" 2 s.row; 104 Alcotest.(check string) "exercise name" "Bench Press" s.exercise_name; 105 Alcotest.(check (float 0.001)) "weight" 60. s.weight_kg; 106 Alcotest.(check int) "reps" 8 s.reps; 107 Alcotest.(check bool) "no warnings" true (WI.batch_warnings b = []) ) 108 109 (* {1 RFC4180 quoting: commas and newlines inside fields} *) 110 111 let quoted_comma_and_newline = 112 ( "quoted commas and newlines are preserved within fields", 113 `Quick, 114 fun () -> 115 let data = 116 mk ~title:"\"Legs, heavy\"" ~exercise_notes:"\"line one\nline two\"" 117 ~exercise_title:"Squat" () 118 in 119 let b = doc [ data ] |> parse in 120 let w = List.hd (WI.batch_workouts b) in 121 Alcotest.(check string) 122 "comma kept in title" "Legs, heavy" (WI.workout_title w); 123 Alcotest.(check int) 124 "one set despite embedded newline" 1 125 (List.length (WI.workout_sets w)) ) 126 127 (* {1 Header order may vary} *) 128 129 let header_reorder = 130 ( "columns are mapped by name, so a reordered header still parses", 131 `Quick, 132 fun () -> 133 let reordered = 134 "set_type,reps,weight_kg,set_index,exercise_title,title,start_time,end_time,description,superset_id,exercise_notes,distance_km,duration_seconds,rpe" 135 in 136 let q s = "\"" ^ s ^ "\"" in 137 let data = 138 String.concat "," 139 [ 140 "normal"; 141 "8"; 142 "60"; 143 "0"; 144 "Bench Press"; 145 "Push A"; 146 q "01 Jan 2025, 08:00"; 147 q "01 Jan 2025, 09:00"; 148 ""; 149 ""; 150 ""; 151 ""; 152 ""; 153 ""; 154 ] 155 in 156 let b = reordered ^ "\n" ^ data ^ "\n" |> parse in 157 let w = List.hd (WI.batch_workouts b) in 158 Alcotest.(check string) 159 "title resolved by name" "Push A" (WI.workout_title w); 160 let s = List.hd (WI.workout_sets w) in 161 Alcotest.(check int) "reps resolved by name" 8 s.reps ) 162 163 (* {1 Missing header column} *) 164 165 let missing_column = 166 ( "a header missing a required column fails with the first missing name", 167 `Quick, 168 fun () -> 169 (* Drop [weight_kg] and [reps]; [weight_kg] is earlier in canonical 170 order, so it is the reported one. *) 171 let short_header = 172 "title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,distance_km,duration_seconds,rpe" 173 in 174 match parse_err (short_header ^ "\n") with 175 | Hevy_csv.Missing_column "weight_kg" -> () 176 | e -> 177 Alcotest.failf "expected Missing_column weight_kg, got %a" 178 Hevy_csv.pp_error e ) 179 180 (* {1 Empty file} *) 181 182 let empty_file = 183 ( "empty input is Empty_file", 184 `Quick, 185 fun () -> 186 match parse_err "" with 187 | Hevy_csv.Empty_file -> () 188 | e -> Alcotest.failf "expected Empty_file, got %a" Hevy_csv.pp_error e ) 189 190 (* {1 Grouping and order} *) 191 192 let grouping_and_order = 193 ( "rows group into workouts by the triple, in first-appearance order", 194 `Quick, 195 fun () -> 196 let body = 197 [ 198 mk ~title:"Push A" ~set_index:"0" (); 199 mk ~title:"Legs A" ~start_time:"03 Jan 2025, 08:00" 200 ~end_time:"03 Jan 2025, 09:00" ~exercise_title:"Squat" 201 ~set_index:"0" (); 202 mk ~title:"Push A" ~set_index:"1" (); 203 ] 204 in 205 let b = doc body |> parse in 206 let workouts = WI.batch_workouts b in 207 Alcotest.(check int) "two workouts" 2 (List.length workouts); 208 let w1 = List.nth workouts 0 in 209 let w2 = List.nth workouts 1 in 210 Alcotest.(check string) 211 "first workout is Push A" "Push A" (WI.workout_title w1); 212 Alcotest.(check string) 213 "second workout is Legs A" "Legs A" (WI.workout_title w2); 214 Alcotest.(check int) 215 "Push A has two sets" 2 216 (List.length (WI.workout_sets w1)); 217 Alcotest.(check (list int)) 218 "rows in source order" [ 2; 4 ] 219 (List.map (fun (s : WI.source_set) -> s.row) (WI.workout_sets w1)); 220 Alcotest.(check string) 221 "first id" "b1:w1" 222 (WI.workout_id_to_string (WI.workout_identity w1)); 223 Alcotest.(check string) 224 "second id" "b1:w2" 225 (WI.workout_id_to_string (WI.workout_identity w2)) ) 226 227 (* {1 Timezone offset} *) 228 229 let timezone_offset = 230 ( "wall time is interpreted at the given offset: UTC = civil - offset", 231 `Quick, 232 fun () -> 233 let offset = 2 * 3_600 in 234 let data = 235 mk ~start_time:"01 Jan 2025, 08:00" ~end_time:"01 Jan 2025, 09:30" () 236 in 237 let b = doc [ data ] |> parse ~utc_offset_seconds:offset in 238 let w = List.hd (WI.batch_workouts b) in 239 let expected_start = utc_of ~y:2025 ~m:1 ~d:1 ~hh:8 ~mm:0 ~offset in 240 let expected_end = utc_of ~y:2025 ~m:1 ~d:1 ~hh:9 ~mm:30 ~offset in 241 Alcotest.(check int) 242 "start at offset" expected_start 243 (Recovery.timestamp_to_unix_seconds (WI.workout_started_at w)); 244 Alcotest.(check int) 245 "end at offset" expected_end 246 (Recovery.timestamp_to_unix_seconds (WI.workout_ended_at w)) ) 247 248 (* {1 Warmup dropped} *) 249 250 let warmup_dropped = 251 ( "a warmup set creates no set and one Warmup_dropped warning", 252 `Quick, 253 fun () -> 254 let b = doc [ mk ~set_type:"warmup" () ] |> parse in 255 Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b)); 256 let warnings = WI.batch_warnings b in 257 Alcotest.(check int) "one warning" 1 (List.length warnings); 258 let w = List.hd warnings in 259 Alcotest.(check int) "warning row is 2" 2 w.row; 260 Alcotest.(check bool) "warmup kind" true (w.kind = WI.Warmup_dropped); 261 Alcotest.(check (option string)) 262 "exercise name retained" (Some "Bench Press") w.exercise_name ) 263 264 (* {1 Unsupported: missing load / reps / distance-only rows} *) 265 266 let unsupported_missing_load = 267 ( "a row with empty weight becomes an Unsupported_row warning", 268 `Quick, 269 fun () -> 270 let b = doc [ mk ~weight_kg:"" () ] |> parse in 271 Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b)); 272 let w = List.hd (WI.batch_warnings b) in 273 Alcotest.(check string) 274 "reason names weight" "missing, negative, or non-finite weight_kg" 275 (warning_reason w) ) 276 277 let unsupported_negative_load = 278 ( "a row with a negative weight becomes an Unsupported_row warning", 279 `Quick, 280 fun () -> 281 (* The adapter applies the effort rule at the trust boundary: a load is 282 finite and nonnegative. A negative load is not evidence. *) 283 let b = doc [ mk ~weight_kg:"-20" () ] |> parse in 284 Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b)); 285 let w = List.hd (WI.batch_warnings b) in 286 Alcotest.(check string) 287 "reason names weight" "missing, negative, or non-finite weight_kg" 288 (warning_reason w) ) 289 290 let unsupported_missing_reps = 291 ( "a row with empty reps becomes an Unsupported_row warning", 292 `Quick, 293 fun () -> 294 let b = doc [ mk ~reps:"" () ] |> parse in 295 let w = List.hd (WI.batch_warnings b) in 296 Alcotest.(check string) 297 "reason names reps" "missing reps or fewer than one" (warning_reason w) 298 ) 299 300 let unsupported_zero_reps = 301 ( "a row with zero reps becomes an Unsupported_row warning", 302 `Quick, 303 fun () -> 304 (* A set taken to failure has at least one rep. Zero reps is not a 305 performance, so it is not evidence. *) 306 let b = doc [ mk ~reps:"0" () ] |> parse in 307 Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b)); 308 let w = List.hd (WI.batch_warnings b) in 309 Alcotest.(check string) 310 "reason names reps" "missing reps or fewer than one" (warning_reason w) 311 ) 312 313 let unsupported_distance_only = 314 ( "a distance/time row with empty weight and reps is an Unsupported_row", 315 `Quick, 316 fun () -> 317 let b = 318 doc 319 [ 320 mk ~weight_kg:"" ~reps:"" ~distance_km:"5.0" 321 ~duration_seconds:"1800" ~exercise_title:"Running" (); 322 ] 323 |> parse 324 in 325 Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b)); 326 Alcotest.(check int) "one warning" 1 (List.length (WI.batch_warnings b)) 327 ) 328 329 (* {1 Unknown set type} *) 330 331 let unknown_set_type = 332 ( "an unknown set type is a warning, not fatal", 333 `Quick, 334 fun () -> 335 let b = doc [ mk ~set_type:"myorep" () ] |> parse in 336 Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b)); 337 let w = List.hd (WI.batch_warnings b) in 338 let reason = warning_reason w in 339 Alcotest.(check bool) 340 "reason mentions unknown set type" true 341 (String.length reason >= 12 && String.sub reason 0 12 = "unknown set ") 342 ) 343 344 (* {1 Dropset parses to a set, but is discarded on promotion} *) 345 346 let dropset_parsed_then_discarded = 347 ( "a dropset parses to a set for provenance, but never promotes or blocks", 348 `Quick, 349 fun () -> 350 let b = doc [ mk ~set_type:"dropset" () ] |> parse in 351 let w = List.hd (WI.batch_workouts b) in 352 (* The parser keeps the row verbatim: the set survives for provenance. *) 353 Alcotest.(check int) 354 "one set retained" 1 355 (List.length (WI.workout_sets w)); 356 (* The app layer discards it, so a dropset-only workout has nothing to 357 promote and reduces to No_sets — not a dropset blocker. *) 358 Alcotest.(check (list string)) 359 "discarded dropset leaves only No_sets" [ "no_sets" ] 360 (List.map show_blocker (WI.blockers w)) ) 361 362 (* {1 Superset provenance} *) 363 364 let superset_provenance = 365 ( "superset_id maps empty to None, an int to Some, and rejects a bad value", 366 `Quick, 367 fun () -> 368 let b_none = doc [ mk ~superset_id:"" () ] |> parse in 369 let s_none = 370 List.hd (WI.workout_sets (List.hd (WI.batch_workouts b_none))) 371 in 372 Alcotest.(check (option int)) 373 "empty superset is None" None s_none.superset_id; 374 let b_some = doc [ mk ~superset_id:"3" () ] |> parse in 375 let s_some = 376 List.hd (WI.workout_sets (List.hd (WI.batch_workouts b_some))) 377 in 378 Alcotest.(check (option int)) 379 "int superset is Some" (Some 3) s_some.superset_id; 380 let b_bad = doc [ mk ~superset_id:"x" () ] |> parse in 381 Alcotest.(check int) 382 "bad superset drops the row" 0 383 (List.length (WI.batch_workouts b_bad)); 384 Alcotest.(check int) "and warns" 1 (List.length (WI.batch_warnings b_bad)) 385 ) 386 387 (* {1 Raw source is retained exactly} *) 388 389 let raw_source_exact = 390 ( "the batch retains the source text byte for byte", 391 `Quick, 392 fun () -> 393 let source = doc [ mk () ] in 394 let b = parse source in 395 Alcotest.(check string) "source unchanged" source (WI.batch_source b) ) 396 397 (* {1 Malformed CSV} *) 398 399 let malformed_csv = 400 ( "a badly quoted field yields Malformed_csv", 401 `Quick, 402 fun () -> 403 (* A quote opened then followed by stray content is malformed under 404 strict RFC4180 parsing. *) 405 let data = "Push A,\"unterminated\" trailing,x" in 406 match parse_err (header ^ "\n" ^ data) with 407 | Hevy_csv.Malformed_csv _ -> () 408 | e -> Alcotest.failf "expected Malformed_csv, got %a" Hevy_csv.pp_error e 409 ) 410 411 (* {1 Invalid calendar date and end-before-start} *) 412 413 let invalid_calendar_date = 414 ( "an impossible calendar date drops the row", 415 `Quick, 416 fun () -> 417 let data = 418 mk ~start_time:"31 Feb 2025, 08:00" ~end_time:"31 Feb 2025, 09:00" () 419 in 420 let b = doc [ data ] |> parse in 421 Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b)); 422 let w = List.hd (WI.batch_warnings b) in 423 Alcotest.(check string) 424 "reason names start_time" "invalid start_time" (warning_reason w) ) 425 426 let end_before_start = 427 ( "a row whose end precedes its start drops the row", 428 `Quick, 429 fun () -> 430 let data = 431 mk ~start_time:"01 Jan 2025, 09:00" ~end_time:"01 Jan 2025, 08:00" () 432 in 433 let b = doc [ data ] |> parse in 434 Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b)); 435 let w = List.hd (WI.batch_warnings b) in 436 Alcotest.(check string) 437 "reason names order" "end_time precedes start_time" (warning_reason w) 438 ) 439 440 (* {1 Mixed rows for one workout: valid rows still group} *) 441 442 let mixed_rows_group = 443 ( "a valid row groups even when a sibling row was dropped", 444 `Quick, 445 fun () -> 446 let good = mk ~set_index:"0" () in 447 let bad = mk ~set_index:"1" ~weight_kg:"" () in 448 let b = doc [ good; bad ] |> parse in 449 let w = List.hd (WI.batch_workouts b) in 450 Alcotest.(check int) 451 "the good row groups" 1 452 (List.length (WI.workout_sets w)); 453 Alcotest.(check int) 454 "the bad row warns" 1 455 (List.length (WI.batch_warnings b)) ) 456 457 let suite = 458 [ 459 ( "Hevy_csv", 460 [ 461 real_sample_parses; 462 quoted_comma_and_newline; 463 header_reorder; 464 missing_column; 465 empty_file; 466 grouping_and_order; 467 timezone_offset; 468 warmup_dropped; 469 unsupported_missing_load; 470 unsupported_negative_load; 471 unsupported_missing_reps; 472 unsupported_zero_reps; 473 unsupported_distance_only; 474 unknown_set_type; 475 dropset_parsed_then_discarded; 476 superset_provenance; 477 raw_source_exact; 478 malformed_csv; 479 invalid_calendar_date; 480 end_before_start; 481 mixed_rows_group; 482 ] ); 483 ] 484