Serialize and deserialize special google types based on name and not …

…on type parameter

src/ocaml_protoc_plugin/deserialize_json.ml

@@ -143,23 +143,60 @@ let%expect_test "google.protobuf.Timestamp" =
     Error parsing 2024-03-06T21:10:27.999999: `Wrong_field_type (("google.protobuf.duration",
                         "\"2024-03-06T21:10:27.999999\"")) |}]
 
+let from_camel_case s =
+  let open Stdlib in
+  let is_lowercase c = Char.lowercase_ascii c = c &&  Char.uppercase_ascii c <> c in
+  let is_uppercase c = Char.lowercase_ascii c <> c &&  Char.uppercase_ascii c = c in
+  let rec map = function
+    | c1 :: c2 :: cs when is_lowercase c1 && is_uppercase c2 ->
+      c1 :: '_' :: (Char.lowercase_ascii c2) :: map cs
+    | c :: cs -> c :: map cs
+    | [] -> []
+  in
+  String.to_seq s
+  |> List.of_seq
+  |> map
+  |> List.to_seq
+  |> String.of_seq
+
+let%expect_test "json name to proto name" =
+  let test s = Printf.printf "%10s -> %10s\n" s (from_camel_case s) in
+  test "camelCase";
+  test "CamelCase";
+  test "Camel_Case";
+  test "Camel_Case";
+  test "camelCASe";
+  test "CAMelCase";
+  ();
+  [%expect {|
+     camelCase -> camel_case
+     CamelCase -> Camel_case
+    Camel_Case -> Camel_Case
+    Camel_Case -> Camel_Case
+     camelCASe -> camel_cASe
+     CAMelCase -> CAMel_case |}]
+
+
 
 let map_json: type a. (module Message with type t = a) -> Yojson.Basic.t -> Yojson.Basic.t = fun (module Message) ->
-  match Message.name' () |> String.split_on_char ~sep:'.'  with
+  match Message.name' () |> String.split_on_char ~sep:'.' with
   | [_; "google"; "protobuf"; "Empty"] (* Already mapped as it should I think *) ->
     fun json -> json
+  (* Duration - google/protobuf/timestamp.proto *)
   | [_; "google"; "protobuf"; "Duration"] ->
     let convert json =
       let (seconds, nanos) = duration_of_json json in
       `Assoc [ "seconds", `Int seconds; "nanos", `Int nanos ]
     in
     convert
+  (* Timestamp - google/protobuf/timestamp.proto *)
   | [_; "google"; "protobuf"; "Timestamp"] ->
     let convert json =
       let (seconds, nanos) = timestamp_of_json json in
       `Assoc [ "seconds", `Int seconds; "nanos", `Int nanos ]
     in
     convert
+  (* Wrapper types - google/protobuf/wrappers.proto *)
   | [_; "google"; "protobuf"; "DoubleValue"]
   | [_; "google"; "protobuf"; "FloatValue"]
   | [_; "google"; "protobuf"; "Int64Value"]
@@ -173,6 +210,7 @@ let map_json: type a. (module Message with type t = a) -> Yojson.Basic.t -> Yojs
     let convert json = `Assoc ["value", json] in
     convert
   | [_; "google"; "protobuf"; "Value"] ->
+    (* Struct - google/protobuf/struct.proto *)
     (* Based on json type do the mapping *)
     let convert (json: Yojson.Basic.t)  =
       let value = match json with
@@ -192,11 +230,24 @@ let map_json: type a. (module Message with type t = a) -> Yojson.Basic.t -> Yojs
           "structValue", value
         | `List _ -> "listValue", `Assoc ["values", json]
       in
-      `Assoc [value ]
+      `Assoc [value]
     in
     convert
-  | _ -> Message.from_json_exn
-
+  (* FieldMask - /usr/include/google/protobuf/field_mask.proto *)
+  | [_; "google"; "protobuf"; "FieldMask"] ->
+    let open StdLabels in
+    let convert = function
+      | `String s ->
+        let masks =
+          String.split_on_char ~sep:',' s
+          |> List.map ~f:from_camel_case
+          |> List.map ~f:(fun s -> `String s)
+        in
+        `Assoc ["masks", `List masks]
+      | json -> value_error "google.protobuf.FieldMask" json
+    in
+    convert
+  | _ -> fun json -> json
 
 let read_value: type a b. (a, b) spec -> Yojson.Basic.t -> a = function
    | Double -> to_float
