[OCaml] High Intensity Training Online
feat Parse native Hevy CSV exports
Add a strict RFC4180 adapter for the verified native Hevy schema. It requires an explicit UTC offset, groups rows into provisional workouts, drops warmups and unsupported rows with ordered warnings, preserves set type and superset provenance, and retains the complete source text. Add the csv 2.4 dependency and 19 parser tests.
Changed files
dune-project
@@ -42,6 +42,8 @@
42
42
(= 3.1))
43
43
(uri
44
44
(= 4.4.0))
45
Added:
(csv
46
Added:
(= 2.4))
45
47
(crunch
46
48
(and
47
49
(= 4.1.0)
hito.opam
@@ -21,6 +21,7 @@
21
21
"caqti-driver-sqlite3" {= "2.3.0"}
22
22
"safepass" {= "3.1"}
23
23
"uri" {= "4.4.0"}
24
Added:
"csv" {= "2.4"}
24
25
"crunch" {= "4.1.0" & build}
25
26
"js_of_ocaml" {= "6.4.1"}
26
27
"js_of_ocaml-lwt" {= "6.4.1"}
lib/web/dune
@@ -31,6 +31,7 @@
31
31
(modules
32
32
routes
33
33
decode
34
Added:
hevy_csv
34
35
view_model
35
36
pages
36
37
handlers
@@ -38,4 +39,4 @@
38
39
workout_client_asset)
39
40
(preprocess
40
41
(pps dream-html.ppx))
41
Removed:
(libraries hito.core hito.app dream dream-html lwt unix))
42
Added:
(libraries hito.core hito.app dream dream-html lwt unix csv))
lib/web/hevy_csv.ml
@@ -0,0 +1,381 @@
1
Added:
(** See {!module:Hevy_csv} for the contract.
2
Added:
3
Added:
The parse runs in two stages. First it maps the header to column indices,
4
Added:
failing early on a missing column. Then it walks the data rows once: each
5
Added:
row becomes a set for some workout, or a batch warning. Rows group into
6
Added:
workouts by their exact [(title, start_time, end_time)] triple in
7
Added:
first-appearance order, and warnings stay in source order. The source text
8
Added:
is never rebuilt — it flows verbatim into the batch. *)
9
Added:
10
Added:
open Hito_app
11
Added:
module WI = Workout_import
12
Added:
13
Added:
type error =
14
Added:
| Malformed_csv of { record : int; field : int; detail : string }
15
Added:
| Missing_column of string
16
Added:
| Empty_file
17
Added:
18
Added:
let pp_error ppf = function
19
Added:
| Malformed_csv { record; field; detail } ->
20
Added:
Format.fprintf ppf "malformed CSV at record %d, field %d: %s" record field
21
Added:
detail
22
Added:
| Missing_column name -> Format.fprintf ppf "missing column %S" name
23
Added:
| Empty_file -> Format.pp_print_string ppf "empty file"
24
Added:
25
Added:
(* The strict native schema. Every column must be present. The order here is
26
Added:
canonical: a missing-column error names the first absent column in this
27
Added:
order, not the order the header happens to use. *)
28
Added:
let canonical_columns =
29
Added:
[
30
Added:
"title";
31
Added:
"start_time";
32
Added:
"end_time";
33
Added:
"description";
34
Added:
"exercise_title";
35
Added:
"superset_id";
36
Added:
"exercise_notes";
37
Added:
"set_index";
38
Added:
"set_type";
39
Added:
"weight_kg";
40
Added:
"reps";
41
Added:
"distance_km";
42
Added:
"duration_seconds";
43
Added:
"rpe";
44
Added:
]
45
Added:
46
Added:
(* Column indices resolved from the header, keyed by canonical name. Built once,
47
Added:
then read for every row. *)
48
Added:
type columns = (string * int) list
49
Added:
50
Added:
(* Maps the header row to column indices. The header order may vary, so each
51
Added:
name is looked up by value. The first canonical column absent from the header
52
Added:
fails the whole parse. *)
53
Added:
let resolve_columns (header : string list) : (columns, error) result =
54
Added:
let indexed = List.mapi (fun i name -> (name, i)) header in
55
Added:
let rec go acc = function
56
Added:
| [] -> Ok (List.rev acc)
57
Added:
| name :: rest -> (
58
Added:
match List.assoc_opt name indexed with
59
Added:
| Some i -> go ((name, i) :: acc) rest
60
Added:
| None -> Error (Missing_column name))
61
Added:
in
62
Added:
go [] canonical_columns
63
Added:
64
Added:
(* A row is a plain string list. This reads one column by canonical name,
65
Added:
returning [""] for a short row rather than raising. The column is guaranteed
66
Added:
present in [cols] once [resolve_columns] succeeds. *)
67
Added:
let field (cols : columns) (row : string list) name =
68
Added:
match List.assoc_opt name cols with
69
Added:
| None -> ""
70
Added:
| Some i -> ( match List.nth_opt row i with Some v -> v | None -> "")
71
Added:
72
Added:
(* {1 Datetime}
73
Added:
74
Added:
Hevy writes local wall time as [DD Mon YYYY, HH:MM] with an English month
75
Added:
abbreviation. The adapter converts to UTC seconds using the caller's fixed
76
Added:
offset: UTC = civil - offset. The calendar date is validated by a round-trip
77
Added:
through [days_from_civil], so an impossible date such as 31 Feb is rejected
78
Added:
rather than normalised. *)
79
Added:
80
Added:
let months =
81
Added:
[|
82
Added:
"Jan";
83
Added:
"Feb";
84
Added:
"Mar";
85
Added:
"Apr";
86
Added:
"May";
87
Added:
"Jun";
88
Added:
"Jul";
89
Added:
"Aug";
90
Added:
"Sep";
91
Added:
"Oct";
92
Added:
"Nov";
93
Added:
"Dec";
94
Added:
|]
95
Added:
96
Added:
let month_index abbrev =
97
Added:
let rec go i =
98
Added:
if i >= Array.length months then None
99
Added:
else if String.equal months.(i) abbrev then Some (i + 1)
100
Added:
else go (i + 1)
101
Added:
in
102
Added:
go 0
103
Added:
104
Added:
(* Days from the civil date 1970-01-01 to [y]-[m]-[d]. Howard Hinnant's
105
Added:
algorithm, valid for the proleptic Gregorian calendar. Used both to compute
106
Added:
the timestamp and, by round-trip, to confirm the date is real. *)
107
Added:
let days_from_civil y m d =
108
Added:
let y = if m <= 2 then y - 1 else y in
109
Added:
let era = (if y >= 0 then y else y - 399) / 400 in
110
Added:
let yoe = y - (era * 400) in
111
Added:
let doy = (((153 * if m > 2 then m - 3 else m + 9) + 2) / 5) + d - 1 in
112
Added:
let doe = (yoe * 365) + (yoe / 4) - (yoe / 100) + doy in
113
Added:
(era * 146097) + doe - 719468
114
Added:
115
Added:
(* The inverse of [days_from_civil], for the round-trip check. *)
116
Added:
let civil_from_days z =
117
Added:
let z = z + 719468 in
118
Added:
let era = (if z >= 0 then z else z - 146096) / 146097 in
119
Added:
let doe = z - (era * 146097) in
120
Added:
let yoe = (doe - (doe / 1460) + (doe / 36524) - (doe / 146096)) / 365 in
121
Added:
let y = yoe + (era * 400) in
122
Added:
let doy = doe - ((365 * yoe) + (yoe / 4) - (yoe / 100)) in
123
Added:
let mp = ((5 * doy) + 2) / 153 in
124
Added:
let d = doy - (((153 * mp) + 2) / 5) + 1 in
125
Added:
let m = if mp < 10 then mp + 3 else mp - 9 in
126
Added:
((if m <= 2 then y + 1 else y), m, d)
127
Added:
128
Added:
let is_digits s =
129
Added:
String.length s > 0 && String.for_all (fun c -> c >= '0' && c <= '9') s
130
Added:
131
Added:
(* Parses one Hevy datetime to UTC seconds at the given offset. Returns [None]
132
Added:
on any deviation from the exact [DD Mon YYYY, HH:MM] shape, an unknown month,
133
Added:
or a date that fails the calendar round-trip. *)
134
Added:
let parse_datetime ~utc_offset_seconds s =
135
Added:
match String.split_on_char ',' s with
136
Added:
| [ date_part; time_part ] -> (
137
Added:
let date_fields = String.split_on_char ' ' (String.trim date_part) in
138
Added:
let time_fields = String.split_on_char ':' (String.trim time_part) in
139
Added:
match (date_fields, time_fields) with
140
Added:
| [ dd; mon; yyyy ], [ hh; mm ]
141
Added:
when is_digits dd && is_digits yyyy && is_digits hh && is_digits mm -> (
142
Added:
match month_index mon with
143
Added:
| None -> None
144
Added:
| Some month ->
145
Added:
let day = int_of_string dd in
146
Added:
let year = int_of_string yyyy in
147
Added:
let hour = int_of_string hh in
148
Added:
let minute = int_of_string mm in
149
Added:
if
150
Added:
day < 1 || day > 31 || hour > 23 || minute > 59
151
Added:
|| String.length yyyy <> 4
152
Added:
then None
153
Added:
else
154
Added:
let days = days_from_civil year month day in
155
Added:
(* Reject impossible calendar dates by round-trip. *)
156
Added:
if civil_from_days days <> (year, month, day) then None
157
Added:
else
158
Added:
let civil_seconds =
159
Added:
(days * 86_400) + (hour * 3_600) + (minute * 60)
160
Added:
in
161
Added:
Some (civil_seconds - utc_offset_seconds))
162
Added:
| _ -> None)
163
Added:
| _ -> None
164
Added:
165
Added:
(* {1 Set types} *)
166
Added:
167
Added:
(* Hevy set types the adapter understands. [Warmup] never reaches a set: it
168
Added:
becomes a [Warmup_dropped] warning. Any other value is an unsupported row. *)
169
Added:
type parsed_set_type = Warmup | Working of WI.source_set_type
170
Added:
171
Added:
let parse_set_type s =
172
Added:
match String.lowercase_ascii (String.trim s) with
173
Added:
| "warmup" -> Some Warmup
174
Added:
| "normal" -> Some (Working WI.Normal)
175
Added:
| "failure" -> Some (Working WI.Failure)
176
Added:
| "dropset" -> Some (Working WI.Dropset)
177
Added:
| _ -> None
178
Added:
179
Added:
(* {1 Row outcome}
180
Added:
181
Added:
Each data row resolves to exactly one of: a set belonging to a workout keyed
182
Added:
by its datetime triple, a warning, or — when the datetimes are invalid and
183
Added:
the row cannot be grouped — a batch-level warning with no workout. *)
184
Added:
185
Added:
(* A parsed superset id: absent, present, or malformed. *)
186
Added:
type superset = Absent | Present of int | Invalid
187
Added:
188
Added:
let parse_superset s =
189
Added:
let s = String.trim s in
190
Added:
if String.equal s "" then Absent
191
Added:
else match int_of_string_opt s with Some i -> Present i | None -> Invalid
192
Added:
193
Added:
(* A finite float, rejecting NaN and the infinities that [float_of_string]
194
Added:
otherwise accepts. *)
195
Added:
let finite_float_opt s =
196
Added:
match float_of_string_opt (String.trim s) with
197
Added:
| Some f when Float.is_finite f -> Some f
198
Added:
| _ -> None
199
Added:
200
Added:
let nonneg_int_opt s =
201
Added:
match int_of_string_opt (String.trim s) with
202
Added:
| Some i when i >= 0 -> Some i
203
Added:
| _ -> None
204
Added:
205
Added:
(* The grouping key: the exact triple that identifies a workout. *)
206
Added:
type key = string * string * string
207
Added:
208
Added:
(* One classified row, before workouts are assembled. *)
209
Added:
type row_outcome =
210
Added:
| Set of { key : key; started : int; ended : int; set : WI.source_set }
211
Added:
| Warning of WI.warning
212
Added:
213
Added:
(* Classifies one data row at 1-based source [row]. The header is row 1, so the
214
Added:
first data row is row 2. The datetime triple keys the workout; invalid or
215
Added:
reversed datetimes drop the row. A warmup is dropped with its own warning.
216
Added:
Any field the strict schema needs but the row lacks turns the row into an
217
Added:
[Unsupported_row] warning, with a concise reason, never a guessed set. *)
218
Added:
let classify_row ~utc_offset_seconds cols ~row (fields : string list) :
219
Added:
row_outcome =
220
Added:
let get = field cols fields in
221
Added:
let title = get "title" in
222
Added:
let start_time = get "start_time" in
223
Added:
let end_time = get "end_time" in
224
Added:
let exercise_title = get "exercise_title" in
225
Added:
let exercise_name =
226
Added:
if String.equal (String.trim exercise_title) "" then None
227
Added:
else Some exercise_title
228
Added:
in
229
Added:
let warn reason =
230
Added:
Warning { row; exercise_name; kind = WI.Unsupported_row reason }
231
Added:
in
232
Added:
match parse_set_type (get "set_type") with
233
Added:
| None -> warn ("unknown set type " ^ get "set_type")
234
Added:
| Some Warmup -> Warning { row; exercise_name; kind = WI.Warmup_dropped }
235
Added:
| Some (Working set_type) -> (
236
Added:
match
237
Added:
( parse_datetime ~utc_offset_seconds start_time,
238
Added:
parse_datetime ~utc_offset_seconds end_time )
239
Added:
with
240
Added:
| None, _ -> warn "invalid start_time"
241
Added:
| _, None -> warn "invalid end_time"
242
Added:
| Some started, Some ended -> (
243
Added:
if ended < started then warn "end_time precedes start_time"
244
Added:
else if String.equal (String.trim exercise_title) "" then
245
Added:
warn "missing exercise_title"
246
Added:
else
247
Added:
match parse_superset (get "superset_id") with
248
Added:
| Invalid -> warn ("invalid superset_id " ^ get "superset_id")
249
Added:
| superset_id -> (
250
Added:
let superset_id =
251
Added:
match superset_id with
252
Added:
| Present i -> Some i
253
Added:
| Absent -> None
254
Added:
| Invalid -> None (* unreachable, handled above *)
255
Added:
in
256
Added:
match
257
Added:
( nonneg_int_opt (get "set_index"),
258
Added:
finite_float_opt (get "weight_kg"),
259
Added:
nonneg_int_opt (get "reps") )
260
Added:
with
261
Added:
| None, _, _ -> warn "invalid set_index"
262
Added:
| _, None, _ -> warn "missing or non-finite weight_kg"
263
Added:
| _, _, None -> warn "missing or negative reps"
264
Added:
| Some set_index, Some weight_kg, Some reps ->
265
Added:
let set : WI.source_set =
266
Added:
{
267
Added:
row;
268
Added:
exercise_name = exercise_title;
269
Added:
set_index;
270
Added:
set_type;
271
Added:
weight_kg;
272
Added:
reps;
273
Added:
superset_id;
274
Added:
}
275
Added:
in
276
Added:
Set
277
Added:
{
278
Added:
key = (title, start_time, end_time);
279
Added:
started;
280
Added:
ended;
281
Added:
set;
282
Added:
})))
283
Added:
284
Added:
(* {1 Grouping}
285
Added:
286
Added:
Sets group into workouts by their key, in first-appearance order. A row whose
287
Added:
datetimes were valid contributes its set here; the workout keeps the first
288
Added:
[started]/[ended] it saw for that key. Warnings never group — they are
289
Added:
collected separately in source order. *)
290
Added:
291
Added:
type group = {
292
Added:
title : string;
293
Added:
started : int;
294
Added:
ended : int;
295
Added:
mutable sets_rev : WI.source_set list;
296
Added:
}
297
Added:
298
Added:
(* Folds classified rows into ordered groups and an ordered warning list. Groups
299
Added:
keep first-appearance order; within a group, sets keep source order. *)
300
Added:
let assemble outcomes =
301
Added:
let groups_rev = ref [] in
302
Added:
let table : (key, group) Hashtbl.t = Hashtbl.create 16 in
303
Added:
let warnings_rev = ref [] in
304
Added:
List.iter
305
Added:
(fun outcome ->
306
Added:
match outcome with
307
Added:
| Warning w -> warnings_rev := w :: !warnings_rev
308
Added:
| Set { key; started; ended; set } -> (
309
Added:
match Hashtbl.find_opt table key with
310
Added:
| Some g -> g.sets_rev <- set :: g.sets_rev
311
Added:
| None ->
312
Added:
let title, _, _ = key in
313
Added:
let g = { title; started; ended; sets_rev = [ set ] } in
314
Added:
Hashtbl.add table key g;
315
Added:
groups_rev := g :: !groups_rev))
316
Added:
outcomes;
317
Added:
(List.rev !groups_rev, List.rev !warnings_rev)
318
Added:
319
Added:
(* Builds one imported workout from a group. [make_workout] can still reject the
320
Added:
times with [Invalid_time]; the classifier already dropped reversed rows, so a
321
Added:
surviving group should not hit it, but the adapter converts any such rejection
322
Added:
into a batch warning rather than raising. *)
323
Added:
let build_workout ~batch_id ~index (g : group) : (WI.workout, WI.warning) result
324
Added:
=
325
Added:
let id =
326
Added:
WI.workout_id (WI.batch_id_to_string batch_id ^ ":w" ^ string_of_int index)
327
Added:
in
328
Added:
let sets = List.rev g.sets_rev in
329
Added:
match
330
Added:
WI.make_workout ~id ~title:g.title
331
Added:
~started_at:(Recovery.timestamp_of_unix_seconds g.started)
332
Added:
~ended_at:(Recovery.timestamp_of_unix_seconds g.ended)
333
Added:
~sets
334
Added:
with
335
Added:
| Ok w -> Ok w
336
Added:
| Error _ ->
337
Added:
(* A whole group with reversed times; report at batch level. *)
338
Added:
Error
339
Added:
{
340
Added:
WI.row = 0;
341
Added:
exercise_name = None;
342
Added:
kind = WI.Unsupported_row ("workout " ^ g.title ^ " has invalid time");
343
Added:
}
344
Added:
345
Added:
let parse ~batch_id ~fingerprint ~imported_at ~utc_offset_seconds source =
346
Added:
(* Parse the CSV text. [strip:false] keeps RFC4180 fidelity; quoted commas and
347
Added:
newlines are preserved. A malformed export raises [Csv.Failure]. *)
348
Added:
match
349
Added:
try Ok (Csv.input_all (Csv.of_string ~strip:false source))
350
Added:
with Csv.Failure (record, field, detail) ->
351
Added:
Error (Malformed_csv { record; field; detail })
352
Added:
with
353
Added:
| Error _ as e -> e
354
Added:
| Ok [] -> Error Empty_file
355
Added:
| Ok (header :: data_rows) -> (
356
Added:
match resolve_columns header with
357
Added:
| Error _ as e -> e
358
Added:
| Ok cols ->
359
Added:
(* Row 1 is the header, so the first data row is row 2. *)
360
Added:
let outcomes =
361
Added:
List.mapi
362
Added:
(fun i fields ->
363
Added:
classify_row ~utc_offset_seconds cols ~row:(i + 2) fields)
364
Added:
data_rows
365
Added:
in
366
Added:
let groups, row_warnings = assemble outcomes in
367
Added:
let workouts_rev, workout_warnings_rev, _ =
368
Added:
List.fold_left
369
Added:
(fun (workouts, warnings, index) g ->
370
Added:
match build_workout ~batch_id ~index g with
371
Added:
| Ok w -> (w :: workouts, warnings, index + 1)
372
Added:
| Error warning -> (workouts, warning :: warnings, index + 1))
373
Added:
([], [], 1) groups
374
Added:
in
375
Added:
let workouts = List.rev workouts_rev in
376
Added:
(* Batch warnings stay in source order: the row warnings, then any
377
Added:
workout-level rejections in group order. *)
378
Added:
let warnings = row_warnings @ List.rev workout_warnings_rev in
379
Added:
Ok
380
Added:
(WI.make_batch ~id:batch_id ~source ~fingerprint ~imported_at
381
Added:
~workouts ~warnings))
lib/web/hevy_csv.mli
@@ -0,0 +1,44 @@
1
Added:
(** Parses a native Hevy CSV export into a {!Workout_import.batch}.
2
Added:
3
Added:
This is a web-layer adapter: it turns untrusted export text into the
4
Added:
application's import use case. It does not construct canonical evidence or
5
Added:
apply Heavy Duty judgment. It never depends on [hito.persistence]. The whole
6
Added:
export text is retained verbatim through
7
Added:
{!Hito_app.Workout_import.make_batch}, so provenance survives the parse.
8
Added:
9
Added:
The adapter enforces the strict native schema. The header must carry all 14
10
Added:
verified columns, in any order. Rows the adapter cannot promote — warmups,
11
Added:
non-strength data, unknown set types, malformed fields — become
12
Added:
{!Workout_import.warning} values, not sets. A row is dropped, never guessed
13
Added:
at. Rows group into workouts by the exact [(title, start_time, end_time)]
14
Added:
triple, in first-appearance order. *)
15
Added:
16
Added:
type error =
17
Added:
| Malformed_csv of { record : int; field : int; detail : string }
18
Added:
(** The CSV text does not conform to RFC4180. [record] and [field] are
19
Added:
1-based, as {!Csv.Failure} reports them. *)
20
Added:
| Missing_column of string
21
Added:
(** A required column is absent from the header. The first missing column
22
Added:
in canonical order is reported. *)
23
Added:
| Empty_file (** The export has no rows at all, not even a header. *)
24
Added:
25
Added:
val pp_error : Format.formatter -> error -> unit
26
Added:
27
Added:
val parse :
28
Added:
batch_id:Hito_app.Workout_import.batch_id ->
29
Added:
fingerprint:string ->
30
Added:
imported_at:Recovery.timestamp ->
31
Added:
utc_offset_seconds:int ->
32
Added:
string ->
33
Added:
(Hito_app.Workout_import.batch, error) result
34
Added:
(** [parse ~batch_id ~fingerprint ~imported_at ~utc_offset_seconds source]
35
Added:
parses [source] as a native Hevy export.
36
Added:
37
Added:
[utc_offset_seconds] is the offset of the wall-clock times in the export.
38
Added:
Hevy datetimes are local wall time, so UTC seconds = civil seconds - offset.
39
Added:
40
Added:
Returns [Error Empty_file] for empty input, [Error (Missing_column _)] when
41
Added:
the header lacks a required column, and [Error (Malformed_csv _)] when the
42
Added:
CSV text is not well formed. On success the batch retains [source] exactly.
43
Added:
Rows the adapter cannot use appear in {!Workout_import.batch_warnings} in
44
Added:
source order. *)
test/dune
@@ -14,6 +14,7 @@
14
14
test_bcrypt_hash
15
15
test_sqlite_repo
16
16
test_decode
17
Added:
test_hevy_csv
17
18
test_web)
18
19
(libraries
19
20
hito.core
test/test_hevy_csv.ml
@@ -0,0 +1,454 @@
1
Added:
(** Unit tests for {!Hevy_csv}, authored against the hevy_csv.mli contract.
2
Added:
3
Added:
The adapter turns untrusted native Hevy CSV text into a
4
Added:
{!Workout_import.batch}. These tests exercise the strict native schema: the
5
Added:
exact 14-column header in any order, RFC4180 quoting, workout grouping by
6
Added:
the datetime triple, deterministic workout ids, the local-to-UTC offset, and
7
Added:
the full family of dropped-row warnings. They also confirm the source text
8
Added:
is retained byte for byte and that a dropset survives as a blocker rather
9
Added:
than silently vanishing. *)
10
Added:
11
Added:
open Hito_app
12
Added:
module WI = Workout_import
13
Added:
module Hevy_csv = Hito_web.Hevy_csv
14
Added:
15
Added:
(* The verified native header, 14 columns in canonical order. *)
16
Added:
let header =
17
Added:
"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
Added:
19
Added:
let bid = WI.batch_id "b1"
20
Added:
let at s = Recovery.timestamp_of_unix_seconds s
21
Added:
22
Added:
let parse ?(utc_offset_seconds = 0) source =
23
Added:
match
24
Added:
Hevy_csv.parse ~batch_id:bid ~fingerprint:"fp" ~imported_at:(at 5_000)
25
Added:
~utc_offset_seconds source
26
Added:
with
27
Added:
| Ok b -> b
28
Added:
| Error e -> Alcotest.failf "expected Ok, got %a" Hevy_csv.pp_error e
29
Added:
30
Added:
let parse_err ?(utc_offset_seconds = 0) source =
31
Added:
match
32
Added:
Hevy_csv.parse ~batch_id:bid ~fingerprint:"fp" ~imported_at:(at 5_000)
33
Added:
~utc_offset_seconds source
34
Added:
with
35
Added:
| Ok _ -> Alcotest.fail "expected Error"
36
Added:
| Error e -> e
37
Added:
38
Added:
(* Howard Hinnant's civil-to-days, mirrored here so the timezone test can state
39
Added:
its own expected UTC second independently of the adapter. *)
40
Added:
let days_from_civil y m d =
41
Added:
let y = if m <= 2 then y - 1 else y in
42
Added:
let era = (if y >= 0 then y else y - 399) / 400 in
43
Added:
let yoe = y - (era * 400) in
44
Added:
let doy = (((153 * if m > 2 then m - 3 else m + 9) + 2) / 5) + d - 1 in
45
Added:
let doe = (yoe * 365) + (yoe / 4) - (yoe / 100) + doy in
46
Added:
(era * 146097) + doe - 719468
47
Added:
48
Added:
let utc_of ~y ~m ~d ~hh ~mm ~offset =
49
Added:
(days_from_civil y m d * 86_400) + (hh * 3_600) + (mm * 60) - offset
50
Added:
51
Added:
let show_blocker : WI.blocker -> string = function
52
Added:
| No_sets -> "no_sets"
53
Added:
| Dropset_present rows ->
54
Added:
"dropset:" ^ String.concat "," (List.map string_of_int rows)
55
Added:
| Unmapped_exercise name -> "unmapped:" ^ name
56
Added:
| Normal_sets_unconfirmed -> "normal_unconfirmed"
57
Added:
58
Added:
let warning_reason (w : WI.warning) =
59
Added:
match w.kind with
60
Added:
| WI.Warmup_dropped -> "warmup"
61
Added:
| WI.Unsupported_row reason -> reason
62
Added:
63
Added:
(* A workout row using quoted datetimes, so the embedded comma in the Hevy
64
Added:
datetime does not split a field. Callers override any field. *)
65
Added:
let mk ?(title = "Push A") ?(start_time = "01 Jan 2025, 08:00")
66
Added:
?(end_time = "01 Jan 2025, 09:00") ?(description = "")
67
Added:
?(exercise_title = "Bench Press") ?(superset_id = "") ?(exercise_notes = "")
68
Added:
?(set_index = "0") ?(set_type = "normal") ?(weight_kg = "60") ?(reps = "8")
69
Added:
?(distance_km = "") ?(duration_seconds = "") ?(rpe = "") () =
70
Added:
let q s = "\"" ^ s ^ "\"" in
71
Added:
String.concat ","
72
Added:
[
73
Added:
title;
74
Added:
q start_time;
75
Added:
q end_time;
76
Added:
description;
77
Added:
exercise_title;
78
Added:
superset_id;
79
Added:
exercise_notes;
80
Added:
set_index;
81
Added:
set_type;
82
Added:
weight_kg;
83
Added:
reps;
84
Added:
distance_km;
85
Added:
duration_seconds;
86
Added:
rpe;
87
Added:
]
88
Added:
89
Added:
let doc rows = header ^ "\n" ^ String.concat "\n" rows ^ "\n"
90
Added:
91
Added:
(* {1 A real sample header and row parse into one set} *)
92
Added:
93
Added:
let real_sample_parses =
94
Added:
( "the verified header and a real data row yield one workout with one set",
95
Added:
`Quick,
96
Added:
fun () ->
97
Added:
let b = doc [ mk () ] |> parse in
98
Added:
let workouts = WI.batch_workouts b in
99
Added:
Alcotest.(check int) "one workout" 1 (List.length workouts);
100
Added:
let w = List.hd workouts in
101
Added:
Alcotest.(check string) "title" "Push A" (WI.workout_title w);
102
Added:
let sets = WI.workout_sets w in
103
Added:
Alcotest.(check int) "one set" 1 (List.length sets);
104
Added:
let s = List.hd sets in
105
Added:
Alcotest.(check int) "set row is 2" 2 s.row;
106
Added:
Alcotest.(check string) "exercise name" "Bench Press" s.exercise_name;
107
Added:
Alcotest.(check (float 0.001)) "weight" 60. s.weight_kg;
108
Added:
Alcotest.(check int) "reps" 8 s.reps;
109
Added:
Alcotest.(check bool) "no warnings" true (WI.batch_warnings b = []) )
110
Added:
111
Added:
(* {1 RFC4180 quoting: commas and newlines inside fields} *)
112
Added:
113
Added:
let quoted_comma_and_newline =
114
Added:
( "quoted commas and newlines are preserved within fields",
115
Added:
`Quick,
116
Added:
fun () ->
117
Added:
let data =
118
Added:
mk ~title:"\"Legs, heavy\"" ~exercise_notes:"\"line one\nline two\""
119
Added:
~exercise_title:"Squat" ()
120
Added:
in
121
Added:
let b = doc [ data ] |> parse in
122
Added:
let w = List.hd (WI.batch_workouts b) in
123
Added:
Alcotest.(check string)
124
Added:
"comma kept in title" "Legs, heavy" (WI.workout_title w);
125
Added:
Alcotest.(check int)
126
Added:
"one set despite embedded newline" 1
127
Added:
(List.length (WI.workout_sets w)) )
128
Added:
129
Added:
(* {1 Header order may vary} *)
130
Added:
131
Added:
let header_reorder =
132
Added:
( "columns are mapped by name, so a reordered header still parses",
133
Added:
`Quick,
134
Added:
fun () ->
135
Added:
let reordered =
136
Added:
"set_type,reps,weight_kg,set_index,exercise_title,title,start_time,end_time,description,superset_id,exercise_notes,distance_km,duration_seconds,rpe"
137
Added:
in
138
Added:
let q s = "\"" ^ s ^ "\"" in
139
Added:
let data =
140
Added:
String.concat ","
141
Added:
[
142
Added:
"normal";
143
Added:
"8";
144
Added:
"60";
145
Added:
"0";
146
Added:
"Bench Press";
147
Added:
"Push A";
148
Added:
q "01 Jan 2025, 08:00";
149
Added:
q "01 Jan 2025, 09:00";
150
Added:
"";
151
Added:
"";
152
Added:
"";
153
Added:
"";
154
Added:
"";
155
Added:
"";
156
Added:
]
157
Added:
in
158
Added:
let b = reordered ^ "\n" ^ data ^ "\n" |> parse in
159
Added:
let w = List.hd (WI.batch_workouts b) in
160
Added:
Alcotest.(check string)
161
Added:
"title resolved by name" "Push A" (WI.workout_title w);
162
Added:
let s = List.hd (WI.workout_sets w) in
163
Added:
Alcotest.(check int) "reps resolved by name" 8 s.reps )
164
Added:
165
Added:
(* {1 Missing header column} *)
166
Added:
167
Added:
let missing_column =
168
Added:
( "a header missing a required column fails with the first missing name",
169
Added:
`Quick,
170
Added:
fun () ->
171
Added:
(* Drop [weight_kg] and [reps]; [weight_kg] is earlier in canonical
172
Added:
order, so it is the reported one. *)
173
Added:
let short_header =
174
Added:
"title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,distance_km,duration_seconds,rpe"
175
Added:
in
176
Added:
match parse_err (short_header ^ "\n") with
177
Added:
| Hevy_csv.Missing_column "weight_kg" -> ()
178
Added:
| e ->
179
Added:
Alcotest.failf "expected Missing_column weight_kg, got %a"
180
Added:
Hevy_csv.pp_error e )
181
Added:
182
Added:
(* {1 Empty file} *)
183
Added:
184
Added:
let empty_file =
185
Added:
( "empty input is Empty_file",
186
Added:
`Quick,
187
Added:
fun () ->
188
Added:
match parse_err "" with
189
Added:
| Hevy_csv.Empty_file -> ()
190
Added:
| e -> Alcotest.failf "expected Empty_file, got %a" Hevy_csv.pp_error e )
191
Added:
192
Added:
(* {1 Grouping and order} *)
193
Added:
194
Added:
let grouping_and_order =
195
Added:
( "rows group into workouts by the triple, in first-appearance order",
196
Added:
`Quick,
197
Added:
fun () ->
198
Added:
let body =
199
Added:
[
200
Added:
mk ~title:"Push A" ~set_index:"0" ();
201
Added:
mk ~title:"Legs A" ~start_time:"03 Jan 2025, 08:00"
202
Added:
~end_time:"03 Jan 2025, 09:00" ~exercise_title:"Squat"
203
Added:
~set_index:"0" ();
204
Added:
mk ~title:"Push A" ~set_index:"1" ();
205
Added:
]
206
Added:
in
207
Added:
let b = doc body |> parse in
208
Added:
let workouts = WI.batch_workouts b in
209
Added:
Alcotest.(check int) "two workouts" 2 (List.length workouts);
210
Added:
let w1 = List.nth workouts 0 in
211
Added:
let w2 = List.nth workouts 1 in
212
Added:
Alcotest.(check string)
213
Added:
"first workout is Push A" "Push A" (WI.workout_title w1);
214
Added:
Alcotest.(check string)
215
Added:
"second workout is Legs A" "Legs A" (WI.workout_title w2);
216
Added:
Alcotest.(check int)
217
Added:
"Push A has two sets" 2
218
Added:
(List.length (WI.workout_sets w1));
219
Added:
Alcotest.(check (list int))
220
Added:
"rows in source order" [ 2; 4 ]
221
Added:
(List.map (fun (s : WI.source_set) -> s.row) (WI.workout_sets w1));
222
Added:
Alcotest.(check string)
223
Added:
"first id" "b1:w1"
224
Added:
(WI.workout_id_to_string (WI.workout_identity w1));
225
Added:
Alcotest.(check string)
226
Added:
"second id" "b1:w2"
227
Added:
(WI.workout_id_to_string (WI.workout_identity w2)) )
228
Added:
229
Added:
(* {1 Timezone offset} *)
230
Added:
231
Added:
let timezone_offset =
232
Added:
( "wall time is interpreted at the given offset: UTC = civil - offset",
233
Added:
`Quick,
234
Added:
fun () ->
235
Added:
let offset = 2 * 3_600 in
236
Added:
let data =
237
Added:
mk ~start_time:"01 Jan 2025, 08:00" ~end_time:"01 Jan 2025, 09:30" ()
238
Added:
in
239
Added:
let b = doc [ data ] |> parse ~utc_offset_seconds:offset in
240
Added:
let w = List.hd (WI.batch_workouts b) in
241
Added:
let expected_start = utc_of ~y:2025 ~m:1 ~d:1 ~hh:8 ~mm:0 ~offset in
242
Added:
let expected_end = utc_of ~y:2025 ~m:1 ~d:1 ~hh:9 ~mm:30 ~offset in
243
Added:
Alcotest.(check int)
244
Added:
"start at offset" expected_start
245
Added:
(Recovery.timestamp_to_unix_seconds (WI.workout_started_at w));
246
Added:
Alcotest.(check int)
247
Added:
"end at offset" expected_end
248
Added:
(Recovery.timestamp_to_unix_seconds (WI.workout_ended_at w)) )
249
Added:
250
Added:
(* {1 Warmup dropped} *)
251
Added:
252
Added:
let warmup_dropped =
253
Added:
( "a warmup set creates no set and one Warmup_dropped warning",
254
Added:
`Quick,
255
Added:
fun () ->
256
Added:
let b = doc [ mk ~set_type:"warmup" () ] |> parse in
257
Added:
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
258
Added:
let warnings = WI.batch_warnings b in
259
Added:
Alcotest.(check int) "one warning" 1 (List.length warnings);
260
Added:
let w = List.hd warnings in
261
Added:
Alcotest.(check int) "warning row is 2" 2 w.row;
262
Added:
Alcotest.(check bool) "warmup kind" true (w.kind = WI.Warmup_dropped);
263
Added:
Alcotest.(check (option string))
264
Added:
"exercise name retained" (Some "Bench Press") w.exercise_name )
265
Added:
266
Added:
(* {1 Unsupported: missing load / reps / distance-only rows} *)
267
Added:
268
Added:
let unsupported_missing_load =
269
Added:
( "a row with empty weight becomes an Unsupported_row warning",
270
Added:
`Quick,
271
Added:
fun () ->
272
Added:
let b = doc [ mk ~weight_kg:"" () ] |> parse in
273
Added:
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
274
Added:
let w = List.hd (WI.batch_warnings b) in
275
Added:
Alcotest.(check string)
276
Added:
"reason names weight" "missing or non-finite weight_kg"
277
Added:
(warning_reason w) )
278
Added:
279
Added:
let unsupported_missing_reps =
280
Added:
( "a row with empty reps becomes an Unsupported_row warning",
281
Added:
`Quick,
282
Added:
fun () ->
283
Added:
let b = doc [ mk ~reps:"" () ] |> parse in
284
Added:
let w = List.hd (WI.batch_warnings b) in
285
Added:
Alcotest.(check string)
286
Added:
"reason names reps" "missing or negative reps" (warning_reason w) )
287
Added:
288
Added:
let unsupported_distance_only =
289
Added:
( "a distance/time row with empty weight and reps is an Unsupported_row",
290
Added:
`Quick,
291
Added:
fun () ->
292
Added:
let b =
293
Added:
doc
294
Added:
[
295
Added:
mk ~weight_kg:"" ~reps:"" ~distance_km:"5.0"
296
Added:
~duration_seconds:"1800" ~exercise_title:"Running" ();
297
Added:
]
298
Added:
|> parse
299
Added:
in
300
Added:
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
301
Added:
Alcotest.(check int) "one warning" 1 (List.length (WI.batch_warnings b))
302
Added:
)
303
Added:
304
Added:
(* {1 Unknown set type} *)
305
Added:
306
Added:
let unknown_set_type =
307
Added:
( "an unknown set type is a warning, not fatal",
308
Added:
`Quick,
309
Added:
fun () ->
310
Added:
let b = doc [ mk ~set_type:"myorep" () ] |> parse in
311
Added:
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
312
Added:
let w = List.hd (WI.batch_warnings b) in
313
Added:
let reason = warning_reason w in
314
Added:
Alcotest.(check bool)
315
Added:
"reason mentions unknown set type" true
316
Added:
(String.length reason >= 12 && String.sub reason 0 12 = "unknown set ")
317
Added:
)
318
Added:
319
Added:
(* {1 Dropset retained as a blocker} *)
320
Added:
321
Added:
let dropset_retained_blocker =
322
Added:
( "a dropset creates a set that blocks its workout, never a silent drop",
323
Added:
`Quick,
324
Added:
fun () ->
325
Added:
let b = doc [ mk ~set_type:"dropset" () ] |> parse in
326
Added:
let w = List.hd (WI.batch_workouts b) in
327
Added:
Alcotest.(check int) "one set" 1 (List.length (WI.workout_sets w));
328
Added:
let blockers = List.map show_blocker (WI.blockers w) in
329
Added:
Alcotest.(check bool)
330
Added:
"a dropset blocker is present" true
331
Added:
(List.exists
332
Added:
(fun s -> String.length s >= 8 && String.sub s 0 8 = "dropset:")
333
Added:
blockers) )
334
Added:
335
Added:
(* {1 Superset provenance} *)
336
Added:
337
Added:
let superset_provenance =
338
Added:
( "superset_id maps empty to None, an int to Some, and rejects a bad value",
339
Added:
`Quick,
340
Added:
fun () ->
341
Added:
let b_none = doc [ mk ~superset_id:"" () ] |> parse in
342
Added:
let s_none =
343
Added:
List.hd (WI.workout_sets (List.hd (WI.batch_workouts b_none)))
344
Added:
in
345
Added:
Alcotest.(check (option int))
346
Added:
"empty superset is None" None s_none.superset_id;
347
Added:
let b_some = doc [ mk ~superset_id:"3" () ] |> parse in
348
Added:
let s_some =
349
Added:
List.hd (WI.workout_sets (List.hd (WI.batch_workouts b_some)))
350
Added:
in
351
Added:
Alcotest.(check (option int))
352
Added:
"int superset is Some" (Some 3) s_some.superset_id;
353
Added:
let b_bad = doc [ mk ~superset_id:"x" () ] |> parse in
354
Added:
Alcotest.(check int)
355
Added:
"bad superset drops the row" 0
356
Added:
(List.length (WI.batch_workouts b_bad));
357
Added:
Alcotest.(check int) "and warns" 1 (List.length (WI.batch_warnings b_bad))
358
Added:
)
359
Added:
360
Added:
(* {1 Raw source is retained exactly} *)
361
Added:
362
Added:
let raw_source_exact =
363
Added:
( "the batch retains the source text byte for byte",
364
Added:
`Quick,
365
Added:
fun () ->
366
Added:
let source = doc [ mk () ] in
367
Added:
let b = parse source in
368
Added:
Alcotest.(check string) "source unchanged" source (WI.batch_source b) )
369
Added:
370
Added:
(* {1 Malformed CSV} *)
371
Added:
372
Added:
let malformed_csv =
373
Added:
( "a badly quoted field yields Malformed_csv",
374
Added:
`Quick,
375
Added:
fun () ->
376
Added:
(* A quote opened then followed by stray content is malformed under
377
Added:
strict RFC4180 parsing. *)
378
Added:
let data = "Push A,\"unterminated\" trailing,x" in
379
Added:
match parse_err (header ^ "\n" ^ data) with
380
Added:
| Hevy_csv.Malformed_csv _ -> ()
381
Added:
| e -> Alcotest.failf "expected Malformed_csv, got %a" Hevy_csv.pp_error e
382
Added:
)
383
Added:
384
Added:
(* {1 Invalid calendar date and end-before-start} *)
385
Added:
386
Added:
let invalid_calendar_date =
387
Added:
( "an impossible calendar date drops the row",
388
Added:
`Quick,
389
Added:
fun () ->
390
Added:
let data =
391
Added:
mk ~start_time:"31 Feb 2025, 08:00" ~end_time:"31 Feb 2025, 09:00" ()
392
Added:
in
393
Added:
let b = doc [ data ] |> parse in
394
Added:
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
395
Added:
let w = List.hd (WI.batch_warnings b) in
396
Added:
Alcotest.(check string)
397
Added:
"reason names start_time" "invalid start_time" (warning_reason w) )
398
Added:
399
Added:
let end_before_start =
400
Added:
( "a row whose end precedes its start drops the row",
401
Added:
`Quick,
402
Added:
fun () ->
403
Added:
let data =
404
Added:
mk ~start_time:"01 Jan 2025, 09:00" ~end_time:"01 Jan 2025, 08:00" ()
405
Added:
in
406
Added:
let b = doc [ data ] |> parse in
407
Added:
Alcotest.(check int) "no workouts" 0 (List.length (WI.batch_workouts b));
408
Added:
let w = List.hd (WI.batch_warnings b) in
409
Added:
Alcotest.(check string)
410
Added:
"reason names order" "end_time precedes start_time" (warning_reason w)
411
Added:
)
412
Added:
413
Added:
(* {1 Mixed rows for one workout: valid rows still group} *)
414
Added:
415
Added:
let mixed_rows_group =
416
Added:
( "a valid row groups even when a sibling row was dropped",
417
Added:
`Quick,
418
Added:
fun () ->
419
Added:
let good = mk ~set_index:"0" () in
420
Added:
let bad = mk ~set_index:"1" ~weight_kg:"" () in
421
Added:
let b = doc [ good; bad ] |> parse in
422
Added:
let w = List.hd (WI.batch_workouts b) in
423
Added:
Alcotest.(check int)
424
Added:
"the good row groups" 1
425
Added:
(List.length (WI.workout_sets w));
426
Added:
Alcotest.(check int)
427
Added:
"the bad row warns" 1
428
Added:
(List.length (WI.batch_warnings b)) )
429
Added:
430
Added:
let suite =
431
Added:
[
432
Added:
( "Hevy_csv",
433
Added:
[
434
Added:
real_sample_parses;
435
Added:
quoted_comma_and_newline;
436
Added:
header_reorder;
437
Added:
missing_column;
438
Added:
empty_file;
439
Added:
grouping_and_order;
440
Added:
timezone_offset;
441
Added:
warmup_dropped;
442
Added:
unsupported_missing_load;
443
Added:
unsupported_missing_reps;
444
Added:
unsupported_distance_only;
445
Added:
unknown_set_type;
446
Added:
dropset_retained_blocker;
447
Added:
superset_provenance;
448
Added:
raw_source_exact;
449
Added:
malformed_csv;
450
Added:
invalid_calendar_date;
451
Added:
end_before_start;
452
Added:
mixed_rows_group;
453
Added:
] );
454
Added:
]
test/test_hito.ml
@@ -11,4 +11,4 @@
11
11
@ Test_prescription.suite @ Test_evidence.suite @ Test_progression.suite
12
12
@ Test_service.suite @ Test_workout_import.suite @ Test_codec.suite
13
13
@ Test_bcrypt_hash.suite @ Test_sqlite_repo.suite @ Test_decode.suite
14
Removed:
@ Test_web.suite)
14
Added:
@ Test_hevy_csv.suite @ Test_web.suite)