2817

Committed 23 Oct 2024 05:55PM UTC coverage: 33.411% (-27.7%) from 61.089%

Build # 2817

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16270 from MinaProtocol/dkijania/fix_promotion_job

Fix verify promoted docker check

Run Details

22271 of 66658 relevant lines covered (33.41%)

131054.24 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

15.94

/src/lib/error_json/error_json.ml

open Base

let rec sexp_to_yojson (sexp : Sexp.t) : Yojson.Safe.t =
  match sexp with
  | Atom str ->
      `String str
  | List sexps ->
      `List (List.map ~f:sexp_to_yojson sexps)

let sexp_record_to_yojson (sexp : Sexp.t) : Yojson.Safe.t =
  let fail () =
    failwith
      (Printf.sprintf
         "sexp_record_to_yojson called on an s-expression with a non-record \
          structure %s"
         (Sexp.to_string_hum sexp) )
  in
  match sexp with
  | List fields ->
      `Assoc
        (List.map fields ~f:(function
          | List [ Atom label; value ] ->
              (label, sexp_to_yojson value)
          | _ ->
              fail () ) )
  | _ ->
      fail ()

let rec sexp_of_yojson (json : Yojson.Safe.t) : (Sexp.t, string) Result.t =
  match json with
  | `String str ->
      Ok (Sexp.Atom str)
  | `List jsons ->
      let rev_sexps =
        List.fold_until ~init:[] jsons ~finish:Result.return
          ~f:(fun sexps json ->
            match sexp_of_yojson json with
            | Ok sexp ->
                Continue (sexp :: sexps)
            | Error str ->
                Stop (Error str) )
      in
      Result.map ~f:(fun l -> Sexp.List (List.rev l)) rev_sexps
  | _ ->
      Error "Error_json.sexp_of_yojson: Expected a string or a list"

type info_data =
  | Sexp of Sexp.t
  | String of string
  | Exn of exn
  | Of_list of int option * int * Yojson.Safe.t

(* Used to encode sub-lists of infos *)

type info_tag =
  { tag : string; data : Sexp.t option; loc : Source_code_position.t option }

type 'a info_repr =
  { base : 'a; rev_tags : info_tag list; backtrace : string option }

let info_repr_to_yojson (info : info_data info_repr) : Yojson.Safe.t =
  let base_pairs =
    match info.base with
    | Sexp sexp ->
        [ ("sexp", sexp_to_yojson sexp) ]
    | String str ->
        [ ("string", `String str) ]
    | Exn exn ->
        [ ( "exn_name"
          , `String Stdlib.Obj.Extension_constructor.(name @@ of_val exn) )
        ; ("exn", sexp_to_yojson (Sexplib.Conv.sexp_of_exn exn))
        ]
    | Of_list (Some trunc_after, length, json) ->
        [ ("multiple", json)
        ; ("length", `Int length)
        ; ("truncated_after", `Int trunc_after)
        ]
    | Of_list (None, length, json) ->
        [ ("multiple", json); ("length", `Int length) ]
  in
  let tags =
    let tag_to_json { tag; data; loc } =
      let jsons =
        match loc with
        | None ->
            []
        | Some loc ->
            [ ("loc", `String (Source_code_position.to_string loc)) ]
      in
      let jsons =
        match data with
        | None ->
            jsons
        | Some data ->
            ("sexp", sexp_to_yojson data) :: jsons
      in
      `Assoc (("tag", `String tag) :: jsons)
    in
    match info.rev_tags with
    | [] ->
        []
    | _ :: _ ->
        [ ("tags", `List (List.rev_map ~f:tag_to_json info.rev_tags)) ]
  in
  let backtrace =
    match info.backtrace with
    | None ->
        []
    | Some backtrace ->
        (* Split backtrace at lines so that it prints nicely in errors *)
        [ ( "backtrace"
          , `List
              (List.map ~f:(fun s -> `String s) (String.split_lines backtrace))
          )
        ]
  in
  `Assoc (base_pairs @ tags @ backtrace)

(* NOTE: Could also add a [of_yojson] version for everything except [Exn]
   (which could be converted to [String]), but it's not clear that it would
   ever be useful.
*)

let rec info_internal_repr_to_yojson_aux (info : Info.Internal_repr.t)
    (acc : unit info_repr) : info_data info_repr =
  match info with
  | Could_not_construct sexp ->
      { acc with base = Sexp (List [ Atom "Could_not_construct"; sexp ]) }
  | Sexp sexp ->
      { acc with base = Sexp sexp }
  | String str ->
      { acc with base = String str }
  | Exn exn ->
      { acc with base = Exn exn }
  | Tag_sexp (tag, sexp, loc) ->
      { acc with
        base = Sexp sexp
      ; rev_tags = { tag; data = None; loc } :: acc.rev_tags
      }
  | Tag_t (tag, info) ->
      info_internal_repr_to_yojson_aux info
        { acc with rev_tags = { tag; data = None; loc = None } :: acc.rev_tags }
  | Tag_arg (tag, data, info) ->
      info_internal_repr_to_yojson_aux info
        { acc with
          rev_tags = { tag; data = Some data; loc = None } :: acc.rev_tags
        }
  | Of_list (trunc_after, infos) ->
      let rec rev_take i acc_len infos acc_infos =
        match (i, infos) with
        | _, [] ->
            (None, acc_len, acc_infos)
        | None, info :: infos ->
            let json_info = info_internal_repr_to_yojson info in
            rev_take i (acc_len + 1) infos (json_info :: acc_infos)
        | Some i, info :: infos ->
            if i > 0 then
              let json_info = info_internal_repr_to_yojson info in
              rev_take
                (Some (i - 1))
                (acc_len + 1) infos (json_info :: acc_infos)
            else (Some acc_len, acc_len + 1 + List.length infos, acc_infos)
      in
      let trunc_after, length, rev_json_infos =
        rev_take trunc_after 0 infos []
      in
      let json_infos = `List (List.rev rev_json_infos) in
      { acc with base = Of_list (trunc_after, length, json_infos) }
  | With_backtrace (info, backtrace) ->
      info_internal_repr_to_yojson_aux info
        { acc with backtrace = Some backtrace }