@@ -226,19 +277,11 @@ let read_value: type a b. (a, b) spec -> Yojson.Basic.t -> a = function
    | Bytes -> to_bytes
    | Enum (module Enum) -> to_enum (module Enum)
    | Message ((module Message), _) ->
-     let from_json = json_mapping (module Message) in
-     to_json
-
-   | Message ((module Message), Empty) -> begin
-       function
-       | `Assoc [] -> Message.from_tuple ()
-       | json -> value_error "google.protobuf.empty" json
-     end
-   | Message ((module Message), Duration) ->
-     fun json -> duration_of_json json |> Message.from_tuple
-   | Message ((module Message), Timestamp) ->
-     fun json -> timestamp_of_json json |> Message.from_tuple
-   | Message ((module Message), Default) -> Message.from_json_exn
+     let map_json = map_json (module Message) in
+     let of_json json =
+       map_json json |> Message.from_json_exn
+     in
+     of_json
 
 let find_field (_number, field_name, json_name) fields =
   match FieldMap.find_opt json_name fields with

src/ocaml_protoc_plugin/deserialize_json.mli

@@ -1 +1,13 @@
 val deserialize: ('constr, 'a) Spec.compound_list -> 'constr -> Yojson.Basic.t -> 'a
+
+(**)
+val to_int64: Yojson.Basic.t -> int64
+val to_int32: Yojson.Basic.t -> int32
+val to_int: Yojson.Basic.t -> int
+val to_string: Yojson.Basic.t -> string
+val to_bytes: Yojson.Basic.t -> bytes
+val to_float: Yojson.Basic.t -> float
+val to_bool: Yojson.Basic.t -> bool
+val to_list: Yojson.Basic.t -> Yojson.Basic.t list
+
+(**)

src/ocaml_protoc_plugin/serialize_json.ml

@@ -2,6 +2,8 @@ open! StdLabels
 open Spec
 
 (** Serialize to json as per https://protobuf.dev/programming-guides/proto3/#json-options *)
+let value_error type_name json =
+  Result.raise (`Wrong_field_type (type_name, Yojson.Basic.to_string json))
 
 type field = string * Yojson.Basic.t
 
@@ -31,6 +33,156 @@ let key ~json_names (_, name, json_name) =
   | true -> json_name
   | false -> name
 
