3409

Committed 26 Feb 2025 01:10PM UTC coverage: 32.353% (-28.4%) from 60.756%

Build # 3409

Build Type

push

buildkite

Committed by

web-flow

Commit Message

Merge pull request #16687 from MinaProtocol/dw/merge-compatible-into-develop-20250225

Merge compatible into develop [20250224]

Run Details

23144 of 71535 relevant lines covered (32.35%)

16324.05 hits per line

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

52.5

/src/lib/fields_derivers/fields_derivers.ml

open Core_kernel

module Annotations = struct
  module Utils = struct
    let find xs key =
      List.find ~f:(fun (k', _) -> String.equal key k') xs |> Option.map ~f:snd

    let find_string xs key =
      find xs key |> Option.join |> Option.map ~f:(fun s -> String.strip s)

    let find_bool xs key =
      find xs key
      |> Option.map ~f:(fun _ -> true)
      |> Option.value ~default:false
  end

  module Top = struct
    (** Top comment *)
    type t = { name : string; doc : string option }
    [@@deriving annot, sexp, compare, equal]

    open Utils

    let of_annots ~name t_toplevel_annots =
      let xs = t_toplevel_annots () in
      { name; doc = find_string xs "ocaml.doc" }

    let%test_unit "top annots parse" =
      let t = of_annots ~name:"Top" t_toplevel_annots in
      [%test_eq: t] t { name = "Top"; doc = Some "Top comment" }
  end

  module Fields = struct
    module T = struct
      type t =
        { name : string option
        ; doc : string option [@name "document"]
        ; skip : bool [@skip]
        ; deprecated : string option [@depr "foo"]  (** this is deprecated *)
        }
      [@@deriving annot, sexp, compare, equal]
    end

    type t = string -> T.t

    open Utils

    let of_annots t_fields_annots field =
      let xs = t_fields_annots field in
      let s = find_string xs in
      let b = find_bool xs in
      { T.name = s "name"
      ; doc = s "ocaml.doc"
      ; skip = b "skip"
      ; deprecated = s "depr"
      }

    let%test_unit "field annots parse" =
      let annots = of_annots T.t_fields_annots in
      [%test_eq: T.t] (annots "doc")
        { name = Some "document"; doc = None; skip = false; deprecated = None } ;
      [%test_eq: T.t] (annots "skip")
        { name = None; doc = None; skip = true; deprecated = None } ;
      [%test_eq: T.t] (annots "deprecated")
        { name = None
        ; doc = Some "this is deprecated"
        ; skip = false
        ; deprecated = Some "foo"
        }
  end
end

(** Rewrites underscore_case to camelCase. Note: Keeps leading underscores. *)
let under_to_camel s =
  (* take all the underscores *)
  let prefix_us =
    String.take_while s ~f:(function '_' -> true | _ -> false)
  in
  (* remove them from the original *)
  let rest = String.substr_replace_first ~pattern:prefix_us ~with_:"" s in
  let ws = String.split rest ~on:'_' in
  let result =
    match ws with
    | [] ->
        ""
    | w :: ws ->
        (* capitalize each word separated by underscores *)
        w :: (ws |> List.map ~f:String.capitalize) |> String.concat ?sep:None
  in
  (* add the leading underscoes back *)
  String.concat [ prefix_us; result ]

let%test_unit "under_to_camel works as expected" =
  let open Core_kernel in
  [%test_eq: string] "fooHello" (under_to_camel "foo_hello") ;
  [%test_eq: string] "fooHello" (under_to_camel "foo_hello___") ;
  [%test_eq: string] "_fooHello" (under_to_camel "_foo_hello__")

(** Like Field.name but rewrites underscore_case to camelCase. *)
let name_under_to_camel f = Fieldslib.Field.name f |> under_to_camel

let introspection_query_raw =
  {graphql|
  query IntrospectionQuery {
    __schema {
      queryType { name }
      mutationType { name }
      subscriptionType { name }
      types {
        ...FullType
      }
      directives {
        name
        description
        locations
        args {
          ...InputValue
        }
      }
    }
  }
  fragment FullType on __Type {
    kind
    name
    description
    fields(includeDeprecated: true) {
      name
      description
      args {
        ...InputValue
      }
      type {
        ...TypeRef
      }
      isDeprecated
      deprecationReason
    }
    inputFields {
      ...InputValue
    }
    interfaces {
      ...TypeRef
    }
    enumValues(includeDeprecated: true) {
      name
      description
      isDeprecated
      deprecationReason
    }
    possibleTypes {
      ...TypeRef
    }
  }
  fragment InputValue on __InputValue {
    name
    description
    type { ...TypeRef }
    defaultValue
  }
  fragment TypeRef on __Type {
    kind
    name
    ofType {
      kind
      name
      ofType {
        kind
        name
        ofType {
          kind
          name
          ofType {
            kind
            name
            ofType {
              kind
              name
              ofType {
                kind
                name
                ofType {
                  kind
                  name
                }
              }
            }
          }
        }
      }
    }
  }
  |graphql}

1	open Core_kernel	34✔
2
3	module Annotations = struct
4	module Utils = struct
5	let find xs key =
6	List.find ~f:(fun (k', _) -> String.equal key k') xs \|> Option.map ~f:snd	702✔
7
8	let find_string xs key =
9	find xs key \|> Option.join \|> Option.map ~f:(fun s -> String.strip s)	234✔
10
11	let find_bool xs key =
12	find xs key	19,344✔
13	\|> Option.map ~f:(fun _ -> true)	×
14	\|> Option.value ~default:false
15	end
16
17	module Top = struct
18	(** Top comment *)
19	type t = { name : string; doc : string option }	×
20	[@@deriving annot, sexp, compare, equal]
21
22	open Utils
23
24	let of_annots ~name t_toplevel_annots =
25	let xs = t_toplevel_annots () in	2,730✔
26	{ name; doc = find_string xs "ocaml.doc" }	2,730✔
27
28	let%test_unit "top annots parse" =
29	let t = of_annots ~name:"Top" t_toplevel_annots in	×
30	[%test_eq: t] t { name = "Top"; doc = Some "Top comment" }	×
31	end
32
33	module Fields = struct
34	module T = struct
35	type t =	×
36	{ name : string option	×
37	; doc : string option [@name "document"]	×
38	; skip : bool [@skip]	×
39	; deprecated : string option [@depr "foo"] (** this is deprecated *)	×
40	}
41	[@@deriving annot, sexp, compare, equal]
42	end
43
44	type t = string -> T.t
45
46	open Utils
47
48	let of_annots t_fields_annots field =
49	let xs = t_fields_annots field in	19,344✔
50	let s = find_string xs in	19,344✔
51	let b = find_bool xs in	19,344✔
52	{ T.name = s "name"	19,344✔
53	; doc = s "ocaml.doc"	19,344✔
54	; skip = b "skip"	19,344✔
55	; deprecated = s "depr"	19,344✔
56	}
57
58	let%test_unit "field annots parse" =
59	let annots = of_annots T.t_fields_annots in	×
60	[%test_eq: T.t] (annots "doc")	×
61	{ name = Some "document"; doc = None; skip = false; deprecated = None } ;
62	[%test_eq: T.t] (annots "skip")	×
63	{ name = None; doc = None; skip = true; deprecated = None } ;
64	[%test_eq: T.t] (annots "deprecated")	×
65	{ name = None
66	; doc = Some "this is deprecated"
67	; skip = false
68	; deprecated = Some "foo"
69	}
70	end
71	end
72
73	(** Rewrites underscore_case to camelCase. Note: Keeps leading underscores. *)
74	let under_to_camel s =
75	(* take all the underscores *)
76	let prefix_us =	24,154✔
77	String.take_while s ~f:(function '_' -> true \| _ -> false)	×
78	in
79	(* remove them from the original *)
80	let rest = String.substr_replace_first ~pattern:prefix_us ~with_:"" s in	24,154✔
81	let ws = String.split rest ~on:'_' in	24,154✔
82	let result =	24,154✔
83	match ws with
84	\| [] ->	×
85	""
86	\| w :: ws ->	24,154✔
87	(* capitalize each word separated by underscores *)
88	w :: (ws \|> List.map ~f:String.capitalize) \|> String.concat ?sep:None	24,154✔
89	in
90	(* add the leading underscoes back *)
91	String.concat [ prefix_us; result ]
92
93	let%test_unit "under_to_camel works as expected" =
94	let open Core_kernel in	×
95	[%test_eq: string] "fooHello" (under_to_camel "foo_hello") ;	×
96	[%test_eq: string] "fooHello" (under_to_camel "foo_hello___") ;	×
97	[%test_eq: string] "_fooHello" (under_to_camel "_foo_hello__")	×
98
99	(** Like Field.name but rewrites underscore_case to camelCase. *)
100	let name_under_to_camel f = Fieldslib.Field.name f \|> under_to_camel	12,896✔
101
102	let introspection_query_raw =
103	{graphql\|
104	query IntrospectionQuery {
105	__schema {
106	queryType { name }
107	mutationType { name }
108	subscriptionType { name }
109	types {
110	...FullType
111	}
112	directives {
113	name
114	description
115	locations
116	args {
117	...InputValue
118	}
119	}
120	}
121	}
122	fragment FullType on __Type {
123	kind
124	name
125	description
126	fields(includeDeprecated: true) {
127	name
128	description
129	args {
130	...InputValue
131	}
132	type {
133	...TypeRef
134	}
135	isDeprecated
136	deprecationReason
137	}
138	inputFields {
139	...InputValue
140	}
141	interfaces {
142	...TypeRef
143	}
144	enumValues(includeDeprecated: true) {
145	name
146	description
147	isDeprecated
148	deprecationReason
149	}
150	possibleTypes {
151	...TypeRef
152	}
153	}
154	fragment InputValue on __InputValue {
155	name
156	description
157	type { ...TypeRef }
158	defaultValue
159	}
160	fragment TypeRef on __Type {
161	kind
162	name
163	ofType {
164	kind
165	name
166	ofType {
167	kind
168	name
169	ofType {
170	kind
171	name
172	ofType {
173	kind
174	name
175	ofType {
176	kind
177	name
178	ofType {
179	kind
180	name
181	ofType {
182	kind
183	name
184	}
185	}
186	}
187	}
188	}
189	}
190	}
191	}
192	\|graphql}	68✔

MinaProtocol / mina / 3409

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