[OCaml] High Intensity Training Online
feat Show every feedback factor on one modal screen
The feedback modal walked the trainee through one factor per step, with Back, Skip, a progress bar, an auto-advancing radio click, a session record of the partial flow, and a cancel route to discard it. Replace all of that with one form: every factor visible, each an optional three-way choice with nothing preselected, one Submit at the bottom. A factor left untouched is absent from the post, so a partial report needs no Skip. Nothing is stored before Submit, so Close is a plain link back to the logbook and the cancel route and session flow state go. An empty submission is refused with a message rather than stored as an empty report. A value outside the three choices is treated as unselected, so it cannot reach the domain. The client keeps only open and dismiss for the dialog; the form submits through the shared app-form path. Dead step-flow CSS is removed. Six step-flow tests become five single-screen tests, one of which asserts the rendered form directly: two radio groups of three, no checked input, no step field, one submit, no cancel route.
Changed files
ARCHITECTURE.org
@@ -269,10 +269,13 @@
269
269
measurement gradations, and =Worse_than_usual= is the concerning direction for
270
270
both. HD1 gauges recovery by time and by effect, so no wider battery of wellness
271
271
proxies is modeled. The application stores reports independently of workouts,
272
Removed:
and the web tier records them through a sequential optional flow. The flow keeps
273
Removed:
its partial answers: Back and Skip preserve them, Close cancels the flow, and a
274
Removed:
report may be saved as a partial list. The logbook draws a small inline-SVG time
275
Removed:
graph of the readings, one line per factor, once two reports carry a factor.
272
Added:
and the web tier records them from one modal form: every factor shown at once,
273
Added:
each an optional three-way choice with nothing preselected, one Submit. A
274
Added:
factor left untouched is absent from the post, so a partial report needs no
275
Added:
Skip, and nothing is stored before Submit, so Close is a plain link with no
276
Added:
state to discard. An empty submission is refused with a message rather than
277
Added:
stored as an empty report. The logbook draws a small inline-SVG time graph of
278
Added:
the readings, one line per factor, once two reports carry a factor.
276
279
277
280
** Progress — the judgment
278
281
@@ -463,8 +466,7 @@
463
466
| =/logbook/:id= | GET | A saved workout |
464
467
| =/logbook/:id/slots/:slot= | POST | Add a missing record |
465
468
| =/logbook/:id/slots/:slot/edit= | POST | Correct a saved slot |
466
Removed:
| =/feedback= | POST | Advance or save subjective feedback |
467
Removed:
| =/feedback/cancel= | POST | Discard the current feedback flow |
469
Added:
| =/feedback= | POST | Save a subjective feedback report |
468
470
| =/app-feedback= | GET | Write or review application feedback |
469
471
| =/app-feedback/submit= | POST | Submit application feedback |
470
472
| =/app-feedback/:id/upvote= | POST | Upvote another trainee's feedback |
@@ -523,7 +525,7 @@
523
525
| =data-hito-toast= | a transient notice the client dismisses |
524
526
| =data-hito-dialog-open= | a button that opens the modal with that id |
525
527
| =data-hito-confirm-*= | the confirm-modal parts: form, accept, dismiss |
526
Removed:
| =data-hito-feedback-*= | the sequential feedback modal and its actions |
528
Added:
| =data-hito-feedback-*= | open and dismiss the feedback modal in place |
527
529
| =data-hito-exercise-*= | the slot selector that navigates on change |
528
530
529
531
Behaviour: the client fetches the same URL the link or form would have
lib/presenter/pages.ml
@@ -13,12 +13,6 @@
13
13
let workout_in_progress = Pages_routine.workout_in_progress
14
14
let routine = Pages_routine.routine
15
15
let workout = Pages_workout.workout
16
Removed:
17
Removed:
type feedback_flow = Pages_logbook.feedback_flow = {
18
Removed:
step : int;
19
Removed:
answers : (string * string) list;
20
Removed:
}
21
Removed:
22
16
let feedback_factors = Pages_logbook.feedback_factors
23
17
let logbook = Pages_logbook.logbook
24
18
let app_feedback = Pages_app_feedback.app_feedback
lib/presenter/pages.mli
@@ -48,10 +48,9 @@
48
48
action. It defaults to a live workout view (true when [record_id] is
49
49
[None]). *)
50
50
51
Removed:
type feedback_flow = { step : int; answers : (string * string) list }
52
Removed:
53
51
val feedback_factors : (string * string) list
54
Removed:
(** Ordered factor codes and labels used by the sequential feedback flow. *)
52
Added:
(** Ordered factor codes and labels. Each is a radio group in the feedback form
53
Added:
and a series in the feedback graph. *)
55
54
56
55
val logbook :
57
56
Dream.request ->
@@ -59,13 +58,14 @@
59
58
viewer:View_model.Viewer.t ->
60
59
?feedback:View_model.Feedback.report list ->
61
60
?suggest_feedback:bool ->
62
Removed:
?feedback_flow:feedback_flow ->
63
61
?feedback_open:bool ->
64
62
View_model.Logbook_entry.t list ->
65
63
page
66
Removed:
(** The logbook: recorded workouts and a modal sequential subjective feedback
67
Removed:
flow. [feedback] lists past reports, most recent first. [suggest_feedback]
68
Removed:
shows a prompt inviting feedback, set after a workout finishes. *)
64
Added:
(** The logbook: recorded workouts and a modal subjective feedback form that
65
Added:
shows every factor at once, each optionally rated against the trainee's
66
Added:
usual, with one submit. [feedback] lists past reports, most recent first.
67
Added:
[suggest_feedback] shows a prompt inviting feedback, set after a workout
68
Added:
finishes. [feedback_open] renders the modal open for no-script clients. *)
69
69
70
70
val profile :
71
71
Dream.request ->
lib/presenter/pages_logbook.ml
@@ -3,28 +3,24 @@
3
3
open Page_shell
4
4
5
5
(* HD1-grounded self-reports, each relative to the trainee's usual baseline. *)
6
Removed:
type feedback_flow = { step : int; answers : (string * string) list }
7
Removed:
8
6
let feedback_factors =
9
7
[ ("motivation", "Motivation"); ("difficulty", "Perceived difficulty") ]
10
8
11
Removed:
(* Each subjective metric uses five unselected radio buttons styled as inline
12
Removed:
buttons. The server shows one metric at a time. *)
13
Removed:
let feedback_level_buttons field label ~selected =
9
Added:
(* One factor: three radio buttons styled as inline buttons, none preselected.
10
Added:
The group is named by its factor, so leaving it untouched reports nothing for
11
Added:
that factor. *)
12
Added:
let feedback_level_buttons field label =
14
13
let choice code text =
15
14
tag "label"
16
Removed:
[ class_ "feedback-choice"; Dream_html.attr "data-hito-feedback-choice" ]
15
Added:
[ class_ "feedback-choice" ]
17
16
[
18
17
void "input"
19
Removed:
([
20
Removed:
type_ "radio";
21
Removed:
Dream_html.string_attr "name" "choice";
22
Removed:
Dream_html.string_attr "value" "%s" code;
23
Removed:
Dream_html.string_attr "id" "%s-%s" field code;
24
Removed:
]
25
Removed:
@
26
Removed:
if String.equal code selected then [ Dream_html.attr "checked" ]
27
Removed:
else []);
18
Added:
[
19
Added:
type_ "radio";
20
Added:
Dream_html.string_attr "name" "%s" field;
21
Added:
Dream_html.string_attr "value" "%s" code;
22
Added:
Dream_html.string_attr "id" "%s-%s" field code;
23
Added:
];
28
24
tag "span" [] [ txt "%s" text ];
29
25
]
30
26
in
@@ -45,96 +41,9 @@
45
41
];
46
42
]
47
43
48
Removed:
let feedback_progress step =
49
Removed:
let total = List.length feedback_factors in
50
Removed:
let completed = min total (max 0 step) in
51
Removed:
tag "div"
52
Removed:
[ class_ "feedback-progress" ]
53
Removed:
[
54
Removed:
tag "progress"
55
Removed:
[
56
Removed:
Dream_html.string_attr "value" "%s" (string_of_int completed);
57
Removed:
Dream_html.string_attr "max" "%d" total;
58
Removed:
Dream_html.string_attr "aria-label" "Feedback progress";
59
Removed:
]
60
Removed:
[ txt "%d of %d factors" completed total ];
61
Removed:
tag "p"
62
Removed:
[ class_ "ledger-meta" ]
63
Removed:
[ txt "%d of %d factors" completed total ];
64
Removed:
]
65
Removed:
66
Removed:
let feedback_action_button ~action ~label ?(secondary = false) () =
67
Removed:
tag "button"
68
Removed:
([
69
Removed:
type_ "submit";
70
Removed:
name "action";
71
Removed:
value action;
72
Removed:
Dream_html.attr "data-hito-feedback-action";
73
Removed:
]
74
Removed:
@ if secondary then [ class_ "secondary" ] else [])
75
Removed:
[ txt "%s" label ]
76
Removed:
77
Removed:
let feedback_flow_form request flow =
78
Removed:
let total = List.length feedback_factors in
79
Removed:
let step = min total (max 0 flow.step) in
80
Removed:
let fields =
81
Removed:
[
82
Removed:
void "input"
83
Removed:
[
84
Removed:
type_ "hidden";
85
Removed:
name "step";
86
Removed:
Dream_html.string_attr "value" "%s" (string_of_int step);
87
Removed:
];
88
Removed:
void "input"
89
Removed:
[
90
Removed:
type_ "hidden";
91
Removed:
name "action";
92
Removed:
Dream_html.string_attr "value" "";
93
Removed:
Dream_html.attr "data-hito-feedback-action-value";
94
Removed:
];
95
Removed:
Dream_html.csrf_tag request;
96
Removed:
]
97
Removed:
in
98
Removed:
let body =
99
Removed:
if step < total then
100
Removed:
let field, label = List.nth feedback_factors step in
101
Removed:
fields
102
Removed:
@ [
103
Removed:
tag "h3" [] [ txt "%s" label ];
104
Removed:
feedback_level_buttons field label
105
Removed:
~selected:
106
Removed:
(Option.value (List.assoc_opt field flow.answers) ~default:"");
107
Removed:
feedback_progress (step + 1);
108
Removed:
tag "div"
109
Removed:
[ class_ "feedback-actions" ]
110
Removed:
((if step > 0 then
111
Removed:
let _, previous_label = List.nth feedback_factors (step - 1) in
112
Removed:
[
113
Removed:
feedback_action_button ~action:"back"
114
Removed:
~label:(Printf.sprintf "Back to %s" previous_label)
115
Removed:
~secondary:true ();
116
Removed:
]
117
Removed:
else [])
118
Removed:
@ [
119
Removed:
feedback_action_button ~action:"skip" ~label:"Skip this factor"
120
Removed:
~secondary:true ();
121
Removed:
]);
122
Removed:
]
123
Removed:
else
124
Removed:
fields
125
Removed:
@ [
126
Removed:
tag "h3" [] [ txt "Ready to save" ];
127
Removed:
tag "p" [] [ txt "Submit the feedback you chose to report." ];
128
Removed:
feedback_progress total;
129
Removed:
tag "div"
130
Removed:
[ class_ "feedback-actions" ]
131
Removed:
[
132
Removed:
feedback_action_button ~action:"back"
133
Removed:
~label:"Back to Perceived difficulty" ~secondary:true ();
134
Removed:
feedback_action_button ~action:"save" ~label:"Submit feedback" ();
135
Removed:
];
136
Removed:
]
137
Removed:
in
44
Added:
(* Every factor on one screen, one submit. A factor left unselected is simply
45
Added:
absent from the post, so a partial report needs no Skip. *)
46
Added:
let feedback_form request =
138
47
tag "form"
139
48
[
140
49
action Routes.feedback;
@@ -143,9 +52,20 @@
143
52
Dream_html.attr "data-hito-feedback-form";
144
53
Dream_html.attr "data-hito-app-form";
145
54
]
146
Removed:
[ tag "fieldset" [] body ]
55
Added:
[
56
Added:
tag "fieldset" []
57
Added:
([ Dream_html.csrf_tag request ]
58
Added:
@ List.map
59
Added:
(fun (field, label) -> feedback_level_buttons field label)
60
Added:
feedback_factors
61
Added:
@ [
62
Added:
tag "div"
63
Added:
[ class_ "feedback-actions" ]
64
Added:
[ tag "button" [ type_ "submit" ] [ txt "Submit feedback" ] ];
65
Added:
]);
66
Added:
]
147
67
148
Removed:
let feedback_modal request ~flow ~open_ =
68
Added:
let feedback_modal request ~open_ =
149
69
tag "dialog"
150
70
([ class_ "feedback-modal"; Dream_html.attr "data-hito-feedback-modal" ]
151
71
@ if open_ then [ Dream_html.attr "open" ] else [])
@@ -157,27 +77,19 @@
157
77
[ class_ "feedback-modal-heading" ]
158
78
[
159
79
tag "h2" [] [ txt "How are you feeling?" ];
160
Removed:
(* Close cancels the flow: it submits the cancel form, so the
161
Removed:
partial progress is discarded rather than kept for later. *)
162
Removed:
tag "form"
80
Added:
(* Close is a plain link back to the logbook. Nothing is stored
81
Added:
until Submit, so there is no flow state to discard. With
82
Added:
script, the client closes the dialog in place instead. *)
83
Added:
tag "a"
163
84
[
164
Removed:
action Routes.cancel_feedback;
165
Removed:
post_form;
166
Removed:
class_ "feedback-close-form";
167
Removed:
Dream_html.attr "data-hito-app-form";
85
Added:
href Routes.logbook;
86
Added:
class_ "feedback-modal-close";
87
Added:
Dream_html.string_attr "aria-label" "Close feedback";
88
Added:
Dream_html.attr "data-hito-feedback-dismiss";
168
89
]
169
Removed:
[
170
Removed:
Dream_html.csrf_tag request;
171
Removed:
tag "button"
172
Removed:
[
173
Removed:
type_ "submit";
174
Removed:
class_ "feedback-modal-close";
175
Removed:
Dream_html.string_attr "aria-label" "Close feedback";
176
Removed:
]
177
Removed:
[ txt "×" ];
178
Removed:
];
90
Added:
[ txt "×" ];
179
91
];
180
Removed:
feedback_flow_form request flow;
92
Added:
feedback_form request;
181
93
];
182
94
]
183
95
@@ -297,11 +209,7 @@
297
209
]
298
210
299
211
let logbook request ?(logging = false) ~viewer ?(feedback = [])
300
Removed:
?(suggest_feedback = false) ?feedback_flow ?(feedback_open = false) records
301
Removed:
=
302
Removed:
let feedback_flow =
303
Removed:
Option.value feedback_flow ~default:{ step = 0; answers = [] }
304
Removed:
in
212
Added:
?(suggest_feedback = false) ?(feedback_open = false) records =
305
213
html_page ~viewer ~request ~active:"logbook" ~logging "Logbook"
306
214
[
307
215
tag "h1" [] [ txt "Logbook" ];
@@ -379,7 +287,8 @@
379
287
tag "p" []
380
288
[
381
289
txt
382
Removed:
"Report each factor in turn. Skip any factor or the full flow.";
290
Added:
"Rate any factor against your usual. Leave the rest \
291
Added:
unselected.";
383
292
];
384
293
tag "a"
385
294
[
@@ -388,7 +297,7 @@
388
297
Dream_html.attr "data-hito-feedback-open";
389
298
]
390
299
[ txt "Record feedback" ];
391
Removed:
feedback_modal request ~flow:feedback_flow ~open_:feedback_open;
300
Added:
feedback_modal request ~open_:feedback_open;
392
301
]
393
302
@ feedback_graph feedback @ feedback_list feedback);
394
303
]
lib/presenter/routes.ml
@@ -31,7 +31,6 @@
31
31
let%path edit_app_feedback = "/app-feedback/%s/edit"
32
32
let%path remove_app_feedback = "/app-feedback/%s/remove"
33
33
let%path feedback = "/feedback"
34
Removed:
let%path cancel_feedback = "/feedback/cancel"
35
34
let%path record = "/logbook/%s"
36
35
let%path record_slot = "/logbook/%s/slots/%d"
37
36
let%path record_slot_edit = "/logbook/%s/slots/%d/edit"
lib/web/assets/hito.css
@@ -765,8 +765,7 @@
765
765
gap: 0.6rem;
766
766
margin-top: 1rem;
767
767
}
768
Removed:
.feedback-actions button,
769
Removed:
.feedback-cancel-form button {
768
Added:
.feedback-actions button {
770
769
flex: 1 1 10rem;
771
770
min-height: 3rem;
772
771
border: 2px solid var(--oxblood-dark);
@@ -778,35 +777,13 @@
778
777
letter-spacing: 0.055em;
779
778
text-transform: uppercase;
780
779
}
781
Removed:
.feedback-actions button:hover,
782
Removed:
.feedback-cancel-form button:hover {
780
Added:
.feedback-actions button:hover {
783
781
background: var(--oxblood-dark);
784
782
}
785
Removed:
.feedback-actions button.secondary,
786
Removed:
.feedback-cancel-form button.secondary {
787
Removed:
color: var(--brass);
788
Removed:
background: transparent;
789
Removed:
border-color: var(--brass);
790
Removed:
}
791
Removed:
.feedback-actions button.secondary:hover,
792
Removed:
.feedback-cancel-form button.secondary:hover {
793
Removed:
color: var(--paper-raised);
794
Removed:
background: var(--brass);
795
Removed:
}
796
Removed:
.feedback-progress { margin-top: 1rem; }
797
Removed:
.feedback-progress progress {
798
Removed:
display: block;
799
Removed:
width: 100%;
800
Removed:
height: 0.8rem;
801
Removed:
accent-color: var(--oxblood);
802
Removed:
}
803
Removed:
.feedback-progress p { margin: 0.35rem 0 0; }
804
Removed:
.feedback-cancel-form { margin-top: 1rem; }
805
Removed:
.feedback-cancel-form button { width: 100%; }
806
783
807
784
/* The subjective feedback section on the Logbook. A bordered block separating
808
Removed:
the standalone feedback form from the workout list. The flags stack as
809
Removed:
inline checkbox rows; past reports read as a plain list. */
785
Added:
the standalone feedback form from the workout list. Past reports read as a
786
Added:
plain list. */
810
787
.feedback-section {
811
788
margin-top: 2rem;
812
789
border-top: 1px solid var(--rule);
@@ -833,18 +810,6 @@
833
810
}
834
811
.feedback-disclosure[open] .feedback-toggle {
835
812
margin-bottom: 1rem;
836
Removed:
}
837
Removed:
.feedback-flag {
838
Removed:
display: flex;
839
Removed:
align-items: center;
840
Removed:
gap: 0.5rem;
841
Removed:
margin: 0.4rem 0;
842
Removed:
font-weight: 500;
843
Removed:
}
844
Removed:
.feedback-flag input {
845
Removed:
width: auto;
846
Removed:
min-height: 0;
847
Removed:
margin: 0;
848
813
}
849
814
.feedback-list {
850
815
margin-top: 1rem;
lib/web/handlers_kit.ml
@@ -140,6 +140,7 @@
140
140
| Feedback.Difficulty l -> "Difficulty " ^ feedback_level l
141
141
142
142
let app_feedback_empty = "Enter feedback before submitting."
143
Added:
let feedback_empty = "Rate at least one factor before submitting."
143
144
let username_changed = "Username changed."
144
145
let password_changed = "Password changed."
145
146
end
lib/web/handlers_logbook.ml
@@ -9,69 +9,20 @@
9
9
struct
10
10
open Kit
11
11
12
Removed:
let feedback_session_key = "hito.feedback.flow"
13
Removed:
let feedback_factors = List.map fst Pages.feedback_factors
14
Removed:
15
Removed:
let valid_choice = function
16
Removed:
| ("worse" | "usual" | "better") as choice -> Some choice
17
Removed:
| _ -> None
18
Removed:
19
Removed:
let valid_factor field = List.mem field feedback_factors
20
Removed:
21
Removed:
let encode_feedback_flow (flow : Pages.feedback_flow) =
22
Removed:
let answers =
23
Removed:
List.map (fun (field, choice) -> field ^ ":" ^ choice) flow.answers
24
Removed:
in
25
Removed:
Printf.sprintf "%d|%s" flow.step (String.concat ";" answers)
26
Removed:
27
Removed:
let decode_feedback_flow raw =
28
Removed:
match String.split_on_char '|' raw with
29
Removed:
| [ step; answers ] -> (
30
Removed:
match int_of_string_opt step with
31
Removed:
| None -> None
32
Removed:
| Some step when step < 0 || step > List.length feedback_factors -> None
33
Removed:
| Some step ->
34
Removed:
let answers =
35
Removed:
answers |> String.split_on_char ';'
36
Removed:
|> List.filter_map (fun answer ->
37
Removed:
match String.split_on_char ':' answer with
38
Removed:
| [ field; choice ]
39
Removed:
when valid_factor field
40
Removed:
&& Option.is_some (valid_choice choice) ->
41
Removed:
Some (field, choice)
42
Removed:
| _ -> None)
43
Removed:
in
44
Removed:
Some Pages.{ step; answers })
45
Removed:
| _ -> None
46
Removed:
47
Removed:
let feedback_flow request =
48
Removed:
Dream.session_field request feedback_session_key |> fun raw ->
49
Removed:
Option.bind raw decode_feedback_flow
50
Removed:
51
Removed:
let initial_feedback_flow = Pages.{ step = 0; answers = [] }
52
Removed:
53
Removed:
let set_feedback_flow request flow =
54
Removed:
Dream.set_session_field request feedback_session_key
55
Removed:
(encode_feedback_flow flow)
56
Removed:
57
Removed:
let clear_feedback_flow request =
58
Removed:
Dream.drop_session_field request feedback_session_key
59
Removed:
60
12
let field name fields = List.assoc_opt name fields
61
13
62
Removed:
let feedback_signals answers _fields =
14
Added:
(* Each factor is its own radio group. A group left untouched is absent from
15
Added:
the post, and a value outside the three choices is treated the same way, so
16
Added:
a partial report needs no separate Skip. *)
17
Added:
let feedback_signals fields =
63
18
let level = function
64
Removed:
| "worse" -> Feedback.Worse_than_usual
65
Removed:
| "better" -> Feedback.Better_than_usual
66
Removed:
| _ -> Feedback.As_usual
19
Added:
| "worse" -> Some Feedback.Worse_than_usual
20
Added:
| "usual" -> Some Feedback.As_usual
21
Added:
| "better" -> Some Feedback.Better_than_usual
22
Added:
| _ -> None
67
23
in
68
Removed:
let leveled field make =
69
Removed:
List.find_map
70
Removed:
(fun (answer_field, choice) ->
71
Removed:
if String.equal field answer_field then
72
Removed:
Option.map (fun choice -> make (level choice)) (valid_choice choice)
73
Removed:
else None)
74
Removed:
answers
24
Added:
let leveled name make =
25
Added:
Option.bind (field name fields) level |> Option.map make
75
26
in
76
27
List.filter_map Fun.id
77
28
[
@@ -135,11 +86,10 @@
135
86
Service.feedback t.service trainee.Trainee.id >>= fun feedback ->
136
87
let feedback = List.map feedback_view feedback in
137
88
let records = List.map (entry_view log) records in
138
Removed:
let saved_flow = feedback_flow request in
139
89
let feedback_open =
140
90
match (Dream.query request "feedback", Dream.query request "prompt") with
141
91
| Some "start", _ | _, Some "feedback" -> true
142
Removed:
| _ -> Option.is_some saved_flow
92
Added:
| _ -> false
143
93
in
144
94
html
145
95
(Pages.logbook request
@@ -149,105 +99,25 @@
149
99
(match Dream.query request "prompt" with
150
100
| Some "feedback" -> true
151
101
| _ -> false)
152
Removed:
~feedback_flow:(Option.value saved_flow ~default:initial_feedback_flow)
153
102
~feedback_open records)
154
103
155
Removed:
let finish_feedback t trainee request flow flags =
156
Removed:
let signals = feedback_signals flow.Pages.answers flags in
157
Removed:
Service.record_feedback t.service trainee.Trainee.id ~reported_at:(t.now ())
158
Removed:
signals
159
Removed:
>>= function
160
Removed:
| Ok _ ->
161
Removed:
clear_feedback_flow request >>= fun () ->
162
Removed:
redirect_with_flash request
163
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
164
Removed:
"Feedback saved."
165
Removed:
| Error _ ->
166
Removed:
clear_feedback_flow request >>= fun () ->
167
Removed:
redirect_with_flash request
168
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
169
Removed:
Present.form_invalid
170
Removed:
171
Removed:
(* Advance one factor. The answer map stays in the session until the final
172
Removed:
optional-observations step, so refreshes never lose earlier choices. *)
104
Added:
(* One post saves the whole report. Nothing is stored before Submit, so there
105
Added:
is no partial state to keep or discard. An empty submission is a mistake
106
Added:
worth naming rather than an empty report worth storing. *)
173
107
let record_feedback t trainee request =
108
Added:
let back = Dream_html.path_attr Dream_html.HTML.href Routes.logbook in
174
109
Dream.form request >>= function
175
110
| `Ok fields -> (
176
Removed:
let flow =
177
Removed:
Option.value (feedback_flow request) ~default:initial_feedback_flow
178
Removed:
in
179
Removed:
match
180
Removed:
field "step" fields |> fun raw ->
181
Removed:
(Option.bind raw int_of_string_opt, flow.step)
182
Removed:
with
183
Removed:
| Some step, expected when step = expected ->
184
Removed:
let action =
185
Removed:
match field "action" fields with
186
Removed:
| Some ("next" | "Next") -> Some "next"
187
Removed:
| Some ("back" | "Back") -> Some "back"
188
Removed:
| Some ("skip" | "Skip this factor" | "Skip this step") ->
189
Removed:
Some "skip"
190
Removed:
| Some ("save" | "Record feedback") -> Some "save"
191
Removed:
| _ -> None
192
Removed:
in
193
Removed:
(* Back steps to the previous factor and keeps every answer, so a
194
Removed:
trainee can revise an earlier report without losing the rest. *)
195
Removed:
if action = Some "back" then
196
Removed:
if step = 0 then redirect_to request Routes.logbook
197
Removed:
else
198
Removed:
let previous = Pages.{ flow with step = step - 1 } in
199
Removed:
set_feedback_flow request previous >>= fun () ->
200
Removed:
redirect_to request Routes.logbook
201
Removed:
else if step = List.length feedback_factors then
202
Removed:
if action = Some "skip" then
203
Removed:
finish_feedback t trainee request flow []
204
Removed:
else if action = Some "save" then
205
Removed:
finish_feedback t trainee request flow fields
206
Removed:
else
207
Removed:
redirect_with_flash request
208
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
209
Removed:
Present.form_invalid
210
Removed:
else
211
Removed:
let factor = List.nth feedback_factors step in
212
Removed:
let answers =
213
Removed:
match
214
Removed:
( action,
215
Removed:
field "choice" fields |> fun raw ->
216
Removed:
Option.bind raw valid_choice )
217
Removed:
with
218
Removed:
| Some "next", Some choice -> (factor, choice) :: flow.answers
219
Removed:
| Some "skip", _ -> flow.answers
220
Removed:
| _ -> flow.answers
221
Removed:
in
222
Removed:
if action <> Some "next" && action <> Some "skip" then
223
Removed:
redirect_with_flash request
224
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
225
Removed:
Present.form_invalid
226
Removed:
else
227
Removed:
let next = Pages.{ step = step + 1; answers } in
228
Removed:
set_feedback_flow request next >>= fun () ->
229
Removed:
redirect_to request Routes.logbook
230
Removed:
| _ ->
231
Removed:
redirect_with_flash request
232
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
233
Removed:
Present.form_invalid)
234
Removed:
| _ ->
235
Removed:
redirect_with_flash request
236
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
237
Removed:
Present.form_invalid
111
Added:
match feedback_signals fields with
112
Added:
| [] -> redirect_with_flash request back Present.feedback_empty
113
Added:
| signals -> (
114
Added:
Service.record_feedback t.service trainee.Trainee.id
115
Added:
~reported_at:(t.now ()) signals
116
Added:
>>= function
117
Added:
| Ok _ -> redirect_with_flash request back "Feedback saved."
118
Added:
| Error _ -> redirect_with_flash request back Present.form_invalid))
119
Added:
| _ -> redirect_with_flash request back Present.form_invalid
238
120
239
Removed:
let cancel_feedback _t _trainee request =
240
Removed:
guard_csrf request >>= function
241
Removed:
| Error _ ->
242
Removed:
redirect_with_flash request
243
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
244
Removed:
Present.form_invalid
245
Removed:
| Ok () ->
246
Removed:
clear_feedback_flow request >>= fun () ->
247
Removed:
redirect_with_flash request
248
Removed:
(Dream_html.path_attr Dream_html.HTML.href Routes.logbook)
249
Removed:
"Feedback skipped."
250
Removed:
251
121
let show t trainee request id =
252
122
let viewer =
253
123
{
@@ -334,9 +204,6 @@
334
204
Dream_html.post Routes.feedback (fun request ->
335
205
authenticated t request (fun trainee ->
336
206
record_feedback t trainee request));
337
Removed:
Dream_html.post Routes.cancel_feedback (fun request ->
338
Removed:
authenticated t request (fun trainee ->
339
Removed:
cancel_feedback t trainee request));
340
207
Dream_html.get Routes.record (fun request id ->
341
208
authenticated t request (fun trainee -> show t trainee request id));
342
209
Dream_html.post Routes.record_slot (fun request id slot ->
lib/web/workout_client.ml
@@ -378,9 +378,11 @@
378
378
| None -> Js._false)
379
379
| None -> Js._true))
380
380
381
Removed:
(* The feedback flow uses the same native dialog behavior as workout
381
Added:
(* The feedback modal uses the same native dialog behavior as workout
382
382
cancellation. The trigger remains a normal link, so no-script clients open
383
Removed:
the server-rendered modal page instead. *)
383
Added:
the server-rendered modal page instead, and Close is a link back to the
384
Added:
logbook that the client turns into an in-place dismiss. The form itself
385
Added:
submits through the shared app-form path. *)
384
386
let feedback_click event =
385
387
let target = Dom_html.eventTarget event in
386
388
match closest "[data-hito-feedback-open]" target with
@@ -394,72 +396,8 @@
394
396
Dom.preventDefault event;
395
397
close_feedback_modal ();
396
398
Js._false
397
Removed:
| None -> (
398
Removed:
match closest "[data-hito-feedback-action]" target with
399
Removed:
| None -> Js._true
400
Removed:
| Some action -> (
401
Removed:
match closest "form" action with
402
Removed:
| None -> Js._true
403
Removed:
| Some form -> (
404
Removed:
match
405
Removed:
Js.Opt.to_option
406
Removed:
(form##getAttribute
407
Removed:
(Js.string "data-hito-feedback-pending"))
408
Removed:
with
409
Removed:
| Some _ ->
410
Removed:
Dom.preventDefault event;
411
Removed:
Js._false
412
Removed:
| None -> (
413
Removed:
match
414
Removed:
Js.Opt.to_option
415
Removed:
(action##getAttribute (Js.string "value"))
416
Removed:
with
417
Removed:
| None -> Js._true
418
Removed:
| Some value -> (
419
Removed:
match
420
Removed:
query_one form "[data-hito-feedback-action-value]"
421
Removed:
with
422
Removed:
| None -> Js._true
423
Removed:
| Some hidden ->
424
Removed:
form##setAttribute
425
Removed:
(Js.string "data-hito-feedback-pending")
426
Removed:
(Js.string "");
427
Removed:
hidden##setAttribute (Js.string "value") value;
428
Removed:
Js._true))))))
399
Added:
| None -> Js._true)
429
400
430
Removed:
(* Selecting a score advances to the next factor without a separate Next
431
Removed:
action. Handle click rather than change so selecting the current score again
432
Removed:
follows the same path. Defer the submit by one event-loop tick so the browser
433
Removed:
applies the radio value before form data is collected. *)
434
Removed:
let feedback_choice event =
435
Removed:
match closest "[data-hito-feedback-choice]" (Dom_html.eventTarget event) with
436
Removed:
| None -> Js._true
437
Removed:
| Some choice -> (
438
Removed:
match closest "form" choice with
439
Removed:
| None -> Js._true
440
Removed:
| Some form -> (
441
Removed:
match
442
Removed:
Js.Opt.to_option
443
Removed:
(form##getAttribute (Js.string "data-hito-feedback-pending"))
444
Removed:
with
445
Removed:
| Some _ -> Js._false
446
Removed:
| None -> (
447
Removed:
match query_one form "[data-hito-feedback-action-value]" with
448
Removed:
| None -> Js._true
449
Removed:
| Some hidden ->
450
Removed:
form##setAttribute
451
Removed:
(Js.string "data-hito-feedback-pending")
452
Removed:
(Js.string "");
453
Removed:
ignore
454
Removed:
(Dom_html.window##setTimeout
455
Removed:
(Js.wrap_callback (fun () ->
456
Removed:
hidden##setAttribute (Js.string "value")
457
Removed:
(Js.string "next");
458
Removed:
ignore
459
Removed:
(Js.Unsafe.meth_call form "requestSubmit" [||])))
460
Removed:
(Js.number_of_float 0.));
461
Removed:
Js._true)))
462
Removed:
463
401
(* The exercise dropdown navigates the moment its selection changes. It lives in
464
402
a GET form ([data-hito-exercise-form]) that submits to the workout path. The
465
403
client turns a change into a workout-scoped content swap to [?slot=N], so no
@@ -499,10 +437,6 @@
499
437
|> ignore;
500
438
Dom_html.addEventListener document Dom_html.Event.click
501
439
(Dom_html.handler dialog_click)
502
Removed:
Js._false
503
Removed:
|> ignore;
504
Removed:
Dom_html.addEventListener document Dom_html.Event.click
505
Removed:
(Dom_html.handler feedback_choice)
506
440
Js._false
507
441
|> ignore;
508
442
Dom_html.addEventListener document Dom_html.Event.change
test/web/logbook.ml
@@ -208,194 +208,136 @@
208
208
with
209
209
| Some r -> Evidence.Workout.filled_slots r.Repository.workout
210
210
| None -> Alcotest.failf "expected the saved workout w1") );
211
Removed:
( "sequential feedback stores only answered factors, never skipped ones",
211
Added:
( "the feedback modal shows every factor with three choices, none \
212
Added:
preselected, and one submit",
212
213
`Quick,
213
214
fun () ->
214
Removed:
let c, repo = client_with_repo () in
215
Added:
let c, _ = client_with_repo () in
215
216
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
216
Removed:
let trainee = the_trainee repo ~username:"lifter" in
217
Removed:
let _ = get c "/logbook?feedback=start" in
218
Removed:
let step_action step action extra =
219
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
220
Removed:
post c "/feedback"
221
Removed:
(("dream.csrf", token)
222
Removed:
:: ("step", string_of_int step)
223
Removed:
:: ("action", action) :: extra)
217
Added:
let page = body (get c "/logbook?feedback=start") in
218
Added:
let count needle =
219
Added:
let rec go from acc =
220
Added:
match index_from ~needle page from with
221
Added:
| Some i -> go (i + 1) (acc + 1)
222
Added:
| None -> acc
223
Added:
in
224
Added:
go 0 0
224
225
in
225
Removed:
let first = step_action 0 "next" [ ("choice", "better") ] in
226
Removed:
Alcotest.(check int) "first factor redirects" 303 (status first);
227
Removed:
let _ = step_action 1 "skip" [] in
228
Removed:
let saved = step_action 2 "save" [] in
229
Removed:
Alcotest.(check int) "final feedback redirects" 303 (status saved);
230
Removed:
let reports =
231
Removed:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
232
Removed:
in
226
Added:
(* One radio group per factor, three values each. *)
233
227
Alcotest.(check int)
234
Removed:
"one feedback report stored" 1 (List.length reports);
235
Removed:
let signal_list = Feedback.signals (List.hd reports) in
236
Removed:
Alcotest.(check (list bool))
237
Removed:
"only motivation stored" [ true ]
238
Removed:
(List.map
239
Removed:
(function
240
Removed:
| Feedback.Motivation Feedback.Better_than_usual -> true
241
Removed:
| _ -> false)
242
Removed:
signal_list) );
243
Removed:
( "skipping the entire feedback flow records nothing",
244
Removed:
`Quick,
245
Removed:
fun () ->
246
Removed:
let c, repo = client_with_repo () in
247
Removed:
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
248
Removed:
let trainee = the_trainee repo ~username:"lifter" in
249
Removed:
let start = body (get c "/logbook?feedback=start") in
250
Removed:
let token = Option.get (csrf_token start) in
251
Removed:
let skipped = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
252
Removed:
Alcotest.(check int) "full-flow skip redirects" 303 (status skipped);
228
Added:
"motivation has three choices" 3
229
Added:
(count "name=\"motivation\"");
253
230
Alcotest.(check int)
254
Removed:
"no feedback report was stored" 0
255
Removed:
(List.length
256
Removed:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
231
Added:
"difficulty has three choices" 3
232
Added:
(count "name=\"difficulty\"");
233
Added:
List.iter
234
Added:
(fun v ->
235
Added:
Alcotest.(check bool)
236
Added:
("offers " ^ v) true
237
Added:
(count (Printf.sprintf "value=\"%s\"" v) >= 2))
238
Added:
[ "worse"; "usual"; "better" ];
239
Added:
(* Nothing is preselected and there is no step machinery. *)
240
Added:
Alcotest.(check int) "no checked radio" 0 (count " checked");
241
Added:
Alcotest.(check int) "no step field" 0 (count "name=\"step\"");
242
Added:
Alcotest.(check int) "one submit" 1 (count ">Submit feedback<");
243
Added:
(* Close is a plain link back to the logbook, not a cancel post. *)
244
Added:
Alcotest.(check bool)
245
Added:
"close links to the logbook" true
246
Added:
(count "href=\"/logbook\"" >= 1);
247
Added:
Alcotest.(check int) "no cancel route" 0 (count "/feedback/cancel")
257
248
);
258
Removed:
( "back keeps an earlier answer, which still persists on save",
249
Added:
( "submitting one factor stores only that signal",
259
250
`Quick,
260
251
fun () ->
261
252
let c, repo = client_with_repo () in
262
253
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
263
254
let trainee = the_trainee repo ~username:"lifter" in
264
Removed:
let _ = get c "/logbook?feedback=start" in
265
Removed:
let step_action step action extra =
266
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
255
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
256
Added:
let saved =
267
257
post c "/feedback"
268
Removed:
(("dream.csrf", token)
269
Removed:
:: ("step", string_of_int step)
270
Removed:
:: ("action", action) :: extra)
258
Added:
[ ("dream.csrf", token); ("motivation", "better") ]
271
259
in
272
Removed:
(* Answer motivation, move to difficulty, return, then skip
273
Removed:
motivation and difficulty before saving. The earlier motivation
274
Removed:
answer remains in the flow. *)
275
Removed:
let _ = step_action 0 "next" [ ("choice", "better") ] in
276
Removed:
let back = step_action 1 "back" [] in
277
Removed:
Alcotest.(check int) "back redirects" 303 (status back);
278
Removed:
let _ = step_action 0 "skip" [] in
279
Removed:
let _ = step_action 1 "skip" [] in
280
Removed:
let _ = step_action 2 "save" [] in
260
Added:
Alcotest.(check int) "submit redirects" 303 (status saved);
261
Added:
Alcotest.(check string)
262
Added:
"back to the logbook" "/logbook" (location saved);
281
263
let reports =
282
264
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
283
265
in
284
266
Alcotest.(check int) "one report stored" 1 (List.length reports);
285
Removed:
let signals = Feedback.signals (List.hd reports) in
286
267
Alcotest.(check bool)
287
Removed:
"the pre-back motivation answer persists" true
288
Removed:
(List.exists
289
Removed:
(function
290
Removed:
| Feedback.Motivation Feedback.Better_than_usual -> true
291
Removed:
| _ -> false)
292
Removed:
signals) );
293
Removed:
( "closing the feedback modal discards the flow",
268
Added:
"only motivation, better than usual" true
269
Added:
(Feedback.signals (List.hd reports)
270
Added:
= [ Feedback.Motivation Feedback.Better_than_usual ]) );
271
Added:
( "submitting every factor stores exactly one signal per category",
294
272
`Quick,
295
273
fun () ->
296
274
let c, repo = client_with_repo () in
297
275
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
298
276
let trainee = the_trainee repo ~username:"lifter" in
299
Removed:
let start = body (get c "/logbook?feedback=start") in
300
Removed:
let token = Option.get (csrf_token start) in
301
Removed:
let _ =
277
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
278
Added:
let saved =
302
279
post c "/feedback"
303
280
[
304
281
("dream.csrf", token);
305
Removed:
("step", "0");
306
Removed:
("action", "next");
307
Removed:
("choice", "better");
282
Added:
("motivation", "worse");
283
Added:
("difficulty", "usual");
308
284
]
309
285
in
310
Removed:
let appetite = body (get c "/logbook") in
311
Removed:
let token = Option.get (csrf_token appetite) in
312
Removed:
let closed = post c "/feedback/cancel" [ ("dream.csrf", token) ] in
313
Removed:
Alcotest.(check int) "close redirects" 303 (status closed);
314
Removed:
(* A discarded flow stores nothing. *)
286
Added:
Alcotest.(check int) "submit redirects" 303 (status saved);
287
Added:
let reports =
288
Added:
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
289
Added:
in
290
Added:
Alcotest.(check int) "one report stored" 1 (List.length reports);
291
Added:
let signals = Feedback.signals (List.hd reports) in
292
Added:
let count p = List.length (List.filter p signals) in
293
Added:
let open Feedback in
315
294
Alcotest.(check int)
316
Removed:
"no feedback report stored" 0
317
Removed:
(List.length
318
Removed:
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
319
Removed:
);
320
Removed:
( "a step out of sync with the session records nothing",
295
Added:
"one motivation signal" 1
296
Added:
(count (function Motivation _ -> true | _ -> false));
297
Added:
Alcotest.(check int)
298
Added:
"one difficulty signal" 1
299
Added:
(count (function Difficulty _ -> true | _ -> false)) );
300
Added:
( "submitting with nothing selected stores nothing",
321
301
`Quick,
322
302
fun () ->
323
Removed:
(* The flow advances one factor at a time and stores its position in
324
Removed:
the session. A post whose [step] disagrees with that position —
325
Removed:
a stale form, a double submit, or a crafted body — is refused as
326
Removed:
an invalid form rather than recording a factor twice. This is the
327
Removed:
web tier's guard against a duplicate signal ever reaching the
328
Removed:
domain. *)
329
303
let c, repo = client_with_repo () in
330
304
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
331
305
let trainee = the_trainee repo ~username:"lifter" in
332
Removed:
let start = body (get c "/logbook?feedback=start") in
333
Removed:
let token = Option.get (csrf_token start) in
334
Removed:
(* The session is at step 0; post step 3 instead. *)
335
Removed:
let mismatched =
336
Removed:
post c "/feedback"
337
Removed:
[
338
Removed:
("dream.csrf", token);
339
Removed:
("step", "3");
340
Removed:
("action", "next");
341
Removed:
("choice", "1");
342
Removed:
]
343
Removed:
in
344
Removed:
Alcotest.(check int)
345
Removed:
"mismatched step redirects" 303 (status mismatched);
306
Added:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
307
Added:
let empty = post c "/feedback" [ ("dream.csrf", token) ] in
308
Added:
Alcotest.(check int) "empty submit redirects" 303 (status empty);
346
309
Alcotest.(check string)
347
Removed:
"stale feedback returns to the logbook" "/logbook"
348
Removed:
(location mismatched);
349
Removed:
(* The mismatched post advanced nothing and stored no report. *)
310
Added:
"back to the logbook" "/logbook" (location empty);
350
311
Alcotest.(check int)
351
Removed:
"no feedback stored" 0
312
Added:
"no report stored" 0
352
313
(List.length
353
314
(Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)))
354
315
);
355
Removed:
( "answering every factor stores exactly one signal per category",
316
Added:
( "a value outside the three choices is ignored",
356
317
`Quick,
357
318
fun () ->
358
Removed:
(* The flow admits one answer per factor, so the stored report holds
359
Removed:
one signal per category and never a duplicate. *)
319
Added:
(* A crafted or stale value for a factor is treated as unselected,
320
Added:
so it can neither store a bad level nor reach the domain. *)
360
321
let c, repo = client_with_repo () in
361
322
let _ = register c ~username:"lifter" ~password:"heavyduty1" in
362
323
let trainee = the_trainee repo ~username:"lifter" in
363
Removed:
let _ = get c "/logbook?feedback=start" in
364
Removed:
let rec advance step =
365
Removed:
if step < 2 then begin
366
Removed:
let token = Option.get (csrf_token (body (get c "/logbook"))) in
367
Removed:
let _ =
368
Removed:
post c "/feedback"
369
Removed:
[
370
Removed:
("dream.csrf", token);
371
Removed:
("step", string_of_int step);
372
Removed:
("action", "next");
373
Removed:
("choice", "worse");
374
Removed:
]
375
Removed:
in
376
Removed:
advance (step + 1)
377
Removed:
end
378
Removed:
in
379
Removed:
advance 0;
380
324
let token = Option.get (csrf_token (body (get c "/logbook"))) in
381
Removed:
let saved =
325
Added:
let bad =
382
326
post c "/feedback"
383
Removed:
[ ("dream.csrf", token); ("step", "2"); ("action", "save") ]
327
Added:
[
328
Added:
("dream.csrf", token);
329
Added:
("motivation", "7");
330
Added:
("difficulty", "better");
331
Added:
]
384
332
in
385
Removed:
Alcotest.(check int) "final save redirects" 303 (status saved);
386
Removed:
(* Exactly one report, with one signal per distinct factor. *)
333
Added:
Alcotest.(check int) "submit redirects" 303 (status bad);
387
334
let reports =
388
335
Lwt_main.run (Memory_repo.feedback repo trainee.Trainee.id)
389
336
in
390
337
Alcotest.(check int) "one report stored" 1 (List.length reports);
391
Removed:
let signals = Feedback.signals (List.hd reports) in
392
Removed:
let count p = List.length (List.filter p signals) in
393
Removed:
let open Feedback in
394
Removed:
Alcotest.(check int)
395
Removed:
"one motivation signal" 1
396
Removed:
(count (function Motivation _ -> true | _ -> false));
397
Removed:
Alcotest.(check int)
398
Removed:
"one difficulty signal" 1
399
Removed:
(count (function Difficulty _ -> true | _ -> false)) );
338
Added:
Alcotest.(check bool)
339
Added:
"only the valid factor survives" true
340
Added:
(Feedback.signals (List.hd reports)
341
Added:
= [ Feedback.Difficulty Feedback.Better_than_usual ]) );
400
342
] );
401
343
]