+let get_key ~f ~default key = function
+  | `Assoc l ->
+    List.assoc_opt key l
+    |> Option.map f
+    |> Option.value ~default
+  | json -> value_error "Expected Assoc" json
+
+let to_camel_case s =
+  let open Stdlib in
+  let is_ascii c = Char.lowercase_ascii c <> Char.uppercase_ascii c in
+  let rec map = function
+    | '_' :: c :: cs when is_ascii c ->
+      Char.uppercase_ascii c :: map cs
+    | c :: cs -> c :: map cs
+    | [] -> []
+  in
+  String.to_seq s
+  |> List.of_seq
+  |> map
+  |> List.to_seq
+  |> String.of_seq
+
+let%expect_test "json name to proto name" =
+  let test s = Printf.printf "%10s -> %10s\n" s (to_camel_case s) in
+  test "camel_case";
+  test "Camel_case";
+  test "Camel_Case";
+  test "Camel_Case";
+  test "camel_cASe";
+  test "CAMel_case";
+  ();
+  [%expect {|
+    camel_case ->  camelCase
+    Camel_case ->  CamelCase
+    Camel_Case ->  CamelCase
+    Camel_Case ->  CamelCase
+    camel_cASe ->  camelCASe
+    CAMel_case ->  CAMelCase |}]
+
+let duration_to_json json =
+  let seconds = get_key "seconds" ~f:Deserialize_json.to_int64 ~default:0L json in
+  let nanos = get_key "nanos" ~f:Deserialize_json.to_int32 ~default:0l json in
+  let seconds = match seconds < 0L || nanos < 0l with
+    | true -> Int64.mul (-1L) (Int64.abs seconds)
+    | false -> (Int64.abs seconds)
+  in
+  let duration =
+    match nanos with
+    | 0l -> Printf.sprintf "%Lds" seconds
+    | _ -> Printf.sprintf "%Ld.%09lds" seconds (Int32.abs nanos)
+  in
+  `String duration
+
+let%expect_test "duration_to_json" =
+  let test seconds nanos =
+    let json = `Assoc ["seconds", `Int seconds; "nanos", `Int nanos] in
+    Printf.printf "%d.%d -> %s\n" seconds nanos (Yojson.Basic.to_string (duration_to_json json))
+  in
+  test 100 0;
+  test (1000) (123456);
+  test (-1000) (-123456);
+  ();
+  [%expect {|
+    100.0 -> "100s"
+    1000.123456 -> "1000.000123456s"
+    -1000.-123456 -> "-1000.000123456s" |}]
+
+let timestamp_to_json json =
+  let open Stdlib in
+  let open StdLabels in
+  let seconds = get_key "seconds" ~f:Deserialize_json.to_int ~default:0 json in
+  let nanos = get_key "nanos" ~f:Deserialize_json.to_int ~default:0 json in
+  let s1 = Ptime.Span.of_int_s seconds in
+  let s2 = Ptime.Span.of_float_s (float nanos /. 1_000_000_000.0) |> Option.get in
+  let t =
+    Ptime.Span.add s1 s2
+    |> Ptime.of_span
+    |> Option.get
+   in
+  t
+  |> Ptime.to_rfc3339 ~frac_s:9
+  |> String.split_on_char ~sep:'-'
+  |> List.rev
+  |> List.tl
+  |> List.rev
+  |> String.concat ~sep:"-"
+  |> fun s -> `String (s^"Z")
+
+let%expect_test "timestamp_to_json" =
+  let test seconds nanos =
+    let json = `Assoc ["seconds", `Int seconds; "nanos", `Int nanos] in
+    Printf.printf "%d.%d -> %s\n" seconds nanos (Yojson.Basic.to_string (timestamp_to_json json))
+  in
+  test 1709931283 0;
+  test 1709931283 (1_000_000_002/2);
+  test 1709931283 1_000_000_000;
+  test 0 1;
+  ();
+  [%expect {|
+    1709931283.0 -> "2024-03-08T20:54:43.000000000Z"
+    1709931283.500000001 -> "2024-03-08T20:54:43.500000001Z"
+    1709931283.1000000000 -> "2024-03-08T20:54:44.000000000Z"
+    0.1 -> "1970-01-01T00:00:00.000000001Z" |}]
+
+let wrapper_to_json json = get_key ~f:(fun id -> id) ~default:`Null "value" json
+
+(* Convert already emitted json based on json mappings *)
+let map_json: type a. (module Message with type t = a) -> Yojson.Basic.t -> Yojson.Basic.t = fun (module Message) ->
+  match Message.name' () |> String.split_on_char ~sep:'.' with
+  | [_; "google"; "protobuf"; "Empty"]  ->
+    fun json -> json
+  (* Duration - google/protobuf/timestamp.proto *)
+  | [_; "google"; "protobuf"; "Duration"] ->
+    duration_to_json
+  (* Timestamp - google/protobuf/timestamp.proto *)
+  | [_; "google"; "protobuf"; "Timestamp"] ->
+    timestamp_to_json
+  (* Wrapper types - google/protobuf/wrappers.proto *)
+  | [_; "google"; "protobuf"; "DoubleValue"]
+  | [_; "google"; "protobuf"; "FloatValue"]
+  | [_; "google"; "protobuf"; "Int64Value"]
+  | [_; "google"; "protobuf"; "UInt64Value"]
+  | [_; "google"; "protobuf"; "Int32Value"]
+  | [_; "google"; "protobuf"; "UInt32Value"]
+  | [_; "google"; "protobuf"; "BoolValue"]
+  | [_; "google"; "protobuf"; "StringValue"]
+  | [_; "google"; "protobuf"; "BytesValue"] ->
+    wrapper_to_json
+  | [_; "google"; "protobuf"; "Value"] ->
+    let map = function
+      | `Assoc [_, json] -> json
+      | json -> value_error "google.protobuf.Value" json
+    in
+    map
+  (* FieldMask - /usr/include/google/protobuf/field_mask.proto *)
+  | [_; "google"; "protobuf"; "FieldMask"] ->
+    let open StdLabels in
+    let convert = function
+      | `Assoc ["masks", `List masks] ->
+        List.map ~f:(function
+          | `String mask -> (to_camel_case mask)
+          | json -> value_error "google.protobuf.FieldMask" json
+        ) masks
+        |> String.concat ~sep:","
+        |> fun mask -> `String mask
+      | json -> value_error "google.protobuf.FieldMask" json
+    in
+    convert
+  | _ -> fun json -> json
+
 let rec json_of_spec: type a b. enum_names:bool -> json_names:bool -> omit_default_values:bool -> (a, b) spec -> a -> Yojson.Basic.t =
   fun ~enum_names ~json_names ~omit_default_values -> function
   | Double -> float_value
@@ -68,15 +220,8 @@ let rec json_of_spec: type a b. enum_names:bool -> json_names:bool -> omit_defau
       | true -> enum_name ~f:Enum.to_string
       | false -> enum_value ~f:Enum.to_int
     end
-  | Message ((module Message), Duration) ->
-    fun duration ->
-      let seconds, nanos = Message.to_tuple duration in
-      `String (Printf.sprintf "%d.%09ds" seconds nanos)
-  | Message ((module Message), Empty) ->
-    fun _ -> `Assoc []
-  | Message ((module Message), Timestamp) -> failwith "Unhandled"
   | Message ((module Message), Default) ->
-    Message.to_json ~enum_names ~json_names ~omit_default_values
+    fun v -> Message.to_json ~enum_names ~json_names ~omit_default_values v |> map_json (module Message)
 
 and write: type a b. enum_names:bool -> json_names:bool -> omit_default_values:bool -> (a, b) compound -> a -> field list =
   fun ~enum_names ~json_names ~omit_default_values -> function

src/ocaml_protoc_plugin/spec.ml

@@ -43,9 +43,6 @@ module Make(T : T) = struct
   type message = [ `Message ]
   type _ message_type =
     | Default: 'a message_type