and info_internal_repr_to_yojson (info : Info.Internal_repr.t) : Yojson.Safe.t =
  info_internal_repr_to_yojson_aux info
    { base = (); rev_tags = []; backtrace = None }
  |> info_repr_to_yojson

let info_to_yojson (info : Info.t) : Yojson.Safe.t =
  info_internal_repr_to_yojson (Info.Internal_repr.of_info info)

let error_to_yojson (err : Error.t) : Yojson.Safe.t =
  match info_to_yojson (err :> Info.t) with
  | `Assoc assocs ->
      `Assoc assocs
  | json ->
      `Assoc [ ("error", json) ]

1	open Base
2
3	let rec sexp_to_yojson (sexp : Sexp.t) : Yojson.Safe.t =
4	match sexp with	×
5	\| Atom str ->	×
6	`String str
7	\| List sexps ->	×
8	`List (List.map ~f:sexp_to_yojson sexps)	×
9
10	let sexp_record_to_yojson (sexp : Sexp.t) : Yojson.Safe.t =
11	let fail () =	×
12	failwith	×
13	(Printf.sprintf	×
14	"sexp_record_to_yojson called on an s-expression with a non-record \
15	structure %s"
16	(Sexp.to_string_hum sexp) )	×
17	in
18	match sexp with
19	\| List fields ->	×
20	`Assoc
21	(List.map fields ~f:(function	×
22	\| List [ Atom label; value ] ->	×
23	(label, sexp_to_yojson value)	×
24	\| _ ->	×
25	fail () ) )
26	\| _ ->	×
27	fail ()
28
29	let rec sexp_of_yojson (json : Yojson.Safe.t) : (Sexp.t, string) Result.t =
30	match json with	×
31	\| `String str ->	×
32	Ok (Sexp.Atom str)
33	\| `List jsons ->	×
34	let rev_sexps =
35	List.fold_until ~init:[] jsons ~finish:Result.return
36	~f:(fun sexps json ->
37	match sexp_of_yojson json with	×
38	\| Ok sexp ->	×
39	Continue (sexp :: sexps)
40	\| Error str ->	×
41	Stop (Error str) )
42	in
43	Result.map ~f:(fun l -> Sexp.List (List.rev l)) rev_sexps	×
44	\| _ ->	×
45	Error "Error_json.sexp_of_yojson: Expected a string or a list"
46
47	type info_data =
48	\| Sexp of Sexp.t
49	\| String of string
50	\| Exn of exn
51	\| Of_list of int option * int * Yojson.Safe.t
52
53	(* Used to encode sub-lists of infos *)
54
55	type info_tag =
56	{ tag : string; data : Sexp.t option; loc : Source_code_position.t option }
57
58	type 'a info_repr =
59	{ base : 'a; rev_tags : info_tag list; backtrace : string option }
60
61	let info_repr_to_yojson (info : info_data info_repr) : Yojson.Safe.t =
62	let base_pairs =	1✔
63	match info.base with
64	\| Sexp sexp ->	×
65	[ ("sexp", sexp_to_yojson sexp) ]	×
66	\| String str ->	1✔
67	[ ("string", `String str) ]
68	\| Exn exn ->	×
69	[ ( "exn_name"
70	, `String Stdlib.Obj.Extension_constructor.(name @@ of_val exn) )	×
71	; ("exn", sexp_to_yojson (Sexplib.Conv.sexp_of_exn exn))	×
72	]
73	\| Of_list (Some trunc_after, length, json) ->	×
74	[ ("multiple", json)
75	; ("length", `Int length)
76	; ("truncated_after", `Int trunc_after)
77	]
78	\| Of_list (None, length, json) ->	×
79	[ ("multiple", json); ("length", `Int length) ]
80	in
81	let tags =
82	let tag_to_json { tag; data; loc } =
83	let jsons =	×
84	match loc with
85	\| None ->	×
86	[]
87	\| Some loc ->	×
88	[ ("loc", `String (Source_code_position.to_string loc)) ]	×
89	in
90	let jsons =
91	match data with
92	\| None ->	×
93	jsons
94	\| Some data ->	×
95	("sexp", sexp_to_yojson data) :: jsons	×
96	in
97	`Assoc (("tag", `String tag) :: jsons)
98	in
99	match info.rev_tags with
100	\| [] ->	1✔
101	[]
102	\| _ :: _ ->	×
103	[ ("tags", `List (List.rev_map ~f:tag_to_json info.rev_tags)) ]	×
104	in
105	let backtrace =
106	match info.backtrace with
107	\| None ->	1✔
108	[]
109	\| Some backtrace ->	×
110	(* Split backtrace at lines so that it prints nicely in errors *)
111	[ ( "backtrace"
112	, `List
113	(List.map ~f:(fun s -> `String s) (String.split_lines backtrace))	×
114	)
115	]
116	in
117	`Assoc (base_pairs @ tags @ backtrace)
118
119	(* NOTE: Could also add a [of_yojson] version for everything except [Exn]
120	(which could be converted to [String]), but it's not clear that it would
121	ever be useful.
122	*)
123
124	let rec info_internal_repr_to_yojson_aux (info : Info.Internal_repr.t)
125	(acc : unit info_repr) : info_data info_repr =
126	match info with	1✔
127	\| Could_not_construct sexp ->	×
128	{ acc with base = Sexp (List [ Atom "Could_not_construct"; sexp ]) }
129	\| Sexp sexp ->	×
130	{ acc with base = Sexp sexp }
131	\| String str ->	1✔
132	{ acc with base = String str }
133	\| Exn exn ->	×
134	{ acc with base = Exn exn }
135	\| Tag_sexp (tag, sexp, loc) ->	×
136	{ acc with
137	base = Sexp sexp
138	; rev_tags = { tag; data = None; loc } :: acc.rev_tags
139	}
140	\| Tag_t (tag, info) ->	×
141	info_internal_repr_to_yojson_aux info
142	{ acc with rev_tags = { tag; data = None; loc = None } :: acc.rev_tags }
143	\| Tag_arg (tag, data, info) ->	×
144	info_internal_repr_to_yojson_aux info
145	{ acc with
146	rev_tags = { tag; data = Some data; loc = None } :: acc.rev_tags
147	}
148	\| Of_list (trunc_after, infos) ->	×
149	let rec rev_take i acc_len infos acc_infos =
150	match (i, infos) with	×
151	\| _, [] ->	×
152	(None, acc_len, acc_infos)
153	\| None, info :: infos ->	×
154	let json_info = info_internal_repr_to_yojson info in
155	rev_take i (acc_len + 1) infos (json_info :: acc_infos)	×
156	\| Some i, info :: infos ->	×
157	if i > 0 then
158	let json_info = info_internal_repr_to_yojson info in	×
159	rev_take	×
160	(Some (i - 1))
161	(acc_len + 1) infos (json_info :: acc_infos)
162	else (Some acc_len, acc_len + 1 + List.length infos, acc_infos)	×
163	in
164	let trunc_after, length, rev_json_infos =
165	rev_take trunc_after 0 infos []
166	in
167	let json_infos = `List (List.rev rev_json_infos) in	×
168	{ acc with base = Of_list (trunc_after, length, json_infos) }
169	\| With_backtrace (info, backtrace) ->	×
170	info_internal_repr_to_yojson_aux info
171	{ acc with backtrace = Some backtrace }
172
173	and info_internal_repr_to_yojson (info : Info.Internal_repr.t) : Yojson.Safe.t =
174	info_internal_repr_to_yojson_aux info	1✔
175	{ base = (); rev_tags = []; backtrace = None }
176	\|> info_repr_to_yojson	1✔
177
178	let info_to_yojson (info : Info.t) : Yojson.Safe.t =
179	info_internal_repr_to_yojson (Info.Internal_repr.of_info info)	1✔
180
181	let error_to_yojson (err : Error.t) : Yojson.Safe.t =
182	match info_to_yojson (err :> Info.t) with	1✔
183	\| `Assoc assocs ->	1✔
184	`Assoc assocs
185	\| json ->	×
186	`Assoc [ ("error", json) ]

MinaProtocol / mina / 2817

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous