[OCaml] High Intensity Training Online
feat Show logbook as a table with progress
Present recorded workouts in a table with date, workout, and a count of exercises that beat their previous record. Add a Log feedback / Edit logbook action group under the heading. Progress is judged in Progression.workout_progress, exposed through Service.workout_log.
Changed files
lib/app/service.ml
@@ -294,6 +294,7 @@
294
294
with Evidence.Workout.Invalid error -> Error error)
295
295
296
296
let history t trainee = R.history t.repo trainee
297
Added:
let workout_log t trainee = R.log t.repo trainee
297
298
end
298
299
299
300
(* --- what the record means --- *)
@@ -505,6 +506,7 @@
505
506
let add_to_record = Records.add_to_record
506
507
let replace_in_record = Records.replace_in_record
507
508
let history = Records.history
509
Added:
let workout_log = Records.workout_log
508
510
let progress = Assessment.progress
509
511
let diagnostics = Assessment.diagnostics
510
512
let record_feedback = Feedback.record
lib/app/service.mli
@@ -170,6 +170,11 @@
170
170
171
171
val history : t -> Trainee.id -> Repository.record list Lwt.t
172
172
173
Added:
val workout_log : t -> Trainee.id -> Evidence.Log.t Lwt.t
174
Added:
(** The trainee's native workout log, for judging progress across history.
175
Added:
Distinct from imported records, which {!Progression} merges only per
176
Added:
exercise. *)
177
Added:
173
178
val progress :
174
179
t ->
175
180
Trainee.id ->
lib/core/progression.ml
@@ -143,3 +143,41 @@
143
143
n
144
144
| Trained_under_recovered n ->
145
145
Format.fprintf ppf "%d workout(s) begun before recovery was complete" n
146
Added:
147
Added:
(* How many distinct exercises in [workout] beat their most recent earlier
148
Added:
observation in [log]. Progress is the Heavy Duty signal — an increase in reps
149
Added:
or load — judged here, in the one module that judges, so a caller receives a
150
Added:
count and never re-derives the rule. An exercise with no earlier observation
151
Added:
does not count: a first performance has nothing to beat. The comparison
152
Added:
baseline is the latest observation strictly before this workout started, so
153
Added:
re-opening a saved workout to correct it does not compare an exercise against
154
Added:
itself. *)
155
Added:
let workout_progress log workout =
156
Added:
let started = Evidence.Workout.started_at workout in
157
Added:
let progressed exercise current =
158
Added:
let prior =
159
Added:
Evidence.Log.observations log exercise
160
Added:
|> List.filter (fun o ->
161
Added:
Recovery.duration_to_seconds
162
Added:
(Recovery.elapsed
163
Added:
~since:(Evidence.Observation.performed_at o)
164
Added:
~now:started)
165
Added:
> 0)
166
Added:
in
167
Added:
match last prior with
168
Added:
| None -> false
169
Added:
| Some previous ->
170
Added:
beats ~previous:(Evidence.Observation.effort previous) ~current
171
Added:
in
172
Added:
Evidence.Workout.stimuli workout
173
Added:
|> List.concat_map Evidence.Stimulus.efforts
174
Added:
|> List.fold_left
175
Added:
(fun (seen, count) effort ->
176
Added:
let exercise = Evidence.Stimulus.Effort.exercise effort in
177
Added:
if
178
Added:
List.exists (Exercise.equal exercise) seen
179
Added:
|| not (progressed exercise effort)
180
Added:
then (exercise :: seen, count)
181
Added:
else (exercise :: seen, count + 1))
182
Added:
([], 0)
183
Added:
|> snd
lib/core/progression.mli
@@ -52,3 +52,10 @@
52
52
53
53
val diagnose : Evidence.Log.t -> diagnostic list
54
54
val pp_diagnostic : Format.formatter -> diagnostic -> unit
55
Added:
56
Added:
val workout_progress : Evidence.Log.t -> Evidence.Workout.t -> int
57
Added:
(** How many distinct exercises in the workout beat their most recent earlier
58
Added:
observation in the log. Progress is more reps or load; one extra rep counts.
59
Added:
An exercise with no earlier observation does not count, and the baseline is
60
Added:
the latest observation strictly before the workout started, so correcting a
61
Added:
saved workout never compares an exercise against itself. *)
lib/presenter/pages_logbook.ml
@@ -334,30 +334,68 @@
334
334
html_page ~viewer ~request ~active:"logbook" ~logging "Logbook"
335
335
[
336
336
tag "h1" [] [ txt "Logbook" ];
337
Added:
tag "div"
338
Added:
[
339
Added:
class_ "button-group";
340
Added:
Dream_html.string_attr "role" "group";
341
Added:
Dream_html.string_attr "aria-label" "Logbook actions";
342
Added:
]
343
Added:
[
344
Added:
tag "a"
345
Added:
[
346
Added:
class_ "button primary";
347
Added:
Dream_html.string_attr "href" "/logbook?feedback=start";
348
Added:
Dream_html.attr "data-hito-feedback-open";
349
Added:
]
350
Added:
[ txt "Log feedback" ];
351
Added:
tag "a"
352
Added:
[
353
Added:
class_ "button secondary";
354
Added:
Dream_html.string_attr "href" "/logbook?edit=1";
355
Added:
]
356
Added:
[ txt "Edit logbook" ];
357
Added:
];
337
358
(if records = [] then tag "p" [] [ txt "Nothing logged yet." ]
338
359
else
339
Removed:
tag "ul" []
340
Removed:
(List.map
341
Removed:
(fun (entry : View_model.Logbook_entry.t) ->
342
Removed:
tag "li" []
343
Removed:
[
344
Removed:
tag "a"
360
Added:
tag "table"
361
Added:
[ class_ "logbook-table" ]
362
Added:
[
363
Added:
tag "thead" []
364
Added:
[
365
Added:
tag "tr" []
366
Added:
[
367
Added:
tag "th"
368
Added:
[ Dream_html.string_attr "scope" "col" ]
369
Added:
[ txt "Date" ];
370
Added:
tag "th"
371
Added:
[ Dream_html.string_attr "scope" "col" ]
372
Added:
[ txt "Workout" ];
373
Added:
tag "th"
374
Added:
[ Dream_html.string_attr "scope" "col" ]
375
Added:
[ txt "Exercises progressed" ];
376
Added:
];
377
Added:
];
378
Added:
tag "tbody" []
379
Added:
(List.map
380
Added:
(fun (entry : View_model.Logbook_entry.t) ->
381
Added:
tag "tr" []
345
382
[
346
Removed:
href Routes.record entry.id;
347
Removed:
Dream_html.attr "data-hito-app-link";
348
Removed:
]
349
Removed:
[
350
Removed:
txt "%s — %d stimuli" entry.workout_name
351
Removed:
entry.stimuli_count;
352
Removed:
];
353
Removed:
tag "p"
354
Removed:
[ class_ "done" ]
355
Removed:
[
356
Removed:
txt "%s"
357
Removed:
(if entry.complete then "complete" else "incomplete");
358
Removed:
];
359
Removed:
])
360
Removed:
records));
383
Added:
tag "td" [] [ txt "%s" entry.date ];
384
Added:
tag "td" []
385
Added:
[
386
Added:
tag "a"
387
Added:
[
388
Added:
href Routes.record entry.id;
389
Added:
Dream_html.attr "data-hito-app-link";
390
Added:
]
391
Added:
[ txt "%s" entry.workout_name ];
392
Added:
];
393
Added:
tag "td"
394
Added:
[ class_ "logbook-progress" ]
395
Added:
[ txt "%d" entry.progressed_exercises ];
396
Added:
])
397
Added:
records);
398
Added:
]);
361
399
tag "section"
362
400
[ class_ "feedback-section" ]
363
401
([
lib/presenter/view_model.ml
@@ -124,11 +124,13 @@
124
124
type t = {
125
125
id : string; (** Record id for the link. *)
126
126
workout_name : string;
127
Removed:
stimuli_count : int;
128
Removed:
complete : bool;
127
Added:
date : string; (** Workout date, pre-formatted "YYYY-MM-DD" in UTC. *)
128
Added:
progressed_exercises : int;
129
Added:
(** How many exercises beat their previous record, judged by
130
Added:
{!Progression}. *)
129
131
}
130
Removed:
(** One saved workout as the logbook list shows it: a link, a name, how many
131
Removed:
stimuli it holds, and whether it is complete. No Repository record and no
132
Added:
(** One saved workout as the logbook table shows it: a link, a name, the date,
133
Added:
and how many exercises progressed. No Repository record and no
132
134
Evidence.Workout entity. *)
133
135
end
134
136
lib/web/assets/hito.css
@@ -464,6 +464,64 @@
464
464
.button-group form { margin: 0; }
465
465
.button-group input[type="submit"] { width: 100%; }
466
466
467
Added:
/* Anchor actions styled as buttons, for the logbook action group: a primary
468
Added:
action beside lower-emphasis secondary ones. Mirrors the submit-button look
469
Added:
so links and form buttons read alike. The group's own top margin gives the
470
Added:
actions room under the page heading. */
471
Added:
.button-group { margin-top: 1rem; }
472
Added:
a.button {
473
Added:
display: inline-flex;
474
Added:
align-items: center;
475
Added:
justify-content: center;
476
Added:
min-height: 3rem;
477
Added:
padding: 0 1rem;
478
Added:
border: 2px solid var(--oxblood-dark);
479
Added:
border-radius: var(--radius);
480
Added:
color: var(--paper-raised);
481
Added:
background: var(--oxblood);
482
Added:
font: 700 var(--font-size-small)/1 var(--sans);
483
Added:
letter-spacing: 0.055em;
484
Added:
text-transform: uppercase;
485
Added:
text-decoration: none;
486
Added:
transition: background-color 150ms ease, transform 150ms ease;
487
Added:
}
488
Added:
a.button:hover {
489
Added:
color: var(--paper-raised);
490
Added:
background: var(--oxblood-dark);
491
Added:
transform: translateY(-2px);
492
Added:
}
493
Added:
a.button.secondary {
494
Added:
color: var(--brass);
495
Added:
background: transparent;
496
Added:
border-color: var(--brass);
497
Added:
}
498
Added:
a.button.secondary:hover {
499
Added:
color: var(--paper-raised);
500
Added:
background: var(--brass);
501
Added:
}
502
Added:
503
Added:
/* The logbook table: recorded workouts, one row each, with the date, a link to
504
Added:
the workout, and how many exercises progressed. */
505
Added:
.logbook-table {
506
Added:
width: 100%;
507
Added:
margin-top: 1.5rem;
508
Added:
border-collapse: collapse;
509
Added:
}
510
Added:
.logbook-table th,
511
Added:
.logbook-table td {
512
Added:
padding: 0.5rem 0.75rem;
513
Added:
border-bottom: 1px solid var(--rule);
514
Added:
text-align: left;
515
Added:
}
516
Added:
.logbook-table th {
517
Added:
color: var(--muted-ink);
518
Added:
font: 700 var(--font-size-small)/1 var(--sans);
519
Added:
letter-spacing: 0.04em;
520
Added:
text-transform: uppercase;
521
Added:
}
522
Added:
.logbook-table td:first-child { font-family: var(--mono); white-space: nowrap; }
523
Added:
.logbook-progress { text-align: right; font-family: var(--mono); }
524
Added:
467
525
/* One responsive grid for the whole logging fieldset. Every movement's name,
468
526
load, and reps line up in the same three columns — the name takes the
469
527
remaining space, the two numeric inputs take fixed, tap-friendly columns — so
lib/web/handlers_logbook.ml
@@ -128,17 +128,22 @@
128
128
in
129
129
List.find_map of_signal (Evidence.Feedback.signals report)
130
130
131
Removed:
let entry_view (record : Repository.record) : View_model.Logbook_entry.t =
131
Added:
let entry_view log (record : Repository.record) : View_model.Logbook_entry.t =
132
132
let workout = record.Repository.workout in
133
Added:
let tm =
134
Added:
Unix.gmtime
135
Added:
(float_of_int
136
Added:
(Recovery.timestamp_to_unix_seconds
137
Added:
(Evidence.Workout.started_at workout)))
138
Added:
in
133
139
{
134
140
id = (record.Repository.id :> string);
135
141
workout_name =
136
142
Prescription.Workout.name (Evidence.Workout.prescription workout);
137
Removed:
stimuli_count = List.length (Evidence.Workout.stimuli workout);
138
Removed:
complete =
139
Removed:
(match Evidence.Workout.completeness workout with
140
Removed:
| Evidence.Workout.Complete -> true
141
Removed:
| Incomplete -> false);
143
Added:
date =
144
Added:
Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900)
145
Added:
(tm.Unix.tm_mon + 1) tm.Unix.tm_mday;
146
Added:
progressed_exercises = Progression.workout_progress log workout;
142
147
}
143
148
144
149
let feedback_view (report : Evidence.Feedback.t) : View_model.Feedback.report
@@ -161,9 +166,10 @@
161
166
in
162
167
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
163
168
Service.history t.service trainee.Trainee.id >>= fun records ->
169
Added:
Service.workout_log t.service trainee.Trainee.id >>= fun log ->
164
170
Service.feedback t.service trainee.Trainee.id >>= fun feedback ->
165
171
let feedback = List.map feedback_view feedback in
166
Removed:
let records = List.map entry_view records in
172
Added:
let records = List.map (entry_view log) records in
167
173
let saved_flow = feedback_flow request in
168
174
let feedback_open =
169
175
match (Dream.query request "feedback", Dream.query request "prompt") with
test/test_progression.ml
@@ -298,10 +298,58 @@
298
298
= Progression.Stalled) );
299
299
]
300
300
301
Added:
(* --- per-workout progress count --- *)
302
Added:
303
Added:
(* A single-slot workout of one exercise, started on [on], recording [load]x[r].
304
Added:
Slot 1 of the ideal Day 1 is the single Laterals movement. *)
305
Added:
let solo ~on ~load ~r =
306
Added:
Workout.add_stimulus
307
Added:
(Workout.start prescribed ~clearance:cleared ~started_at:(day on))
308
Added:
(laterals load r)
309
Added:
310
Added:
let log_of workouts =
311
Added:
List.fold_left Evidence.Log.add Evidence.Log.empty workouts
312
Added:
313
Added:
let workout_progress_tests =
314
Added:
[
315
Added:
( "a first workout has nothing to beat",
316
Added:
`Quick,
317
Added:
fun () ->
318
Added:
let w = solo ~on:1 ~load:12. ~r:8 in
319
Added:
Alcotest.(check int)
320
Added:
"no progress on the first record" 0
321
Added:
(Progression.workout_progress (log_of [ w ]) w) );
322
Added:
( "beating the previous record counts the exercise",
323
Added:
`Quick,
324
Added:
fun () ->
325
Added:
let first = solo ~on:1 ~load:12. ~r:8 in
326
Added:
let second = solo ~on:8 ~load:12. ~r:9 in
327
Added:
Alcotest.(check int)
328
Added:
"one exercise progressed" 1
329
Added:
(Progression.workout_progress (log_of [ first; second ]) second) );
330
Added:
( "matching the previous record is not progress",
331
Added:
`Quick,
332
Added:
fun () ->
333
Added:
let first = solo ~on:1 ~load:12. ~r:8 in
334
Added:
let second = solo ~on:8 ~load:12. ~r:8 in
335
Added:
Alcotest.(check int)
336
Added:
"no exercise progressed" 0
337
Added:
(Progression.workout_progress (log_of [ first; second ]) second) );
338
Added:
( "more load with fewer reps still counts as progress",
339
Added:
`Quick,
340
Added:
fun () ->
341
Added:
let first = solo ~on:1 ~load:12. ~r:8 in
342
Added:
let second = solo ~on:8 ~load:14. ~r:7 in
343
Added:
Alcotest.(check int)
344
Added:
"heavier load progressed" 1
345
Added:
(Progression.workout_progress (log_of [ first; second ]) second) );
346
Added:
]
347
Added:
301
348
let suite =
302
349
[
303
350
("progression.assess", assess_tests);
304
351
("progression.remedy", remedy_tests);
305
352
("progression.load", load_tests);
306
353
("progression.diagnostics", diagnostic_tests);
354
Added:
("progression.workout_progress", workout_progress_tests);
307
355
]
test/test_web.ml
@@ -393,6 +393,45 @@
393
393
] );
394
394
( "web.flow",
395
395
[
396
Added:
( "the logbook shows the action button group and an empty table state",
397
Added:
`Quick,
398
Added:
fun () ->
399
Added:
let c = client () in
400
Added:
let _ = sign_in_new c in
401
Added:
let page = body (get c "/logbook") in
402
Added:
Alcotest.(check bool)
403
Added:
"Log feedback action" true
404
Added:
(Option.is_some (index_from ~needle:"Log feedback" page 0));
405
Added:
Alcotest.(check bool)
406
Added:
"Edit logbook action" true
407
Added:
(Option.is_some (index_from ~needle:"Edit logbook" page 0));
408
Added:
Alcotest.(check bool)
409
Added:
"the button group is present" true
410
Added:
(Option.is_some
411
Added:
(index_from ~needle:"class=\"button-group\"" page 0));
412
Added:
Alcotest.(check bool)
413
Added:
"empty state when nothing is logged" true
414
Added:
(Option.is_some (index_from ~needle:"Nothing logged yet." page 0))
415
Added:
);
416
Added:
( "a finished workout appears in the logbook table with a progress \
417
Added:
column",
418
Added:
`Quick,
419
Added:
fun () ->
420
Added:
let c = client () in
421
Added:
let _ = sign_in_new c in
422
Added:
let _ = start_day_one c in
423
Added:
record_all_day_one_slots c;
424
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
425
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
426
Added:
let page = body (get c "/logbook") in
427
Added:
Alcotest.(check bool)
428
Added:
"the logbook table is present" true
429
Added:
(Option.is_some
430
Added:
(index_from ~needle:"class=\"logbook-table\"" page 0));
431
Added:
Alcotest.(check bool)
432
Added:
"the progressed-exercises column header" true
433
Added:
(Option.is_some
434
Added:
(index_from ~needle:"Exercises progressed" page 0)) );
396
435
( "selecting a routine redirects and records the active routine",
397
436
`Quick,
398
437
fun () ->