[OCaml] High Intensity Training Online
fix phrase form errors through named keys, never raw text
The form decoder matched Dream_html's error keys by spelling them out as string literals, so a change to the library's wording would slip past silently, and its fallback returned the raw key to the trainee. Library keys are now compared through Dream_html's exported constants, so a rename breaks the build instead. hito's own keys are named values. A key with no wording reads as a generic invalid-value message and is reported on stderr for the developer, so a raw key never reaches a page.
Changed files
lib/web/decode.ml
@@ -14,24 +14,35 @@
14
14
extension : Evidence.Stimulus.extension option;
15
15
}
16
16
17
Added:
(* hito's own error keys. Dream_html's keys are named by its exported
18
Added:
constants below, never spelled out here, so a change to the library's
19
Added:
wording breaks the build rather than slipping past a string match. *)
20
Added:
let error_load = "error.load"
21
Added:
let error_reps = "error.reps"
22
Added:
let error_extension = "error.extension"
23
Added:
17
24
let extension_kind = function
18
25
| "" -> Ok None
19
26
| "forced" -> Ok (Some (fun n -> Evidence.Stimulus.Forced_reps n))
20
27
| "negatives" -> Ok (Some (fun n -> Evidence.Stimulus.Negatives n))
21
28
| "static" -> Ok (Some (fun n -> Evidence.Stimulus.Static_hold n))
22
Removed:
| _ -> Error "error.extension"
29
Added:
| _ -> Error error_extension
23
30
31
Added:
(* A load below zero is a range failure the library reports as its own key; a
32
Added:
non-numeric load is a parse failure. Both read to the trainee as one thing:
33
Added:
the load is not a finite, nonnegative number. *)
24
34
let load value =
25
35
match Form.float ~min:0. value with
26
36
| Ok value -> Ok value
27
Removed:
| Error "error.expected.int" -> Error "error.expected.number"
28
Removed:
| Error _ -> Error "error.load"
37
Added:
| Error key when String.equal key Form.error_expected_number ->
38
Added:
Error Form.error_expected_number
39
Added:
| Error _ -> Error error_load
29
40
30
41
let reps value =
31
42
match Form.int value with
32
43
| Error error -> Error error
33
44
| Ok value when value > 0 -> Ok value
34
Removed:
| Ok _ -> Error "error.reps"
45
Added:
| Ok _ -> Error error_reps
35
46
36
47
let fields prescription =
37
48
let open Form in
@@ -41,7 +52,7 @@
41
52
match (make, amount) with
42
53
| None, _ -> ok None
43
54
| Some make, Some amount -> ok (Some (make amount))
44
Removed:
| Some _, None -> error "extension_amount" "error.required"
55
Added:
| Some _, None -> error "extension_amount" Form.error_required
45
56
in
46
57
match Prescription.Stimulus.delivery prescription with
47
58
| Prescription.Stimulus.Single _ ->
@@ -64,10 +75,10 @@
64
75
let effort_error ~load_field ~reps_field = function
65
76
| Evidence.Stimulus.Effort.Load_not_finite
66
77
| Evidence.Stimulus.Effort.Negative_load _ ->
67
Removed:
(load_field, "error.load")
68
Removed:
| Evidence.Stimulus.Effort.No_reps _ -> (reps_field, "error.reps")
78
Added:
(load_field, error_load)
79
Added:
| Evidence.Stimulus.Effort.No_reps _ -> (reps_field, error_reps)
69
80
| Evidence.Stimulus.Effort.Empty_extension _ ->
70
Removed:
("extension_amount", "error.reps")
81
Added:
("extension_amount", error_reps)
71
82
72
83
let effort ~load_field ~reps_field ~exercise ~load ~reps ~outcome =
73
84
match Evidence.Stimulus.Effort.make ~exercise ~load ~reps ~outcome with
@@ -131,14 +142,22 @@
131
142
132
143
(* --- error presentation --- *)
133
144
134
Removed:
let message = function
135
Removed:
| "error.required" -> "Enter a value."
136
Removed:
| "error.expected.number" -> "Enter a valid number."
137
Removed:
| "error.expected.int" -> "Enter a valid whole number."
138
Removed:
| "error.reps" -> "Enter at least one repetition."
139
Removed:
| "error.load" -> "Enter a finite, nonnegative load."
140
Removed:
| "error.extension" -> "Select one of the offered endings."
141
Removed:
| key -> key
145
Added:
(* User-facing wording for each error key. Library keys are compared through
146
Added:
Dream_html's exported constants. An unrecognised key never reaches the
147
Added:
trainee as raw text: it reads as a generic invalid-value message, and a
148
Added:
developer sees which key was missing on stderr. *)
149
Added:
let message key =
150
Added:
let is = String.equal key in
151
Added:
if is Form.error_required then "Enter a value."
152
Added:
else if is Form.error_expected_number then "Enter a valid number."
153
Added:
else if is Form.error_expected_int then "Enter a valid whole number."
154
Added:
else if is Form.error_range then "Enter a value within the allowed range."
155
Added:
else if is error_reps then "Enter at least one repetition."
156
Added:
else if is error_load then "Enter a finite, nonnegative load."
157
Added:
else if is error_extension then "Select one of the offered endings."
158
Added:
else (
159
Added:
Printf.eprintf "hito: no wording for form error key %S\n%!" key;
160
Added:
"Enter a valid value.")
142
161
143
162
let errors_to_text errors =
144
163
errors |> List.map (fun (_, key) -> message key) |> String.concat " "
test/web/errors.ml
@@ -4,6 +4,26 @@
4
4
[
5
5
( "web.errors",
6
6
[
7
Added:
( "form error keys are phrased for the trainee and never leak raw",
8
Added:
`Quick,
9
Added:
fun () ->
10
Added:
(* Library keys are phrased through Dream_html's exported constants,
11
Added:
and a key with no wording reads as a generic message rather than
12
Added:
the key itself. *)
13
Added:
let text = Hito_web.Decode.errors_to_text in
14
Added:
Alcotest.(check string)
15
Added:
"a library key is phrased" "Enter a value."
16
Added:
(text [ ("load", Dream_html.Form.error_required) ]);
17
Added:
Alcotest.(check string)
18
Added:
"a whole-number key is phrased" "Enter a valid whole number."
19
Added:
(text [ ("reps", Dream_html.Form.error_expected_int) ]);
20
Added:
let unknown = text [ ("reps", "error.something.new") ] in
21
Added:
Alcotest.(check bool)
22
Added:
"an unknown key does not leak" false
23
Added:
(Option.is_some (index_from ~needle:"error." unknown 0));
24
Added:
Alcotest.(check string)
25
Added:
"an unknown key reads as a generic message" "Enter a valid value."
26
Added:
unknown );
7
27
( "an unknown path responds 404",
8
28
`Quick,
9
29
fun () ->