[OCaml] High Intensity Training Online
feat show imported workouts in the logbook, read-only
Promoted imports were stored but never rendered. The logbook now interleaves them with native records by date, tagged "Imported" and read-only: no edit or delete, and an expandable list of the imported efforts. Native prescribed logging stays the only writable path forward -- imports are past evidence that feeds progress per exercise, never a prescribed record. The expand toggle is now an app link, so the SPA client swaps the content in place instead of reloading the whole page; without script it stays an ordinary link. This also fixes the same full-reload on the native progress toggle.
Changed files
lib/presenter/pages_logbook.ml
@@ -188,6 +188,28 @@
188
188
];
189
189
]
190
190
191
Added:
(* An imported entry has no prescription and no progress comparison. Its detail
192
Added:
lists the imported efforts verbatim. *)
193
Added:
let imported_detail_row (entry : View_model.Logbook_entry.t) =
194
Added:
tag "tr"
195
Added:
[ class_ "logbook-detail-row" ]
196
Added:
[
197
Added:
tag "td"
198
Added:
[ Dream_html.string_attr "colspan" "5" ]
199
Added:
[
200
Added:
tag "section"
201
Added:
[ class_ "logbook-progress-detail" ]
202
Added:
[
203
Added:
tag "h2" [] [ txt "Imported efforts" ];
204
Added:
tag "ul"
205
Added:
[ class_ "logbook-change-list" ]
206
Added:
(List.map
207
Added:
(fun line -> tag "li" [] [ txt "%s" line ])
208
Added:
entry.View_model.Logbook_entry.imported_lines);
209
Added:
];
210
Added:
];
211
Added:
]
212
Added:
191
213
let logbook request ?(logging = false) ~viewer ?(feedback = [])
192
214
?(suggest_feedback = false) ?(feedback_open = false) ?delete_record
193
215
?expanded_record records =
@@ -231,8 +253,35 @@
231
253
entry.id)
232
254
expanded_record
233
255
in
256
Added:
let expand_toggle ~label =
257
Added:
let attrs =
258
Added:
[
259
Added:
class_ "logbook-progress-toggle";
260
Added:
(* An app link, so the client swaps the content in
261
Added:
place rather than reloading the whole page. Without
262
Added:
script it stays an ordinary link. *)
263
Added:
Dream_html.attr "data-hito-app-link";
264
Added:
Dream_html.string_attr "aria-expanded" "%b" expanded;
265
Added:
]
266
Added:
@
267
Added:
if expanded then [ href Routes.logbook ]
268
Added:
else
269
Added:
[
270
Added:
Dream_html.string_attr "href" "/logbook?expand=%s"
271
Added:
entry.id;
272
Added:
]
273
Added:
in
274
Added:
tag "a" attrs
275
Added:
[ txt "%s %s" label (if expanded then "▴" else "▾") ]
276
Added:
in
234
277
let progress =
235
Removed:
if entry.compared_exercises = 0 then
278
Added:
if entry.View_model.Logbook_entry.imported then
279
Added:
if entry.imported_lines = [] then
280
Added:
tag "span"
281
Added:
[ class_ "logbook-no-progress" ]
282
Added:
[ txt "Imported" ]
283
Added:
else expand_toggle ~label:"Imported efforts"
284
Added:
else if entry.compared_exercises = 0 then
236
285
tag "span"
237
286
[ class_ "logbook-no-progress" ]
238
287
[ txt "No prior comparison" ]
@@ -241,25 +290,65 @@
241
290
[ class_ "logbook-no-progress" ]
242
291
[ txt "No progress" ]
243
292
else
244
Removed:
let progress_attrs =
293
Added:
expand_toggle
294
Added:
~label:
295
Added:
(Printf.sprintf "%d/%d progressed"
296
Added:
entry.progressed_exercises
297
Added:
entry.compared_exercises)
298
Added:
in
299
Added:
(* A read-only import carries an Imported tag and no action
300
Added:
menu. A native record keeps Edit and Delete. *)
301
Added:
let name_cell =
302
Added:
if entry.imported then
303
Added:
tag "td" []
245
304
[
246
Removed:
class_ "logbook-progress-toggle";
247
Removed:
Dream_html.string_attr "aria-expanded" "%b" expanded;
305
Added:
txt "%s" entry.workout_name;
306
Added:
tag "span"
307
Added:
[ class_ "logbook-source-tag" ]
308
Added:
[ txt " Imported" ];
248
309
]
249
Removed:
@
250
Removed:
if expanded then [ href Routes.logbook ]
251
Removed:
else
310
Added:
else tag "td" [] [ txt "%s" entry.workout_name ]
311
Added:
in
312
Added:
let actions =
313
Added:
if entry.imported then []
314
Added:
else
315
Added:
[
316
Added:
tag "details"
317
Added:
[ class_ "logbook-row-menu" ]
252
318
[
253
Removed:
Dream_html.string_attr "href" "/logbook?expand=%s"
254
Removed:
entry.id;
255
Removed:
]
256
Removed:
in
257
Removed:
tag "a" progress_attrs
258
Removed:
[
259
Removed:
txt "%d/%d progressed %s" entry.progressed_exercises
260
Removed:
entry.compared_exercises
261
Removed:
(if expanded then "▴" else "▾");
262
Removed:
]
319
Added:
tag "summary"
320
Added:
[
321
Added:
Dream_html.string_attr "aria-label"
322
Added:
"Actions for %s on %s" entry.workout_name
323
Added:
entry.date;
324
Added:
]
325
Added:
[ txt "⋮" ];
326
Added:
tag "div"
327
Added:
[
328
Added:
class_ "logbook-row-menu-drawer";
329
Added:
Dream_html.string_attr "role" "menu";
330
Added:
Dream_html.string_attr "aria-label"
331
Added:
"Workout actions";
332
Added:
]
333
Added:
[
334
Added:
tag "a"
335
Added:
[
336
Added:
href Routes.record entry.id;
337
Added:
Dream_html.attr "data-hito-app-link";
338
Added:
Dream_html.string_attr "role" "menuitem";
339
Added:
]
340
Added:
[ txt "Edit" ];
341
Added:
tag "a"
342
Added:
[
343
Added:
Dream_html.string_attr "href"
344
Added:
"/logbook?delete=%s" entry.id;
345
Added:
Dream_html.string_attr "role" "menuitem";
346
Added:
class_ "danger";
347
Added:
]
348
Added:
[ txt "Delete" ];
349
Added:
];
350
Added:
];
351
Added:
]
263
352
in
264
353
let row =
265
354
tag "tr"
@@ -267,56 +356,19 @@
267
356
else [])
268
357
[
269
358
tag "td" [] [ txt "%s" entry.date ];
270
Removed:
tag "td" [] [ txt "%s" entry.workout_name ];
359
Added:
name_cell;
271
360
tag "td"
272
361
[ class_ "logbook-duration" ]
273
362
[ txt "%s" entry.duration ];
274
363
tag "td" [ class_ "logbook-progress" ] [ progress ];
275
Removed:
tag "td"
276
Removed:
[ class_ "logbook-actions" ]
277
Removed:
[
278
Removed:
tag "details"
279
Removed:
[ class_ "logbook-row-menu" ]
280
Removed:
[
281
Removed:
tag "summary"
282
Removed:
[
283
Removed:
Dream_html.string_attr "aria-label"
284
Removed:
"Actions for %s on %s"
285
Removed:
entry.workout_name entry.date;
286
Removed:
]
287
Removed:
[ txt "⋮" ];
288
Removed:
tag "div"
289
Removed:
[
290
Removed:
class_ "logbook-row-menu-drawer";
291
Removed:
Dream_html.string_attr "role" "menu";
292
Removed:
Dream_html.string_attr "aria-label"
293
Removed:
"Workout actions";
294
Removed:
]
295
Removed:
[
296
Removed:
tag "a"
297
Removed:
[
298
Removed:
href Routes.record entry.id;
299
Removed:
Dream_html.attr "data-hito-app-link";
300
Removed:
Dream_html.string_attr "role"
301
Removed:
"menuitem";
302
Removed:
]
303
Removed:
[ txt "Edit" ];
304
Removed:
tag "a"
305
Removed:
[
306
Removed:
Dream_html.string_attr "href"
307
Removed:
"/logbook?delete=%s" entry.id;
308
Removed:
Dream_html.string_attr "role"
309
Removed:
"menuitem";
310
Removed:
class_ "danger";
311
Removed:
]
312
Removed:
[ txt "Delete" ];
313
Removed:
];
314
Removed:
];
315
Removed:
];
364
Added:
tag "td" [ class_ "logbook-actions" ] actions;
316
365
]
317
366
in
318
Removed:
if expanded then [ row; progress_detail_row entry ]
319
Removed:
else [ row ])
367
Added:
let detail =
368
Added:
if entry.imported then imported_detail_row entry
369
Added:
else progress_detail_row entry
370
Added:
in
371
Added:
if expanded then [ row; detail ] else [ row ])
320
372
records);
321
373
]);
322
374
tag "section"
lib/presenter/view_model.ml
@@ -133,18 +133,29 @@
133
133
module Logbook_entry = struct
134
134
type t = {
135
135
id : string; (** Record id for links and URL-addressable expansion. *)
136
Added:
imported : bool;
137
Added:
(** True for a promoted third-party import. Shown read-only and tagged;
138
Added:
it feeds progress per exercise but is never a prescribed native
139
Added:
record. *)
140
Added:
at_unix : int; (** Start time in Unix seconds, for interleaving by date. *)
136
141
workout_name : string;
137
142
date : string; (** Workout date, pre-formatted "YYYY-MM-DD" in UTC. *)
138
143
duration : string;
139
144
(** Finished elapsed time, pre-formatted for scanning. *)
140
Removed:
progressed_exercises : int;
145
Added:
progressed_exercises : int; (** Native only; zero for an import. *)
141
146
compared_exercises : int;
142
Removed:
(** Exercises with a prior baseline. First performances do not count. *)
147
Added:
(** Exercises with a prior baseline. First performances do not count.
148
Added:
Native only; zero for an import. *)
143
149
changes : Logbook_change.t list;
144
Removed:
(** Exact positive overload changes, in workout performance order. *)
150
Added:
(** Exact positive overload changes, in workout performance order.
151
Added:
Native only; empty for an import. *)
152
Added:
imported_lines : string list;
153
Added:
(** One pre-phrased line per imported effort (exercise, load, reps).
154
Added:
Empty for a native entry. *)
145
155
}
146
Removed:
(** One saved workout as the logbook table shows it: compact evidence for
147
Removed:
scanning, plus the proof needed by the expanded detail row. No Repository
156
Added:
(** One logbook entry as the table shows it: a native prescribed workout or a
157
Added:
read-only imported workout, interleaved by date. Compact evidence for
158
Added:
scanning, plus the proof the expanded detail row needs. No Repository
148
159
record and no Evidence.Workout entity. *)
149
160
end
150
161
lib/web/handlers_logbook.ml
@@ -32,13 +32,15 @@
32
32
33
33
let describe_signal = Present.feedback_signal
34
34
35
Added:
let date_of_unix seconds =
36
Added:
let tm = Unix.gmtime (float_of_int seconds) in
37
Added:
Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900)
38
Added:
(tm.Unix.tm_mon + 1) tm.Unix.tm_mday
39
Added:
35
40
let entry_view log (record : Repository.record) : View_model.Logbook_entry.t =
36
41
let workout = record.Repository.workout in
37
Removed:
let tm =
38
Removed:
Unix.gmtime
39
Removed:
(float_of_int
40
Removed:
(Recovery.timestamp_to_unix_seconds
41
Removed:
(Evidence.Workout.started_at workout)))
42
Added:
let started =
43
Added:
Recovery.timestamp_to_unix_seconds (Evidence.Workout.started_at workout)
42
44
in
43
45
let comparisons = Progress.workout_comparisons log workout in
44
46
let changes =
@@ -65,17 +67,48 @@
65
67
in
66
68
{
67
69
id = (record.Repository.id :> string);
70
Added:
imported = false;
71
Added:
at_unix = started;
68
72
workout_name =
69
73
Prescription.Workout.name (Evidence.Workout.prescription workout);
70
Removed:
date =
71
Removed:
Printf.sprintf "%04d-%02d-%02d" (tm.Unix.tm_year + 1900)
72
Removed:
(tm.Unix.tm_mon + 1) tm.Unix.tm_mday;
74
Added:
date = date_of_unix started;
73
75
duration;
74
76
progressed_exercises = List.length changes;
75
77
compared_exercises = List.length comparisons;
76
78
changes;
79
Added:
imported_lines = [];
77
80
}
78
81
82
Added:
(* A promoted import: canonical evidence, read-only. It carries no
83
Added:
prescription, so the native progress columns do not apply. Its detail lists
84
Added:
the imported efforts verbatim. It still feeds progress per exercise through
85
Added:
the service; the logbook only shows it. *)
86
Added:
let imported_line (o : Evidence.Observation.t) =
87
Added:
let effort = Evidence.Observation.effort o in
88
Added:
Printf.sprintf "%s — %g kg × %d"
89
Added:
(Exercise.name (Evidence.Observation.exercise o))
90
Added:
(Evidence.Stimulus.Effort.load effort)
91
Added:
(Evidence.Stimulus.Effort.reps effort)
92
Added:
93
Added:
let imported_entry_view (record : Repository.imported_record) :
94
Added:
View_model.Logbook_entry.t =
95
Added:
let started =
96
Added:
Recovery.timestamp_to_unix_seconds record.Repository.started_at
97
Added:
in
98
Added:
let ended = Recovery.timestamp_to_unix_seconds record.Repository.ended_at in
99
Added:
{
100
Added:
id = Workout_import.workout_id_to_string record.Repository.workout_id;
101
Added:
imported = true;
102
Added:
at_unix = started;
103
Added:
workout_name = record.Repository.title;
104
Added:
date = date_of_unix started;
105
Added:
duration = Printf.sprintf "%d min" ((ended - started) / 60);
106
Added:
progressed_exercises = 0;
107
Added:
compared_exercises = 0;
108
Added:
changes = [];
109
Added:
imported_lines = List.map imported_line record.Repository.observations;
110
Added:
}
111
Added:
79
112
let feedback_view (report : Feedback.t) : View_model.Feedback.report =
80
113
{
81
114
at_unix = Recovery.timestamp_to_unix_seconds (Feedback.reported_at report);
@@ -92,14 +125,24 @@
92
125
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
93
126
Service.history t.service trainee.Trainee.id >>= fun records ->
94
127
Service.workout_log t.service trainee.Trainee.id >>= fun log ->
128
Added:
Service.imported_records t.service trainee.Trainee.id >>= fun imported ->
95
129
Service.feedback t.service trainee.Trainee.id >>= fun feedback ->
96
130
let feedback = List.map feedback_view feedback in
97
Removed:
let records = List.map (entry_view log) records in
131
Added:
(* Native prescribed records and read-only imports, interleaved by start
132
Added:
date, most recent first. *)
133
Added:
let records =
134
Added:
List.map (entry_view log) records @ List.map imported_entry_view imported
135
Added:
|> List.stable_sort (fun a b ->
136
Added:
Int.compare b.View_model.Logbook_entry.at_unix
137
Added:
a.View_model.Logbook_entry.at_unix)
138
Added:
in
98
139
let delete_record =
99
140
match Dream.query request "delete" with
100
141
| Some id ->
101
142
List.find_opt
102
Removed:
(fun entry -> String.equal entry.View_model.Logbook_entry.id id)
143
Added:
(fun entry ->
144
Added:
String.equal entry.View_model.Logbook_entry.id id
145
Added:
&& not entry.View_model.Logbook_entry.imported)
103
146
records
104
147
| None -> None
105
148
in
test/web/logbook.ml
@@ -444,5 +444,75 @@
444
444
"only the valid factor survives" true
445
445
(Feedback.signals (List.hd reports)
446
446
= [ Feedback.Difficulty Feedback.Better_than_usual ]) );
447
Added:
( "a promoted import appears in the logbook tagged Imported and \
448
Added:
read-only",
449
Added:
`Quick,
450
Added:
fun () ->
451
Added:
(* Upload one failure set, map its exercise, promote it, then read
452
Added:
the logbook. The promoted import shows tagged and read-only, and
453
Added:
its title interleaves with native records. *)
454
Added:
let c, repo = client_with_repo () in
455
Added:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
456
Added:
let trainee = the_trainee repo ~username:"lifter" in
457
Added:
let header =
458
Added:
"title,start_time,end_time,description,exercise_title,superset_id,exercise_notes,set_index,set_type,weight_kg,reps,distance_km,duration_seconds,rpe\r\n"
459
Added:
in
460
Added:
let source =
461
Added:
header
462
Added:
^ "Legs,\"01 Jan 2024, 10:00\",\"01 Jan 2024, 11:00\",,Barbell \
463
Added:
Squat,,,0,failure,100,8,,,\r\n"
464
Added:
in
465
Added:
let token = Option.get (csrf_token (body (get c "/profile"))) in
466
Added:
let _ =
467
Added:
post_multipart c "/profile/import"
468
Added:
~file:(Some ("csv", "workouts.csv", source))
469
Added:
~fields:[ ("dream.csrf", token); ("utc_offset_seconds", "0") ]
470
Added:
in
471
Added:
let batch =
472
Added:
List.hd
473
Added:
(Lwt_main.run
474
Added:
(Memory_repo.import_batches repo trainee.Trainee.id))
475
Added:
in
476
Added:
let bid =
477
Added:
Workout_import.batch_id_to_string
478
Added:
(Workout_import.batch_identity batch)
479
Added:
in
480
Added:
let wid =
481
Added:
Workout_import.workout_id_to_string
482
Added:
(Workout_import.workout_identity
483
Added:
(List.hd (Workout_import.batch_workouts batch)))
484
Added:
in
485
Added:
let review = "/profile/import/" ^ bid in
486
Added:
let t = Option.get (csrf_token (body (get c review))) in
487
Added:
let _ =
488
Added:
post c
489
Added:
(Printf.sprintf "/profile/import/%s/workouts/%s/map" bid wid)
490
Added:
[
491
Added:
("dream.csrf", t);
492
Added:
("source_name", "Barbell Squat");
493
Added:
("exercise_id", "squats");
494
Added:
]
495
Added:
in
496
Added:
let t = Option.get (csrf_token (body (get c review))) in
497
Added:
let _ =
498
Added:
post c
499
Added:
(Printf.sprintf "/profile/import/%s/workouts/%s/promote" bid wid)
500
Added:
[ ("dream.csrf", t) ]
501
Added:
in
502
Added:
Alcotest.(check int)
503
Added:
"the import is promoted" 1
504
Added:
(List.length
505
Added:
(Lwt_main.run
506
Added:
(Memory_repo.imported_records repo trainee.Trainee.id)));
507
Added:
let page = body (get c "/logbook") in
508
Added:
Alcotest.(check bool)
509
Added:
"the imported workout title is shown" true
510
Added:
(Option.is_some (index_from ~needle:"Legs" page 0));
511
Added:
Alcotest.(check bool)
512
Added:
"it carries the Imported tag" true
513
Added:
(Option.is_some (index_from ~needle:"logbook-source-tag" page 0));
514
Added:
Alcotest.(check bool)
515
Added:
"a read-only import offers no delete action" false
516
Added:
(Option.is_some (index_from ~needle:"?delete=" page 0)) );
447
517
] );
448
518
]