[OCaml] High Intensity Training Online
feat add logbook performance tables
Align completed and planned workout values for faster comparison. Preserve stimulus groups, show progression deltas, and add workout metadata without changing training rules.
Changed files
lib/presenter/pages_logbook.ml
@@ -118,87 +118,138 @@
118
118
(* An inline coloured delta for one metric: green for an increase, oxblood for a
119
119
decrease, following the app's progress palette. [None] when there is no prior
120
120
value or the value is unchanged, so no parenthetical is shown. *)
121
Removed:
let metric_delta ~previous ~current =
122
Removed:
match previous with
123
Removed:
| None -> None
124
Removed:
| Some p ->
125
Removed:
let d = current -. p in
126
Removed:
if Float.equal d 0. then None
127
Removed:
else
128
Removed:
let cls = if d > 0. then "delta-up" else "delta-down" in
129
Removed:
Some
130
Removed:
(tag "span"
131
Removed:
[ Dream_html.string_attr "class" "metric-delta %s" cls ]
132
Removed:
[ txt " (%+g)" d ])
133
Removed:
134
Removed:
(* One metric line: monospaced "<value> <unit>" with an optional coloured delta.
135
Removed:
[unit_] is pluralised by the caller. *)
136
Removed:
let metric_line ~value ~unit_ ~delta =
137
Removed:
tag "p"
138
Removed:
[ class_ "exercise-metric" ]
139
Removed:
([ txt "%s %s" value unit_ ] @ Option.to_list delta)
140
Removed:
141
Removed:
(* The workout duration line, with a coloured delta against the most recent
142
Removed:
earlier performance of the identical prescribed workout. Unlike a weight or
143
Removed:
reps delta, less time is the favourable direction here — finishing faster at
144
Removed:
the same or greater intensity is the signal this line exists to show — so a
145
Removed:
decrease colours green and an increase colours oxblood, the opposite mapping
146
Removed:
from {!metric_delta}. [None] when there is no such earlier workout or either
147
Removed:
workout is unfinished. *)
148
Removed:
let duration_line ~seconds ~previous_seconds =
121
Added:
let duration_text ~seconds ~previous_seconds =
149
122
match (seconds, previous_seconds) with
150
123
| None, _ -> None
151
Removed:
| Some seconds, None ->
152
Removed:
Some
153
Removed:
(metric_line
154
Removed:
~value:(Printf.sprintf "%d" (seconds / 60))
155
Removed:
~unit_:"min" ~delta:None)
124
Added:
| Some seconds, None -> Some (Printf.sprintf "%d min (—)" (seconds / 60))
156
125
| Some seconds, Some previous_seconds ->
157
126
let delta_seconds = seconds - previous_seconds in
158
Removed:
let delta =
159
Removed:
if delta_seconds = 0 then None
160
Removed:
else
161
Removed:
let cls = if delta_seconds < 0 then "delta-up" else "delta-down" in
162
Removed:
let delta_minutes = float_of_int delta_seconds /. 60. in
163
Removed:
Some
164
Removed:
(tag "span"
165
Removed:
[ Dream_html.string_attr "class" "metric-delta %s" cls ]
166
Removed:
[ txt " (%+.1f min)" delta_minutes ])
167
Removed:
in
168
Removed:
Some
169
Removed:
(metric_line
170
Removed:
~value:(Printf.sprintf "%d" (seconds / 60))
171
Removed:
~unit_:"min" ~delta)
127
Added:
let value = Printf.sprintf "%d min" (seconds / 60) in
128
Added:
let delta_minutes = float_of_int delta_seconds /. 60. in
129
Added:
Some (Printf.sprintf "%s (%+.1f min)" value delta_minutes)
172
130
173
Removed:
(* One exercise block in a row menu: a bold name, then a weight line and a reps
174
Removed:
line, each with its own coloured change. Shared by native and imported
175
Removed:
menus; [prev_*] is [None] for a first performance. *)
176
Removed:
let exercise_block ~name ~weight ~reps ~prev_weight ~prev_reps =
177
Removed:
tag "li"
178
Removed:
[ class_ "exercise-block" ]
179
Removed:
[
180
Removed:
tag "strong" [] [ txt "%s" name ];
181
Removed:
metric_line
182
Removed:
~value:(Printf.sprintf "%g" weight)
183
Removed:
~unit_:"kg"
184
Removed:
~delta:(metric_delta ~previous:prev_weight ~current:weight);
185
Removed:
metric_line ~value:(string_of_int reps)
186
Removed:
~unit_:(if reps = 1 then "rep" else "reps")
187
Removed:
~delta:
188
Removed:
(metric_delta
189
Removed:
~previous:(Option.map float_of_int prev_reps)
190
Removed:
~current:(float_of_int reps));
191
Removed:
]
131
Added:
let format_load load = Printf.sprintf "%g" load
132
Added:
let format_reps reps = string_of_int reps
192
133
193
Removed:
let native_change_line (change : View_model.Logbook_change.t) =
194
Removed:
exercise_block ~name:change.exercise_name ~weight:change.current_load
195
Removed:
~reps:change.current_reps ~prev_weight:(Some change.previous_load)
196
Removed:
~prev_reps:(Some change.previous_reps)
134
Added:
let delta_value ~previous ~current =
135
Added:
let delta = current -. previous in
136
Added:
let class_name, value =
137
Added:
if Float.equal delta 0. then ("performance-delta", "—")
138
Added:
else if delta > 0. then
139
Added:
("performance-delta delta-up", Printf.sprintf "%+g" delta)
140
Added:
else ("performance-delta delta-down", Printf.sprintf "%+g" delta)
141
Added:
in
142
Added:
(class_name, value)
197
143
198
Removed:
let imported_effort_line (e : View_model.Imported_effort.t) =
199
Removed:
exercise_block ~name:e.exercise_name ~weight:e.load ~reps:e.reps
200
Removed:
~prev_weight:e.previous_load ~prev_reps:e.previous_reps
144
Added:
let value_cell class_name value =
145
Added:
tag "td" [ class_ "%s" class_name ] [ txt "%s" value ]
201
146
147
Added:
let delta_cell ~previous ~current =
148
Added:
let class_name, value = delta_value ~previous ~current in
149
Added:
tag "td" [ class_ "%s" class_name ] [ txt "%s" value ]
150
Added:
151
Added:
let comparison_rows (row : View_model.Logbook_row.t) =
152
Added:
let exercise_cell =
153
Added:
tag "th"
154
Added:
[ Dream_html.string_attr "scope" "row"; class_ "performance-exercise" ]
155
Added:
[ txt "%s" row.exercise_name ]
156
Added:
in
157
Added:
[
158
Added:
tag "tr" []
159
Added:
[
160
Added:
exercise_cell;
161
Added:
value_cell "performance-current" (format_load row.current_load);
162
Added:
delta_cell
163
Added:
~previous:(Option.value ~default:row.current_load row.previous_load)
164
Added:
~current:row.current_load;
165
Added:
value_cell "performance-current" (format_reps row.current_reps);
166
Added:
delta_cell
167
Added:
~previous:
168
Added:
(float_of_int
169
Added:
(Option.value ~default:row.current_reps row.previous_reps))
170
Added:
~current:(float_of_int row.current_reps);
171
Added:
];
172
Added:
]
173
Added:
174
Added:
let performance_table groups =
175
Added:
tag "table"
176
Added:
[ class_ "logbook-performance-table" ]
177
Added:
([
178
Added:
tag "caption" [ class_ "sr-only" ] [ txt "Workout performance" ];
179
Added:
tag "thead" []
180
Added:
[
181
Added:
tag "tr" []
182
Added:
[
183
Added:
tag "th"
184
Added:
[ Dream_html.string_attr "scope" "col" ]
185
Added:
[ txt "Exercise" ];
186
Added:
tag "th"
187
Added:
[ Dream_html.string_attr "scope" "col" ]
188
Added:
[ txt "Load (kg)" ];
189
Added:
tag "th" [ Dream_html.string_attr "scope" "col" ] [ txt "Δ" ];
190
Added:
tag "th" [ Dream_html.string_attr "scope" "col" ] [ txt "Reps" ];
191
Added:
tag "th" [ Dream_html.string_attr "scope" "col" ] [ txt "Δ" ];
192
Added:
];
193
Added:
];
194
Added:
]
195
Added:
@ List.map
196
Added:
(fun (group : View_model.Logbook_group.t) ->
197
Added:
tag "tbody"
198
Added:
[ class_ "logbook-stimulus-group" ]
199
Added:
(List.concat_map comparison_rows group.rows))
200
Added:
groups)
201
Added:
202
Added:
let planned_table (groups : View_model.Selected_day.Planned.group list) =
203
Added:
let rows_of_group (group : View_model.Selected_day.Planned.group) =
204
Added:
List.map
205
Added:
(fun (exercise : View_model.Selected_day.Planned.exercise) ->
206
Added:
tag "tr" []
207
Added:
[
208
Added:
tag "th"
209
Added:
[
210
Added:
Dream_html.string_attr "scope" "row";
211
Added:
class_ "performance-exercise";
212
Added:
]
213
Added:
[ txt "%s" exercise.name ];
214
Added:
tag "td"
215
Added:
[ class_ "performance-previous" ]
216
Added:
[
217
Added:
txt "%s"
218
Added:
(Option.fold ~none:"—" ~some:format_load exercise.latest_load);
219
Added:
];
220
Added:
tag "td" [ class_ "performance-previous" ] [ txt "—" ];
221
Added:
tag "td"
222
Added:
[ class_ "performance-previous" ]
223
Added:
[
224
Added:
txt "%s"
225
Added:
(Option.fold ~none:"—" ~some:format_reps exercise.latest_reps);
226
Added:
];
227
Added:
tag "td" [ class_ "performance-previous" ] [ txt "—" ];
228
Added:
])
229
Added:
group.exercises
230
Added:
in
231
Added:
tag "table"
232
Added:
[ class_ "logbook-performance-table logbook-planned-table" ]
233
Added:
([
234
Added:
tag "caption" [ class_ "sr-only" ] [ txt "Latest performance" ];
235
Added:
tag "thead" []
236
Added:
[
237
Added:
tag "tr" []
238
Added:
[
239
Added:
tag "th"
240
Added:
[ Dream_html.string_attr "scope" "col" ]
241
Added:
[ txt "Exercise" ];
242
Added:
tag "th"
243
Added:
[ Dream_html.string_attr "scope" "col" ]
244
Added:
[ txt "Load (kg)" ];
245
Added:
tag "th" [ Dream_html.string_attr "scope" "col" ] [ txt "Δ" ];
246
Added:
tag "th" [ Dream_html.string_attr "scope" "col" ] [ txt "Reps" ];
247
Added:
tag "th" [ Dream_html.string_attr "scope" "col" ] [ txt "Δ" ];
248
Added:
];
249
Added:
];
250
Added:
]
251
Added:
@ List.map (fun group -> tag "tbody" [] (rows_of_group group)) groups)
252
Added:
202
253
let calendar_month_name month =
203
254
List.nth
204
255
[
@@ -217,53 +268,63 @@
217
268
]
218
269
(month - 1)
219
270
271
Added:
let workout_metadata (entry : View_model.Logbook_entry.t) =
272
Added:
let duration_item =
273
Added:
match
274
Added:
duration_text ~seconds:entry.duration_seconds
275
Added:
~previous_seconds:entry.duration_previous_seconds
276
Added:
with
277
Added:
| None -> []
278
Added:
| Some value ->
279
Added:
[ tag "dt" [] [ txt "Duration" ]; tag "dd" [] [ txt "%s" value ] ]
280
Added:
in
281
Added:
let next_item =
282
Added:
Option.to_list
283
Added:
(Option.map
284
Added:
(fun next ->
285
Added:
[ tag "dt" [] [ txt "Next planned" ]; tag "dd" [] [ txt "%s" next ] ])
286
Added:
entry.next_planned)
287
Added:
|> List.concat
288
Added:
in
289
Added:
tag "dl"
290
Added:
[ class_ "performance-metadata" ]
291
Added:
(duration_item
292
Added:
@ [
293
Added:
tag "dt" [] [ txt "Performed" ];
294
Added:
tag "dd" [] [ txt "%s" entry.performed_ago ];
295
Added:
]
296
Added:
@ next_item)
297
Added:
220
298
let selected_workout_card (entry : View_model.Logbook_entry.t) =
221
Removed:
let detail =
222
Removed:
if entry.imported then
223
Removed:
tag "ul"
224
Removed:
[ class_ "logbook-change-list" ]
225
Removed:
(List.map imported_effort_line entry.imported_efforts)
226
Removed:
:: Option.to_list
227
Removed:
(duration_line ~seconds:entry.duration_seconds
228
Removed:
~previous_seconds:entry.duration_previous_seconds)
299
Added:
let performance =
300
Added:
if entry.groups = [] then
301
Added:
[
302
Added:
tag "p" [ class_ "logbook-no-progress" ] [ txt "No exercises recorded" ];
303
Added:
]
304
Added:
else [ performance_table entry.groups ]
305
Added:
in
306
Added:
let actions =
307
Added:
if entry.imported then []
229
308
else
230
Removed:
let exercises =
231
Removed:
if entry.changes = [] then
309
Added:
[
310
Added:
tag "div"
311
Added:
[ class_ "logbook-entry-actions" ]
232
312
[
233
Removed:
tag "p"
234
Removed:
[ class_ "logbook-no-progress" ]
235
Removed:
[ txt "No prior comparison" ];
236
Removed:
]
237
Removed:
else
238
Removed:
[
239
Removed:
tag "ul"
240
Removed:
[ class_ "logbook-change-list" ]
241
Removed:
(List.map native_change_line entry.changes);
242
Removed:
]
243
Removed:
in
244
Removed:
exercises
245
Removed:
@ Option.to_list
246
Removed:
(duration_line ~seconds:entry.duration_seconds
247
Removed:
~previous_seconds:entry.duration_previous_seconds)
248
Removed:
@ [
249
Removed:
tag "div"
250
Removed:
[ class_ "logbook-entry-actions" ]
251
Removed:
[
252
Removed:
tag "a"
253
Removed:
[
254
Removed:
href Routes.record entry.id;
255
Removed:
class_ "button secondary";
256
Removed:
Dream_html.attr "data-hito-app-link";
257
Removed:
]
258
Removed:
[ txt "Edit" ];
259
Removed:
tag "a"
260
Removed:
[
261
Removed:
Dream_html.string_attr "href" "/logbook?delete=%s" entry.id;
262
Removed:
class_ "button outline danger";
263
Removed:
]
264
Removed:
[ txt "Delete" ];
265
Removed:
];
266
Removed:
]
313
Added:
tag "a"
314
Added:
[
315
Added:
href Routes.record entry.id;
316
Added:
class_ "button secondary";
317
Added:
Dream_html.attr "data-hito-app-link";
318
Added:
]
319
Added:
[ txt "Edit" ];
320
Added:
tag "a"
321
Added:
[
322
Added:
Dream_html.string_attr "href" "/logbook?delete=%s" entry.id;
323
Added:
class_ "button outline danger";
324
Added:
]
325
Added:
[ txt "Delete" ];
326
Added:
];
327
Added:
]
267
328
in
268
329
let header =
269
330
tag "header"
@@ -276,7 +337,11 @@
276
337
in
277
338
tag "article"
278
339
[ class_ "selected-workout" ]
279
Removed:
[ header; tag "div" [ class_ "selected-workout-panel" ] detail ]
340
Added:
[
341
Added:
header;
342
Added:
workout_metadata entry;
343
Added:
tag "div" [ class_ "selected-workout-panel" ] (performance @ actions);
344
Added:
]
280
345
281
346
let selected_planned_card (planned : View_model.Selected_day.Planned.t) =
282
347
tag "article"
@@ -284,9 +349,10 @@
284
349
[
285
350
tag "h3" [] [ txt "Planned: %s" planned.name ];
286
351
tag "p" [] [ txt "This workout follows your routine recovery." ];
287
Removed:
tag "ul"
288
Removed:
[ class_ "planned-exercise-list" ]
289
Removed:
(List.map (fun name -> tag "li" [] [ txt "%s" name ]) planned.exercises);
352
Added:
planned_table planned.groups;
353
Added:
tag "p"
354
Added:
[ class_ "planned-record-note" ]
355
Added:
[ txt "Latest performance is the record to beat." ];
290
356
]
291
357
292
358
let selected_day_panel (selected : View_model.Selected_day.t) =
lib/presenter/view_model.ml
@@ -145,42 +145,22 @@
145
145
form, since its option set is fixed UI vocabulary, not domain data. *)
146
146
end
147
147
148
Removed:
(** A per-exercise progress verdict, for colour coding. Progress is green,
149
Removed:
regress oxblood, stagnation brass. *)
150
Removed:
type verdict = Progressed | Regressed | Stagnant
151
Removed:
152
Removed:
module Logbook_change = struct
148
Added:
module Logbook_row = struct
153
149
type t = {
154
150
exercise_name : string;
155
Removed:
previous_load : float;
156
Removed:
previous_reps : int;
157
151
current_load : float;
158
152
current_reps : int;
159
Removed:
verdict : verdict; (** This exercise's outcome versus its prior baseline. *)
160
Removed:
}
161
Removed:
(** Exact evidence for one compared exercise. The presenter derives display
162
Removed:
deltas and the verdict colour from these plain values, never from a core
163
Removed:
effort. *)
164
Removed:
end
165
Removed:
166
Removed:
module Imported_effort = struct
167
Removed:
type t = {
168
Removed:
exercise_name : string;
169
Removed:
load : float; (** The imported effort's load, in kg. *)
170
Removed:
reps : int;
171
153
previous_load : float option;
172
Removed:
(** The same exercise's most recent prior performance, when one exists.
173
Removed:
[None] for a first performance. *)
174
154
previous_reps : int option;
175
Removed:
verdict : verdict option;
176
Removed:
(** This effort's outcome versus its prior performance. [None] for a
177
Removed:
first performance, which has nothing to compare against. *)
178
155
}
179
Removed:
(** One imported exercise effort with the progress since it was last
180
Removed:
performed. The presenter derives the delta and verdict colour from the
181
Removed:
plain values; a first performance carries no previous. *)
156
Added:
(** One observed exercise effort and its optional previous performance. *)
182
157
end
183
158
159
Added:
module Logbook_group = struct
160
Added:
type t = { rows : Logbook_row.t list }
161
Added:
(** The exercises delivered by one stimulus, in performance order. *)
162
Added:
end
163
Added:
184
164
module Logbook_entry = struct
185
165
type t = {
186
166
id : string; (** Record id for edit and delete links. *)
@@ -199,21 +179,29 @@
199
179
duration_seconds : int option;
200
180
(** This workout's own elapsed seconds, when finished. Carried with the
201
181
previous duration so the presenter can derive a signed delta. *)
202
Removed:
changes : Logbook_change.t list;
203
Removed:
(** Per-exercise comparisons for a native workout, in performance order,
204
Removed:
each carrying its own verdict. Empty for an import. *)
205
Removed:
imported_efforts : Imported_effort.t list;
206
Removed:
(** One per imported effort, in source order, each with the progress
207
Removed:
since it was last performed. Empty for a native entry. *)
182
Added:
performed_ago : string;
183
Added:
(** Time since the workout started, already phrased for the view. *)
184
Added:
next_planned : string option;
185
Added:
(** Time until the next planned occurrence of this workout, already
186
Added:
phrased for the view. *)
187
Added:
groups : Logbook_group.t list;
188
Added:
(** Exercise rows grouped by the stimulus that delivered them. *)
208
189
}
209
190
(** One recorded workout for the selected-day detail panel. It carries the
210
Removed:
exercise comparisons and actions for a native record, or imported efforts
211
Removed:
for a read-only imported record. *)
191
Added:
exercise rows grouped by stimulus, or one read-only group for an import.
192
Added:
*)
212
193
end
213
194
214
195
module Selected_day = struct
215
196
module Planned = struct
216
Removed:
type t = { name : string; exercises : string list }
197
Added:
type exercise = {
198
Added:
name : string;
199
Added:
latest_load : float option;
200
Added:
latest_reps : int option;
201
Added:
}
202
Added:
203
Added:
type group = { exercises : exercise list }
204
Added:
type t = { name : string; groups : group list }
217
205
end
218
206
219
207
type t = {
lib/web/assets/hito.css
@@ -557,7 +557,85 @@
557
557
background: var(--blood-hover);
558
558
}
559
559
560
Removed:
/* The Logbook records exercise facts in the selected-day panel. */
560
Added:
/* The Logbook tables align current, previous, and change rows. Each tbody is
561
Added:
one delivered stimulus, so a pre-exhaust pair remains a visible group. */
562
Added:
.logbook-performance-table {
563
Added:
width: 100%;
564
Added:
margin: 0;
565
Added:
border-collapse: collapse;
566
Added:
font-family: var(--mono);
567
Added:
}
568
Added:
.logbook-performance-table thead {
569
Added:
color: var(--ink);
570
Added:
font-family: var(--sans);
571
Added:
font-size: inherit;
572
Added:
}
573
Added:
.logbook-performance-table thead th {
574
Added:
font-weight: 700;
575
Added:
}
576
Added:
.logbook-performance-table th,
577
Added:
.logbook-performance-table td {
578
Added:
padding: 0.45rem 0.35rem;
579
Added:
text-align: right;
580
Added:
vertical-align: middle;
581
Added:
}
582
Added:
.logbook-performance-table th:first-child {
583
Added:
text-align: left;
584
Added:
}
585
Added:
.logbook-performance-table tbody + tbody {
586
Added:
border-top: 1px solid var(--rule-strong);
587
Added:
}
588
Added:
.logbook-planned-table tbody {
589
Added:
border-top: 1px solid var(--rule-strong);
590
Added:
}
591
Added:
.logbook-performance-table .performance-exercise {
592
Added:
width: 40%;
593
Added:
color: var(--ink);
594
Added:
font-family: var(--sans);
595
Added:
font-weight: 400;
596
Added:
text-align: left;
597
Added:
}
598
Added:
.logbook-performance-table .performance-current,
599
Added:
.logbook-performance-table .performance-previous {
600
Added:
font-family: var(--mono);
601
Added:
font-weight: 400;
602
Added:
}
603
Added:
.logbook-performance-table .performance-current {
604
Added:
color: var(--ink);
605
Added:
}
606
Added:
.logbook-performance-table .performance-previous {
607
Added:
color: var(--muted-ink);
608
Added:
}
609
Added:
.performance-delta {
610
Added:
font-weight: 700;
611
Added:
}
612
Added:
.performance-delta.delta-up { color: var(--evergreen); }
613
Added:
.performance-delta.delta-down { color: var(--blood-dark); }
614
Added:
.logbook-planned-table .performance-previous {
615
Added:
color: var(--ink);
616
Added:
font-style: italic;
617
Added:
}
618
Added:
.performance-metadata {
619
Added:
display: grid;
620
Added:
grid-template-columns: auto 1fr;
621
Added:
gap: 0.25rem 0.75rem;
622
Added:
margin: 0.65rem 0 0;
623
Added:
}
624
Added:
.performance-metadata dt {
625
Added:
color: var(--ink);
626
Added:
font-family: var(--sans);
627
Added:
font-weight: 700;
628
Added:
}
629
Added:
.performance-metadata dd {
630
Added:
margin: 0;
631
Added:
color: var(--ink);
632
Added:
font-family: var(--mono);
633
Added:
}
634
Added:
margin: 0.65rem 0 0;
635
Added:
color: var(--muted-ink);
636
Added:
font-size: var(--font-size-small);
637
Added:
}
638
Added:
561
639
.logbook-import-pill {
562
640
display: inline-block;
563
641
padding: 0.05rem 0.5rem;
@@ -582,28 +660,6 @@
582
660
.feedback-modal-content h2,
583
661
.profile-dialog h3 { margin-top: 0; text-align: center; }
584
662
585
Removed:
.logbook-change-list {
586
Removed:
display: grid;
587
Removed:
gap: 0.75rem;
588
Removed:
margin: 0;
589
Removed:
padding: 0;
590
Removed:
list-style: none;
591
Removed:
}
592
Removed:
/* One exercise: a bold name, then a weight line and a reps line. */
593
Removed:
.exercise-block > strong {
594
Removed:
display: block;
595
Removed:
color: var(--ink);
596
Removed:
}
597
Removed:
.exercise-metric {
598
Removed:
margin: 0.15rem 0 0;
599
Removed:
font-family: var(--mono);
600
Removed:
color: var(--ink);
601
Removed:
}
602
Removed:
/* The per-metric change, coloured by the app's progress palette: an increase
603
Removed:
is green, a decrease blood. */
604
Removed:
.metric-delta { font-weight: 700; }
605
Removed:
.metric-delta.delta-up { color: var(--evergreen); }
606
Removed:
.metric-delta.delta-down { color: var(--blood-dark); }
607
663
608
664
/* The month calendar is a self-contained widget above the selected-day panel,
609
665
flat on the page. A header row holds a previous arrow, the month and year, a
lib/web/handlers_logbook.ml
@@ -32,17 +32,28 @@
32
32
33
33
(* {1 Calendar} *)
34
34
35
Added:
type planned_group = { exercises : Exercise.t list }
36
Added:
35
37
type planned_workout = {
36
38
at_unix : int;
37
39
workout_name : string;
38
Removed:
exercises : string list;
40
Added:
groups : planned_group list;
39
41
}
40
42
41
Removed:
let exercises_of_prescription prescription =
43
Added:
let groups_of_prescription prescription =
42
44
Prescription.Workout.stimuli prescription
43
Removed:
|> List.concat_map Prescription.Stimulus.exercises
44
Removed:
|> List.map Exercise.name
45
Added:
|> List.map (fun stimulus ->
46
Added:
{ exercises = Prescription.Stimulus.exercises stimulus })
45
47
48
Added:
let latest_performance history =
49
Added:
match List.rev history with
50
Added:
| observation :: _ ->
51
Added:
let effort = Evidence.Observation.effort observation in
52
Added:
Some
53
Added:
( Evidence.Stimulus.Effort.load effort,
54
Added:
Evidence.Stimulus.Effort.reps effort )
55
Added:
| [] -> None
56
Added:
46
57
let latest_finished_workout log =
47
58
Evidence.Log.workouts log
48
59
|> List.find_map (fun workout ->
@@ -74,7 +85,7 @@
74
85
{
75
86
at_unix = planned_at;
76
87
workout_name = Prescription.Workout.name next;
77
Removed:
exercises = exercises_of_prescription next;
88
Added:
groups = groups_of_prescription next;
78
89
}
79
90
:: loop next
80
91
(Recovery.timestamp_of_unix_seconds planned_at)
@@ -154,24 +165,6 @@
154
165
weeks = weeks cells;
155
166
}
156
167
157
Removed:
(* One exercise's outcome versus its prior effort: load leads, then reps,
158
Removed:
matching the Heavy Duty progress rule. Progress is an increase, regress a
159
Removed:
decrease, stagnation a flat repeat. *)
160
Removed:
let effort_verdict ~previous ~current : View_model.verdict =
161
Removed:
let load =
162
Removed:
Float.compare
163
Removed:
(Evidence.Stimulus.Effort.load current)
164
Removed:
(Evidence.Stimulus.Effort.load previous)
165
Removed:
in
166
Removed:
let reps =
167
Removed:
Int.compare
168
Removed:
(Evidence.Stimulus.Effort.reps current)
169
Removed:
(Evidence.Stimulus.Effort.reps previous)
170
Removed:
in
171
Removed:
if load > 0 || (load = 0 && reps > 0) then Progressed
172
Removed:
else if load < 0 || (load = 0 && reps < 0) then Regressed
173
Removed:
else Stagnant
174
Removed:
175
168
(* The most recent other finished workout in the log with the same
176
169
prescription name, started strictly before [workout]. This is the
177
170
"identical workout" baseline for a duration comparison: same prescribed
@@ -199,23 +192,45 @@
199
192
let started =
200
193
Recovery.timestamp_to_unix_seconds (Evidence.Workout.started_at workout)
201
194
in
202
Removed:
(* Every compared exercise, each with its own verdict — progress, regress,
203
Removed:
or stagnation — for the colour-coded per-exercise menu line. *)
204
Removed:
let changes =
205
Removed:
Progress.workout_comparisons log workout
206
Removed:
|> List.map (fun (c : Progress.workout_comparison) ->
207
Removed:
View_model.Logbook_change.
208
Removed:
{
209
Removed:
exercise_name = Exercise.name c.Progress.exercise;
210
Removed:
previous_load = Evidence.Stimulus.Effort.load c.Progress.previous;
211
Removed:
previous_reps = Evidence.Stimulus.Effort.reps c.Progress.previous;
212
Removed:
current_load = Evidence.Stimulus.Effort.load c.Progress.current;
213
Removed:
current_reps = Evidence.Stimulus.Effort.reps c.Progress.current;
214
Removed:
verdict =
215
Removed:
effort_verdict ~previous:c.Progress.previous
216
Removed:
~current:c.Progress.current;
217
Removed:
})
195
Added:
let comparison_for exercise comparisons =
196
Added:
List.find_opt
197
Added:
(fun (comparison : Progress.workout_comparison) ->
198
Added:
Exercise.equal comparison.exercise exercise)
199
Added:
comparisons
218
200
in
201
Added:
let row_of_effort comparisons (effort : Evidence.Stimulus.Effort.t) =
202
Added:
let exercise = Evidence.Stimulus.Effort.exercise effort in
203
Added:
match comparison_for exercise comparisons with
204
Added:
| None ->
205
Added:
{
206
Added:
View_model.Logbook_row.exercise_name = Exercise.name exercise;
207
Added:
current_load = Evidence.Stimulus.Effort.load effort;
208
Added:
current_reps = Evidence.Stimulus.Effort.reps effort;
209
Added:
previous_load = None;
210
Added:
previous_reps = None;
211
Added:
}
212
Added:
| Some comparison ->
213
Added:
{
214
Added:
View_model.Logbook_row.exercise_name = Exercise.name exercise;
215
Added:
current_load = Evidence.Stimulus.Effort.load effort;
216
Added:
current_reps = Evidence.Stimulus.Effort.reps effort;
217
Added:
previous_load =
218
Added:
Some (Evidence.Stimulus.Effort.load comparison.previous);
219
Added:
previous_reps =
220
Added:
Some (Evidence.Stimulus.Effort.reps comparison.previous);
221
Added:
}
222
Added:
in
223
Added:
let comparisons = Progress.workout_comparisons log workout in
224
Added:
let groups =
225
Added:
Evidence.Workout.performed workout
226
Added:
|> List.map (fun (_slot, stimulus) ->
227
Added:
{
228
Added:
View_model.Logbook_group.rows =
229
Added:
List.map
230
Added:
(row_of_effort comparisons)
231
Added:
(Evidence.Stimulus.efforts stimulus);
232
Added:
})
233
Added:
in
219
234
let duration_previous_seconds =
220
235
previous_same_workout_duration log workout
221
236
in
@@ -229,36 +244,15 @@
229
244
duration_seconds =
230
245
Option.map Recovery.duration_to_seconds
231
246
(Evidence.Workout.duration workout);
232
Removed:
changes;
233
Removed:
imported_efforts = [];
247
Added:
performed_ago = "";
248
Added:
next_planned = None;
249
Added:
groups;
234
250
}
235
251
236
Removed:
(* A promoted import: canonical evidence, read-only. It carries no
237
Removed:
prescription, so the native progress columns do not apply. Its detail lists
238
Removed:
the imported efforts verbatim. It still feeds progress per exercise through
239
Removed:
the service. The logbook only shows it. *)
240
Removed:
let imported_effort_view ~history (o : Evidence.Observation.t) :
241
Removed:
View_model.Imported_effort.t =
242
Removed:
let effort = Evidence.Observation.effort o in
243
Removed:
let previous = Progress.previous_observation history o in
244
Removed:
let previous_effort = Option.map Evidence.Observation.effort previous in
245
Removed:
{
246
Removed:
exercise_name = Exercise.name (Evidence.Observation.exercise o);
247
Removed:
load = Evidence.Stimulus.Effort.load effort;
248
Removed:
reps = Evidence.Stimulus.Effort.reps effort;
249
Removed:
previous_load = Option.map Evidence.Stimulus.Effort.load previous_effort;
250
Removed:
previous_reps = Option.map Evidence.Stimulus.Effort.reps previous_effort;
251
Removed:
verdict =
252
Removed:
Option.map
253
Removed:
(fun previous -> effort_verdict ~previous ~current:effort)
254
Removed:
previous_effort;
255
Removed:
}
256
Removed:
257
252
(* Build one imported entry. Each imported effort carries the progress since
258
253
that exercise was last performed, compared against the merged native and
259
254
imported history the service supplies. The service fetches history once per
260
Removed:
distinct exercise in the record, so a workout of repeated exercises stays
261
Removed:
cheap. *)
255
Added:
distinct exercise in the record. *)
262
256
let imported_entry_view t trainee (record : Repository.imported_record) :
263
257
View_model.Logbook_entry.t Lwt.t =
264
258
let started =
@@ -285,11 +279,25 @@
285
279
| Some (_, h) -> h
286
280
| None -> []
287
281
in
288
Removed:
let efforts =
282
Added:
let rows =
289
283
List.map
290
Removed:
(fun o ->
284
Added:
(fun (o : Evidence.Observation.t) ->
285
Added:
let effort = Evidence.Observation.effort o in
291
286
let history = history_of (Evidence.Observation.exercise o) in
292
Removed:
imported_effort_view ~history o)
287
Added:
let previous = Progress.previous_observation history o in
288
Added:
let previous_effort =
289
Added:
Option.map Evidence.Observation.effort previous
290
Added:
in
291
Added:
{
292
Added:
View_model.Logbook_row.exercise_name =
293
Added:
Exercise.name (Evidence.Observation.exercise o);
294
Added:
current_load = Evidence.Stimulus.Effort.load effort;
295
Added:
current_reps = Evidence.Stimulus.Effort.reps effort;
296
Added:
previous_load =
297
Added:
Option.map Evidence.Stimulus.Effort.load previous_effort;
298
Added:
previous_reps =
299
Added:
Option.map Evidence.Stimulus.Effort.reps previous_effort;
300
Added:
})
293
301
observations
294
302
in
295
303
({
@@ -299,8 +307,9 @@
299
307
workout_name = record.Repository.title;
300
308
duration_previous_seconds = None;
301
309
duration_seconds = Some (ended - started);
302
Removed:
changes = [];
303
Removed:
imported_efforts = efforts;
310
Added:
performed_ago = "";
311
Added:
next_planned = None;
312
Added:
groups = [ { View_model.Logbook_group.rows } ];
304
313
}
305
314
: View_model.Logbook_entry.t)
306
315
@@ -324,7 +333,7 @@
324
333
Service.imported_records t.service trainee.Trainee.id >>= fun imported ->
325
334
Lwt_list.map_s (imported_entry_view t trainee.Trainee.id) imported
326
335
>>= fun imported_entries ->
327
Removed:
let all_records =
336
Added:
let recorded_entries =
328
337
List.map (entry_view log) records @ imported_entries
329
338
|> List.stable_sort (fun a b ->
330
339
Int.compare b.View_model.Logbook_entry.at_unix
@@ -347,17 +356,56 @@
347
356
&& tm.Unix.tm_mon + 1 = month
348
357
&& tm.Unix.tm_mday = day
349
358
in
359
Added:
let planned =
360
Added:
match active_routine with
361
Added:
| Some (_, routine) -> planned_workouts ~now ~log ~routine
362
Added:
| None -> []
363
Added:
in
364
Added:
let plural count singular plural = if count = 1 then singular else plural in
365
Added:
let elapsed_words seconds suffix =
366
Added:
if seconds < 3600 then
367
Added:
let minutes = max 1 (seconds / 60) in
368
Added:
Printf.sprintf "%d %s %s" minutes
369
Added:
(plural minutes "minute" "minutes")
370
Added:
suffix
371
Added:
else if seconds < 86_400 then
372
Added:
let hours = seconds / 3600 in
373
Added:
Printf.sprintf "%d %s %s" hours (plural hours "hour" "hours") suffix
374
Added:
else
375
Added:
let days = seconds / 86_400 in
376
Added:
Printf.sprintf "%d %s %s" days (plural days "day" "days") suffix
377
Added:
in
378
Added:
let performed_ago ~at =
379
Added:
let elapsed = max 0 (now - at) in
380
Added:
if elapsed < 60 then "Just now" else elapsed_words elapsed "ago"
381
Added:
in
382
Added:
let next_planned_for name =
383
Added:
List.find_opt
384
Added:
(fun (planned : planned_workout) ->
385
Added:
String.equal planned.workout_name name)
386
Added:
planned
387
Added:
in
388
Added:
let enriched_entries =
389
Added:
List.map
390
Added:
(fun (entry : View_model.Logbook_entry.t) ->
391
Added:
{
392
Added:
entry with
393
Added:
performed_ago = performed_ago ~at:entry.at_unix;
394
Added:
next_planned =
395
Added:
Option.map
396
Added:
(fun (planned : planned_workout) ->
397
Added:
elapsed_words (max 0 (planned.at_unix - now)) "from now")
398
Added:
(next_planned_for entry.workout_name);
399
Added:
})
400
Added:
recorded_entries
401
Added:
in
402
Added:
let all_records = enriched_entries in
350
403
let selected_completed =
351
404
Option.map
352
405
(fun day -> List.filter (fun entry -> same_day entry day) all_records)
353
406
selected_day_number
354
407
|> Option.value ~default:[]
355
408
in
356
Removed:
let planned =
357
Removed:
match active_routine with
358
Removed:
| Some (_, routine) -> planned_workouts ~now ~log ~routine
359
Removed:
| None -> []
360
Removed:
in
361
409
let planned_for_day day =
362
410
List.find_opt
363
411
(fun (planned : planned_workout) ->
@@ -368,6 +416,32 @@
368
416
planned
369
417
in
370
418
let selected_planned = Option.bind selected_day_number planned_for_day in
419
Added:
let selected_planned_lwt =
420
Added:
match selected_planned with
421
Added:
| None -> Lwt.return_none
422
Added:
| Some planned ->
423
Added:
Lwt_list.map_s
424
Added:
(fun (group : planned_group) ->
425
Added:
Lwt_list.map_s
426
Added:
(fun exercise ->
427
Added:
Service.exercise_history t.service trainee.Trainee.id exercise
428
Added:
>|= fun history ->
429
Added:
let latest_load, latest_reps =
430
Added:
match latest_performance history with
431
Added:
| None -> (None, None)
432
Added:
| Some (load, reps) -> (Some load, Some reps)
433
Added:
in
434
Added:
View_model.Selected_day.Planned.
435
Added:
{ name = Exercise.name exercise; latest_load; latest_reps })
436
Added:
group.exercises
437
Added:
>|= fun exercises -> View_model.Selected_day.Planned.{ exercises })
438
Added:
planned.groups
439
Added:
>|= fun groups ->
440
Added:
Some
441
Added:
View_model.Selected_day.Planned.
442
Added:
{ name = planned.workout_name; groups }
443
Added:
in
444
Added:
selected_planned_lwt >>= fun selected_planned ->
371
445
let selected_day =
372
446
Option.map
373
447
(fun day ->
@@ -376,15 +450,7 @@
376
450
date =
377
451
utc_long_date (Calendar.unix_seconds_of_date ~year ~month ~day);
378
452
completed = selected_completed;
379
Removed:
planned =
380
Removed:
Option.map
381
Removed:
(fun planned ->
382
Removed:
View_model.Selected_day.Planned.
383
Removed:
{
384
Removed:
name = planned.workout_name;
385
Removed:
exercises = planned.exercises;
386
Removed:
})
387
Removed:
selected_planned;
453
Added:
planned = selected_planned;
388
454
})
389
455
selected_day_number
390
456
in
test/web/logbook.ml
@@ -59,8 +59,8 @@
59
59
"selected planned workout is displayed" true
60
60
(Option.is_some (index_from ~needle:"Planned: Day 2" page 0));
61
61
Alcotest.(check bool)
62
Removed:
"selected planned exercises are displayed" true
63
Removed:
(Option.is_some (index_from ~needle:"Pullovers" page 0));
62
Added:
"planned workout uses the latest-performance table" true
63
Added:
(Option.is_some (index_from ~needle:"Latest performance" page 0));
64
64
Alcotest.(check bool)
65
65
"the old entry list is absent" true
66
66
(Option.is_none (index_from ~needle:"logbook-entry" page 0)) );
@@ -181,7 +181,13 @@
181
181
("history reports " ^ needle)
182
182
true
183
183
(Option.is_some (index_from ~needle page 0)))
184
Removed:
[ "Laterals"; "12 kg"; "(+2)"; "9 reps"; "(+1)" ] );
184
Added:
[ "Laterals"; "12"; "+2"; "9"; "+1"; "Δ"; "Performed" ];
185
Added:
Alcotest.(check bool)
186
Added:
"the table labels the load unit in its header" true
187
Added:
(Option.is_some (index_from ~needle:"Load (kg)" page 0));
188
Added:
Alcotest.(check bool)
189
Added:
"the table does not repeat units in values" true
190
Added:
(Option.is_none (index_from ~needle:"12 kg" page 0)) );
185
191
( "each saved workout has an edit and confirmation-gated delete action",
186
192
`Quick,
187
193
fun () ->
@@ -593,10 +599,10 @@
593
599
(Test_repo.imported_records repo trainee.Trainee.id)));
594
600
let page = body (get c "/logbook?year=2024&month=1&day=8") in
595
601
(* The later import gained 10 kg over the earlier one, shown as a
596
Removed:
green weight delta. *)
602
Added:
green weight delta without repeating the unit in the value. *)
597
603
Alcotest.(check bool)
598
604
"the load gain is reported" true
599
Removed:
(Option.is_some (index_from ~needle:"(+10)" page 0)) );
605
Added:
(Option.is_some (index_from ~needle:"+10" page 0)) );
600
606
( "the progress page charts an exercise with enough history",
601
607
`Quick,
602
608
fun () ->