ppx: add int64 to runtime

Author: jchavarri

ppx/browser/ppx_deriving_json_runtime.ml

@@ -28,6 +28,9 @@ module To_json = struct
   external string_to_json : string -> t = "%identity"
   external bool_to_json : bool -> t = "%identity"
   external int_to_json : int -> t = "%identity"
+
+  let int64_to_json : int64 -> t = fun v -> Obj.magic (Int64.to_string v)
+
   external float_to_json : float -> t = "%identity"
 
   let unit_to_json () : t = Obj.magic Js.null
@@ -68,6 +71,14 @@ module Of_json = struct
       else of_json_error "expected an integer"
     else of_json_error "expected an integer"
 
+  let int64_of_json (json : t) : int64 =
+    if Js.typeof json = "string" then
+      let v = (Obj.magic json : string) in
+      match Int64.of_string_opt v with
+      | Some v -> v
+      | None -> of_json_error "expected an int64"
+    else of_json_error "expected a string"
+
   let float_of_json (json : t) : float =
     if Js.typeof json = "number" then (Obj.magic json : float)
     else of_json_error "expected a float"

ppx/native/ppx_deriving_json_runtime.ml

@@ -32,6 +32,7 @@ module To_json = struct
   let string_to_json v = `String v
   let bool_to_json v = `Bool v
   let int_to_json v = `Int v
+  let int64_to_json v = `String (Int64.to_string v)
   let float_to_json v = `Float v
   let unit_to_json () = `Null
   let list_to_json v_to_json vs = `List (List.map v_to_json vs)
@@ -68,6 +69,13 @@ module Of_json = struct
     | `Int i -> i
     | json -> of_json_error_type_mismatch json "int"
 
+  let int64_of_json = function
+    | `String i as json -> (
+        match Int64.of_string_opt i with
+        | Some v -> v
+        | None -> of_json_error_type_mismatch json "string")
+    | json -> of_json_error_type_mismatch json "string"
+
   let float_of_json = function
     | `Float f -> f
     | `Int i -> float_of_int i

ppx/test/example.ml

@@ -1,4 +1,5 @@
 type user = int [@@deriving json]
+type userid = int64 [@@deriving json]
 type floaty = float [@@deriving json]
 type 'a param = 'a [@@deriving json]
 type opt = string option [@@deriving json]
@@ -25,6 +26,7 @@ type json = Ppx_deriving_json_runtime.t
 type of_json = C : string * (json -> 'a) * ('a -> json) * 'a -> of_json
 let of_json_cases = [
   C ({|1|}, user_of_json, user_to_json, 1);
+  C ({|"9223372036854775807"|}, userid_of_json, userid_to_json, 9223372036854775807L);
   C ({|1.1|}, floaty_of_json, floaty_to_json, 1.1);
   C ({|1.0|}, floaty_of_json, floaty_to_json, 1.0);
   C ({|42|}, floaty_of_json, floaty_to_json, 42.0);

ppx/test/ppx_deriving_json_js.e2e.t

@@ -29,6 +29,8 @@
   *** json deriver tests ***
   JSON    DATA: 1
   JSON REPRINT: 1
+  JSON    DATA: "9223372036854775807"
+  JSON REPRINT: "9223372036854775807"
   JSON    DATA: 1.1
   JSON REPRINT: 1.1
   JSON    DATA: 1.0

ppx/test/ppx_deriving_json_native.e2e.t

@@ -19,6 +19,8 @@
   $ dune exec ./main.exe
   JSON    DATA: 1
   JSON REPRINT: 1
+  JSON    DATA: "9223372036854775807"
+  JSON REPRINT: "9223372036854775807"
   JSON    DATA: 1.1
   JSON REPRINT: 1.1
   JSON    DATA: 1.0