[OCaml] High Intensity Training Online
feat add sequential feedback flow
Changed files
lib/web/assets/hito.css
@@ -529,6 +529,86 @@
529
529
.recorded-slot { margin: 1rem 0; }
530
530
.recorded-slot .done { margin-bottom: 0.35rem; }
531
531
532
Added:
/* The sequential feedback flow opens in a native modal. The [open] fallback
533
Added:
keeps the flow usable when script is disabled, while the client upgrades it
534
Added:
to [showModal] and supplies the backdrop. */
535
Added:
.feedback-modal {
536
Added:
width: min(calc(100% - 2rem), 34rem);
537
Added:
margin: auto;
538
Added:
border: 1px solid var(--rule-strong);
539
Added:
border-top: 6px solid var(--oxblood);
540
Added:
border-radius: var(--radius);
541
Added:
background: var(--paper-raised);
542
Added:
box-shadow: 0 0.6rem 2rem rgba(26, 26, 22, 0.25);
543
Added:
padding: 0;
544
Added:
color: var(--ink);
545
Added:
}
546
Added:
.feedback-modal::backdrop { background: rgba(26, 26, 22, 0.45); }
547
Added:
.feedback-modal-content { padding: 1.25rem; }
548
Added:
.feedback-modal-heading {
549
Added:
display: flex;
550
Added:
align-items: start;
551
Added:
justify-content: space-between;
552
Added:
gap: 1rem;
553
Added:
}
554
Added:
.feedback-modal-heading h2 { margin-top: 0; }
555
Added:
.feedback-modal-close {
556
Added:
min-width: 2.5rem;
557
Added:
min-height: 2.5rem;
558
Added:
border: 1px solid var(--rule-strong);
559
Added:
border-radius: 50%;
560
Added:
color: var(--ink);
561
Added:
background: transparent;
562
Added:
cursor: pointer;
563
Added:
font-size: 1.5rem;
564
Added:
line-height: 1;
565
Added:
}
566
Added:
.feedback-modal-close:hover { background: var(--brass-wash); }
567
Added:
.feedback-actions {
568
Added:
display: flex;
569
Added:
flex-wrap: wrap;
570
Added:
gap: 0.6rem;
571
Added:
margin-top: 1rem;
572
Added:
}
573
Added:
.feedback-actions button,
574
Added:
.feedback-cancel-form button {
575
Added:
flex: 1 1 10rem;
576
Added:
min-height: 3rem;
577
Added:
border: 2px solid var(--oxblood-dark);
578
Added:
border-radius: var(--radius);
579
Added:
color: var(--paper-raised);
580
Added:
background: var(--oxblood);
581
Added:
cursor: pointer;
582
Added:
font: 700 var(--font-size-small)/1 var(--sans);
583
Added:
letter-spacing: 0.055em;
584
Added:
text-transform: uppercase;
585
Added:
}
586
Added:
.feedback-actions button:hover,
587
Added:
.feedback-cancel-form button:hover {
588
Added:
background: var(--oxblood-dark);
589
Added:
}
590
Added:
.feedback-actions button.secondary,
591
Added:
.feedback-cancel-form button.secondary {
592
Added:
color: var(--brass);
593
Added:
background: transparent;
594
Added:
border-color: var(--brass);
595
Added:
}
596
Added:
.feedback-actions button.secondary:hover,
597
Added:
.feedback-cancel-form button.secondary:hover {
598
Added:
color: var(--paper-raised);
599
Added:
background: var(--brass);
600
Added:
}
601
Added:
.feedback-progress { margin-top: 1rem; }
602
Added:
.feedback-progress progress {
603
Added:
display: block;
604
Added:
width: 100%;
605
Added:
height: 0.8rem;
606
Added:
accent-color: var(--oxblood);
607
Added:
}
608
Added:
.feedback-progress p { margin: 0.35rem 0 0; }
609
Added:
.feedback-cancel-form { margin-top: 1rem; }
610
Added:
.feedback-cancel-form button { width: 100%; }
611
Added:
532
612
/* The subjective feedback section on the Logbook. A bordered block separating
533
613
the standalone feedback form from the workout list. The flags stack as
534
614
inline checkbox rows; past reports read as a plain list. */
lib/web/handlers.ml
@@ -440,35 +440,184 @@
440
440
end
441
441
442
442
module Logbook = struct
443
Added:
let feedback_session_key = "hito.feedback.flow"
444
Added:
445
Added:
let feedback_factors =
446
Added:
[ "sleep"; "appetite"; "readiness"; "motivation"; "difficulty" ]
447
Added:
448
Added:
let valid_choice = function
449
Added:
| ("below" | "usual" | "above") as choice -> Some choice
450
Added:
| _ -> None
451
Added:
452
Added:
let valid_factor field = List.mem field feedback_factors
453
Added:
454
Added:
let encode_feedback_flow (flow : Pages.feedback_flow) =
455
Added:
let answers =
456
Added:
List.map (fun (field, choice) -> field ^ ":" ^ choice) flow.answers
457
Added:
in
458
Added:
Printf.sprintf "%d|%s" flow.step (String.concat ";" answers)
459
Added:
460
Added:
let decode_feedback_flow raw =
461
Added:
match String.split_on_char '|' raw with
462
Added:
| [ step; answers ] -> (
463
Added:
match int_of_string_opt step with
464
Added:
| None -> None
465
Added:
| Some step when step < 0 || step > 5 -> None
466
Added:
| Some step ->
467
Added:
let answers =
468
Added:
answers |> String.split_on_char ';'
469
Added:
|> List.filter_map (fun answer ->
470
Added:
match String.split_on_char ':' answer with
471
Added:
| [ field; choice ]
472
Added:
when valid_factor field
473
Added:
&& Option.is_some (valid_choice choice) ->
474
Added:
Some (field, choice)
475
Added:
| _ -> None)
476
Added:
in
477
Added:
Some Pages.{ step; answers })
478
Added:
| _ -> None
479
Added:
480
Added:
let feedback_flow request =
481
Added:
Dream.session_field request feedback_session_key |> fun raw ->
482
Added:
Option.bind raw decode_feedback_flow
483
Added:
484
Added:
let initial_feedback_flow = Pages.{ step = 0; answers = [] }
485
Added:
486
Added:
let set_feedback_flow request flow =
487
Added:
Dream.set_session_field request feedback_session_key
488
Added:
(encode_feedback_flow flow)
489
Added:
490
Added:
let clear_feedback_flow request =
491
Added:
Dream.drop_session_field request feedback_session_key
492
Added:
493
Added:
let field name fields = List.assoc_opt name fields
494
Added:
495
Added:
let feedback_signals answers flags =
496
Added:
let level = function
497
Added:
| "below" -> Evidence.Feedback.Below_usual
498
Added:
| "usual" -> Evidence.Feedback.Usual
499
Added:
| _ -> Evidence.Feedback.Above_usual
500
Added:
in
501
Added:
let leveled field make =
502
Added:
List.find_map
503
Added:
(fun (answer_field, choice) ->
504
Added:
if String.equal field answer_field then
505
Added:
Option.map
506
Added:
(fun choice -> make (level choice))
507
Added:
(valid_choice choice)
508
Added:
else None)
509
Added:
answers
510
Added:
in
511
Added:
let optional_flag name signal =
512
Added:
match field name flags with Some "true" -> Some signal | _ -> None
513
Added:
in
514
Added:
List.filter_map Fun.id
515
Added:
[
516
Added:
leveled "sleep" (fun l -> Evidence.Feedback.Sleep l);
517
Added:
leveled "appetite" (fun l -> Evidence.Feedback.Appetite l);
518
Added:
leveled "readiness" (fun l -> Evidence.Feedback.Readiness l);
519
Added:
leveled "motivation" (fun l -> Evidence.Feedback.Motivation l);
520
Added:
leveled "difficulty" (fun l -> Evidence.Feedback.Difficulty l);
521
Added:
optional_flag "pain" Evidence.Feedback.Pain;
522
Added:
optional_flag "injury" Evidence.Feedback.Injury;
523
Added:
optional_flag "preparation" Evidence.Feedback.Preparation_insufficient;
524
Added:
]
525
Added:
443
526
let index t trainee request =
444
527
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
445
528
Service.history t.service trainee.Trainee.id >>= fun records ->
446
529
Service.feedback t.service trainee.Trainee.id >>= fun feedback ->
447
Removed:
let suggest_feedback =
448
Removed:
match Dream.query request "prompt" with
449
Removed:
| Some "feedback" -> true
450
Removed:
| _ -> false
530
Added:
let saved_flow = feedback_flow request in
531
Added:
let feedback_open =
532
Added:
match
533
Added:
(Dream.query request "feedback", Dream.query request "prompt")
534
Added:
with
535
Added:
| Some "start", _ | _, Some "feedback" -> true
536
Added:
| _ -> Option.is_some saved_flow
451
537
in
452
538
html
453
539
(Pages.logbook request
454
540
~logging:(Option.is_some in_progress)
455
Removed:
~trainee ~feedback ~suggest_feedback records)
541
Added:
~trainee ~feedback
542
Added:
~suggest_feedback:
543
Added:
(match Dream.query request "prompt" with
544
Added:
| Some "feedback" -> true
545
Added:
| _ -> false)
546
Added:
~feedback_flow:
547
Added:
(Option.value saved_flow ~default:initial_feedback_flow)
548
Added:
~feedback_open records)
456
549
457
Removed:
(* Record subjective feedback. Standalone: it needs no workout, so it is
458
Removed:
available from the Logbook at any time. An empty submission (no signal
459
Removed:
chosen) is accepted and simply stores nothing meaningful; a repeated
460
Removed:
signal category is rejected by the domain. *)
550
Added:
let finish_feedback t trainee request flow flags =
551
Added:
let signals = feedback_signals flow.Pages.answers flags in
552
Added:
Service.record_feedback t.service trainee.Trainee.id
553
Added:
~reported_at:(t.now ()) signals
554
Added:
>>= function
555
Added:
| Ok _ ->
556
Added:
clear_feedback_flow request >>= fun () ->
557
Added:
redirect_with_flash request Routes.logbook "Feedback saved."
558
Added:
| Error _ ->
559
Added:
clear_feedback_flow request >>= fun () ->
560
Added:
redirect_with_flash request Routes.logbook Present.form_invalid
561
Added:
562
Added:
(* Advance one factor. The answer map stays in the session until the final
563
Added:
optional-observations step, so refreshes never lose earlier choices. *)
461
564
let record_feedback t trainee request =
462
Removed:
decode_form Decode.feedback request >>= function
565
Added:
Dream.form request >>= function
566
Added:
| `Ok fields -> (
567
Added:
let flow =
568
Added:
Option.value (feedback_flow request) ~default:initial_feedback_flow
569
Added:
in
570
Added:
match
571
Added:
field "step" fields |> fun raw ->
572
Added:
(Option.bind raw int_of_string_opt, flow.step)
573
Added:
with
574
Added:
| Some step, expected when step = expected ->
575
Added:
let action =
576
Added:
match field "action" fields with
577
Added:
| Some ("next" | "Next") -> Some "next"
578
Added:
| Some ("skip" | "Skip this factor" | "Skip this step") ->
579
Added:
Some "skip"
580
Added:
| Some ("save" | "Record feedback") -> Some "save"
581
Added:
| _ -> None
582
Added:
in
583
Added:
if step = 5 then
584
Added:
if action = Some "skip" then
585
Added:
finish_feedback t trainee request flow []
586
Added:
else if action = Some "save" then
587
Added:
finish_feedback t trainee request flow fields
588
Added:
else
589
Added:
redirect_with_flash request Routes.logbook
590
Added:
Present.form_invalid
591
Added:
else
592
Added:
let factor = List.nth feedback_factors step in
593
Added:
let answers =
594
Added:
match
595
Added:
( action,
596
Added:
field "choice" fields |> fun raw ->
597
Added:
Option.bind raw valid_choice )
598
Added:
with
599
Added:
| Some "next", Some choice -> (factor, choice) :: flow.answers
600
Added:
| Some "skip", _ -> flow.answers
601
Added:
| _ -> flow.answers
602
Added:
in
603
Added:
if action <> Some "next" && action <> Some "skip" then
604
Added:
redirect_with_flash request Routes.logbook
605
Added:
Present.form_invalid
606
Added:
else
607
Added:
let next = Pages.{ step = step + 1; answers } in
608
Added:
set_feedback_flow request next >>= fun () ->
609
Added:
redirect_to request Routes.logbook
610
Added:
| _ -> redirect_with_flash request Routes.logbook Present.form_invalid
611
Added:
)
612
Added:
| _ -> redirect_with_flash request Routes.logbook Present.form_invalid
613
Added:
614
Added:
let cancel_feedback _t _trainee request =
615
Added:
guard_csrf request >>= function
463
616
| Error _ ->
464
617
redirect_with_flash request Routes.logbook Present.form_invalid
465
Removed:
| Ok signals -> (
466
Removed:
Service.record_feedback t.service trainee.Trainee.id
467
Removed:
~reported_at:(t.now ()) signals
468
Removed:
>>= function
469
Removed:
| Ok _ -> redirect_with_flash request Routes.logbook "Feedback saved."
470
Removed:
| Error _ ->
471
Removed:
redirect_with_flash request Routes.logbook Present.form_invalid)
618
Added:
| Ok () ->
619
Added:
clear_feedback_flow request >>= fun () ->
620
Added:
redirect_with_flash request Routes.logbook "Feedback skipped."
472
621
473
622
let show t trainee request id =
474
623
Service.in_progress t.service trainee.Trainee.id >>= fun in_progress ->
@@ -551,6 +700,9 @@
551
700
Dream_html.post Routes.feedback (fun request ->
552
701
authenticated t request (fun trainee ->
553
702
record_feedback t trainee request));
703
Added:
Dream_html.post Routes.cancel_feedback (fun request ->
704
Added:
authenticated t request (fun trainee ->
705
Added:
cancel_feedback t trainee request));
554
706
Dream_html.get Routes.record (fun request id ->
555
707
authenticated t request (fun trainee -> show t trainee request id));
556
708
Dream_html.post Routes.record_slot (fun request id slot ->
lib/web/pages.ml
@@ -1119,6 +1119,19 @@
1119
1119
standalone — recorded from the Logbook at any time. *)
1120
1120
(* Each subjective metric uses three unselected radio buttons styled as inline buttons.
1121
1121
Leaving a group untouched records no signal for that metric. *)
1122
Added:
type feedback_flow = { step : int; answers : (string * string) list }
1123
Added:
1124
Added:
let feedback_factors =
1125
Added:
[
1126
Added:
("sleep", "Sleep");
1127
Added:
("appetite", "Appetite");
1128
Added:
("readiness", "Readiness");
1129
Added:
("motivation", "Motivation");
1130
Added:
("difficulty", "Perceived difficulty");
1131
Added:
]
1132
Added:
1133
Added:
(* Each subjective metric uses three unselected radio buttons styled as inline
1134
Added:
buttons. The server shows one metric at a time. *)
1122
1135
let feedback_level_buttons field label =
1123
1136
let choice code text =
1124
1137
tag "label"
@@ -1127,7 +1140,7 @@
1127
1140
void "input"
1128
1141
[
1129
1142
type_ "radio";
1130
Removed:
Dream_html.string_attr "name" "%s" field;
1143
Added:
Dream_html.string_attr "name" "choice";
1131
1144
Dream_html.string_attr "value" "%s" code;
1132
1145
Dream_html.string_attr "id" "%s-%s" field code;
1133
1146
];
@@ -1162,31 +1175,137 @@
1162
1175
txt " %s" label;
1163
1176
]
1164
1177
1165
Removed:
let feedback_form request =
1178
Added:
let feedback_progress step =
1179
Added:
let completed = min 5 (max 0 step) in
1180
Added:
tag "div"
1181
Added:
[ class_ "feedback-progress" ]
1182
Added:
[
1183
Added:
tag "progress"
1184
Added:
[
1185
Added:
Dream_html.string_attr "value" "%s" (string_of_int completed);
1186
Added:
Dream_html.string_attr "max" "5";
1187
Added:
Dream_html.string_attr "aria-label" "Feedback progress";
1188
Added:
]
1189
Added:
[ txt "%d of 5 factors" completed ];
1190
Added:
tag "p" [ class_ "ledger-meta" ] [ txt "%d of 5 factors" completed ];
1191
Added:
]
1192
Added:
1193
Added:
let feedback_action_button ~action ~label ?(secondary = false) () =
1194
Added:
tag "button"
1195
Added:
([
1196
Added:
type_ "submit";
1197
Added:
name "action";
1198
Added:
value action;
1199
Added:
Dream_html.attr "data-hito-feedback-action";
1200
Added:
]
1201
Added:
@ if secondary then [ class_ "secondary" ] else [])
1202
Added:
[ txt "%s" label ]
1203
Added:
1204
Added:
let feedback_cancel_form request =
1166
1205
tag "form"
1167
1206
[
1168
Removed:
action Routes.feedback;
1207
Added:
action Routes.cancel_feedback;
1169
1208
post_form;
1170
Removed:
class_ "feedback-form";
1209
Added:
class_ "feedback-cancel-form";
1171
1210
Dream_html.attr "data-hito-app-form";
1172
1211
]
1173
1212
[
1174
1213
Dream_html.csrf_tag request;
1175
Removed:
tag "fieldset" []
1214
Added:
feedback_action_button ~action:"cancel" ~label:"Skip all feedback"
1215
Added:
~secondary:true ();
1216
Added:
]
1217
Added:
1218
Added:
let feedback_flow_form request flow =
1219
Added:
let step = min 5 (max 0 flow.step) in
1220
Added:
let fields =
1221
Added:
[
1222
Added:
void "input"
1176
1223
[
1177
Removed:
feedback_level_buttons "sleep" "Sleep";
1178
Removed:
feedback_level_buttons "appetite" "Appetite";
1179
Removed:
feedback_level_buttons "readiness" "Readiness";
1180
Removed:
feedback_level_buttons "motivation" "Motivation";
1181
Removed:
feedback_level_buttons "difficulty" "Perceived difficulty";
1224
Added:
type_ "hidden";
1225
Added:
name "step";
1226
Added:
Dream_html.string_attr "value" "%s" (string_of_int step);
1227
Added:
];
1228
Added:
void "input"
1229
Added:
[
1230
Added:
type_ "hidden";
1231
Added:
name "action";
1232
Added:
Dream_html.string_attr "value" "";
1233
Added:
Dream_html.attr "data-hito-feedback-action-value";
1234
Added:
];
1235
Added:
Dream_html.csrf_tag request;
1236
Added:
]
1237
Added:
in
1238
Added:
let body =
1239
Added:
if step < 5 then
1240
Added:
let field, label = List.nth feedback_factors step in
1241
Added:
fields
1242
Added:
@ [
1243
Added:
tag "h3" [] [ txt "%s" label ];
1244
Added:
feedback_level_buttons field label;
1245
Added:
feedback_progress (step + 1);
1182
1246
tag "div"
1247
Added:
[ class_ "feedback-actions" ]
1248
Added:
[
1249
Added:
feedback_action_button ~action:"next" ~label:"Next" ();
1250
Added:
feedback_action_button ~action:"skip" ~label:"Skip this factor"
1251
Added:
~secondary:true ();
1252
Added:
];
1253
Added:
]
1254
Added:
else
1255
Added:
fields
1256
Added:
@ [
1257
Added:
tag "h3" [] [ txt "Anything else?" ];
1258
Added:
tag "p" []
1259
Added:
[ txt "Add an optional note about pain, injury, or preparation." ];
1260
Added:
tag "div"
1183
1261
[ class_ "field" ]
1184
1262
[
1185
1263
feedback_flag "pain" "Pain";
1186
1264
feedback_flag "injury" "Injury";
1187
1265
feedback_flag "preparation" "Preparation was insufficient";
1188
1266
];
1189
Removed:
void "input" [ type_ "submit"; value "Record feedback" ];
1267
Added:
feedback_progress 5;
1268
Added:
tag "div"
1269
Added:
[ class_ "feedback-actions" ]
1270
Added:
[
1271
Added:
feedback_action_button ~action:"save" ~label:"Record feedback" ();
1272
Added:
feedback_action_button ~action:"skip" ~label:"Skip this step"
1273
Added:
~secondary:true ();
1274
Added:
];
1275
Added:
]
1276
Added:
in
1277
Added:
tag "form"
1278
Added:
[
1279
Added:
action Routes.feedback;
1280
Added:
post_form;
1281
Added:
class_ "feedback-form";
1282
Added:
Dream_html.attr "data-hito-app-form";
1283
Added:
]
1284
Added:
[ tag "fieldset" [] body ]
1285
Added:
1286
Added:
let feedback_modal request ~flow ~open_ =
1287
Added:
tag "dialog"
1288
Added:
([ class_ "feedback-modal"; Dream_html.attr "data-hito-feedback-modal" ]
1289
Added:
@ if open_ then [ Dream_html.attr "open" ] else [])
1290
Added:
[
1291
Added:
tag "div"
1292
Added:
[ class_ "feedback-modal-content" ]
1293
Added:
[
1294
Added:
tag "div"
1295
Added:
[ class_ "feedback-modal-heading" ]
1296
Added:
[
1297
Added:
tag "h2" [] [ txt "How are you feeling?" ];
1298
Added:
tag "button"
1299
Added:
[
1300
Added:
type_ "button";
1301
Added:
class_ "feedback-modal-close";
1302
Added:
Dream_html.attr "data-hito-feedback-dismiss";
1303
Added:
Dream_html.string_attr "aria-label" "Close feedback";
1304
Added:
]
1305
Added:
[ txt "×" ];
1306
Added:
];
1307
Added:
feedback_flow_form request flow;
1308
Added:
feedback_cancel_form request;
1190
1309
];
1191
1310
]
1192
1311
@@ -1224,7 +1343,11 @@
1224
1343
]
1225
1344
1226
1345
let logbook request ?(logging = false) ~trainee ?(feedback = [])
1227
Removed:
?(suggest_feedback = false) records =
1346
Added:
?(suggest_feedback = false) ?feedback_flow ?(feedback_open = false) records
1347
Added:
=
1348
Added:
let feedback_flow =
1349
Added:
Option.value feedback_flow ~default:{ step = 0; answers = [] }
1350
Added:
in
1228
1351
html_page ~trainee ~request ~active:"logbook" ~logging "Logbook"
1229
1352
[
1230
1353
tag "h1" [] [ txt "Logbook" ];
@@ -1264,25 +1387,19 @@
1264
1387
[ class_ "eyebrow" ]
1265
1388
[ txt "Workout saved — add feedback while it is fresh." ]
1266
1389
else txt "");
1267
Removed:
(* The form is gated behind a dedicated disclosure button rather than
1268
Removed:
shown outright. A native [details] needs no script and stays
1269
Removed:
accessible without JavaScript. After a workout the suggestion opens
1270
Removed:
it so the prompt is not buried; otherwise it stays collapsed. *)
1271
Removed:
tag "details"
1272
Removed:
([ class_ "feedback-disclosure" ]
1273
Removed:
@ if suggest_feedback then [ Dream_html.attr "open" ] else [])
1390
Added:
tag "p" []
1274
1391
[
1275
Removed:
tag "summary"
1276
Removed:
[ class_ "feedback-toggle" ]
1277
Removed:
[ txt "Record feedback" ];
1278
Removed:
tag "p" []
1279
Removed:
[
1280
Removed:
txt
1281
Removed:
"Record subjective feedback at any time. Report only what \
1282
Removed:
you mean to; leave the rest blank.";
1283
Removed:
];
1284
Removed:
feedback_form request;
1392
Added:
txt
1393
Added:
"Report each factor in turn. Skip any factor or the full flow.";
1285
1394
];
1395
Added:
tag "a"
1396
Added:
[
1397
Added:
class_ "feedback-toggle";
1398
Added:
Dream_html.string_attr "href" "/logbook?feedback=start";
1399
Added:
Dream_html.attr "data-hito-feedback-open";
1400
Added:
]
1401
Added:
[ txt "Record feedback" ];
1402
Added:
feedback_modal request ~flow:feedback_flow ~open_:feedback_open;
1286
1403
]
1287
1404
@ feedback_list feedback);
1288
1405
]
lib/web/pages.mli
@@ -59,17 +59,21 @@
59
59
(** The slot a workout view opens on: the first slot still awaiting a record, or
60
60
the first slot when every slot is filled. *)
61
61
62
Added:
type feedback_flow = { step : int; answers : (string * string) list }
63
Added:
62
64
val logbook :
63
65
Dream.request ->
64
66
?logging:bool ->
65
67
trainee:Trainee.t ->
66
68
?feedback:Evidence.Feedback.t list ->
67
69
?suggest_feedback:bool ->
70
Added:
?feedback_flow:feedback_flow ->
71
Added:
?feedback_open:bool ->
68
72
Repository.record list ->
69
73
page
70
Removed:
(** The logbook: recorded workouts and a standalone subjective feedback form.
71
Removed:
[feedback] lists past reports, most recent first. [suggest_feedback] shows a
72
Removed:
prompt inviting feedback, set after a workout finishes. *)
74
Added:
(** The logbook: recorded workouts and a modal sequential subjective feedback
75
Added:
flow. [feedback] lists past reports, most recent first. [suggest_feedback]
76
Added:
shows a prompt inviting feedback, set after a workout finishes. *)
73
77
74
78
val profile :
75
79
Dream.request ->
lib/web/routes.ml
@@ -23,6 +23,7 @@
23
23
let%path edit_app_feedback = "/app-feedback/%s/edit"
24
24
let%path remove_app_feedback = "/app-feedback/%s/remove"
25
25
let%path feedback = "/feedback"
26
Added:
let%path cancel_feedback = "/feedback/cancel"
26
27
let%path record = "/logbook/%s"
27
28
let%path record_slot = "/logbook/%s/slots/%d"
28
29
let%path record_slot_edit = "/logbook/%s/slots/%d/edit"
lib/web/workout_client.ml
@@ -102,6 +102,26 @@
102
102
in
103
103
timer_interval := Some id
104
104
105
Added:
let feedback_modal () = query_one document "[data-hito-feedback-modal]"
106
Added:
107
Added:
let open_feedback_modal () =
108
Added:
match feedback_modal () with
109
Added:
| None -> ()
110
Added:
| Some modal ->
111
Added:
modal##removeAttribute (Js.string "open");
112
Added:
ignore (Js.Unsafe.meth_call modal "showModal" [||])
113
Added:
114
Added:
let close_feedback_modal () =
115
Added:
match feedback_modal () with
116
Added:
| None -> ()
117
Added:
| Some modal -> ignore (Js.Unsafe.meth_call modal "close" [||])
118
Added:
119
Added:
let open_marked_feedback_modal () =
120
Added:
match feedback_modal () with
121
Added:
| Some modal when Js.to_bool (modal##hasAttribute (Js.string "open")) ->
122
Added:
open_feedback_modal ()
123
Added:
| _ -> ()
124
Added:
105
125
let replace selector html =
106
126
let next = Dom_html.createDiv document in
107
127
next##.innerHTML := Js.string html;
@@ -126,6 +146,7 @@
126
146
the swap lands, because the fresh status node starts empty. *)
127
147
start_timer ();
128
148
dismiss_toast ();
149
Added:
open_marked_feedback_modal ();
129
150
true
130
151
| _ -> false
131
152
@@ -313,6 +334,42 @@
313
334
| None -> Js._false)
314
335
| None -> Js._true))
315
336
337
Added:
(* The feedback flow uses the same native dialog behavior as workout
338
Added:
cancellation. The trigger remains a normal link, so no-script clients open
339
Added:
the server-rendered modal page instead. *)
340
Added:
let feedback_click event =
341
Added:
let target = Dom_html.eventTarget event in
342
Added:
match closest "[data-hito-feedback-open]" target with
343
Added:
| Some _ ->
344
Added:
Dom.preventDefault event;
345
Added:
open_feedback_modal ();
346
Added:
Js._false
347
Added:
| None -> (
348
Added:
match closest "[data-hito-feedback-dismiss]" target with
349
Added:
| Some _ ->
350
Added:
Dom.preventDefault event;
351
Added:
close_feedback_modal ();
352
Added:
Js._false
353
Added:
| None -> (
354
Added:
match closest "[data-hito-feedback-action]" target with
355
Added:
| None -> Js._true
356
Added:
| Some action -> (
357
Added:
match closest "form" action with
358
Added:
| None -> Js._true
359
Added:
| Some form -> (
360
Added:
match
361
Added:
Js.Opt.to_option (action##getAttribute (Js.string "value"))
362
Added:
with
363
Added:
| None -> Js._true
364
Added:
| Some value -> (
365
Added:
match
366
Added:
query_one form "[data-hito-feedback-action-value]"
367
Added:
with
368
Added:
| None -> Js._true
369
Added:
| Some hidden ->
370
Added:
hidden##setAttribute (Js.string "value") value;
371
Added:
Js._true)))))
372
Added:
316
373
(* The exercise dropdown navigates the moment its selection changes. It lives in
317
374
a GET form ([data-hito-exercise-form]) that submits to the workout path; the
318
375
client turns a change into a workout-scoped content swap to [?slot=N], so no
@@ -344,6 +401,10 @@
344
401
|> ignore;
345
402
Dom_html.addEventListener document Dom_html.Event.submit
346
403
(Dom_html.handler form_submit)
404
Added:
Js._false
405
Added:
|> ignore;
406
Added:
Dom_html.addEventListener document Dom_html.Event.click
407
Added:
(Dom_html.handler feedback_click)
347
408
Js._false
348
409
|> ignore;
349
410
Dom_html.addEventListener document Dom_html.Event.change
test/test_web.ml
@@ -946,7 +946,7 @@
946
946
Alcotest.(check bool)
947
947
"shows bottom navigation" true
948
948
(contains ~substring:"bottom-nav" record_page) );
949
Removed:
( "the logbook gates the feedback form behind a disclosure button",
949
Added:
( "the logbook opens sequential feedback in a modal",
950
950
`Quick,
951
951
fun () ->
952
952
let c = client () in
@@ -956,36 +956,162 @@
956
956
"still renders the feedback form" true
957
957
(contains ~substring:"feedback-form" logbook_page);
958
958
Alcotest.(check bool)
959
Removed:
"posts feedback to its own route" true
960
Removed:
(contains ~substring:"action=\"/feedback\"" logbook_page);
961
Removed:
(* The form is not shown outright: it is wrapped in a native
962
Removed:
disclosure whose summary is the dedicated reveal button, and the
963
Removed:
disclosure is collapsed (no [open]) on a plain logbook visit. *)
959
Added:
"offers a feedback modal trigger" true
960
Added:
(contains ~substring:"data-hito-feedback-open" logbook_page
961
Added:
&& contains ~substring:"Record feedback" logbook_page);
964
962
Alcotest.(check bool)
965
Removed:
"wraps the form in a disclosure" true
966
Removed:
(contains ~substring:"feedback-disclosure" logbook_page);
963
Added:
"renders a native feedback modal" true
964
Added:
(contains ~substring:"data-hito-feedback-modal" logbook_page);
967
965
Alcotest.(check bool)
968
Removed:
"offers a dedicated reveal button" true
969
Removed:
(contains ~substring:"class=\"feedback-toggle\"" logbook_page
970
Removed:
&& contains ~substring:"<summary" logbook_page);
971
Removed:
Alcotest.(check bool)
972
Removed:
"renders inline subjective button groups" true
973
Removed:
(contains ~substring:"feedback-buttons" logbook_page
966
Added:
"renders only the first factor initially" true
967
Added:
(contains ~substring:">Sleep</h3>" logbook_page
974
968
&& contains ~substring:">Worse</span>" logbook_page
975
Removed:
&& contains ~substring:">Same</span>" logbook_page
976
Removed:
&& contains ~substring:">Better</span>" logbook_page);
969
Added:
&& not (contains ~substring:">Appetite</h3>" logbook_page));
977
970
Alcotest.(check bool)
971
Added:
"renders a progress bar and factor skip" true
972
Added:
(contains ~substring:"<progress" logbook_page
973
Added:
&& contains ~substring:"1 of 5 factors" logbook_page
974
Added:
&& contains ~substring:"Skip this factor" logbook_page
975
Added:
&& contains ~substring:"Skip all feedback" logbook_page);
976
Added:
Alcotest.(check bool)
978
977
"does not render subjective selects" false
979
978
(contains ~substring:"<select" logbook_page) );
979
Added:
( "sequential feedback preserves answers and skips factors",
980
Added:
`Quick,
981
Added:
fun () ->
982
Added:
let c = client () in
983
Added:
let _ = sign_in_new c in
984
Added:
let start = body (get c "/logbook?feedback=start") in
985
Added:
Alcotest.(check bool)
986
Added:
"start opens the modal" true
987
Added:
(contains ~substring:"feedback-modal" start
988
Added:
&& contains ~substring:">Sleep</h3>" start);
989
Added:
let token = Option.get (csrf_token start) in
990
Added:
let next =
991
Added:
post c "/feedback"
992
Added:
[
993
Added:
("dream.csrf", token);
994
Added:
("step", "0");
995
Added:
("action", "next");
996
Added:
("choice", "below");
997
Added:
]
998
Added:
in
999
Added:
Alcotest.(check int) "first factor redirects" 303 (status next);
1000
Added:
let appetite = body (get c "/logbook") in
1001
Added:
Alcotest.(check bool)
1002
Added:
"moves to appetite with progress" true
1003
Added:
(contains ~substring:">Appetite</h3>" appetite
1004
Added:
&& contains ~substring:"2 of 5 factors" appetite);
1005
Added:
let token = Option.get (csrf_token appetite) in
1006
Added:
let skipped =
1007
Added:
post c "/feedback"
1008
Added:
[ ("dream.csrf", token); ("step", "1"); ("action", "skip") ]
1009
Added:
in
1010
Added:
Alcotest.(check int) "factor skip redirects" 303 (status skipped);
1011
Added:
let readiness = body (get c "/logbook") in
1012
Added:
Alcotest.(check bool)
1013
Added:
"skipping moves to the next factor" true
1014
Added:
(contains ~substring:">Readiness</h3>" readiness
1015
Added:
&& contains ~substring:"3 of 5 factors" readiness);
1016
Added:
let token = Option.get (csrf_token readiness) in
1017
Added:
ignore
1018
Added:
(post c "/feedback"
1019
Added:
[
1020
Added:
("dream.csrf", token);
1021
Added:
("step", "2");
1022
Added:
("action", "next");
1023
Added:
("choice", "usual");
1024
Added:
]);
1025
Added:
let motivation = body (get c "/logbook") in
1026
Added:
let token = Option.get (csrf_token motivation) in
1027
Added:
ignore
1028
Added:
(post c "/feedback"
1029
Added:
[
1030
Added:
("dream.csrf", token);
1031
Added:
("step", "3");
1032
Added:
("action", "next");
1033
Added:
("choice", "above");
1034
Added:
]);
1035
Added:
let difficulty = body (get c "/logbook") in
1036
Added:
let token = Option.get (csrf_token difficulty) in
1037
Added:
let notes =
1038
Added:
post c "/feedback"
1039
Added:
[ ("dream.csrf", token); ("step", "4"); ("action", "skip") ]
1040
Added:
in
1041
Added:
Alcotest.(check int) "last factor skip redirects" 303 (status notes);
1042
Added:
let notes_page = body (get c "/logbook") in
1043
Added:
Alcotest.(check bool)
1044
Added:
"shows optional observations after factors" true
1045
Added:
(contains ~substring:">Anything else?</h3>" notes_page
1046
Added:
&& contains ~substring:"5 of 5 factors" notes_page);
1047
Added:
let token = Option.get (csrf_token notes_page) in
1048
Added:
let saved =
1049
Added:
post c "/feedback"
1050
Added:
[
1051
Added:
("dream.csrf", token);
1052
Added:
("step", "5");
1053
Added:
("action", "save");
1054
Added:
("pain", "true");
1055
Added:
]
1056
Added:
in
1057
Added:
Alcotest.(check int) "final feedback redirects" 303 (status saved);
1058
Added:
let logbook_page = body (get c "/logbook") in
1059
Added:
Alcotest.(check bool)
1060
Added:
"stores answered factors and final observations" true
1061
Added:
(contains ~substring:"Sleep below usual" logbook_page
1062
Added:
&& contains ~substring:"Readiness usual" logbook_page
1063
Added:
&& contains ~substring:"Motivation above usual" logbook_page
1064
Added:
&& contains ~substring:"Pain" logbook_page);
1065
Added:
Alcotest.(check bool)
1066
Added:
"does not store skipped factors" true
1067
Added:
((not (contains ~substring:"Appetite" logbook_page))
1068
Added:
&& not (contains ~substring:"Difficulty" logbook_page)) );
1069
Added:
( "skipping the entire feedback flow records nothing",
1070
Added:
`Quick,
1071
Added:
fun () ->
1072
Added:
let c = client () in
1073
Added:
let _ = sign_in_new c in
1074
Added:
let start = body (get c "/logbook?feedback=start") in
1075
Added:
let token = Option.get (csrf_token start) in
1076
Added:
let skipped = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
1077
Added:
Alcotest.(check int) "full-flow skip redirects" 303 (status skipped);
1078
Added:
let logbook_page = body (get c "/logbook") in
1079
Added:
Alcotest.(check bool)
1080
Added:
"shows the skip notice" true
1081
Added:
(contains ~substring:"Feedback skipped." logbook_page);
1082
Added:
Alcotest.(check bool)
1083
Added:
"does not add an empty report" false
1084
Added:
(contains ~substring:"No signals" logbook_page) );
980
1085
( "submitting feedback stores it and it appears on the logbook",
981
1086
`Quick,
982
1087
fun () ->
983
1088
let c = client () in
984
1089
let _ = sign_in_new c in
985
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
1090
Added:
let start = body (get c "/logbook?feedback=start") in
1091
Added:
let rec advance step page =
1092
Added:
if step = 5 then page
1093
Added:
else
1094
Added:
let token = Option.get (csrf_token page) in
1095
Added:
ignore
1096
Added:
(post c "/feedback"
1097
Added:
[
1098
Added:
("dream.csrf", token);
1099
Added:
("step", string_of_int step);
1100
Added:
("action", "next");
1101
Added:
("choice", if step = 0 then "below" else "skip");
1102
Added:
]);
1103
Added:
advance (step + 1) (body (get c "/logbook"))
1104
Added:
in
1105
Added:
let notes = advance 0 start in
1106
Added:
let token = Option.get (csrf_token notes) in
986
1107
let stored =
987
1108
post c "/feedback"
988
Removed:
[ ("dream.csrf", token); ("sleep", "below"); ("pain", "true") ]
1109
Added:
[
1110
Added:
("dream.csrf", token);
1111
Added:
("step", "5");
1112
Added:
("action", "save");
1113
Added:
("pain", "true");
1114
Added:
]
989
1115
in
990
1116
Alcotest.(check int) "feedback stored" 303 (status stored);
991
1117
let logbook_page = body (get c "/logbook") in
@@ -1020,9 +1146,9 @@
1020
1146
(* The gated form opens on a suggestion, so the prompt lands on a
1021
1147
visible form rather than a collapsed disclosure. *)
1022
1148
Alcotest.(check bool)
1023
Removed:
"opens the feedback disclosure on a suggestion" true
1024
Removed:
(contains ~substring:"<details class=\"feedback-disclosure\" open"
1025
Removed:
prompted) );
1149
Added:
"opens the feedback modal on a suggestion" true
1150
Added:
(contains ~substring:"data-hito-feedback-modal" prompted
1151
Added:
&& contains ~substring:" open" prompted) );
1026
1152
( "beginning under override is gated behind a confirmation modal",
1027
1153
`Quick,
1028
1154
fun () ->