Protocol Buffers codec for hand-written schemas
protobuf: complete Error facade with verb re-exports and shape helpers
Add the missing pieces to Protobuf.Error so callers don't need to reach
into Loc.Error directly:
- Verb re-exports: v, msg, raise, fail, failf, push_array, push_object,
kind_to_string (were previously missing; users had to import Loc.Error
separately).
- Typed kinds: Sort_mismatch, Kinded_sort_mismatch (for schema-vs-payload
sort errors at the codec layer, complementing the existing wire-layer
kinds).
- Shape helpers: expected, sort, kinded_sort, missing_mems, unexpected_mems,
index_out_of_range, number_range, integer_range, no_decoder, no_encoder,
decode_todo, encode_todo.
Brings the protobuf facade in line with the json exemplar and toml.
+151
+69
lib/error.ml
+69
lib/error.ml
···
9
9
| Unsupported_wire_type of int
10
10
| Truncated of { need : int; have : int }
11
11
| Overrun
12
+
| Sort_mismatch of { exp : Sort.t; fnd : Sort.t }
13
+
| Kinded_sort_mismatch of { exp : string; fnd : Sort.t }
12
14
13
15
type t = Loc.Error.t
16
+
17
+
let pp_code ppf s = Fmt.(styled `Bold string) ppf s
14
18
15
19
let () =
16
20
Loc.Error.register_kind_printer (function
···
32
36
Some
33
37
(fun ppf -> Fmt.pf ppf "truncated: need %d bytes, have %d" need have)
34
38
| Overrun -> Some (fun ppf -> Fmt.string ppf "overran message boundary")
39
+
| Sort_mismatch { exp; fnd } ->
40
+
Some
41
+
(fun ppf ->
42
+
Fmt.pf ppf "Expected %a but found %a" Sort.pp exp Sort.pp fnd)
43
+
| Kinded_sort_mismatch { exp; fnd } ->
44
+
Some
45
+
(fun ppf ->
46
+
Fmt.pf ppf "Expected %a but found %a" pp_code exp Sort.pp fnd)
35
47
| _ -> None)
36
48
49
+
(* Re-exports: thin aliases over Loc.Error. *)
50
+
51
+
let kind_to_string = Loc.Error.kind_to_string
52
+
let v = Loc.Error.v
53
+
let msg = Loc.Error.msg
54
+
let raise = Loc.Error.raise
55
+
let fail = Loc.Error.fail
56
+
let failf = Loc.Error.failf
57
+
let push_array = Loc.Error.push_array
58
+
let push_object = Loc.Error.push_object
37
59
let pp = Loc.Error.pp
38
60
let to_string = Loc.Error.to_string
39
61
let raise_kind k = Loc.Error.raise ~ctx:Loc.Context.empty ~meta:Loc.Meta.none k
···
44
66
[Loc.Error.t] with kind [Loc.Error.Msg]. *)
45
67
let of_wire_error msg =
46
68
Loc.Error.msg ~ctx:Loc.Context.empty ~meta:Loc.Meta.none msg
69
+
70
+
(* Shape-error helpers following the skill's standard menu. *)
71
+
72
+
let expected meta exp ~fnd =
73
+
failf meta "Expected %a but found %a" pp_code exp pp_code fnd
74
+
75
+
let sort meta ~exp ~fnd =
76
+
raise ~ctx:Loc.Context.empty ~meta (Sort_mismatch { exp; fnd })
77
+
78
+
let kinded_sort meta ~exp ~fnd =
79
+
raise ~ctx:Loc.Context.empty ~meta (Kinded_sort_mismatch { exp; fnd })
80
+
81
+
let missing_mems meta ~kinded_sort:ks ~exp ~fnd:_ =
82
+
match exp with
83
+
| [ n ] -> failf meta "Missing member %a in %a" pp_code n pp_code ks
84
+
| ns ->
85
+
failf meta "@[<v1>Missing members in %a:@,%a@]" pp_code ks
86
+
Fmt.(list ~sep:cut (fun ppf n -> pf ppf "%a" pp_code n))
87
+
ns
88
+
89
+
let unexpected_mems meta ~kinded_sort:ks ~exp:_ ~fnd =
90
+
match fnd with
91
+
| [ (u, _) ] -> failf meta "Unexpected member %a for %a" pp_code u pp_code ks
92
+
| us ->
93
+
failf meta "@[<v1>Unexpected members for %a:@,%a@]" pp_code ks
94
+
Fmt.(list ~sep:cut (fun ppf (n, _) -> pf ppf "%a" pp_code n))
95
+
us
96
+
97
+
let index_out_of_range meta ~n ~len =
98
+
failf meta "Index %d out of range [0;%d]" n (len - 1)
99
+
100
+
let number_range meta ~kind n =
101
+
failf meta "Number %g not in %a range" n pp_code kind
102
+
103
+
let integer_range meta ~kind n =
104
+
failf meta "Integer %d not in %a range" n pp_code kind
105
+
106
+
let no_decoder meta ~kind = failf meta "No decoder for %a" pp_code kind
107
+
let no_encoder meta ~kind = failf meta "No encoder for %a" pp_code kind
108
+
109
+
let decode_todo meta ~kind_opt =
110
+
if kind_opt = "" then failf meta "TODO: decode"
111
+
else failf meta "TODO: decode %a" pp_code kind_opt
112
+
113
+
let encode_todo meta ~kind_opt =
114
+
if kind_opt = "" then failf meta "TODO: encode"
115
+
else failf meta "TODO: encode %a" pp_code kind_opt
+82
lib/error.mli
+82
lib/error.mli
···
33
33
| Overrun
34
34
(** The decoder finished a field past the declared message boundary — a
35
35
length-prefix lied about how many bytes follow. *)
36
+
| Sort_mismatch of { exp : Sort.t; fnd : Sort.t }
37
+
(** Schema/payload sort mismatch (e.g. schema says [Int32], payload
38
+
decoded to [String]). *)
39
+
| Kinded_sort_mismatch of { exp : string; fnd : Sort.t }
40
+
(** Like {!Sort_mismatch} but with a free-form expected description. *)
41
+
42
+
val kind_to_string : kind -> string
43
+
(** [kind_to_string k] renders [k] via the printers registered with
44
+
{!Loc.Error.register_kind_printer}. *)
36
45
37
46
type t = Loc.Error.t
38
47
(** Alias for {!Loc.Error.t}. *)
39
48
49
+
val v : ctx:Loc.Context.t -> meta:Loc.Meta.t -> kind -> t
50
+
(** [v ~ctx ~meta k] is a fresh error. *)
51
+
52
+
val msg : ctx:Loc.Context.t -> meta:Loc.Meta.t -> string -> t
53
+
(** [msg ~ctx ~meta s] is an error with kind [Loc.Error.Msg s]. *)
54
+
55
+
val raise : ctx:Loc.Context.t -> meta:Loc.Meta.t -> kind -> 'a
56
+
(** [raise ~ctx ~meta k] raises [Loc.Error.Error (v ~ctx ~meta k)]. *)
57
+
58
+
val fail : Loc.Meta.t -> string -> 'a
59
+
(** [fail meta s] raises with empty context and string [s]. *)
60
+
61
+
val failf : Loc.Meta.t -> ('a, Format.formatter, unit, 'b) format4 -> 'a
62
+
(** [failf meta fmt] is {!fail} with a formatted message. *)
63
+
64
+
val push_array : string Loc.node -> int Loc.node -> t -> 'a
65
+
(** [push_array sort n e] re-raises [e] after pushing an array index onto its
66
+
context. *)
67
+
68
+
val push_object : string Loc.node -> string Loc.node -> t -> 'a
69
+
(** [push_object sort n e] re-raises [e] after pushing an object member onto its
70
+
context. *)
71
+
40
72
val pp : t Fmt.t
41
73
(** [pp ppf e] formats the error using {!Loc.Error.pp}. *)
42
74
···
58
90
structured [Loc.Error.t] with an empty context and no meta. Used by the
59
91
codec top-level to bridge the wire layer's exception into the public result
60
92
type. *)
93
+
94
+
(** {1:shape Shape-error helpers}
95
+
96
+
Generic helpers for the recurring shape categories a decoder hits — typed
97
+
sort mismatches, object member issues, index bounds, numeric ranges. *)
98
+
99
+
val expected : Loc.Meta.t -> string -> fnd:string -> 'a
100
+
(** [expected meta exp ~fnd] raises ["Expected exp but found fnd"]. *)
101
+
102
+
val sort : Loc.Meta.t -> exp:Sort.t -> fnd:Sort.t -> 'a
103
+
(** [sort meta ~exp ~fnd] raises {!Sort_mismatch}. *)
104
+
105
+
val kinded_sort : Loc.Meta.t -> exp:string -> fnd:Sort.t -> 'a
106
+
(** [kinded_sort meta ~exp ~fnd] raises {!Kinded_sort_mismatch}. *)
107
+
108
+
val missing_mems :
109
+
Loc.Meta.t -> kinded_sort:string -> exp:string list -> fnd:string list -> 'a
110
+
(** [missing_mems meta ~kinded_sort ~exp ~fnd] raises listing the [exp] members
111
+
that were missing from a message of [kinded_sort]. *)
112
+
113
+
val unexpected_mems :
114
+
Loc.Meta.t ->
115
+
kinded_sort:string ->
116
+
exp:string list ->
117
+
fnd:(string * Loc.Meta.t) list ->
118
+
'a
119
+
(** [unexpected_mems meta ~kinded_sort ~exp ~fnd] raises listing the unexpected
120
+
members in [fnd] for a message of [kinded_sort]. *)
121
+
122
+
val index_out_of_range : Loc.Meta.t -> n:int -> len:int -> 'a
123
+
(** [index_out_of_range meta ~n ~len] raises ["Index n out of range [0;len-1]"].
124
+
*)
125
+
126
+
val number_range : Loc.Meta.t -> kind:string -> float -> 'a
127
+
(** [number_range meta ~kind n] raises ["Number n not in kind range"]. *)
128
+
129
+
val integer_range : Loc.Meta.t -> kind:string -> int -> 'a
130
+
(** [integer_range meta ~kind n] raises ["Integer n not in kind range"]. *)
131
+
132
+
val no_decoder : Loc.Meta.t -> kind:string -> 'a
133
+
(** [no_decoder meta ~kind] raises ["No decoder for kind"]. *)
134
+
135
+
val no_encoder : Loc.Meta.t -> kind:string -> 'a
136
+
(** [no_encoder meta ~kind] raises ["No encoder for kind"]. *)
137
+
138
+
val decode_todo : Loc.Meta.t -> kind_opt:string -> 'a
139
+
(** [decode_todo meta ~kind_opt] raises ["TODO: decode kind_opt"]. *)
140
+
141
+
val encode_todo : Loc.Meta.t -> kind_opt:string -> 'a
142
+
(** [encode_todo meta ~kind_opt] raises ["TODO: encode kind_opt"]. *)