[OCaml] High Intensity Training Online
feat score subjective feedback one to five
Replace the three-point Below_usual/Usual/Above_usual level with a five-point score: Very_poor is 1, Very_good is 5. Application feedback asked for a 1-to-5 scale where 1 is very poor and 5 is very good. These remain wellness and readiness self-reports. Doctrine holds that intensity is categorical, not scalar (HD1, "The Intensity Factor": 0% at rest, 100% at failure), so this score never measures a set's intensity; the logbook records the report, it does not judge it. Carry the change through the codec (levels encode as 1..5), the web flow (five score buttons, described with their labels), and add migration 6 to drop feedback rows written with the old codes, since feedback is observed and may be dropped rather than migrated.
Changed files
ARCHITECTURE.org
@@ -220,8 +220,10 @@
220
220
221
221
=Feedback= is a typed vocabulary for reported signals — sleep, appetite,
222
222
readiness, motivation, difficulty, pain, injury, insufficient preparation — with
223
Removed:
duplicate categories rejected. The application stores reports independently of
224
Removed:
workouts, and the web tier records them through a sequential optional flow.
223
Added:
duplicate categories rejected. Leveled signals carry a five-point score, 1 (very
224
Added:
poor) to 5 (very good); these are wellness self-reports, never a measure of set
225
Added:
intensity. The application stores reports independently of workouts, and the web
226
Added:
tier records them through a sequential optional flow.
225
227
226
228
** Progression — the judgment
227
229
lib/app/codec.ml
@@ -315,16 +315,16 @@
315
315
316
316
(* --- subjective feedback --- *)
317
317
318
Removed:
let level_code : Evidence.Feedback.level -> string = function
319
Removed:
| Below_usual -> "below"
320
Removed:
| Usual -> "usual"
321
Removed:
| Above_usual -> "above"
318
Added:
let level_code (l : Evidence.Feedback.level) =
319
Added:
string_of_int (Evidence.Feedback.level_to_score l)
322
320
323
Removed:
let level_of_code = function
324
Removed:
| "below" -> Ok Evidence.Feedback.Below_usual
325
Removed:
| "usual" -> Ok Evidence.Feedback.Usual
326
Removed:
| "above" -> Ok Evidence.Feedback.Above_usual
327
Removed:
| other -> Error (Malformed (Printf.sprintf "level %S" other))
321
Added:
let level_of_code code =
322
Added:
match int_of_string_opt code with
323
Added:
| Some n -> (
324
Added:
match Evidence.Feedback.level_of_score n with
325
Added:
| Some l -> Ok l
326
Added:
| None -> Error (Malformed (Printf.sprintf "level %S" code)))
327
Added:
| None -> Error (Malformed (Printf.sprintf "level %S" code))
328
328
329
329
let signal_code : Evidence.Feedback.signal -> string = function
330
330
| Sleep l -> "sleep:" ^ level_code l
lib/app/migrations.ml
@@ -132,6 +132,26 @@
132
132
ON app_feedback_vote (voter_id)|};
133
133
];
134
134
};
135
Added:
{
136
Added:
version = 6;
137
Added:
name = "five-point feedback scores";
138
Added:
(* Subjective feedback now encodes levels as scores 1..5, so rows written
139
Added:
with the old below/usual/above codes no longer decode. Feedback is
140
Added:
observed, not authored, so the domain permits dropping it rather than
141
Added:
migrating it. *)
142
Added:
statements =
143
Added:
[
144
Added:
{|DROP TABLE IF EXISTS feedback|};
145
Added:
{|CREATE TABLE IF NOT EXISTS feedback (
146
Added:
trainee_id TEXT NOT NULL,
147
Added:
seq INTEGER NOT NULL,
148
Added:
encoded TEXT NOT NULL,
149
Added:
PRIMARY KEY (trainee_id, seq)
150
Added:
)|};
151
Added:
{|CREATE INDEX IF NOT EXISTS feedback_by_trainee
152
Added:
ON feedback (trainee_id, seq DESC)|};
153
Added:
];
154
Added:
};
135
155
]
136
156
137
157
(* The ledger of applied migrations. A row per version, so a reconnect knows
lib/core/evidence.ml
@@ -70,7 +70,22 @@
70
70
end
71
71
72
72
module Feedback = struct
73
Removed:
type level = Below_usual | Usual | Above_usual
73
Added:
type level = Very_poor | Poor | Fair | Good | Very_good
74
Added:
75
Added:
let level_to_score = function
76
Added:
| Very_poor -> 1
77
Added:
| Poor -> 2
78
Added:
| Fair -> 3
79
Added:
| Good -> 4
80
Added:
| Very_good -> 5
81
Added:
82
Added:
let level_of_score = function
83
Added:
| 1 -> Some Very_poor
84
Added:
| 2 -> Some Poor
85
Added:
| 3 -> Some Fair
86
Added:
| 4 -> Some Good
87
Added:
| 5 -> Some Very_good
88
Added:
| _ -> None
74
89
75
90
type signal =
76
91
| Sleep of level
lib/core/evidence.mli
@@ -48,7 +48,22 @@
48
48
49
49
(** Typed signals reported at a point in time. *)
50
50
module Feedback : sig
51
Removed:
type level = Below_usual | Usual | Above_usual
51
Added:
type level =
52
Added:
| Very_poor
53
Added:
| Poor
54
Added:
| Fair
55
Added:
| Good
56
Added:
| Very_good
57
Added:
(** A five-point subjective score. [Very_poor] is 1, [Very_good] is 5.
58
Added:
These are wellness and readiness self-reports, never a measure of
59
Added:
the working set's intensity, which is categorical (0% at rest, 100%
60
Added:
at failure). *)
61
Added:
62
Added:
val level_to_score : level -> int
63
Added:
(** The score in 1..5. *)
64
Added:
65
Added:
val level_of_score : int -> level option
66
Added:
(** [Some] for 1..5, [None] otherwise. *)
52
67
53
68
type signal =
54
69
| Sleep of level
lib/web/handlers.ml
@@ -444,7 +444,7 @@
444
444
let feedback_factors = List.map fst Pages.feedback_factors
445
445
446
446
let valid_choice = function
447
Removed:
| ("below" | "usual" | "above") as choice -> Some choice
447
Added:
| ("1" | "2" | "3" | "4" | "5") as choice -> Some choice
448
448
| _ -> None
449
449
450
450
let valid_factor field = List.mem field feedback_factors
@@ -491,10 +491,13 @@
491
491
let field name fields = List.assoc_opt name fields
492
492
493
493
let feedback_signals answers flags =
494
Removed:
let level = function
495
Removed:
| "below" -> Evidence.Feedback.Below_usual
496
Removed:
| "usual" -> Evidence.Feedback.Usual
497
Removed:
| _ -> Evidence.Feedback.Above_usual
494
Added:
let level choice =
495
Added:
match int_of_string_opt choice with
496
Added:
| Some n -> (
497
Added:
match Evidence.Feedback.level_of_score n with
498
Added:
| Some l -> l
499
Added:
| None -> Evidence.Feedback.Fair)
500
Added:
| None -> Evidence.Feedback.Fair
498
501
in
499
502
let leveled field make =
500
503
List.find_map
lib/web/pages.ml
@@ -1174,7 +1174,11 @@
1174
1174
Dream_html.string_attr "aria-label" "%s" label;
1175
1175
]
1176
1176
[
1177
Removed:
choice "below" "Worse"; choice "usual" "Same"; choice "above" "Better";
1177
Added:
choice "1" "1 — very poor";
1178
Added:
choice "2" "2";
1179
Added:
choice "3" "3";
1180
Added:
choice "4" "4";
1181
Added:
choice "5" "5 — very good";
1178
1182
];
1179
1183
]
1180
1184
@@ -1326,10 +1330,12 @@
1326
1330
]
1327
1331
1328
1332
let describe_signal (signal : Evidence.Feedback.signal) =
1329
Removed:
let level = function
1330
Removed:
| Evidence.Feedback.Below_usual -> "below usual"
1331
Removed:
| Usual -> "usual"
1332
Removed:
| Above_usual -> "above usual"
1333
Added:
let level l =
1334
Added:
let score = Evidence.Feedback.level_to_score l in
1335
Added:
match l with
1336
Added:
| Evidence.Feedback.Very_poor -> Printf.sprintf "%d (very poor)" score
1337
Added:
| Very_good -> Printf.sprintf "%d (very good)" score
1338
Added:
| _ -> string_of_int score
1333
1339
in
1334
1340
match signal with
1335
1341
| Sleep l -> Printf.sprintf "Sleep %s" (level l)
test/test_codec.ml
@@ -184,4 +184,56 @@
184
184
(List.hd (Stimulus.efforts (List.hd (Workout.stimuli d))))) );
185
185
]
186
186
187
Removed:
let suite = [ ("timestamp", timestamp_tests); ("codec", codec_tests) ]
187
Added:
let feedback_tests =
188
Added:
[
189
Added:
( "five-point feedback round-trips every score",
190
Added:
`Quick,
191
Added:
fun () ->
192
Added:
let open Evidence.Feedback in
193
Added:
let report =
194
Added:
make ~reported_at:(at 100)
195
Added:
[
196
Added:
Sleep Very_poor;
197
Added:
Appetite Poor;
198
Added:
Readiness Fair;
199
Added:
Motivation Good;
200
Added:
Difficulty Very_good;
201
Added:
Pain;
202
Added:
]
203
Added:
in
204
Added:
match Codec.decode_feedback (Codec.encode_feedback report) with
205
Added:
| Ok decoded ->
206
Added:
let show s =
207
Added:
let lvl l = string_of_int (level_to_score l) in
208
Added:
match s with
209
Added:
| Sleep l -> "sleep:" ^ lvl l
210
Added:
| Appetite l -> "appetite:" ^ lvl l
211
Added:
| Readiness l -> "readiness:" ^ lvl l
212
Added:
| Motivation l -> "motivation:" ^ lvl l
213
Added:
| Difficulty l -> "difficulty:" ^ lvl l
214
Added:
| Pain -> "pain"
215
Added:
| Injury -> "injury"
216
Added:
| Preparation_insufficient -> "preparation"
217
Added:
in
218
Added:
Alcotest.(check int)
219
Added:
"report time" 100
220
Added:
(Recovery.timestamp_to_unix_seconds (reported_at decoded));
221
Added:
Alcotest.(check (list string))
222
Added:
"same signals"
223
Added:
(List.map show (signals report))
224
Added:
(List.map show (signals decoded))
225
Added:
| Error e -> Alcotest.failf "decode failed: %a" Codec.pp_error e );
226
Added:
( "an out-of-range score is reported as malformed",
227
Added:
`Quick,
228
Added:
fun () ->
229
Added:
match Codec.decode_feedback "1970-01-01T00:00:00Z\tsleep:6" with
230
Added:
| Error (Codec.Malformed _) -> ()
231
Added:
| _ -> Alcotest.fail "expected Malformed for score 6" );
232
Added:
]
233
Added:
234
Added:
let suite =
235
Added:
[
236
Added:
("timestamp", timestamp_tests);
237
Added:
("codec", codec_tests);
238
Added:
("feedback", feedback_tests);
239
Added:
]
test/test_evidence.ml
@@ -538,13 +538,11 @@
538
538
let open Feedback in
539
539
match
540
540
try
541
Removed:
ignore
542
Removed:
(make ~reported_at:(at 60)
543
Removed:
[ Sleep Below_usual; Sleep Above_usual ]);
541
Added:
ignore (make ~reported_at:(at 60) [ Sleep Poor; Sleep Good ]);
544
542
None
545
543
with Invalid error -> Some error
546
544
with
547
Removed:
| Some (Duplicate_signal (Sleep Above_usual)) -> ()
545
Added:
| Some (Duplicate_signal (Sleep Good)) -> ()
548
546
| _ -> Alcotest.fail "expected duplicate sleep rejection" );
549
547
( "feedback retains its report time and signals",
550
548
`Quick,
@@ -553,11 +551,11 @@
553
551
let feedback =
554
552
make ~reported_at:(at 60)
555
553
[
556
Removed:
Sleep Above_usual;
557
Removed:
Appetite Usual;
558
Removed:
Readiness Above_usual;
559
Removed:
Motivation Above_usual;
560
Removed:
Difficulty Usual;
554
Added:
Sleep Good;
555
Added:
Appetite Fair;
556
Added:
Readiness Good;
557
Added:
Motivation Good;
558
Added:
Difficulty Fair;
561
559
Preparation_insufficient;
562
560
]
563
561
in
test/test_sqlite_repo.ml
@@ -291,7 +291,7 @@
291
291
(run
292
292
(S.record_feedback s id ~reported_at:(day 1)
293
293
[
294
Removed:
Evidence.Feedback.Sleep Evidence.Feedback.Below_usual;
294
Added:
Evidence.Feedback.Sleep Evidence.Feedback.Poor;
295
295
Evidence.Feedback.Pain;
296
296
]))
297
297
in
@@ -307,8 +307,7 @@
307
307
Alcotest.(check int) "two signals" 2 (List.length signals);
308
308
Alcotest.(check bool)
309
309
"sleep signal preserved" true
310
Removed:
(List.mem (Evidence.Feedback.Sleep Evidence.Feedback.Below_usual)
311
Removed:
signals);
310
Added:
(List.mem (Evidence.Feedback.Sleep Evidence.Feedback.Poor) signals);
312
311
Alcotest.(check bool)
313
312
"pain signal preserved" true
314
313
(List.mem Evidence.Feedback.Pain signals)) );
test/test_web.ml
@@ -1064,7 +1064,7 @@
1064
1064
Alcotest.(check bool)
1065
1065
"renders only the first factor initially" true
1066
1066
(contains ~substring:">Sleep</h3>" logbook_page
1067
Removed:
&& contains ~substring:">Worse</span>" logbook_page
1067
Added:
&& contains ~substring:"1 — very poor</span>" logbook_page
1068
1068
&& not (contains ~substring:">Appetite</h3>" logbook_page));
1069
1069
Alcotest.(check bool)
1070
1070
"renders a progress bar and factor skip" true
@@ -1092,7 +1092,7 @@
1092
1092
("dream.csrf", token);
1093
1093
("step", "0");
1094
1094
("action", "next");
1095
Removed:
("choice", "below");
1095
Added:
("choice", "1");
1096
1096
]
1097
1097
in
1098
1098
Alcotest.(check int) "first factor redirects" 303 (status next);
@@ -1119,7 +1119,7 @@
1119
1119
("dream.csrf", token);
1120
1120
("step", "2");
1121
1121
("action", "next");
1122
Removed:
("choice", "usual");
1122
Added:
("choice", "3");
1123
1123
]);
1124
1124
let motivation = body (get c "/logbook") in
1125
1125
let token = Option.get (csrf_token motivation) in
@@ -1129,7 +1129,7 @@
1129
1129
("dream.csrf", token);
1130
1130
("step", "3");
1131
1131
("action", "next");
1132
Removed:
("choice", "above");
1132
Added:
("choice", "5");
1133
1133
]);
1134
1134
let difficulty = body (get c "/logbook") in
1135
1135
let token = Option.get (csrf_token difficulty) in
@@ -1157,9 +1157,9 @@
1157
1157
let logbook_page = body (get c "/logbook") in
1158
1158
Alcotest.(check bool)
1159
1159
"stores answered factors and final observations" true
1160
Removed:
(contains ~substring:"Sleep below usual" logbook_page
1161
Removed:
&& contains ~substring:"Readiness usual" logbook_page
1162
Removed:
&& contains ~substring:"Motivation above usual" logbook_page
1160
Added:
(contains ~substring:"Sleep 1 (very poor)" logbook_page
1161
Added:
&& contains ~substring:"Readiness 3" logbook_page
1162
Added:
&& contains ~substring:"Motivation 5 (very good)" logbook_page
1163
1163
&& contains ~substring:"Pain" logbook_page);
1164
1164
Alcotest.(check bool)
1165
1165
"does not store skipped factors" true
@@ -1197,7 +1197,7 @@
1197
1197
("dream.csrf", token);
1198
1198
("step", string_of_int step);
1199
1199
("action", "next");
1200
Removed:
("choice", if step = 0 then "below" else "skip");
1200
Added:
("choice", if step = 0 then "1" else "skip");
1201
1201
]);
1202
1202
advance (step + 1) (body (get c "/logbook"))
1203
1203
in
@@ -1216,7 +1216,7 @@
1216
1216
let logbook_page = body (get c "/logbook") in
1217
1217
Alcotest.(check bool)
1218
1218
"shows the reported sleep signal" true
1219
Removed:
(contains ~substring:"Sleep below usual" logbook_page);
1219
Added:
(contains ~substring:"Sleep 1 (very poor)" logbook_page);
1220
1220
Alcotest.(check bool)
1221
1221
"shows the reported pain signal" true
1222
1222
(contains ~substring:"Pain" logbook_page) );
@@ -1942,7 +1942,7 @@
1942
1942
("dream.csrf", token);
1943
1943
("step", "3");
1944
1944
("action", "next");
1945
Removed:
("choice", "below");
1945
Added:
("choice", "1");
1946
1946
]
1947
1947
in
1948
1948
Alcotest.(check int)
@@ -1976,7 +1976,7 @@
1976
1976
("dream.csrf", token);
1977
1977
("step", string_of_int step);
1978
1978
("action", "next");
1979
Removed:
("choice", "below");
1979
Added:
("choice", "1");
1980
1980
]
1981
1981
in
1982
1982
advance (step + 1)
@@ -1992,11 +1992,11 @@
1992
1992
let logbook_page = body (get c "/logbook") in
1993
1993
Alcotest.(check bool)
1994
1994
"stores one signal per distinct factor" true
1995
Removed:
(contains ~substring:"Sleep below usual" logbook_page
1996
Removed:
&& contains ~substring:"Appetite below usual" logbook_page
1997
Removed:
&& contains ~substring:"Readiness below usual" logbook_page
1998
Removed:
&& contains ~substring:"Motivation below usual" logbook_page
1999
Removed:
&& contains ~substring:"Difficulty below usual" logbook_page) );
1995
Added:
(contains ~substring:"Sleep 1 (very poor)" logbook_page
1996
Added:
&& contains ~substring:"Appetite 1 (very poor)" logbook_page
1997
Added:
&& contains ~substring:"Readiness 1 (very poor)" logbook_page
1998
Added:
&& contains ~substring:"Motivation 1 (very poor)" logbook_page
1999
Added:
&& contains ~substring:"Difficulty 1 (very poor)" logbook_page) );
2000
2000
] );
2001
2001
( "web.lifecycle",
2002
2002
[