View raw

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