Streaming opam file codec for OCaml
meta,opam,csv,sexp,toml: migrate Error/Context/Path to new Loc shape
Every codec library now:
- aliases [type t = Loc.Error.t = { ctx; meta; kind }] so consumers can
destructure with [Error.Error { ctx; meta; kind }] patterns
- takes [~ctx] / [~meta] labelled args on v / msg / raise
- drops the library-local Context sub-module in favour of the top-level
Loc.Context
- flattens error.context via Loc.Context.frames (root-to-leaf
(sort, step) pairs), with wildcard arms for the extensible Path.step
Meta: meta_error.{ml,mli} -> error.{ml,mli}, Meta_error -> Error across
lib and tests; the public module remains [Meta.Error].
Opam, CSV, TOML, Sexp: test helpers use the new Context.frames accessor
+ extensible-step wildcard (|_ -> "?"). The CSV Json.Error.to_string
leak (legacy copy-paste) dropped in favour of raw string error.
+34
-27
+2
-2
lib/codec.ml
+2
-2
lib/codec.ml
···
88
88
match List.assoc_opt s cases with
89
89
| Some v -> v
90
90
| None ->
91
-
Loc.Error.raise [] Loc.Meta.none (Opam_error.Unknown_enum_value s)
92
-
)
91
+
Opam_error.raise ~ctx:Loc.Context.empty ~meta:Loc.Meta.none
92
+
(Opam_error.Unknown_enum_value s))
93
93
| v -> err_expected "identifier or string" v);
94
94
enc =
95
95
(fun x ->
+3
-1
lib/lexer.ml
+3
-1
lib/lexer.ml
···
208
208
209
209
let raise_kind l kind =
210
210
mark_end l;
211
-
Loc.Error.raise [] (Loc.Meta.make (last_loc l)) kind
211
+
Opam_error.raise ~ctx:Loc.Context.empty
212
+
~meta:(Loc.Meta.make (last_loc l))
213
+
kind
212
214
213
215
let is_ident_start = function
214
216
| 'a' .. 'z' | 'A' .. 'Z' | '_' -> true
+12
-8
lib/opam_error.ml
+12
-8
lib/opam_error.ml
···
4
4
---------------------------------------------------------------------------*)
5
5
6
6
type kind = Loc.Error.kind = ..
7
-
type t = Loc.Error.t
8
-
9
-
module Context = Loc.Error.Context
10
7
11
8
type kind +=
12
9
| Unexpected_char of char
···
45
42
| Unknown_enum_value v -> Some (fun ppf -> Fmt.pf ppf "unknown value %S" v)
46
43
| _ -> None)
47
44
45
+
type t = Loc.Error.t = { ctx : Loc.Context.t; meta : Loc.Meta.t; kind : kind }
46
+
48
47
let v = Loc.Error.v
49
48
let msg = Loc.Error.msg
50
49
let raise = Loc.Error.raise
···
55
54
let push_object = Loc.Error.push_object
56
55
let pp = Loc.Error.pp
57
56
let to_string = Loc.Error.to_string
58
-
let unexpected_char meta c = raise Context.empty meta (Unexpected_char c)
59
-
let unterminated_string meta = raise Context.empty meta Unterminated_string
57
+
58
+
let unexpected_char meta c =
59
+
raise ~ctx:Loc.Context.empty ~meta (Unexpected_char c)
60
+
61
+
let unterminated_string meta =
62
+
raise ~ctx:Loc.Context.empty ~meta Unterminated_string
60
63
61
64
let unexpected_token meta ~expected ~found =
62
-
raise Context.empty meta (Unexpected_token { expected; found })
65
+
raise ~ctx:Loc.Context.empty ~meta (Unexpected_token { expected; found })
63
66
64
67
let sort_mismatch meta ~expected ~found =
65
-
raise Context.empty meta (Sort_mismatch { expected; found })
68
+
raise ~ctx:Loc.Context.empty ~meta (Sort_mismatch { expected; found })
66
69
67
-
let missing_field meta name = raise Context.empty meta (Missing_field name)
70
+
let missing_field meta name =
71
+
raise ~ctx:Loc.Context.empty ~meta (Missing_field name)
68
72
69
73
exception Error = Loc.Error
+10
-10
lib/opam_error.mli
+10
-10
lib/opam_error.mli
···
11
11
module load time. *)
12
12
13
13
type kind = Loc.Error.kind = ..
14
-
type t = Loc.Error.t
15
-
16
-
module Context = Loc.Error.Context
17
14
18
15
(** {1:typed Opam-specific kinds} *)
19
16
···
32
29
33
30
(** {1:raise Raise helpers} *)
34
31
35
-
val v : Context.t -> Loc.Meta.t -> kind -> t
36
-
(** [v ctx meta k] is an error value with kind [k] at [meta]. *)
32
+
type t = Loc.Error.t = { ctx : Loc.Context.t; meta : Loc.Meta.t; kind : kind }
33
+
(** The type for errors. *)
37
34
38
-
val msg : Context.t -> Loc.Meta.t -> string -> t
39
-
(** [msg ctx meta s] is [v ctx meta (Loc.Error.Msg s)]. *)
35
+
val v : ctx:Loc.Context.t -> meta:Loc.Meta.t -> kind -> t
36
+
(** [v ~ctx ~meta k] is an error value with kind [k] at [meta]. *)
37
+
38
+
val msg : ctx:Loc.Context.t -> meta:Loc.Meta.t -> string -> t
39
+
(** [msg ~ctx ~meta s] is [v ~ctx ~meta (Loc.Error.Msg s)]. *)
40
40
41
-
val raise : Context.t -> Loc.Meta.t -> kind -> 'a
42
-
(** [raise ctx meta k] raises {!Error} with kind [k]. *)
41
+
val raise : ctx:Loc.Context.t -> meta:Loc.Meta.t -> kind -> 'a
42
+
(** [raise ~ctx ~meta k] raises {!Error} with kind [k]. *)
43
43
44
44
val fail : Loc.Meta.t -> string -> 'a
45
45
(** [fail meta s] raises a {!Loc.Error.Msg} error. *)
···
78
78
(** [to_string e] is [e] formatted as a string. *)
79
79
80
80
exception Error of t
81
-
(** Raised by parser, encoder, and codec on failure. *)
81
+
(** Alias of {!Loc.Error}. *)
+3
-2
test/test_opam_error.ml
+3
-2
test/test_opam_error.ml
···
9
9
let buf = Buffer.create 64 in
10
10
let ppf = Format.formatter_of_buffer buf in
11
11
let err =
12
-
Error.v Error.Context.empty Loc.Meta.none (Error.Unexpected_char '@')
12
+
Error.v ~ctx:Loc.Context.empty ~meta:Loc.Meta.none
13
+
(Error.Unexpected_char '@')
13
14
in
14
15
Error.pp ppf err;
15
16
Format.pp_print_flush ppf ();
···
27
28
28
29
let test_raise_helpers () =
29
30
try Error.unexpected_char Loc.Meta.none 'X' with
30
-
| Error.Error (_, _, Error.Unexpected_char 'X') -> ()
31
+
| Error.Error { kind = Error.Unexpected_char 'X'; _ } -> ()
31
32
| _ -> Alcotest.fail "expected Unexpected_char 'X'"
32
33
33
34
let suite =
+4
-4
test/test_parser.ml
+4
-4
test/test_parser.ml
···
127
127
let _ = parse src in
128
128
Alcotest.failf "expected error %s on %S" name src
129
129
with
130
-
| Opam.Error (_, _, kind) when pred kind -> ()
131
-
| Opam.Error (_, _, _) ->
130
+
| Opam.Error { kind; _ } when pred kind -> ()
131
+
| Opam.Error { kind = _; _ } ->
132
132
Alcotest.failf "wrong error kind: expected %s for %S" name src
133
133
134
134
let test_neg_unbalanced_bracket () = must_fail "unbalanced [" {|x: [|}
···
248
248
try
249
249
let _ = parse src in
250
250
Alcotest.fail "expected error"
251
-
with Opam.Error (_, meta, _) ->
251
+
with Opam.Error { meta; _ } ->
252
252
let loc = Loc.Meta.textloc meta in
253
253
let line = Loc.first_line_num loc in
254
254
let byte = Loc.first_byte loc in
···
266
266
try
267
267
let _ = parse src in
268
268
Alcotest.fail "expected error"
269
-
with Opam.Error (_, meta, _) ->
269
+
with Opam.Error { meta; _ } ->
270
270
let loc = Loc.Meta.textloc meta in
271
271
let byte = Loc.first_byte loc in
272
272
Alcotest.(check bool)