[OCaml] High Intensity Training Online
feat show planned workouts in logbook calendar
Use the latest native workout and the active routine recovery intervals to forecast upcoming sessions. Distinguish completed, planned, and current days for clear logbook scanning.
Changed files
lib/presenter/pages_logbook.ml
@@ -308,14 +308,43 @@
308
308
let classes =
309
309
"calendar-day"
310
310
^ (if d.workout then " calendar-workout" else "")
311
Added:
^ (if Option.is_some d.planned_workout then " calendar-planned"
312
Added:
else "")
311
313
^ if d.today then " calendar-today" else ""
312
314
in
315
Added:
let aria_label =
316
Added:
match (d.workout, d.planned_workout, d.today) with
317
Added:
| true, Some name, true ->
318
Added:
Some
319
Added:
(Printf.sprintf "%d: completed, planned %s, today"
320
Added:
d.day_of_month name)
321
Added:
| true, Some name, false ->
322
Added:
Some
323
Added:
(Printf.sprintf "%d: completed, planned %s" d.day_of_month name)
324
Added:
| true, None, true ->
325
Added:
Some
326
Added:
(Printf.sprintf "%d: completed workout, today" d.day_of_month)
327
Added:
| true, None, false ->
328
Added:
Some (Printf.sprintf "%d: completed workout" d.day_of_month)
329
Added:
| false, Some name, true ->
330
Added:
Some (Printf.sprintf "%d: planned %s, today" d.day_of_month name)
331
Added:
| false, Some name, false ->
332
Added:
Some (Printf.sprintf "%d: planned %s" d.day_of_month name)
333
Added:
| false, None, true ->
334
Added:
Some (Printf.sprintf "%d: today" d.day_of_month)
335
Added:
| false, None, false -> None
336
Added:
in
337
Added:
let title =
338
Added:
Option.map
339
Added:
(fun name -> Printf.sprintf "Planned: %s" name)
340
Added:
d.planned_workout
341
Added:
in
313
342
tag "td"
314
343
([ Dream_html.string_attr "class" "%s" classes ]
315
Removed:
@
316
Removed:
if d.workout then
317
Removed:
[ Dream_html.string_attr "aria-label" "%d: workout" d.day_of_month ]
318
Removed:
else [])
344
Added:
@ Option.to_list
345
Added:
(Option.map (Dream_html.string_attr "aria-label" "%s") aria_label)
346
Added:
@ Option.to_list
347
Added:
(Option.map (Dream_html.string_attr "title" "%s") title))
319
348
[ txt "%d" d.day_of_month ]
320
349
in
321
350
let prev_month =
@@ -376,6 +405,45 @@
376
405
];
377
406
tag "tbody" []
378
407
(List.map (fun week -> tag "tr" [] (List.map cell week)) cal.weeks);
408
Added:
];
409
Added:
tag "div"
410
Added:
[
411
Added:
class_ "calendar-legend";
412
Added:
Dream_html.string_attr "role" "group";
413
Added:
Dream_html.string_attr "aria-label" "Calendar key";
414
Added:
]
415
Added:
[
416
Added:
tag "span"
417
Added:
[ class_ "calendar-legend-item" ]
418
Added:
[
419
Added:
tag "span"
420
Added:
[ class_ "calendar-legend-swatch calendar-legend-workout" ]
421
Added:
[];
422
Added:
txt "Completed";
423
Added:
];
424
Added:
tag "span"
425
Added:
[ class_ "calendar-legend-item" ]
426
Added:
[
427
Added:
tag "span"
428
Added:
[ class_ "calendar-legend-swatch calendar-legend-planned" ]
429
Added:
[];
430
Added:
txt "Planned";
431
Added:
];
432
Added:
tag "span"
433
Added:
[ class_ "calendar-legend-item" ]
434
Added:
[
435
Added:
tag "span"
436
Added:
[ class_ "calendar-legend-swatch calendar-legend-today" ]
437
Added:
[];
438
Added:
txt "Today";
439
Added:
];
440
Added:
];
441
Added:
tag "p"
442
Added:
[ class_ "calendar-note" ]
443
Added:
[
444
Added:
txt
445
Added:
"Planned dates follow the recovery time in your routine. Hover a \
446
Added:
planned day to see the workout.";
379
447
];
380
448
]
381
449
lib/presenter/view_model.ml
@@ -218,8 +218,14 @@
218
218
end
219
219
220
220
module Calendar = struct
221
Removed:
type day = { day_of_month : int; workout : bool; today : bool }
222
Removed:
(** One dated cell. [workout] highlights a day a workout was performed. *)
221
Added:
type day = {
222
Added:
day_of_month : int;
223
Added:
workout : bool;
224
Added:
planned_workout : string option;
225
Added:
today : bool;
226
Added:
}
227
Added:
(** One dated cell. [workout] marks a completed workout. [planned_workout]
228
Added:
names the next workout planned for that day, when one exists. *)
223
229
224
230
type cell =
225
231
| Blank
lib/web/assets/hito.css
@@ -637,8 +637,8 @@
637
637
/* The month calendar is a self-contained widget above the accordion, flat on
638
638
the page. A header row holds a previous arrow, the month and year, a Today
639
639
link, and a next arrow. Below it sits the seven-column day grid. The arrows
640
Removed:
page through months and Today returns to the present. Days with a workout are
641
Removed:
filled blood. Today is ringed. */
640
Added:
page through months and Today returns to the present. Completed days are
641
Added:
filled blood. Planned days use a dotted brass outline. Today is ringed. */
642
642
.calendar {
643
643
max-width: 22rem;
644
644
margin: 0 auto 1.5rem;
@@ -721,10 +721,55 @@
721
721
border-radius: var(--radius);
722
722
font-weight: 700;
723
723
}
724
Added:
/* A planned workout uses a dotted brass outline, so history and forecast stay
725
Added:
distinct without adding a second calendar colour block. */
726
Added:
.calendar-planned {
727
Added:
outline: 2px dotted var(--brass);
728
Added:
outline-offset: -2px;
729
Added:
border-radius: var(--radius);
730
Added:
background: var(--brass-wash);
731
Added:
font-weight: 700;
732
Added:
}
733
Added:
.calendar-legend {
734
Added:
display: flex;
735
Added:
justify-content: center;
736
Added:
gap: 1rem;
737
Added:
margin-top: 0.55rem;
738
Added:
color: var(--muted-ink);
739
Added:
font: 500 var(--font-size-small)/1 var(--sans);
740
Added:
}
741
Added:
.calendar-legend-item {
742
Added:
display: inline-flex;
743
Added:
align-items: center;
744
Added:
gap: 0.35rem;
745
Added:
}
746
Added:
.calendar-legend-swatch {
747
Added:
width: 0.8rem;
748
Added:
height: 0.8rem;
749
Added:
border-radius: calc(var(--radius) / 2);
750
Added:
}
751
Added:
.calendar-legend-workout { background: var(--blood); }
752
Added:
.calendar-legend-planned {
753
Added:
border: 2px dotted var(--brass);
754
Added:
background: var(--brass-wash);
755
Added:
}
756
Added:
757
Added:
758
Added:
.calendar-legend-today {
759
Added:
border: 2px solid var(--rule-strong);
760
Added:
background: transparent;
761
Added:
}
762
Added:
.calendar-note {
763
Added:
margin: 0.55rem 0 0;
764
Added:
color: var(--muted-ink);
765
Added:
font-size: var(--font-size-small);
766
Added:
line-height: 1.35;
767
Added:
text-align: center;
768
Added:
}
769
Added:
724
770
/* Today: a quiet ring, so it reads even on a plain or a highlighted day. */
725
771
.calendar-today {
726
Removed:
outline: 2px solid var(--brass);
727
Removed:
outline-offset: -2px;
772
Added:
box-shadow: 0 0 0 2px var(--rule-strong);
728
773
border-radius: var(--radius);
729
774
}
730
775
lib/web/handlers_logbook.ml
@@ -56,11 +56,49 @@
56
56
(* 1970-01-01 is a Thursday = 3 in Monday-first indexing. *)
57
57
((((days mod 7) + 3) mod 7) + 7) mod 7
58
58
59
Removed:
(* Build the calendar for [year]/[month], highlighting days that carry at
60
Removed:
least one workout. [today] marks the current day when it falls in the shown
61
Removed:
month. [years] spans the earliest entry year through the current year, so
62
Removed:
the picker offers every month with history and the present. *)
63
Removed:
let calendar_view ~now ~year ~month
59
Added:
type planned_workout = { at_unix : int; workout_name : string }
60
Added:
61
Added:
let latest_finished_workout log =
62
Added:
Evidence.Log.workouts log
63
Added:
|> List.find_map (fun workout ->
64
Added:
Option.map
65
Added:
(fun ended_at -> (workout, ended_at))
66
Added:
(Evidence.Workout.ended_at workout))
67
Added:
68
Added:
(* Predict only the next routine positions after the latest finished native
69
Added:
workout. A late workout stays the next workout rather than advancing the
70
Added:
routine silently. *)
71
Added:
let planned_workouts ~now ~log ~routine =
72
Added:
match latest_finished_workout log with
73
Added:
| None -> []
74
Added:
| Some (last, ended_at) ->
75
Added:
let rec loop previous_prescription previous_at remaining =
76
Added:
if remaining = 0 then []
77
Added:
else
78
Added:
let next =
79
Added:
Prescription.Routine.workout_after routine previous_prescription
80
Added:
in
81
Added:
let planned_at =
82
Added:
Recovery.timestamp_to_unix_seconds previous_at
83
Added:
+ Recovery.duration_to_seconds
84
Added:
(Prescription.Routine.recovery_after routine
85
Added:
previous_prescription)
86
Added:
in
87
Added:
if planned_at < now then []
88
Added:
else
89
Added:
{
90
Added:
at_unix = planned_at;
91
Added:
workout_name = Prescription.Workout.name next;
92
Added:
}
93
Added:
:: loop next
94
Added:
(Recovery.timestamp_of_unix_seconds planned_at)
95
Added:
(remaining - 1)
96
Added:
in
97
Added:
loop (Evidence.Workout.prescription last) ended_at 52
98
Added:
99
Added:
(* Build the calendar for [year]/[month], highlighting completed and planned
100
Added:
days. [today] marks the current day when it falls in the shown month. *)
101
Added:
let calendar_view ~now ~year ~month ~(planned : planned_workout list)
64
102
(entries : View_model.Logbook_entry.t list) : View_model.Calendar.t =
65
103
let now_tm = Unix.gmtime (float_of_int now) in
66
104
let this_year = now_tm.Unix.tm_year + 1900 in
@@ -79,6 +117,18 @@
79
117
entries
80
118
in
81
119
let has_workout d = List.mem d workout_days in
120
Added:
let planned_name d =
121
Added:
List.find_map
122
Added:
(fun (p : planned_workout) ->
123
Added:
let tm = Unix.gmtime (float_of_int p.at_unix) in
124
Added:
if
125
Added:
tm.Unix.tm_year + 1900 = year
126
Added:
&& tm.Unix.tm_mon + 1 = month
127
Added:
&& tm.Unix.tm_mday = d
128
Added:
then Some p.workout_name
129
Added:
else None)
130
Added:
planned
131
Added:
in
82
132
let total = days_in_month ~year ~month in
83
133
let lead = monday_first_weekday ~year ~month ~day:1 in
84
134
let cells =
@@ -86,7 +136,12 @@
86
136
@ List.init total (fun i ->
87
137
let d = i + 1 in
88
138
View_model.Calendar.Day
89
Removed:
{ day_of_month = d; workout = has_workout d; today = d = today })
139
Added:
{
140
Added:
day_of_month = d;
141
Added:
workout = has_workout d;
142
Added:
planned_workout = planned_name d;
143
Added:
today = d = today;
144
Added:
})
90
145
in
91
146
let trailing = (7 - (List.length cells mod 7)) mod 7 in
92
147
let cells =
@@ -277,6 +332,8 @@
277
332
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
278
333
Service.history t.service trainee.Trainee.id >>= fun records ->
279
334
Service.workout_log t.service trainee.Trainee.id >>= fun log ->
335
Added:
Service.active_routine t.service trainee.Trainee.id
336
Added:
>>= fun active_routine ->
280
337
Service.imported_records t.service trainee.Trainee.id >>= fun imported ->
281
338
Lwt_list.map_s (imported_entry_view t trainee.Trainee.id) imported
282
339
>>= fun imported_entries ->
@@ -326,7 +383,12 @@
326
383
| Some "start", _ | _, Some "feedback" -> true
327
384
| _ -> false
328
385
in
329
Removed:
let calendar = calendar_view ~now ~year ~month all_records in
386
Added:
let planned =
387
Added:
match active_routine with
388
Added:
| Some (_, routine) -> planned_workouts ~now ~log ~routine
389
Added:
| None -> []
390
Added:
in
391
Added:
let calendar = calendar_view ~now ~year ~month ~planned all_records in
330
392
html
331
393
(Pages.logbook request
332
394
?workout_started:(workout_started in_progress)
test/web/logbook.ml
@@ -16,6 +16,28 @@
16
16
(path ^ " is available") 200
17
17
(status (get c path)))
18
18
[ "/logbook"; "/progress"; "/logbook?feedback=start" ] );
19
Added:
( "the calendar marks the next routine workout after recovery",
20
Added:
`Quick,
21
Added:
fun () ->
22
Added:
let c, now, _repo = clocked_client () in
23
Added:
now := day 10;
24
Added:
let _ = sign_in_new c in
25
Added:
let _ = start_day_one c in
26
Added:
record_all_day_one_slots c;
27
Added:
now := day 10 + 3600;
28
Added:
let token = Option.get (csrf_token (body (get c "/workout"))) in
29
Added:
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
30
Added:
let page = body (get c "/logbook?year=1970&month=1") in
31
Added:
Alcotest.(check bool)
32
Added:
"calendar explains its planned state" true
33
Added:
(Option.is_some (index_from ~needle:"Planned" page 0));
34
Added:
Alcotest.(check bool)
35
Added:
"calendar names the next workout" true
36
Added:
(Option.is_some (index_from ~needle:"13: planned Day 2" page 0));
37
Added:
Alcotest.(check bool)
38
Added:
"planned day exposes its workout" true
39
Added:
(Option.is_some
40
Added:
(index_from ~needle:"title=\"Planned: Day 2\"" page 0)) );
19
41
( "a faster repeat of the identical workout shows a favourable \
20
42
duration delta",
21
43
`Quick,