Skip to content

Commit 15e352c

Browse files
mbarbinmbarbin
authored
Merge pull request #97 from mbarbin/improve-load-config-errors
Improve errors when loading invalid configs
2 parents 88eaed7 + 4409ed0 commit 15e352c

18 files changed

+203
-15
lines changed

‎CHANGES.md‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,9 @@
1+
## 0.0.2025XXXX (unreleased)
2+
3+
### Fixed
4+
5+
- Config loading errors are no longer internal errors and now reported with locations when able (#97, @mbarbin).
6+
17
## 0.0.20250907 (2025-09-07)
28

39
### Added

‎dune-project‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -106,6 +106,8 @@
106106
(>= v0.17))
107107
(ppxlib
108108
(>= 0.35.0))
109+
(re
110+
(>= 1.8.0))
109111
(sexplib0
110112
(>= v0.17))
111113
(sexps-rewriter
@@ -183,6 +185,8 @@
183185
(>= v0.17))
184186
(ppxlib
185187
(>= 0.35.0))
188+
(re
189+
(>= 1.8.0))
186190
(sexplib0
187191
(>= v0.17))
188192
(sexps-rewriter
@@ -280,6 +284,8 @@
280284
(>= v0.17))
281285
(ppxlib
282286
(>= 0.35.0))
287+
(re
288+
(>= 1.8.0))
283289
(sexplib0
284290
(>= v0.17))
285291
(sexps-rewriter

‎dunolint-dev.opam‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -43,6 +43,7 @@ depends: [
4343
"ppx_sexp_conv" {>= "v0.17"}
4444
"ppx_sexp_value" {>= "v0.17"}
4545
"ppxlib" {>= "0.35.0"}
46+
"re" {>= "1.8.0"}
4647
"sexplib0" {>= "v0.17"}
4748
"sexps-rewriter" {>= "0.0.3"}
4849
"stdio" {>= "v0.17"}

‎dunolint-tests.opam‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -36,6 +36,7 @@ depends: [
3636
"ppx_sexp_conv" {>= "v0.17"}
3737
"ppx_sexp_value" {>= "v0.17"}
3838
"ppxlib" {>= "0.35.0"}
39+
"re" {>= "1.8.0"}
3940
"sexplib0" {>= "v0.17"}
4041
"sexps-rewriter" {>= "0.0.3"}
4142
"stdio" {>= "v0.17"}

‎dunolint.opam‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ depends: [
3333
"ppx_sexp_conv" {>= "v0.17"}
3434
"ppx_sexp_value" {>= "v0.17"}
3535
"ppxlib" {>= "0.35.0"}
36+
"re" {>= "1.8.0"}
3637
"sexplib0" {>= "v0.17"}
3738
"sexps-rewriter" {>= "0.0.3"}
3839
"stdio" {>= "v0.17"}

‎lib/dunolint/src/config.ml‎

Lines changed: 6 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -63,10 +63,14 @@ let to_versioned_sexp (t : t) : Sexp.t =
6363

6464
let t_of_sexp (sexp : Sexp.t) =
6565
match sexp with
66-
| List [ List [ Atom "version"; Atom version ]; config ] ->
66+
| List [ List [ Atom "version"; (Atom version as version_sexp) ]; config ] ->
6767
(match version with
6868
| "0" -> `v0 (V0.t_of_sexp config)
69-
| _ -> failwith (Printf.sprintf "Unsupported dunolint config version %S." version))
69+
| _ ->
70+
raise
71+
(Sexp.Of_sexp_error
72+
( Failure (Printf.sprintf "Unsupported dunolint config version [%s]." version)
73+
, version_sexp )))
7074
| _ -> `v0 (V0.t_of_sexp sexp)
7175
;;
7276

‎lib/dunolint/test/test__config.ml‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -103,6 +103,11 @@ let%expect_test "unsupported version" =
103103
let sexp = Sexp.List [ List [ Atom "version"; Atom "unknown" ]; List [] ] in
104104
require_does_raise [%here] (fun () ->
105105
(Dunolint.Config.t_of_sexp sexp : Dunolint.Config.t));
106-
[%expect {| (Failure "Unsupported dunolint config version \"unknown\".") |}];
106+
[%expect
107+
{|
108+
(Of_sexp_error
109+
"Unsupported dunolint config version [unknown]."
110+
(invalid_sexp unknown))
111+
|}];
107112
()
108113
;;

‎lib/dunolint_cli/src/cmd__lint.ml‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -38,9 +38,7 @@ let main =
3838
in
3939
let config =
4040
match config with
41-
| Some config ->
42-
let contents = In_channel.read_all config in
43-
Parsexp.Conv_single.parse_string_exn contents Dunolint.Config.t_of_sexp
41+
| Some filename -> Common_helpers.load_config_exn ~filename
4442
| None ->
4543
Dunolint.Config.create
4644
~skip_subtree:(Common_helpers.skip_subtree ~globs:[])

‎lib/dunolint_cli/src/cmd__tools__lint_file.ml‎

Lines changed: 1 addition & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -198,9 +198,7 @@ let main =
198198
let cwd = Unix.getcwd () |> Absolute_path.v in
199199
let config =
200200
match config with
201-
| Some config ->
202-
let contents = In_channel.read_all config in
203-
Parsexp.Conv_single.parse_string_exn contents Dunolint.Config.t_of_sexp
201+
| Some filename -> Common_helpers.load_config_exn ~filename
204202
| None ->
205203
Dunolint.Config.create
206204
~skip_subtree:(Common_helpers.skip_subtree ~globs:[])

‎lib/dunolint_cli/src/common_helpers.ml‎

Lines changed: 63 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -68,3 +68,66 @@ let skip_subtree ~globs =
6868
, skip_subtree )
6969
]
7070
;;
71+
72+
let error_message_cleanup_pattern =
73+
lazy (Re.Perl.compile_pat {|^(?:[^/]*[/])*([^/]*)\.ml\.([^.]*)\.[^:]*:(.*)$|})
74+
;;
75+
76+
let clean_up_error_message str =
77+
let pattern = Lazy.force error_message_cleanup_pattern in
78+
match Re.exec_opt pattern str with
79+
| None -> str
80+
| Some match_info ->
81+
let basename = Re.Group.get match_info 1 in
82+
let module_name = Re.Group.get match_info 2 in
83+
let rest = Re.Group.get match_info 3 in
84+
Printf.sprintf "%s.%s:%s" basename module_name rest
85+
;;
86+
87+
let loc_of_parsexp_range ~filename (range : Parsexp.Positions.range) =
88+
let source_code_position ({ line; col; offset } : Parsexp.Positions.pos) =
89+
{ Lexing.pos_fname = filename
90+
; pos_lnum = line
91+
; pos_cnum = offset
92+
; pos_bol = offset - col
93+
}
94+
in
95+
Loc.create (source_code_position range.start_pos, source_code_position range.end_pos)
96+
;;
97+
98+
let load_config_exn ~filename =
99+
let contents = In_channel.read_all filename in
100+
match Parsexp.Single_and_positions.parse_string contents with
101+
| Error parse_error ->
102+
let position = Parsexp.Parse_error.position parse_error in
103+
let message = Parsexp.Parse_error.message parse_error in
104+
let loc =
105+
loc_of_parsexp_range ~filename { start_pos = position; end_pos = position }
106+
in
107+
Err.raise ~loc [ Pp.text message ]
108+
| Ok (sexp, positions) ->
109+
(match Parsexp.Conv_single.conv (sexp, positions) Dunolint.Config.t_of_sexp with
110+
| Ok t -> t
111+
| Error of_sexp_error ->
112+
let range =
113+
match Parsexp.Of_sexp_error.location of_sexp_error with
114+
| Some _ as range -> range
115+
| None ->
116+
(let sub = Parsexp.Of_sexp_error.sub_sexp of_sexp_error in
117+
(match Parsexp.Positions.find_sub_sexp_phys positions sexp ~sub with
118+
| Some _ as range -> range
119+
| None -> None))
120+
[@coverage off]
121+
in
122+
let loc =
123+
match range with
124+
| Some range -> loc_of_parsexp_range ~filename range
125+
| None -> Loc.of_file ~path:(Fpath.v filename) [@coverage off]
126+
in
127+
let message =
128+
match Parsexp.Of_sexp_error.user_exn of_sexp_error with
129+
| Failure str -> clean_up_error_message str
130+
| exn -> Exn.to_string exn [@coverage off]
131+
in
132+
Err.raise ~loc [ Pp.text message ])
133+
;;

0 commit comments

Comments
 (0)