forked from
jonmsterling.com/ocaml-forester
ocaml
Improve warnings in configuration parser
Testing setup for configuration errors
+90
-17
+6
lib/core/Error.ml
+6
lib/core/Error.ml
···
2
2
open Grace
3
3
open Grace_ansi_renderer
4
4
5
+
let empty_label ~range = Diagnostic.Label.createf ~priority:Primary ~range ""
6
+
7
+
let print =
8
+
Format.printf "%a@."
9
+
(pp_diagnostic ~code_to_string:Message.to_string ?config:None)
10
+
5
11
let print_warning :
6
12
?notes:Diagnostic.Message.t list ->
7
13
?labels:Diagnostic.Label.t list ->
+40
-17
lib/frontend/Config_parser.ml
+40
-17
lib/frontend/Config_parser.ml
···
8
8
open Message
9
9
open Result.Syntax
10
10
11
-
(* type keys = (Toml.Types.Table.key
12
-
[@printer fun fmt key -> fprintf fmt "%s" (Toml.Types.Table.Key.to_string
13
-
key)]) list list [@@deriving show] *)
14
-
15
11
module Key_set = struct
16
12
include Set.Make (struct
17
13
type t = Toml.Types.Table.key list
···
25
21
remove key set
26
22
end
27
23
24
+
let pp_dirlist fmt key =
25
+
Format.(
26
+
fprintf fmt "[%a]"
27
+
(pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "; ") pp_print_string)
28
+
key)
29
+
28
30
let keys (tbl : Toml.Types.value Toml.Types.Table.t) =
29
31
let rec go current keys tbl =
30
32
List.fold_left
···
43
45
let parse lexbuf filename : Config.t res =
44
46
match Toml.Parser.parse lexbuf filename with
45
47
| `Error (desc, {source; _}) ->
46
-
let loc = Range.of_lexbuf ~source:(`File source) lexbuf in
47
-
error @@ Diagnostic.createf Error ~code:Configuration_error "%s" desc
48
+
let range = Range.of_lexbuf ~source:(`File source) lexbuf in
49
+
error
50
+
@@ Diagnostic.createf Error
51
+
~labels:[Error.empty_label ~range]
52
+
~code:Configuration_error "%s" desc
48
53
| `Ok tbl ->
49
54
let open Toml.Lenses in
50
55
let keys = ref (keys tbl) in
51
-
let with_default ~value k lens =
56
+
let with_default ~value ~pp_value k lens =
52
57
let open Toml.Lenses in
53
58
match get tbl lens with
54
-
| None -> value
59
+
| None ->
60
+
Error.print
61
+
@@ Diagnostic.createf Warning "option [%a] not set, using default %a"
62
+
Format.(
63
+
pp_print_list
64
+
~pp_sep:(fun fmt () -> fprintf fmt ".")
65
+
pp_print_string)
66
+
k pp_value value;
67
+
value
55
68
| Some v ->
56
69
keys := Key_set.remove k !keys;
57
70
v
···
73
86
let default = Config.default ~url () in
74
87
let trees =
75
88
let k = ["forest"; "trees"] in
76
-
with_default ~value:default.trees k
89
+
with_default ~value:default.trees ~pp_value:pp_dirlist k
77
90
(forest |-- key "trees" |-- array |-- strings)
78
91
in
79
92
let errors, foreign =
···
95
108
in
96
109
match get foreign_tbl (key "path" |-- string) with
97
110
| None ->
98
-
error
99
-
@@ [Diagnostic.createf Error ~code:Required_config_option "path"]
111
+
error @@ Diagnostic.createf Error ~code:Required_config_option "path"
100
112
| Some path -> ok Config.{path; route_locally; include_in_manifest})
101
113
in
102
114
let assets =
103
-
with_default ~value:default.assets ["forest"; "assets"]
115
+
with_default ~value:default.assets ~pp_value:pp_dirlist
116
+
["forest"; "assets"]
104
117
(forest |-- key "assets" |-- array |-- strings)
105
118
in
106
119
let home =
107
120
let k = ["forest"; "home"] in
108
121
URI.named_uri ~base:url
109
-
@@ with_default ~value:"index" k (forest |-- key "home" |-- string)
122
+
@@ with_default ~value:"index" ~pp_value:Format.pp_print_string k
123
+
(forest |-- key "home" |-- string)
110
124
in
111
125
let theme = get tbl (forest |-- key "theme" |-- string) in
112
126
(if not (Key_set.is_empty !keys) then
113
127
let unused_keys =
114
128
!keys |> Key_set.to_list
115
-
|> List.map (List.map Toml.Types.Table.Key.to_string)
129
+
|> List.map
130
+
(List.map Toml.Types.Table.Key.to_string >>> String.concat ".")
116
131
in
117
-
Error.print_warning ~code:Uninterpreted_config_options "");
132
+
Error.print
133
+
@@ Diagnostic.createf Warning
134
+
"These configuration options are unknown: %a"
135
+
Format.(
136
+
pp_print_list
137
+
~pp_sep:(fun fmt () -> fprintf fmt "@.")
138
+
pp_print_string)
139
+
unused_keys);
140
+
List.iter Error.print errors;
118
141
ok @@ Config.{url; assets; trees; foreign; home; theme}
119
142
120
143
let parse_forest_config_string str =
···
129
152
let result = parse lexbuf filename in
130
153
Sys.chdir @@ Filename.dirname filename;
131
154
result
132
-
with exn ->
133
-
error @@ Diagnostic.createf Error ~code:IO_error "%a" Eio.Exn.pp exn
155
+
with Sys_error exn ->
156
+
error @@ Diagnostic.createf Error ~code:IO_error "%s" exn
+6
lib/frontend/test/Test_config_parser.ml
+6
lib/frontend/test/Test_config_parser.ml
+12
lib/frontend/test/config.t
+12
lib/frontend/test/config.t
···
1
+
$ parse_forester_config configs/correct.toml
2
+
3
+
$ parse_forester_config configs/missing-fields.toml
4
+
warning: option [forest.trees] not set, using default [trees]
5
+
warning: option [forest.assets] not set, using default []
6
+
warning: option [forest.home] not set, using default index
7
+
8
+
$ parse_forester_config configs/uninterpreted-fields.toml
9
+
warning: These configuration options are unknown: forest.unknown
10
+
11
+
$ parse_forester_config configs/nonexistent.toml
12
+
error[io_error]: configs/nonexistent.toml: No such file or directory
+4
lib/frontend/test/configs/correct.toml
+4
lib/frontend/test/configs/correct.toml
+1
lib/frontend/test/configs/missing-fields.toml
+1
lib/frontend/test/configs/missing-fields.toml
···
1
+
[forest]
+5
lib/frontend/test/configs/uninterpreted-fields.toml
+5
lib/frontend/test/configs/uninterpreted-fields.toml
+16
lib/frontend/test/dune
+16
lib/frontend/test/dune
···
37
37
pure-html
38
38
eio_main
39
39
logs))
40
+
41
+
(executable
42
+
(name Test_config_parser)
43
+
(public_name parse_forester_config)
44
+
(libraries
45
+
forester.prelude
46
+
forester.frontend
47
+
forester.compiler
48
+
forester.core
49
+
grace
50
+
grace.ansi_renderer))
51
+
52
+
(cram
53
+
(deps
54
+
%{bin:parse_forester_config}
55
+
(glob_files configs/*)))