2903

Committed 15 Nov 2024 01:59PM UTC coverage: 36.723% (-25.0%) from 61.682%

Build # 2903

Build Type

Pull #16342

buildkite

Committed by

dkijania

Commit Message

Merge branch 'dkijania/remove_publish_job_from_pr_comp' into dkijania/remove_publish_job_from_pr_dev

Pull Request Pull Request #16342: [DEV] Publish debians only on nightly and stable

Run Details

15 of 40 new or added lines in 14 files covered. (37.5%)

15175 existing lines in 340 files now uncovered.

24554 of 66863 relevant lines covered (36.72%)

20704.91 hits per line

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

45.38

/src/lib/fields_derivers_json/fields_derivers_json.ml

open Core_kernel
open Fieldslib

module To_yojson = struct
  module Input = struct
    type ('input_type, 'a, 'c) t =
      < to_json : ('input_type -> Yojson.Safe.t) ref
      ; contramap : ('c -> 'input_type) ref
      ; skip : bool ref
      ; .. >
      as
      'a
  end

  module Accumulator = struct
    type ('input_type, 'a, 'c) t =
      < to_json_accumulator :
          (string * ('input_type -> Yojson.Safe.t)) option list ref
      ; .. >
      as
      'a
      constraint ('input_type, 'a, 'c) t = ('input_type, 'a, 'c) Input.t
  end

  let add_field ~t_fields_annots t_field field acc =
    let annotations =
      Fields_derivers.Annotations.Fields.of_annots t_fields_annots
        (Field.name field)
    in
    let rest = !(acc#to_json_accumulator) in
    acc#to_json_accumulator :=
      ( if annotations.skip || !(t_field#skip) then None
      else
        ( Option.value annotations.name
            ~default:(Fields_derivers.name_under_to_camel field)
        , fun x -> !(t_field#to_json) (!(t_field#contramap) (Field.get field x))
        )
        |> Option.return )
      :: rest ;
    ((fun _ -> failwith "Unused"), acc)

  let finish (_creator, obj) =
    let to_json_accumulator = !(obj#to_json_accumulator) in
    obj#contramap := Fn.id ;
    (obj#to_json :=
       fun t ->
         `Assoc
           ( List.filter_map to_json_accumulator
               ~f:(Option.map ~f:(fun (name, f) -> (name, f t)))
           |> List.rev ) ) ;
    obj

  let skip obj =
    obj#skip := true ;
    obj#contramap := Fn.id ;
    (obj#to_json :=
       fun _ -> failwith "Unexpected: This obj#to_json should be skipped" ) ;
    obj

  let int obj =
    obj#contramap := Fn.id ;
    (obj#to_json := fun x -> `Int x) ;
    obj

  let string obj =
    obj#contramap := Fn.id ;
    (obj#to_json := fun x -> `String x) ;
    obj

  let bool obj =
    obj#contramap := Fn.id ;
    (obj#to_json := fun x -> `Bool x) ;
    obj

  let list x obj =
    obj#contramap := List.map ~f:!(x#contramap) ;
    (obj#to_json := fun a -> `List (List.map ~f:!(x#to_json) a)) ;
    obj

  let option x obj =
    obj#contramap := Option.map ~f:!(x#contramap) ;
    (obj#to_json :=
       fun a_opt -> match a_opt with Some a -> !(x#to_json) a | None -> `Null ) ;
    obj

  let contramap ~f x obj =
    (obj#contramap := fun a -> !(x#contramap) (f a)) ;
    obj#to_json := !(x#to_json) ;
    obj
end

module Of_yojson = struct
  module Input = struct
    type ('input_type, 'a, 'c) t =
      < of_json : (Yojson.Safe.t -> 'input_type) ref
      ; map : ('input_type -> 'c) ref
      ; skip : bool ref
      ; .. >
      as
      'a
  end

  module Creator = struct
    type ('input_type, 'a, 'c) t =
      < of_json_creator : Yojson.Safe.t String.Map.t ref ; .. > as 'a
      constraint ('input_type, 'a, 'c) t = ('input_type, 'a, 'c) Input.t
  end

  exception Field_not_found of string

  let add_field ?skip_data ~t_fields_annots :
      ('t, 'a, 'c) Input.t -> 'field -> 'obj -> 'creator * 'obj =
   fun t_field field acc_obj ->
    let annotations =
      Fields_derivers.Annotations.Fields.of_annots t_fields_annots
        (Field.name field)
    in
    let creator finished_obj =
      let map = !(finished_obj#of_json_creator) in
      !(t_field#map)
        ( if annotations.skip || !(t_field#skip) then
          match skip_data with
          | Some x ->
              x
          | None ->
              failwith
                "If you are skipping a field in of_json but intend on building \
                 this field, you must provide skip_data to add_field!"
        else
          !(t_field#of_json)
            (let name =
               Option.value annotations.name
                 ~default:(Fields_derivers.name_under_to_camel field)
             in
             match Map.find map name with
             | None ->
                 raise (Field_not_found name)
             | Some x ->
                 x ) )
    in
    (creator, acc_obj)

  exception Json_not_object

  let finish (creator, obj) =
    let of_json json =
      match json with
      | `Assoc pairs ->
          obj#of_json_creator := String.Map.of_alist_exn pairs ;
          creator obj
      | _ ->
          raise Json_not_object
    in
    obj#map := Fn.id ;
    obj#of_json := of_json ;
    obj

  exception Invalid_json_scalar of [ `Int | `String | `Bool | `List ]

  let skip obj =
    obj#contramap := Fn.id ;
    (obj#of_json :=
       fun _ -> failwith "Unexpected: This obj#of_json should be skipped" ) ;
    obj

  let int obj =
    (obj#of_json :=
       function `Int x -> x | _ -> raise (Invalid_json_scalar `Int) ) ;
    obj#map := Fn.id ;
    obj

  let string obj =
    (obj#of_json :=
       function `String x -> x | _ -> raise (Invalid_json_scalar `String) ) ;
    obj#map := Fn.id ;
    obj

  let bool obj =
    (obj#of_json :=
       function `Bool x -> x | _ -> raise (Invalid_json_scalar `Bool) ) ;
    obj#map := Fn.id ;
    obj

  let list x obj =
    (obj#of_json :=
       function
       | `List xs ->
           List.map xs ~f:!(x#of_json)
       | _ ->
           raise (Invalid_json_scalar `List) ) ;
    obj#map := List.map ~f:!(x#map) ;
    obj

  let option x obj =
    (obj#of_json :=
       function `Null -> None | other -> Some (!(x#of_json) other) ) ;
    obj#map := Option.map ~f:!(x#map) ;
    obj

  let map ~f x obj =
    (obj#map := fun a -> f (!(x#map) a)) ;
    obj#of_json := !(x#of_json) ;
    obj
end

let%test_module "Test" =
  ( module struct
    type t = { foo_hello : int; skipped : int [@skip]; bar : string list }
    [@@deriving annot, fields]

    let v = { foo_hello = 1; skipped = 0; bar = [ "baz1"; "baz2" ] }

    let m =
      {json|{ fooHello: 1, bar: ["baz1", "baz2"] }|json}
      |> Yojson.Safe.from_string

    module Yojson_version = struct
      type t = { foo_hello : int [@key "fooHello"]; bar : string list }
      [@@deriving yojson]

      let v = { foo_hello = 1; bar = [ "baz1"; "baz2" ] }
    end

    let deriver () =
      let to_json = ref (fun _ -> failwith "unimplemented") in
      let of_json = ref (fun _ -> failwith "unimplemented") in
      let to_json_accumulator = ref [] in
      let of_json_creator = ref String.Map.empty in
      let map = ref Fn.id in
      let contramap = ref Fn.id in
      let skip = ref false in
      object
        method skip = skip

        method to_json = to_json

        method map = map

        method contramap = contramap

        method of_json = of_json

        method to_json_accumulator = to_json_accumulator

        method of_json_creator = of_json_creator
      end

    let o () = deriver ()

    (* Explanation: Fields.make_creator roughly executes the following code:

       let make_creator ~foo_hello ~bar obj =
         (* Fieldslib.Field is actually a little more complicated *)
         let field_foo = Field { name = "foo_hello" ; getter = (fun o -> o.foo_hello) } in
         let field_bar = Field { name = "bar"; getter = (fun o -> o.bar) } in
         let creator_foo, obj = foo_hello field_foo obj in
         let creator_bar, obj = bar field_bar obj in
         let creator finished_obj =
           { foo_hello = creator_foo finished_obj ; bar = creator_bar finished_obj }
         in
         (creator, obj)
    *)

    let to_json obj =
      let open To_yojson in
      let ( !. ) x fd acc = add_field ~t_fields_annots (x @@ o ()) fd acc in
      Fields.make_creator obj ~foo_hello:!.int ~skipped:!.skip
        ~bar:!.(list @@ string @@ o ())
      |> finish

    let of_json obj =
      let open Of_yojson in
      let ( !. ) ?skip_data x fd acc =
        add_field ?skip_data ~t_fields_annots (x @@ o ()) fd acc
      in
      Fields.make_creator obj ~foo_hello:!.int
        ~skipped:(( !. ) ~skip_data:0 skip)
        ~bar:!.(list @@ string @@ o ())
      |> finish

    let both_json obj =
      let _a = to_json obj in
      let _b = of_json obj in
      obj

    let full_derivers = both_json @@ o ()

    let%test_unit "folding creates a yojson object we expect (modulo camel \
                   casing)" =
      [%test_eq: string]
        (Yojson_version.to_yojson Yojson_version.v |> Yojson.Safe.to_string)
        (!(full_derivers#to_json) v |> Yojson.Safe.to_string)

    let%test_unit "unfolding creates a yojson object we expect" =
      let expected =
        Yojson_version.of_yojson m |> Result.ok |> Option.value_exn
      in
      let actual = !(full_derivers#of_json) m in
      [%test_eq: string list] expected.bar actual.bar ;
      [%test_eq: int] expected.foo_hello actual.foo_hello

    let%test_unit "round trip" =
      [%test_eq: string]
        ( !(full_derivers#to_json) (!(full_derivers#of_json) m)
        |> Yojson.Safe.to_string )
        (m |> Yojson.Safe.to_string)
  end )

1	open Core_kernel	21✔
2	open Fieldslib
3
4	module To_yojson = struct
5	module Input = struct
6	type ('input_type, 'a, 'c) t =
7	< to_json : ('input_type -> Yojson.Safe.t) ref
8	; contramap : ('c -> 'input_type) ref
9	; skip : bool ref
10	; .. >
11	as
12	'a
13	end
14
15	module Accumulator = struct
16	type ('input_type, 'a, 'c) t =
17	< to_json_accumulator :
18	(string * ('input_type -> Yojson.Safe.t)) option list ref
19	; .. >
20	as
21	'a
22	constraint ('input_type, 'a, 'c) t = ('input_type, 'a, 'c) Input.t
23	end
24
25	let add_field ~t_fields_annots t_field field acc =
26	let annotations =	2,852✔
27	Fields_derivers.Annotations.Fields.of_annots t_fields_annots
28	(Field.name field)	2,852✔
29	in
30	let rest = !(acc#to_json_accumulator) in	2,852✔
31	acc#to_json_accumulator :=	2,852✔
UNCOV 32	( if annotations.skip \|\| !(t_field#skip) then None	×
33	else
34	( Option.value annotations.name	2,852✔
35	~default:(Fields_derivers.name_under_to_camel field)	2,852✔
36	, fun x -> !(t_field#to_json) (!(t_field#contramap) (Field.get field x))	11,258✔
37	)
38	\|> Option.return )	2,852✔
39	:: rest ;
40	((fun _ -> failwith "Unused"), acc)	×
41
42	let finish (_creator, obj) =
43	let to_json_accumulator = !(obj#to_json_accumulator) in	805✔
44	obj#contramap := Fn.id ;	805✔
45	(obj#to_json :=	805✔
46	fun t ->
47	`Assoc	2,383✔
48	( List.filter_map to_json_accumulator	2,383✔
49	~f:(Option.map ~f:(fun (name, f) -> (name, f t)))	11,258✔
50	\|> List.rev ) ) ;	2,383✔
51	obj
52
53	let skip obj =
54	obj#skip := true ;	69✔
55	obj#contramap := Fn.id ;	69✔
56	(obj#to_json :=	69✔
57	fun _ -> failwith "Unexpected: This obj#to_json should be skipped" ) ;	×
58	obj
59
60	let int obj =
61	obj#contramap := Fn.id ;	23✔
62	(obj#to_json := fun x -> `Int x) ;	22✔
63	obj
64
65	let string obj =
66	obj#contramap := Fn.id ;	92✔
67	(obj#to_json := fun x -> `String x) ;	88✔
68	obj
69
70	let bool obj =
71	obj#contramap := Fn.id ;	253✔
72	(obj#to_json := fun x -> `Bool x) ;	242✔
73	obj
74
75	let list x obj =
76	obj#contramap := List.map ~f:!(x#contramap) ;	207✔
77	(obj#to_json := fun a -> `List (List.map ~f:!(x#to_json) a)) ;	198✔
78	obj
79
80	let option x obj =
81	obj#contramap := Option.map ~f:!(x#contramap) ;	851✔
82	(obj#to_json :=	851✔
83	fun a_opt -> match a_opt with Some a -> !(x#to_json) a \| None -> `Null ) ;	1,343✔
84	obj
85
86	let contramap ~f x obj =
87	(obj#contramap := fun a -> !(x#contramap) (f a)) ;	946✔
88	obj#to_json := !(x#to_json) ;	989✔
89	obj
90	end
91
92	module Of_yojson = struct
93	module Input = struct
94	type ('input_type, 'a, 'c) t =
95	< of_json : (Yojson.Safe.t -> 'input_type) ref
96	; map : ('input_type -> 'c) ref
97	; skip : bool ref
98	; .. >
99	as
100	'a
101	end
102
103	module Creator = struct
104	type ('input_type, 'a, 'c) t =
105	< of_json_creator : Yojson.Safe.t String.Map.t ref ; .. > as 'a
106	constraint ('input_type, 'a, 'c) t = ('input_type, 'a, 'c) Input.t
107	end
108
109	exception Field_not_found of string
110
111	let add_field ?skip_data ~t_fields_annots :
112	('t, 'a, 'c) Input.t -> 'field -> 'obj -> 'creator * 'obj =
113	fun t_field field acc_obj ->	2,852✔
114	let annotations =	2,852✔
115	Fields_derivers.Annotations.Fields.of_annots t_fields_annots
116	(Field.name field)	2,852✔
117	in
118	let creator finished_obj =	2,852✔
UNCOV 119	let map = !(finished_obj#of_json_creator) in	×
UNCOV 120	!(t_field#map)	×
UNCOV 121	( if annotations.skip \|\| !(t_field#skip) then	×
UNCOV 122	match skip_data with	×
UNCOV 123	\| Some x ->	×
124	x
125	\| None ->	×
126	failwith
127	"If you are skipping a field in of_json but intend on building \
128	this field, you must provide skip_data to add_field!"
129	else
UNCOV 130	!(t_field#of_json)	×
131	(let name =
132	Option.value annotations.name
UNCOV 133	~default:(Fields_derivers.name_under_to_camel field)	×
134	in
UNCOV 135	match Map.find map name with	×
136	\| None ->	×
137	raise (Field_not_found name)
UNCOV 138	\| Some x ->	×
139	x ) )
140	in
141	(creator, acc_obj)
142
143	exception Json_not_object
144
145	let finish (creator, obj) =
146	let of_json json =	805✔
UNCOV 147	match json with	×
UNCOV 148	\| `Assoc pairs ->	×
UNCOV 149	obj#of_json_creator := String.Map.of_alist_exn pairs ;	×
150	creator obj
151	\| _ ->	×
152	raise Json_not_object
153	in
154	obj#map := Fn.id ;	805✔
155	obj#of_json := of_json ;	805✔
156	obj
157
158	exception Invalid_json_scalar of [ `Int \| `String \| `Bool \| `List ]
159
160	let skip obj =
161	obj#contramap := Fn.id ;	69✔
162	(obj#of_json :=	69✔
163	fun _ -> failwith "Unexpected: This obj#of_json should be skipped" ) ;	×
164	obj
165
166	let int obj =
167	(obj#of_json :=	23✔
168	function `Int x -> x \| _ -> raise (Invalid_json_scalar `Int) ) ;	×
169	obj#map := Fn.id ;	23✔
170	obj
171
172	let string obj =
173	(obj#of_json :=	92✔
174	function `String x -> x \| _ -> raise (Invalid_json_scalar `String) ) ;	×
175	obj#map := Fn.id ;	92✔
176	obj
177
178	let bool obj =
179	(obj#of_json :=	253✔
180	function `Bool x -> x \| _ -> raise (Invalid_json_scalar `Bool) ) ;	×
181	obj#map := Fn.id ;	253✔
182	obj
183
184	let list x obj =
185	(obj#of_json :=	207✔
186	function
UNCOV 187	\| `List xs ->	×
UNCOV 188	List.map xs ~f:!(x#of_json)	×
189	\| _ ->	×
190	raise (Invalid_json_scalar `List) ) ;
191	obj#map := List.map ~f:!(x#map) ;	207✔
192	obj
193
194	let option x obj =
195	(obj#of_json :=	851✔
UNCOV 196	function `Null -> None \| other -> Some (!(x#of_json) other) ) ;	×
197	obj#map := Option.map ~f:!(x#map) ;	851✔
198	obj
199
200	let map ~f x obj =
201	(obj#map := fun a -> f (!(x#map) a)) ;	946✔
202	obj#of_json := !(x#of_json) ;	989✔
203	obj
204	end
205
206	let%test_module "Test" =
207	( module struct
208	type t = { foo_hello : int; skipped : int [@skip]; bar : string list }	×
209	[@@deriving annot, fields]
210
211	let v = { foo_hello = 1; skipped = 0; bar = [ "baz1"; "baz2" ] }
212
213	let m =
214	{json\|{ fooHello: 1, bar: ["baz1", "baz2"] }\|json}
UNCOV 215	\|> Yojson.Safe.from_string	×
216
217	module Yojson_version = struct
UNCOV 218	type t = { foo_hello : int [@key "fooHello"]; bar : string list }	×
UNCOV 219	[@@deriving yojson]	×
220
221	let v = { foo_hello = 1; bar = [ "baz1"; "baz2" ] }
222	end
223
224	let deriver () =
225	let to_json = ref (fun _ -> failwith "unimplemented") in	×
226	let of_json = ref (fun _ -> failwith "unimplemented") in	×
227	let to_json_accumulator = ref [] in
228	let of_json_creator = ref String.Map.empty in
229	let map = ref Fn.id in
230	let contramap = ref Fn.id in
231	let skip = ref false in
232	object
UNCOV 233	method skip = skip	×
234
UNCOV 235	method to_json = to_json	×
236
UNCOV 237	method map = map	×
238
UNCOV 239	method contramap = contramap	×
240
UNCOV 241	method of_json = of_json	×
242
UNCOV 243	method to_json_accumulator = to_json_accumulator	×
244
UNCOV 245	method of_json_creator = of_json_creator	×
246	end
247
UNCOV 248	let o () = deriver ()	×
249
250	(* Explanation: Fields.make_creator roughly executes the following code:
251
252	let make_creator ~foo_hello ~bar obj =
253	(* Fieldslib.Field is actually a little more complicated *)
254	let field_foo = Field { name = "foo_hello" ; getter = (fun o -> o.foo_hello) } in
255	let field_bar = Field { name = "bar"; getter = (fun o -> o.bar) } in
256	let creator_foo, obj = foo_hello field_foo obj in
257	let creator_bar, obj = bar field_bar obj in
258	let creator finished_obj =
259	{ foo_hello = creator_foo finished_obj ; bar = creator_bar finished_obj }
260	in
261	(creator, obj)
262	*)
263
264	let to_json obj =
UNCOV 265	let open To_yojson in	×
UNCOV 266	let ( !. ) x fd acc = add_field ~t_fields_annots (x @@ o ()) fd acc in	×
UNCOV 267	Fields.make_creator obj ~foo_hello:!.int ~skipped:!.skip	×
UNCOV 268	~bar:!.(list @@ string @@ o ())	×
269	\|> finish
270
271	let of_json obj =
UNCOV 272	let open Of_yojson in	×
273	let ( !. ) ?skip_data x fd acc =
UNCOV 274	add_field ?skip_data ~t_fields_annots (x @@ o ()) fd acc	×
275	in
UNCOV 276	Fields.make_creator obj ~foo_hello:!.int	×
UNCOV 277	~skipped:(( !. ) ~skip_data:0 skip)	×
UNCOV 278	~bar:!.(list @@ string @@ o ())	×
279	\|> finish
280
281	let both_json obj =
UNCOV 282	let _a = to_json obj in	×
UNCOV 283	let _b = of_json obj in	×
UNCOV 284	obj	×
285
UNCOV 286	let full_derivers = both_json @@ o ()	×
287
288	let%test_unit "folding creates a yojson object we expect (modulo camel \
289	casing)" =
UNCOV 290	[%test_eq: string]	×
UNCOV 291	(Yojson_version.to_yojson Yojson_version.v \|> Yojson.Safe.to_string)	×
UNCOV 292	(!(full_derivers#to_json) v \|> Yojson.Safe.to_string)	×
293
294	let%test_unit "unfolding creates a yojson object we expect" =
UNCOV 295	let expected =	×
UNCOV 296	Yojson_version.of_yojson m \|> Result.ok \|> Option.value_exn	×
297	in
UNCOV 298	let actual = !(full_derivers#of_json) m in	×
UNCOV 299	[%test_eq: string list] expected.bar actual.bar ;	×
UNCOV 300	[%test_eq: int] expected.foo_hello actual.foo_hello	×
301
302	let%test_unit "round trip" =
UNCOV 303	[%test_eq: string]	×
UNCOV 304	( !(full_derivers#to_json) (!(full_derivers#of_json) m)	×
UNCOV 305	\|> Yojson.Safe.to_string )	×
UNCOV 306	(m \|> Yojson.Safe.to_string)	×
307	end )	42✔

MinaProtocol / mina / 2903

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