[OCaml] High Intensity Training Online
feat replace Logbook entries with day details
Make calendar days the primary Logbook navigation and show completed or planned workout details for the selected day. Remove the obsolete accordion presentation and share long-date conversion.
Changed files
lib/presenter/pages.mli
@@ -62,22 +62,14 @@
62
62
?workout_started:int ->
63
63
viewer:View_model.Viewer.t ->
64
64
?calendar:View_model.Calendar.t ->
65
Added:
?selected_day:View_model.Selected_day.t ->
65
66
?suggest_feedback:bool ->
66
67
?feedback_open:bool ->
67
68
?delete_record:View_model.Logbook_entry.t ->
68
Removed:
?expanded_record:View_model.Logbook_entry.t ->
69
Removed:
View_model.Logbook_entry.t list ->
69
Added:
unit ->
70
70
page
71
Removed:
(** The logbook: one month of recorded workouts as an accordion, one collapsible
72
Removed:
entry each, and a modal subjective feedback form that shows every factor at
73
Removed:
once, each optionally rated against the trainee's usual, with one submit.
74
Removed:
[calendar] is the current month above the accordion, highlighting days a
75
Removed:
workout was performed; its arrows page through months and Today returns to
76
Removed:
the present month. Each entry's summary is its date and title; its open
77
Removed:
panel lists the exercises performed and, for a native workout, the Edit and
78
Removed:
Delete actions. [suggest_feedback] shows a prompt inviting feedback, set
79
Removed:
after a workout finishes. [feedback_open] renders the modal open for
80
Removed:
no-script clients. *)
71
Added:
(** The logbook: a month calendar with a selected-day detail panel. The panel
72
Added:
shows recorded workouts and the planned workout for the selected day. *)
81
73
82
74
val progress :
83
75
Dream.request ->
lib/presenter/pages_logbook.ml
@@ -203,38 +203,33 @@
203
203
exercise_block ~name:e.exercise_name ~weight:e.load ~reps:e.reps
204
204
~prev_weight:e.previous_load ~prev_reps:e.previous_reps
205
205
206
Removed:
(* One workout as an accordion entry. The summary carries the monospace date and
207
Removed:
the workout title; the open panel lists the exercises performed and, for a
208
Removed:
native workout, the Edit and Delete actions tucked inside. An import is
209
Removed:
read-only: it shows the "Imported" pill and its efforts, with no actions. A
210
Removed:
native workout with no prior comparison still lists nothing to compare and
211
Removed:
keeps its actions. *)
212
Removed:
let workout_accordion request (entry : View_model.Logbook_entry.t) =
213
Removed:
let summary =
214
Removed:
tag "summary"
215
Removed:
[ class_ "logbook-entry-summary" ]
216
Removed:
([
217
Removed:
tag "span" [ class_ "logbook-entry-date" ] [ txt "%s" entry.date ];
218
Removed:
tag "span"
219
Removed:
[ class_ "logbook-entry-title" ]
220
Removed:
[ txt "%s" entry.workout_name ];
221
Removed:
]
222
Removed:
@
223
Removed:
if entry.imported then
224
Removed:
[ tag "span" [ class_ "logbook-import-pill" ] [ txt "Imported" ] ]
225
Removed:
else [])
226
Removed:
in
227
Removed:
let panel_contents =
206
Added:
let calendar_month_name month =
207
Added:
List.nth
208
Added:
[
209
Added:
"January";
210
Added:
"February";
211
Added:
"March";
212
Added:
"April";
213
Added:
"May";
214
Added:
"June";
215
Added:
"July";
216
Added:
"August";
217
Added:
"September";
218
Added:
"October";
219
Added:
"November";
220
Added:
"December";
221
Added:
]
222
Added:
(month - 1)
223
Added:
224
Added:
let selected_workout_card (entry : View_model.Logbook_entry.t) =
225
Added:
let detail =
228
226
if entry.imported then
229
Removed:
[
230
Removed:
tag "ul"
231
Removed:
[ class_ "logbook-change-list" ]
232
Removed:
(List.map imported_effort_line
233
Removed:
entry.View_model.Logbook_entry.imported_efforts);
234
Removed:
]
235
Removed:
@ Option.to_list
236
Removed:
(duration_line ~seconds:entry.duration_seconds
237
Removed:
~previous_seconds:entry.duration_previous_seconds)
227
Added:
tag "ul"
228
Added:
[ class_ "logbook-change-list" ]
229
Added:
(List.map imported_effort_line entry.imported_efforts)
230
Added:
:: Option.to_list
231
Added:
(duration_line ~seconds:entry.duration_seconds
232
Added:
~previous_seconds:entry.duration_previous_seconds)
238
233
else
239
234
let exercises =
240
235
if entry.changes = [] then
@@ -274,33 +269,47 @@
274
269
];
275
270
]
276
271
in
277
Removed:
ignore request;
278
Removed:
tag "details"
279
Removed:
[ class_ "logbook-entry" ]
280
Removed:
(summary :: [ tag "div" [ class_ "logbook-entry-panel" ] panel_contents ])
272
Added:
let header =
273
Added:
tag "header"
274
Added:
[ class_ "selected-workout-header" ]
275
Added:
([ tag "h3" [] [ txt "%s" entry.workout_name ] ]
276
Added:
@
277
Added:
if entry.imported then
278
Added:
[ tag "span" [ class_ "logbook-import-pill" ] [ txt "Imported" ] ]
279
Added:
else [])
280
Added:
in
281
Added:
tag "article"
282
Added:
[ class_ "selected-workout" ]
283
Added:
[ header; tag "div" [ class_ "selected-workout-panel" ] detail ]
281
284
282
Removed:
let calendar_month_name month =
283
Removed:
List.nth
285
Added:
let selected_planned_card (planned : View_model.Selected_day.Planned.t) =
286
Added:
tag "article"
287
Added:
[ class_ "selected-planned-workout" ]
284
288
[
285
Removed:
"January";
286
Removed:
"February";
287
Removed:
"March";
288
Removed:
"April";
289
Removed:
"May";
290
Removed:
"June";
291
Removed:
"July";
292
Removed:
"August";
293
Removed:
"September";
294
Removed:
"October";
295
Removed:
"November";
296
Removed:
"December";
289
Added:
tag "h3" [] [ txt "Planned: %s" planned.name ];
290
Added:
tag "p" [] [ txt "This workout follows your routine recovery." ];
291
Added:
tag "ul"
292
Added:
[ class_ "planned-exercise-list" ]
293
Added:
(List.map (fun name -> tag "li" [] [ txt "%s" name ]) planned.exercises);
297
294
]
298
Removed:
(month - 1)
299
295
300
Removed:
(* The month calendar above the accordion. Days that carry a workout are
301
Removed:
highlighted; today is marked. A header row holds a previous arrow, the month
302
Removed:
and year, a Today link, and a next arrow. The arrows page the query, and
303
Removed:
Today returns to the current month. *)
296
Added:
let selected_day_panel (selected : View_model.Selected_day.t) =
297
Added:
let completed = List.map selected_workout_card selected.completed in
298
Added:
let planned =
299
Added:
Option.to_list (Option.map selected_planned_card selected.planned)
300
Added:
in
301
Added:
let content =
302
Added:
if completed = [] && planned = [] then
303
Added:
[ tag "p" [] [ txt "No workout was recorded or planned on this day." ] ]
304
Added:
else completed @ planned
305
Added:
in
306
Added:
tag "section"
307
Added:
[ class_ "selected-day" ]
308
Added:
(tag "h2" [] [ txt "%s" selected.date ] :: content)
309
Added:
310
Added:
(* The month calendar above the selected-day panel. Days that carry a workout
311
Added:
are highlighted; today is marked. A header row holds a previous arrow, the
312
Added:
month and year, a Today link, and a next arrow. The arrows page the query. *)
304
313
let calendar_grid (cal : View_model.Calendar.t) =
305
314
let cell = function
306
315
| View_model.Calendar.Blank -> tag "td" [ class_ "calendar-blank" ] []
@@ -310,6 +319,7 @@
310
319
^ (if d.workout then " calendar-workout" else "")
311
320
^ (if Option.is_some d.planned_workout then " calendar-planned"
312
321
else "")
322
Added:
^ (if d.selected then " calendar-selected" else "")
313
323
^ if d.today then " calendar-today" else ""
314
324
in
315
325
let aria_label =
@@ -339,13 +349,27 @@
339
349
(fun name -> Printf.sprintf "Planned: %s" name)
340
350
d.planned_workout
341
351
in
352
Added:
let href =
353
Added:
Printf.sprintf "/logbook?year=%d&month=%d&day=%d" cal.selected_year
354
Added:
cal.selected_month d.day_of_month
355
Added:
in
342
356
tag "td"
343
357
([ Dream_html.string_attr "class" "%s" classes ]
344
358
@ Option.to_list
345
359
(Option.map (Dream_html.string_attr "aria-label" "%s") aria_label)
346
360
@ Option.to_list
347
361
(Option.map (Dream_html.string_attr "title" "%s") title))
348
Removed:
[ txt "%d" d.day_of_month ]
362
Added:
[
363
Added:
tag "a"
364
Added:
[
365
Added:
Dream_html.string_attr "href" "%s" href;
366
Added:
class_ "calendar-day-link";
367
Added:
Dream_html.attr "data-hito-app-link";
368
Added:
Dream_html.string_attr "aria-label" "Select day %d"
369
Added:
d.day_of_month;
370
Added:
]
371
Added:
[ txt "%d" d.day_of_month ];
372
Added:
]
349
373
in
350
374
let prev_month =
351
375
if cal.selected_month = 1 then (cal.selected_year - 1, 12)
@@ -447,10 +471,8 @@
447
471
];
448
472
]
449
473
450
Removed:
let logbook request ?workout_started ~viewer ?calendar
451
Removed:
?(suggest_feedback = false) ?(feedback_open = false) ?delete_record
452
Removed:
?expanded_record records =
453
Removed:
ignore expanded_record;
474
Added:
let logbook request ?workout_started ~viewer ?calendar ?selected_day
475
Added:
?(suggest_feedback = false) ?(feedback_open = false) ?delete_record () =
454
476
html_page ~viewer ~request ~active:"logbook" ?workout_started "Logbook"
455
477
([
456
478
tag "div"
@@ -473,11 +495,12 @@
473
495
]
474
496
@ (match calendar with Some cal -> [ calendar_grid cal ] | None -> [])
475
497
@ [
476
Removed:
(if records = [] then tag "p" [] [ txt "Nothing logged yet." ]
477
Removed:
else
478
Removed:
tag "div"
479
Removed:
[ class_ "logbook-entries" ]
480
Removed:
(List.map (workout_accordion request) records));
498
Added:
(match selected_day with
499
Added:
| Some selected -> selected_day_panel selected
500
Added:
| None ->
501
Added:
tag "section"
502
Added:
[ class_ "selected-day empty-selected-day" ]
503
Added:
[ tag "p" [] [ txt "Select a day to view its workout." ] ]);
481
504
]
482
505
(* The subjective-feedback modal stays in the DOM so the Record feedback
483
506
button opens it. The delete-confirm dialog appears only when an entry
lib/presenter/view_model.ml
@@ -183,7 +183,7 @@
183
183
184
184
module Logbook_entry = struct
185
185
type t = {
186
Removed:
id : string; (** Record id for links and URL-addressable expansion. *)
186
Added:
id : string; (** Record id for edit and delete links. *)
187
187
imported : bool;
188
188
(** True for a promoted third-party import. Shown read-only; its title
189
189
is the source title verbatim, and an oxblood outline pill, not text
@@ -210,19 +210,32 @@
210
210
(** One per imported effort, in source order, each with the progress
211
211
since it was last performed. Empty for a native entry. *)
212
212
}
213
Removed:
(** One logbook entry as the row shows it: a native prescribed workout or a
214
Removed:
read-only imported workout, interleaved by date. Its cells are date, name
215
Removed:
(with an import pill), duration, and a three-dot menu that carries the
216
Removed:
per-exercise progress detail and the row actions. No Repository record and
217
Removed:
no Evidence.Workout entity. *)
213
Added:
(** One recorded workout for the selected-day detail panel. It carries the
214
Added:
exercise comparisons and actions for a native record, or imported efforts
215
Added:
for a read-only imported record. *)
218
216
end
219
217
218
Added:
module Selected_day = struct
219
Added:
module Planned = struct
220
Added:
type t = { name : string; exercises : string list }
221
Added:
end
222
Added:
223
Added:
type t = {
224
Added:
date : string;
225
Added:
completed : Logbook_entry.t list;
226
Added:
planned : Planned.t option;
227
Added:
}
228
Added:
(** The selected calendar day: recorded workouts and the planned workout, if
229
Added:
the routine schedules one. *)
230
Added:
end
231
Added:
220
232
module Calendar = struct
221
233
type day = {
222
234
day_of_month : int;
223
235
workout : bool;
224
236
planned_workout : string option;
225
237
today : bool;
238
Added:
selected : bool;
226
239
}
227
240
(** One dated cell. [workout] marks a completed workout. [planned_workout]
228
241
names the next workout planned for that day, when one exists. *)
lib/web/assets/hito.css
@@ -529,94 +529,7 @@
529
529
background: var(--blood-hover);
530
530
}
531
531
532
Removed:
/* The logbook is an accordion: one collapsible entry per workout under the
533
Removed:
month calendar. A summary shows the monospace date and the workout title; the
534
Removed:
open panel lists the exercises performed and, for a native workout, the Edit
535
Removed:
and Delete actions. */
536
Removed:
.logbook-entries {
537
Removed:
display: grid;
538
Removed:
gap: 0.4rem;
539
Removed:
margin-top: 1.5rem;
540
Removed:
}
541
Removed:
.logbook-entry {
542
Removed:
border-bottom: 1px solid var(--rule);
543
Removed:
}
544
Removed:
.logbook-entry-summary {
545
Removed:
display: flex;
546
Removed:
flex-wrap: wrap;
547
Removed:
align-items: baseline;
548
Removed:
gap: 0.75rem;
549
Removed:
padding: 0.6rem 0.2rem;
550
Removed:
cursor: pointer;
551
Removed:
list-style: none;
552
Removed:
}
553
Removed:
.logbook-entry-summary::-webkit-details-marker {
554
Removed:
display: none;
555
Removed:
}
556
Removed:
/* A rotating caret marks the open state, drawn before the date. */
557
Removed:
.logbook-entry-summary::before {
558
Removed:
content: "›";
559
Removed:
flex: 0 0 auto;
560
Removed:
color: var(--muted-ink);
561
Removed:
font-size: 1.1rem;
562
Removed:
line-height: 1;
563
Removed:
transition: transform 220ms ease;
564
Removed:
}
565
Removed:
.logbook-entry[open] > .logbook-entry-summary::before {
566
Removed:
transform: rotate(90deg);
567
Removed:
}
568
Removed:
/* Unfold and collapse, matching the workout-logging slot accordion.
569
Removed:
::details-content is the box the browser toggles for a <details>. Drive a
570
Removed:
grid row from 0fr to 1fr off the [open] attribute so both opening and closing
571
Removed:
ease. [visibility] keeps a closed panel out of the tab order and the
572
Removed:
accessibility tree. Browsers without ::details-content, and reduced-motion
573
Removed:
users, simply snap. */
574
Removed:
.logbook-entry::details-content {
575
Removed:
content-visibility: visible;
576
Removed:
display: grid;
577
Removed:
grid-template-rows: 0fr;
578
Removed:
visibility: hidden;
579
Removed:
transition:
580
Removed:
grid-template-rows 220ms ease,
581
Removed:
visibility 220ms;
582
Removed:
}
583
Removed:
.logbook-entry[open]::details-content {
584
Removed:
grid-template-rows: 1fr;
585
Removed:
visibility: visible;
586
Removed:
}
587
Removed:
.logbook-entry-date {
588
Removed:
flex: 0 0 auto;
589
Removed:
font-family: var(--mono);
590
Removed:
color: var(--muted-ink);
591
Removed:
white-space: nowrap;
592
Removed:
}
593
Removed:
.logbook-entry-title {
594
Removed:
flex: 1 1 auto;
595
Removed:
font-family: var(--sans);
596
Removed:
font-weight: 700;
597
Removed:
overflow: hidden;
598
Removed:
text-overflow: ellipsis;
599
Removed:
white-space: nowrap;
600
Removed:
}
601
Removed:
.logbook-entry-panel {
602
Removed:
min-height: 0;
603
Removed:
overflow: clip;
604
Removed:
padding: 0.25rem 0.2rem 1rem 1.6rem;
605
Removed:
}
606
Removed:
/* The Edit and Delete affordances sit inside the open panel, after the exercise
607
Removed:
list. Delete is an outline danger button; Edit a secondary. */
608
Removed:
.logbook-entry-actions {
609
Removed:
display: flex;
610
Removed:
gap: 0.75rem;
611
Removed:
margin-top: 1rem;
612
Removed:
}
613
Removed:
.logbook-no-progress { color: var(--muted-ink); }
614
Removed:
@media (prefers-reduced-motion: reduce) {
615
Removed:
.logbook-entry::details-content { transition: none; }
616
Removed:
}
617
Removed:
618
Removed:
/* A blood outline "Imported" pill marks an import, shown in the entry summary
619
Removed:
beside the title. */
532
Added:
/* The Logbook records exercise facts in the selected-day panel. */
620
533
.logbook-import-pill {
621
534
display: inline-block;
622
535
padding: 0.05rem 0.5rem;
@@ -664,14 +577,11 @@
664
577
.metric-delta.delta-up { color: var(--evergreen); }
665
578
.metric-delta.delta-down { color: var(--blood-dark); }
666
579
667
Removed:
/* The action bar under the logbook heading. */
668
Removed:
.logbook-actions-bar { margin: 0.5rem 0 1rem; }
669
Removed:
670
Removed:
/* The month calendar is a self-contained widget above the accordion, flat on
671
Removed:
the page. A header row holds a previous arrow, the month and year, a Today
672
Removed:
link, and a next arrow. Below it sits the seven-column day grid. The arrows
673
Removed:
page through months and Today returns to the present. Completed days are
674
Removed:
filled blood. Planned days use a dotted brass outline. Today is ringed. */
580
Added:
/* The month calendar is a self-contained widget above the selected-day panel,
581
Added:
flat on the page. A header row holds a previous arrow, the month and year, a
582
Added:
Today link, and a next arrow. Below it sits the seven-column day grid. The
583
Added:
arrows page through months and Today returns to the present. Completed days
584
Added:
are filled blood. Planned days use a dotted brass outline. Today is ringed. */
675
585
.calendar {
676
586
max-width: 22rem;
677
587
margin: 0 auto 1.5rem;
@@ -762,6 +672,56 @@
762
672
border-radius: var(--radius);
763
673
background: var(--brass-wash);
764
674
font-weight: 700;
675
Added:
}
676
Added:
.calendar-day-link {
677
Added:
display: block;
678
Added:
height: 2.25rem;
679
Added:
color: inherit;
680
Added:
line-height: 2.25rem;
681
Added:
text-decoration: none;
682
Added:
}
683
Added:
.calendar-day-link:hover,
684
Added:
.calendar-day-link:focus-visible {
685
Added:
text-decoration: underline;
686
Added:
box-shadow: inset 0 0 0 2px var(--rule-strong);
687
Added:
}
688
Added:
.calendar-selected {
689
Added:
outline: 3px solid var(--ink);
690
Added:
outline-offset: 2px;
691
Added:
border-radius: var(--radius);
692
Added:
}
693
Added:
.selected-day {
694
Added:
margin-top: 1.25rem;
695
Added:
padding: 1rem 0;
696
Added:
border-top: 1px solid var(--rule-strong);
697
Added:
}
698
Added:
.selected-day > h2 {
699
Added:
margin: 0 0 0.75rem;
700
Added:
font-size: var(--font-size-lead);
701
Added:
}
702
Added:
.selected-workout,
703
Added:
.selected-planned-workout {
704
Added:
margin-top: 0.75rem;
705
Added:
padding: 0.85rem 0;
706
Added:
border-bottom: 1px solid var(--rule);
707
Added:
}
708
Added:
.selected-workout-header {
709
Added:
display: flex;
710
Added:
align-items: baseline;
711
Added:
gap: 0.75rem;
712
Added:
}
713
Added:
.selected-workout-header h3,
714
Added:
.selected-planned-workout h3 {
715
Added:
margin: 0;
716
Added:
font-size: var(--font-size-lead);
717
Added:
}
718
Added:
.selected-workout-panel { padding-top: 0.65rem; }
719
Added:
.planned-exercise-list {
720
Added:
margin: 0.65rem 0 0;
721
Added:
padding-left: 1.2rem;
722
Added:
}
723
Added:
.empty-selected-day {
724
Added:
color: var(--muted-ink);
765
725
}
766
726
.calendar-legend {
767
727
display: flex;
lib/web/calendar.ml
@@ -7,12 +7,13 @@
7
7
| 2 -> if is_leap year then 29 else 28
8
8
| _ -> invalid_arg "Calendar.days_in_month: month"
9
9
10
Removed:
(* The weekday of a given UTC date, 0 = Monday .. 6 = Sunday. This uses Howard
11
Removed:
Hinnant's day-count from the epoch. The count needs no timezone-aware libc
12
Removed:
call, because [timegm] is not in the stdlib. *)
13
Removed:
let monday_first_weekday ~year ~month ~day =
14
Removed:
if month < 1 || month > 12 then
15
Removed:
invalid_arg "Calendar.monday_first_weekday: month";
10
Added:
let validate_date ~year ~month ~day =
11
Added:
if month < 1 || month > 12 then invalid_arg "Calendar.date: month";
12
Added:
if day < 1 || day > days_in_month ~year ~month then
13
Added:
invalid_arg "Calendar.date: day"
14
Added:
15
Added:
let days_since_epoch ~year ~month ~day =
16
Added:
validate_date ~year ~month ~day;
16
17
let year = if month <= 2 then year - 1 else year in
17
18
let era = (if year >= 0 then year else year - 399) / 400 in
18
19
let year_of_era = year - (era * 400) in
@@ -22,6 +23,15 @@
22
23
let day_of_era =
23
24
(year_of_era * 365) + (year_of_era / 4) - (year_of_era / 100) + day_of_year
24
25
in
25
Removed:
let days = (era * 146097) + day_of_era - 719468 in
26
Added:
(era * 146097) + day_of_era - 719468
27
Added:
28
Added:
(* The weekday of a given UTC date, 0 = Monday .. 6 = Sunday. This uses Howard
29
Added:
Hinnant's day-count from the epoch. The count needs no timezone-aware libc
30
Added:
call, because [timegm] is not in the stdlib. *)
31
Added:
let monday_first_weekday ~year ~month ~day =
32
Added:
let days = days_since_epoch ~year ~month ~day in
26
33
(* 1970-01-01 is a Thursday = 3 in Monday-first indexing. *)
27
34
((((days mod 7) + 3) mod 7) + 7) mod 7
35
Added:
36
Added:
let unix_seconds_of_date ~year ~month ~day =
37
Added:
days_since_epoch ~year ~month ~day * 86_400
lib/web/calendar.mli
@@ -8,3 +8,6 @@
8
8
val monday_first_weekday : year:int -> month:int -> day:int -> int
9
9
(** Returns 0 for Monday through 6 for Sunday. Raises [Invalid_argument] when
10
10
[month] is outside 1 to 12. *)
11
Added:
12
Added:
val unix_seconds_of_date : year:int -> month:int -> day:int -> int
13
Added:
(** Returns the UTC Unix timestamp at the start of a Gregorian date. *)
lib/web/handlers_logbook.ml
@@ -32,8 +32,17 @@
32
32
33
33
(* {1 Calendar} *)
34
34
35
Removed:
type planned_workout = { at_unix : int; workout_name : string }
35
Added:
type planned_workout = {
36
Added:
at_unix : int;
37
Added:
workout_name : string;
38
Added:
exercises : string list;
39
Added:
}
36
40
41
Added:
let exercises_of_prescription prescription =
42
Added:
Prescription.Workout.stimuli prescription
43
Added:
|> List.concat_map Prescription.Stimulus.exercises
44
Added:
|> List.map Exercise.name
45
Added:
37
46
let latest_finished_workout log =
38
47
Evidence.Log.workouts log
39
48
|> List.find_map (fun workout ->
@@ -65,6 +74,7 @@
65
74
{
66
75
at_unix = planned_at;
67
76
workout_name = Prescription.Workout.name next;
77
Added:
exercises = exercises_of_prescription next;
68
78
}
69
79
:: loop next
70
80
(Recovery.timestamp_of_unix_seconds planned_at)
@@ -74,7 +84,8 @@
74
84
75
85
(* Build the calendar for [year]/[month], highlighting completed and planned
76
86
days. [today] marks the current day when it falls in the shown month. *)
77
Removed:
let calendar_view ~now ~year ~month ~(planned : planned_workout list)
87
Added:
let calendar_view ~now ~year ~month ~selected_day
88
Added:
~(planned : planned_workout list)
78
89
(entries : View_model.Logbook_entry.t list) : View_model.Calendar.t =
79
90
let now_tm = Unix.gmtime (float_of_int now) in
80
91
let this_year = now_tm.Unix.tm_year + 1900 in
@@ -117,6 +128,7 @@
117
128
workout = has_workout d;
118
129
planned_workout = planned_name d;
119
130
today = d = today;
131
Added:
selected = Some d = selected_day;
120
132
})
121
133
in
122
134
let trailing = (7 - (List.length cells mod 7)) mod 7 in
@@ -329,13 +341,59 @@
329
341
in
330
342
let year = query_int "year" (now_tm.Unix.tm_year + 1900) in
331
343
let month = clamp 1 12 (query_int "month" (now_tm.Unix.tm_mon + 1)) in
332
Removed:
(* Only the chosen month's entries fill the accordion. The calendar's year
333
Removed:
range still spans all history. *)
334
Removed:
let in_month (e : View_model.Logbook_entry.t) =
344
Added:
let selected_day_number =
345
Added:
match query_int "day" 0 with
346
Added:
| day when day >= 1 && day <= Calendar.days_in_month ~year ~month ->
347
Added:
Some day
348
Added:
| _ -> None
349
Added:
in
350
Added:
let same_day (e : View_model.Logbook_entry.t) day =
335
351
let tm = Unix.gmtime (float_of_int e.at_unix) in
336
Removed:
tm.Unix.tm_year + 1900 = year && tm.Unix.tm_mon + 1 = month
352
Added:
tm.Unix.tm_year + 1900 = year
353
Added:
&& tm.Unix.tm_mon + 1 = month
354
Added:
&& tm.Unix.tm_mday = day
337
355
in
338
Removed:
let records = List.filter in_month all_records in
356
Added:
let selected_completed =
357
Added:
Option.map
358
Added:
(fun day -> List.filter (fun entry -> same_day entry day) all_records)
359
Added:
selected_day_number
360
Added:
|> Option.value ~default:[]
361
Added:
in
362
Added:
let planned =
363
Added:
match active_routine with
364
Added:
| Some (_, routine) -> planned_workouts ~now ~log ~routine
365
Added:
| None -> []
366
Added:
in
367
Added:
let planned_for_day day =
368
Added:
List.find_opt
369
Added:
(fun (planned : planned_workout) ->
370
Added:
let tm = Unix.gmtime (float_of_int planned.at_unix) in
371
Added:
tm.Unix.tm_year + 1900 = year
372
Added:
&& tm.Unix.tm_mon + 1 = month
373
Added:
&& tm.Unix.tm_mday = day)
374
Added:
planned
375
Added:
in
376
Added:
let selected_planned = Option.bind selected_day_number planned_for_day in
377
Added:
let selected_day =
378
Added:
Option.map
379
Added:
(fun day ->
380
Added:
View_model.Selected_day.
381
Added:
{
382
Added:
date =
383
Added:
utc_long_date (Calendar.unix_seconds_of_date ~year ~month ~day);
384
Added:
completed = selected_completed;
385
Added:
planned =
386
Added:
Option.map
387
Added:
(fun planned ->
388
Added:
View_model.Selected_day.Planned.
389
Added:
{
390
Added:
name = planned.workout_name;
391
Added:
exercises = planned.exercises;
392
Added:
})
393
Added:
selected_planned;
394
Added:
})
395
Added:
selected_day_number
396
Added:
in
339
397
let delete_record =
340
398
match Dream.query request "delete" with
341
399
| Some id ->
@@ -346,34 +404,24 @@
346
404
all_records
347
405
| None -> None
348
406
in
349
Removed:
let expanded_record =
350
Removed:
match Dream.query request "expand" with
351
Removed:
| Some id ->
352
Removed:
List.find_opt
353
Removed:
(fun entry -> String.equal entry.View_model.Logbook_entry.id id)
354
Removed:
records
355
Removed:
| None -> None
356
Removed:
in
357
407
let feedback_open =
358
408
match (Dream.query request "feedback", Dream.query request "prompt") with
359
409
| Some "start", _ | _, Some "feedback" -> true
360
410
| _ -> false
361
411
in
362
Removed:
let planned =
363
Removed:
match active_routine with
364
Removed:
| Some (_, routine) -> planned_workouts ~now ~log ~routine
365
Removed:
| None -> []
412
Added:
let calendar =
413
Added:
calendar_view ~now ~year ~month ~selected_day:selected_day_number ~planned
414
Added:
all_records
366
415
in
367
Removed:
let calendar = calendar_view ~now ~year ~month ~planned all_records in
368
416
html
369
417
(Pages.logbook request
370
418
?workout_started:(workout_started in_progress)
371
Removed:
~viewer ~calendar
419
Added:
~viewer ~calendar ?selected_day
372
420
~suggest_feedback:
373
421
(match Dream.query request "prompt" with
374
422
| Some "feedback" -> true
375
423
| _ -> false)
376
Removed:
~feedback_open ?delete_record ?expanded_record records)
424
Added:
~feedback_open ?delete_record ())
377
425
378
426
(* One post saves the whole report. The app stores nothing before Submit, so
379
427
there is no partial state to keep or discard. An empty submission is a
test/test_calendar.ml
@@ -35,6 +35,15 @@
35
35
"month 13" true
36
36
(invalid_month (fun () ->
37
37
Calendar.days_in_month ~year:2024 ~month:13)) );
38
Added:
( "converts Gregorian dates to UTC seconds",
39
Added:
`Quick,
40
Added:
fun () ->
41
Added:
Alcotest.(check int)
42
Added:
"Unix epoch" 0
43
Added:
(Calendar.unix_seconds_of_date ~year:1970 ~month:1 ~day:1);
44
Added:
Alcotest.(check int)
45
Added:
"day after epoch" 86_400
46
Added:
(Calendar.unix_seconds_of_date ~year:1970 ~month:1 ~day:2) );
38
47
( "returns Monday-first weekdays",
39
48
`Quick,
40
49
fun () ->
test/web/logbook.ml
@@ -31,7 +31,7 @@
31
31
now := day 10 + 3600;
32
32
let token = Option.get (csrf_token (body (get c "/workout"))) in
33
33
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
34
Removed:
let page = body (get c "/logbook?year=1970&month=1") in
34
Added:
let page = body (get c "/logbook?year=1970&month=1&day=13") in
35
35
Alcotest.(check bool)
36
36
"calendar explains its planned state" true
37
37
(Option.is_some (index_from ~needle:"Planned" page 0));
@@ -39,9 +39,17 @@
39
39
"calendar names the next workout" true
40
40
(Option.is_some (index_from ~needle:"13: planned Day 2" page 0));
41
41
Alcotest.(check bool)
42
Removed:
"planned day exposes its workout" true
43
Removed:
(Option.is_some
44
Removed:
(index_from ~needle:"title=\"Planned: Day 2\"" page 0)) );
42
Added:
"selected date uses the long ordinal format" true
43
Added:
(Option.is_some (index_from ~needle:"13th January 1970" page 0));
44
Added:
Alcotest.(check bool)
45
Added:
"selected planned workout is displayed" true
46
Added:
(Option.is_some (index_from ~needle:"Planned: Day 2" page 0));
47
Added:
Alcotest.(check bool)
48
Added:
"selected planned exercises are displayed" true
49
Added:
(Option.is_some (index_from ~needle:"Pullovers" page 0));
50
Added:
Alcotest.(check bool)
51
Added:
"the old entry list is absent" true
52
Added:
(Option.is_none (index_from ~needle:"logbook-entry" page 0)) );
45
53
( "a faster repeat of the identical workout shows a favourable \
46
54
duration delta",
47
55
`Quick,
@@ -99,7 +107,7 @@
99
107
now := finished_at;
100
108
let token = Option.get (csrf_token (body (get c "/workout"))) in
101
109
let _ = post c "/workout/finish" [ ("dream.csrf", token) ] in
102
Removed:
let page = body (get c "/logbook") in
110
Added:
let page = body (get c "/logbook?year=1970&month=1&day=20") in
103
111
Alcotest.(check bool)
104
112
"the faster workout shows its own duration" true
105
113
(Option.is_some (index_from ~needle:"40 min" page 0));
@@ -152,7 +160,7 @@
152
160
(saved ~started:172_800 ~load:12. ~reps:9)));
153
161
(* The later workout progressed, so its history reports the exact
154
162
observed values and deltas. *)
155
Removed:
let page = body (get c "/logbook?year=1970&month=1") in
163
Added:
let page = body (get c "/logbook?year=1970&month=1&day=3") in
156
164
List.iter
157
165
(fun needle ->
158
166
Alcotest.(check bool)
@@ -569,7 +577,7 @@
569
577
(List.length
570
578
(Lwt_main.run
571
579
(Test_repo.imported_records repo trainee.Trainee.id)));
572
Removed:
let page = body (get c "/logbook?year=2024&month=1") in
580
Added:
let page = body (get c "/logbook?year=2024&month=1&day=8") in
573
581
(* The later import gained 10 kg over the earlier one, shown as a
574
582
green weight delta. *)
575
583
Alcotest.(check bool)