-    | Empty: unit message_type
-    | Duration: (int * int) message_type
-    | Timestamp: (int * int) message_type (* Thats not entirely clear. What if ints are native? *) (* We should have a type that is set based on the compilation options..... Generically?!?. We should make sure that the tuple is always int32 / int64 - even if conversion tells us othervice! *)
 
 
   type (_, _) spec =
@@ -149,8 +146,6 @@ module Make(T : T) = struct
   let message m t = Message (m, t)
 
   let default = Default
-  let empty = Empty
-  let duration = Duration
 
   let some v = Some v
   let none = None

src/plugin/types.ml

@@ -162,9 +162,6 @@ let default_of_spec: type a. (a, scalar) spec -> a = fun spec -> match spec with
 
 let string_of_message_type: type a. a message_type -> string = function
   | Default -> "default"
-  | Empty -> "empty"
-  | Duration -> "duration"
-  | Timestamp -> "timestamp"
 
 let string_of_spec: type a b. (a, b) spec -> string = function
   | Double -> "double"

test/enum_test.ml

@@ -3,13 +3,15 @@ let%expect_test _ =
   let module T = Enum.Message in
   let t = Enum.Message.E.B in
   Test_lib.test_encode (module T) t;
-  [%expect {| enum: B |}]
+  [%expect {|
+    enum: B |}]
 
 let%expect_test _ =
   let module T = Enum.Outside in
   let t = Enum.E1.C in
   Test_lib.test_encode (module T) t;
-  [%expect {| enum: C |}]
+  [%expect {|
+    enum: C |}]
 
 let%expect_test _ =
   let module T = Enum.Aliasing in
@@ -23,4 +25,5 @@ let%expect_test _ =
   let module T = Enum.Negative in
   let t = T.Enum.A3 in
   Test_lib.test_encode (module T) t;
-  [%expect {| e: A3 |}]
+  [%expect {|
+    e: A3 |}]

test/json_encoding.proto

@@ -1,7 +1,12 @@
 syntax = "proto3";
 
 import "google/protobuf/duration.proto";
+import "google/protobuf/timestamp.proto";
 
-message T {
+message Duration {
   google.protobuf.Duration duration = 1;
 }
+
+message Timestamp {
+  google.protobuf.Timestamp timestamp = 1;
+}