@@ -36,21 +36,27 @@ module Annotation_severity = struct
36
36
;;
37
37
end
38
38
39
- open ! Ppx_yojson_conv_lib.Yojson_conv. Primitives
40
-
41
39
module User_handle = struct
42
40
type t = Vcs.User_handle .t [@@ deriving sexp_of ]
43
41
44
- let t_of_yojson json =
45
- match json |> string_of_yojson |> Vcs.User_handle. of_string with
46
- | Ok t -> t
47
- | Error (`Msg msg ) ->
48
- raise (Ppx_yojson_conv_lib.Yojson_conv. Of_yojson_error (Failure msg, json))
42
+ let of_yojson json =
43
+ match (json : Yojson.Safe.t ) with
44
+ | `String str ->
45
+ (match Vcs.User_handle. of_string str with
46
+ | Ok _ as ok -> ok
47
+ | Error (`Msg msg ) -> Error msg)
48
+ | _ -> Error " User handle expected to be a json string."
49
49
;;
50
50
end
51
51
52
52
module User_list = struct
53
- type t = User_handle .t list [@@ deriving of_yojson ]
53
+ type t = User_handle .t list
54
+
55
+ let of_yojson json : (t, string) Result.t =
56
+ match (json : Yojson.Safe.t ) with
57
+ | `List xs -> Ppx_deriving_yojson_runtime. map_bind User_handle. of_yojson [] xs
58
+ | _ -> Error " User handle list expected to be a list of json strings."
59
+ ;;
54
60
end
55
61
56
62
type t =
@@ -94,6 +100,18 @@ let get_json_enum_constructor json ~loc ~field_name =
94
100
;;
95
101
96
102
let parse_json json ~loc ~emit_github_annotations =
103
+ let of_yojson_exn f json =
104
+ match f json with
105
+ | Ok x -> x
106
+ | Error msg ->
107
+ Err. raise
108
+ ~loc
109
+ Pp.O.
110
+ [ Pp. text " Invalid config."
111
+ ; Pp. text " In: " ++ Pp. text (Yojson.Safe. to_string json)
112
+ ; Pp. text msg
113
+ ]
114
+ in
97
115
match json with
98
116
| `Assoc fields ->
99
117
(* Track which fields have been accessed *)
@@ -104,13 +122,13 @@ let parse_json json ~loc ~emit_github_annotations =
104
122
in
105
123
let default_repo_owner =
106
124
match field " default_repo_owner" with
107
- | Some json -> Some (User_handle. t_of_yojson json)
125
+ | Some json -> Some (of_yojson_exn User_handle. of_yojson json)
108
126
| None -> None
109
127
in
110
128
let user_mentions_allowlist =
111
129
let field_name = " user_mentions_allowlist" in
112
130
match field field_name with
113
- | Some json -> Some (User_list. t_of_yojson json)
131
+ | Some json -> Some (of_yojson_exn User_list. of_yojson json)
114
132
| None ->
115
133
(* See [upgrading-crs] guide in the documentation for more details about
116
134
deprecated fields and compatibility transitions in the configs. *)
@@ -129,7 +147,7 @@ let parse_json json ~loc ~emit_github_annotations =
129
147
++ Pp. text " ."
130
148
]
131
149
~hints: [ Pp. text " Upgrade the config to use the new name." ];
132
- Some (User_list. t_of_yojson json))
150
+ Some (of_yojson_exn User_list. of_yojson json))
133
151
in
134
152
let severity_field ~field_name =
135
153
match field field_name with
@@ -213,27 +231,7 @@ let empty =
213
231
214
232
let load_exn ~path ~emit_github_annotations =
215
233
match Yojson_five.Safe. from_file (Fpath. to_string path) with
234
+ | Ok json -> parse_json json ~loc: (Loc. of_file ~path ) ~emit_github_annotations
216
235
| Error msg ->
217
236
Err. raise ~loc: (Loc. of_file ~path ) [ Pp. text " Not a valid json file." ; Pp. text msg ]
218
- | Ok json ->
219
- (match
220
- match parse_json json ~loc: (Loc. of_file ~path ) ~emit_github_annotations with
221
- | t -> Ok t
222
- | exception Ppx_yojson_conv_lib.Yojson_conv. Of_yojson_error (exn , json ) ->
223
- Error (exn , json)
224
- with
225
- | Ok t -> t
226
- | Error (exn , json ) ->
227
- let msg =
228
- match exn with
229
- | Failure msg -> Pp. text msg
230
- | exn -> Err. exn exn [@ coverage off]
231
- in
232
- Err. raise
233
- ~loc: (Loc. of_file ~path )
234
- Pp.O.
235
- [ Pp. text " Invalid config."
236
- ; Pp. text " In: " ++ Pp. text (Yojson.Safe. to_string json)
237
- ; msg
238
- ])
239
237
;;
0 commit comments