[OCaml] High Intensity Training Online
1
(** Importing a third-party workout export into confirmed evidence.
2
3
This is an application use case, not a core entity. A batch holds the
4
immutable raw source and the workouts parsed from it. Cleaning operations
5
(exercise mapping, acknowledgement) return a revised batch. Promotion turns
6
a fully cleaned workout into canonical {!Evidence.Observation} values.
7
8
The module upholds one invariant on behalf of the core: the core receives
9
only confirmed, catalogued, failure-defined evidence. A row reaches the core
10
only after its exercise is mapped to a catalog entry and its workout-level
11
acknowledgement is present when required. A drop set is not one clean drive
12
to failure, so a [Dropset] row never promotes and never blocks: it is
13
discarded like a warmup, leaving the set taken to failure — the effort HD1
14
counts. Every promoted set becomes one {!Evidence.Observation} recorded at
15
{!Positive_failure}: the export's set type calibrates what confirmation the
16
import demands, never the recorded outcome. *)
17
18
type batch_id = private string
19
type workout_id = private string
20
21
val batch_id : string -> batch_id
22
val workout_id : string -> workout_id
23
val batch_id_to_string : batch_id -> string
24
val workout_id_to_string : workout_id -> string
25
26
(** How the export classified a set. Warmups and unsupported rows never reach
27
here — an adapter turns them into {!warning} values instead. *)
28
type source_set_type =
29
| Normal (** A working set the export did not mark as taken to failure. *)
30
| Failure (** A set the export marked as taken to failure. *)
31
| Dropset
32
(** A drop set. Not one clean drive to failure, so it is discarded on
33
promotion — never an observation, never a blocker. *)
34
35
type source_set = {
36
row : int; (** The source row, retained for provenance. *)
37
exercise_name : string; (** The export's exercise name, before mapping. *)
38
set_index : int; (** The set's position within its exercise. *)
39
set_type : source_set_type;
40
weight_kg : float;
41
reps : int;
42
superset_id : int option;
43
(** The export's superset grouping. Provenance only: it never changes how
44
a set is promoted. *)
45
}
46
47
(** A row the adapter dropped, with the reason. Warmups and unsupported rows are
48
reported here, never as provisional sets. *)
49
type warning_kind = Warmup_dropped | Unsupported_row of string
50
51
type warning = { row : int; exercise_name : string option; kind : warning_kind }
52
type workout
53
type batch
54
55
type error =
56
| Unknown_workout of workout_id
57
| Empty_acknowledgement
58
| Invalid_time (** [ended_at] precedes [started_at]. *)
59
60
val make_workout :
61
id:workout_id ->
62
title:string ->
63
started_at:Recovery.timestamp ->
64
ended_at:Recovery.timestamp ->
65
sets:source_set list ->
66
(workout, error) result
67
(** Builds one imported workout. Returns [Error Invalid_time] when [ended_at]
68
precedes [started_at]. The sets are retained in the given order. *)
69
70
val make_batch :
71
id:batch_id ->
72
source:string ->
73
fingerprint:string ->
74
imported_at:Recovery.timestamp ->
75
workouts:workout list ->
76
warnings:warning list ->
77
batch
78
(** Builds a batch. [source] is the complete immutable export text. *)
79
80
(** {1 Accessors} *)
81
82
val batch_identity : batch -> batch_id
83
84
val batch_source : batch -> string
85
(** The complete immutable export text, exactly as imported. *)
86
87
val batch_fingerprint : batch -> string
88
val batch_imported_at : batch -> Recovery.timestamp
89
val batch_workouts : batch -> workout list
90
val batch_warnings : batch -> warning list
91
val find_workout : batch -> workout_id -> workout option
92
val workout_identity : workout -> workout_id
93
val workout_title : workout -> string
94
val workout_started_at : workout -> Recovery.timestamp
95
val workout_ended_at : workout -> Recovery.timestamp
96
97
val workout_sets : workout -> source_set list
98
(** The source sets in source order. *)
99
100
val workout_revision : workout -> int
101
(** Starts at zero. Each change to a mapping or the acknowledgement increments
102
it. Promotion of an earlier revision is stale. *)
103
104
val workout_acknowledgement : workout -> string option
105
(** The retained workout-level acknowledgement, when present. *)
106
107
val workout_mapping : workout -> source_name:string -> Exercise.t option
108
(** The catalog entry a source exercise name is mapped to, when confirmed. *)
109
110
(** {1 Cleaning} *)
111
112
val map_exercise :
113
batch ->
114
workout:workout_id ->
115
source_name:string ->
116
Exercise.t ->
117
(batch, error) result
118
(** Confirms that [source_name] denotes [Exercise.t] for every matching set in
119
the workout. Increments the workout revision only when the mapping changed.
120
Returns [Error (Unknown_workout _)] for an unknown workout. *)
121
122
val confirm_normal_sets :
123
batch -> workout:workout_id -> acknowledgement:string -> (batch, error) result
124
(** Records the one workout-level acknowledgement that promotes the workout's
125
[Normal] sets. The exact acknowledgement is retained. Whitespace-only
126
acknowledgements are rejected with [Error Empty_acknowledgement]. Increments
127
the workout revision only when the acknowledgement changed. *)
128
129
(** {1 Blockers} *)
130
131
(** Why a workout cannot promote yet. *)
132
type blocker =
133
| No_sets
134
(** No promotable sets. A workout of only drop sets reduces to this, since
135
drop sets are discarded. *)
136
| Unmapped_exercise of string
137
(** An export exercise name without a mapping. *)
138
| Normal_sets_unconfirmed
139
140
val blockers : workout -> blocker list
141
(** The workout's blockers, computed over its promotable sets — the drop sets
142
are excluded, so they never appear here. Deterministic order: [No_sets]
143
first, then one [Unmapped_exercise] per distinct unmapped name in
144
first-appearance order, then [Normal_sets_unconfirmed]. An empty list means
145
the workout can promote. *)
146
147
(** {1 Promotion} *)
148
149
type provenance = {
150
batch_id : batch_id;
151
workout_id : workout_id;
152
source_rows : int list; (** The promoted rows, in source order. *)
153
normal_confirmation : string option;
154
(** The acknowledgement, present when the workout had [Normal] sets. *)
155
revision : int; (** The workout revision this promotion reflects. *)
156
}
157
158
type promoted = {
159
title : string;
160
started_at : Recovery.timestamp;
161
ended_at : Recovery.timestamp;
162
observations : Evidence.Observation.t list;
163
(** One per promoted source set, in source order. *)
164
provenance : provenance;
165
}
166
167
type workout_result =
168
| Promoted of promoted
169
| Already_promoted of promoted
170
(** The workout was already promoted at its current revision. *)
171
| Blocked of blocker list
172
173
type batch_result = {
174
promoted : (workout_id * promoted) list;
175
already_promoted : (workout_id * promoted) list;
176
blocked : (workout_id * blocker list) list;
177
}
178
179
val promote_workout :
180
batch -> workout_id -> (batch * workout_result, error) result
181
(** Promotes one workout, atomically. When the workout has no blockers, every
182
source set becomes one {!Evidence.Observation} at {!Positive_failure},
183
performed at the workout's [ended_at], and the promotion is stored on the
184
returned batch. A workout already promoted at its current revision yields
185
[Already_promoted]; a later revision re-promotes and replaces the stored
186
data. A blocked workout yields [Blocked] and the batch is unchanged. Returns
187
[Error (Unknown_workout _)] for an unknown workout. *)
188
189
val promote_batch : batch -> batch * batch_result
190
(** Promotes every workout in the batch. Promotion is partial: each workout is
191
promoted, already promoted, or blocked independently, and a blocked workout
192
never prevents another from promoting. *)
193
194
(** {1 Snapshot}
195
196
A serialization-neutral view of a batch, so a repository can store and
197
restore a batch without the third-party parser. The snapshot exposes plain
198
records that carry only strings, ints, floats, timestamps, and the public
199
{!source_set}, {!warning}, {!provenance}, and acknowledgement values. It
200
never exposes a mutable internal. A restore rebuilds the opaque batch,
201
resolving each exercise id through a lookup, so a snapshot stays valid only
202
as long as the catalog still names its exercises.
203
204
A prior promotion is preserved exactly, so {!Already_promoted} and the
205
edited re-promote behaviour survive a reconnect. Because every promoted
206
outcome is {!Positive_failure}, an observation snapshots as an exercise id,
207
a load, a rep count, and a performed time. *)
208
209
type observation_snapshot = {
210
exercise_id : Exercise.id;
211
load : float;
212
reps : int;
213
performed_at : Recovery.timestamp;
214
}
215
(** One promoted effort: always {!Positive_failure}, so the outcome is implicit.
216
*)
217
218
type promoted_snapshot = {
219
title : string;
220
started_at : Recovery.timestamp;
221
ended_at : Recovery.timestamp;
222
observations : observation_snapshot list;
223
source_rows : int list;
224
normal_confirmation : string option;
225
revision : int;
226
}
227
(** A stored promotion, flattened from {!promoted} and its {!provenance}. The
228
batch and workout ids are carried by the enclosing {!workout_snapshot}. *)
229
230
type workout_snapshot = {
231
id : workout_id;
232
title : string;
233
started_at : Recovery.timestamp;
234
ended_at : Recovery.timestamp;
235
sets : source_set list;
236
mappings : (string * Exercise.id) list;
237
(** Confirmed source-name-to-exercise mappings. *)
238
acknowledgement : string option;
239
revision : int;
240
promotion : promoted_snapshot option;
241
(** The prior promotion, when the workout was promoted. *)
242
}
243
244
type snapshot = {
245
batch_id : batch_id;
246
source : string;
247
fingerprint : string;
248
imported_at : Recovery.timestamp;
249
workouts : workout_snapshot list;
250
warnings : warning list;
251
}
252
253
(** Why a snapshot cannot be restored. *)
254
type restore_error =
255
| Unknown_exercise of string
256
(** A stored exercise id is not in the catalog. *)
257
| Invalid_time (** A stored [ended_at] precedes its [started_at]. *)
258
| Invalid_effort of Evidence.Stimulus.Effort.error
259
(** A stored observation the core refuses: a nonsensical load or rep
260
count. The snapshot is corrupt, not merely stale. *)
261
262
val snapshot : batch -> snapshot
263
(** A serialization-neutral view of the batch, including any prior promotion. *)
264
265
val restore :
266
find_exercise:(Exercise.id -> Exercise.t option) ->
267
snapshot ->
268
(batch, restore_error) result
269
(** Rebuilds the opaque batch, resolving each mapping's exercise id through
270
[find_exercise]. Returns [Error (Unknown_exercise _)] for a mapping or
271
observation whose exercise id is not in the catalog, and
272
[Error Invalid_time] when a workout's [ended_at] precedes its [started_at].
273
A restored batch reproduces the mappings, acknowledgement, revision, and
274
prior promotion of the snapshot exactly. *)
275