2863

Committed 05 Nov 2024 06:20PM UTC coverage: 30.754% (-16.6%) from 47.311%

Build # 2863

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16296 from MinaProtocol/dkijania/more_multi_jobs

more multi jobs in CI

Run Details

20276 of 65930 relevant lines covered (30.75%)

8631.7 hits per line

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

6.67

/src/lib/graphql_basic_scalars/testing.ml

(**
   Utils for roundtrip testing of graphql scalars.
 *)
open Utils

module type Test_Intf = sig
  type t

  val gen : t Base_quickcheck.Generator.t

  val sexp_of_t : t -> Ppx_sexp_conv_lib.Sexp.t

  val compare : t -> t -> int
end

let list_of_seq seq =
  let rec loop seq =
    match seq () with
    | Seq.Nil ->
        []
    | Seq.Cons (Ok x, next) ->
        x :: loop next
    | Seq.Cons (Error _, _) ->
        assert false
  in
  loop seq

let json_from_response = function
  | Ok (`Response data) ->
      data
  | Ok (`Stream stream) -> (
      try
        match stream () with
        | Seq.Cons (Ok _, _) ->
            `List (list_of_seq stream)
        | Seq.Cons (Error err, _) ->
            err
        | Seq.Nil ->
            `Null
      with _ -> `String "caught stream exn" )
  | Error err ->
      err

let test_query schema ctx query (f_test : Yojson.Basic.t -> unit) : unit =
  match Graphql_parser.parse query with
  | Error err ->
      failwith err
  | Ok doc ->
      Graphql.Schema.execute schema ctx doc |> json_from_response |> f_test

let get_test_field = function
  | `Assoc [ ("data", `Assoc [ ("test", value) ]) ] ->
      value
  | json ->
      Core_kernel.failwithf "(%s) Unexpected format of JSON response:%s" __LOC__
        (Yojson.Basic.to_string json)
        ()

module Produce_test
    (S : Json_intf_any_typ with type ('a, 'b) typ := ('a, 'b) Graphql.Schema.typ)
    (G : Test_Intf with type t = S.t) =
struct
  let query_server_and_compare value =
    let schema =
      Graphql.Schema.(
        schema
          [ field "test"
              ~typ:(non_null @@ S.typ ())
              ~args:Arg.[]
              ~resolve:(fun _ () -> value)
          ])
    in
    test_query schema () "{ test }" (fun response ->
        [%test_eq: G.t] value (S.parse @@ get_test_field response) )

  let test_query () =
    Core_kernel.Quickcheck.test G.gen ~sexp_of:G.sexp_of_t
      ~f:query_server_and_compare
end

module Make_test
    (S : Json_intf_any_typ with type ('a, 'b) typ := ('a, 'b) Graphql.Schema.typ)
    (G : Test_Intf with type t = S.t) =
struct
  include Produce_test (S) (G)

  let%test_unit "test" = test_query ()
end

1	(**
2	Utils for roundtrip testing of graphql scalars.
3	*)	2✔
4	open Utils
5
6	module type Test_Intf = sig
7	type t
8
9	val gen : t Base_quickcheck.Generator.t
10
11	val sexp_of_t : t -> Ppx_sexp_conv_lib.Sexp.t
12
13	val compare : t -> t -> int
14	end
15
16	let list_of_seq seq =
17	let rec loop seq =	×
18	match seq () with	×
19	\| Seq.Nil ->	×
20	[]
21	\| Seq.Cons (Ok x, next) ->	×
22	x :: loop next	×
23	\| Seq.Cons (Error _, _) ->
24	assert false
25	in
26	loop seq
27
28	let json_from_response = function
29	\| Ok (`Response data) ->	×
30	data
31	\| Ok (`Stream stream) -> (	×
32	try
33	match stream () with
34	\| Seq.Cons (Ok _, _) ->	×
35	`List (list_of_seq stream)	×
36	\| Seq.Cons (Error err, _) ->	×
37	err
38	\| Seq.Nil ->	×
39	`Null
40	with _ -> `String "caught stream exn" )	×
41	\| Error err ->	×
42	err
43
44	let test_query schema ctx query (f_test : Yojson.Basic.t -> unit) : unit =
45	match Graphql_parser.parse query with	×
46	\| Error err ->	×
47	failwith err
48	\| Ok doc ->	×
49	Graphql.Schema.execute schema ctx doc \|> json_from_response \|> f_test	×
50
51	let get_test_field = function
52	\| `Assoc [ ("data", `Assoc [ ("test", value) ]) ] ->	×
53	value
54	\| json ->	×
55	Core_kernel.failwithf "(%s) Unexpected format of JSON response:%s" __LOC__
56	(Yojson.Basic.to_string json)	×
57	()
58
59	module Produce_test
60	(S : Json_intf_any_typ with type ('a, 'b) typ := ('a, 'b) Graphql.Schema.typ)
61	(G : Test_Intf with type t = S.t) =
62	struct
63	let query_server_and_compare value =
64	let schema =	×
65	Graphql.Schema.(
66	schema	×
67	[ field "test"	×
68	~typ:(non_null @@ S.typ ())	×
69	~args:Arg.[]
70	~resolve:(fun _ () -> value)	×
71	])
72	in
73	test_query schema () "{ test }" (fun response ->
74	[%test_eq: G.t] value (S.parse @@ get_test_field response) )	×
75
76	let test_query () =
77	Core_kernel.Quickcheck.test G.gen ~sexp_of:G.sexp_of_t	×
78	~f:query_server_and_compare
79	end
80
81	module Make_test
82	(S : Json_intf_any_typ with type ('a, 'b) typ := ('a, 'b) Graphql.Schema.typ)
83	(G : Test_Intf with type t = S.t) =
84	struct
85	include Produce_test (S) (G)
86
87	let%test_unit "test" = test_query ()	×
88	end	4✔

MinaProtocol / mina / 2863

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