[OCaml] High Intensity Training Online
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