Merge pull request #13 from melange-community/ppx-add-result-runtime

ppx: add runtime for result

CHANGES.md

@@ -1,3 +1,8 @@
+## Unpublished
+
+- PPX: Add runtime for `result`
+  ([#13](https://github.com/melange-community/melange-json/pull/13))
+
 ## 1.3.0 (2024-08-28)
 
 - PPX: Qualify usages of infix operators with `Stdlib`

ppx/browser/ppx_deriving_json_runtime.ml

@@ -24,6 +24,11 @@ module To_json = struct
 
   let option_to_json v_to_json v : t =
     match v with None -> Obj.magic Js.null | Some v -> v_to_json v
+
+  let result_to_json a_to_json b_to_json v : t =
+    match v with
+    | Ok x -> Obj.magic [| string_to_json "Ok"; a_to_json x |]
+    | Error x -> Obj.magic [| string_to_json "Error"; b_to_json x |]
 end
 
 module Of_json = struct
@@ -65,6 +70,29 @@ module Of_json = struct
   let option_of_json v_of_json (json : t) =
     if (Obj.magic json : 'a Js.null) == Js.null then None
     else Some (v_of_json json)
+
+  let result_of_json a_of_json b_of_json (json : t) =
+    if Js.Array.isArray json then
+      let array = (Obj.magic json : Js.Json.t array) in
+      let len = Js.Array.length array in
+      if Stdlib.( > ) len 0 then
+        let tag = Js.Array.unsafe_get array 0 in
+        if Stdlib.( = ) (Js.typeof tag) "string" then
+          let tag = (Obj.magic tag : string) in
+          if Stdlib.( = ) tag "Ok" then (
+            if Stdlib.( <> ) len 2 then
+              of_json_error "expected a JSON array of length 2";
+            Ok (a_of_json (Js.Array.unsafe_get array 1)))
+          else if Stdlib.( = ) tag "Error" then (
+            if Stdlib.( <> ) len 2 then
+              of_json_error "expected a JSON array of length 2";
+            Error (b_of_json (Js.Array.unsafe_get array 1)))
+          else of_json_error "invalid JSON"
+        else
+          of_json_error
+            "expected a non empty JSON array with element being a string"
+      else of_json_error "expected a non empty JSON array"
+    else of_json_error "expected a non empty JSON array"
 end
 
 module Primitives = struct

ppx/native/ppx_deriving_json_runtime.ml

@@ -20,6 +20,11 @@ module To_json = struct
   let option_to_json v_to_json = function
     | None -> `Null
     | Some v -> v_to_json v
+
+  let result_to_json a_to_json b_to_json v =
+    match v with
+    | Ok x -> `List [ `String "Ok"; a_to_json x ]
+    | Error x -> `List [ `String "Error"; b_to_json x ]
 end
 
 module Of_json = struct
@@ -36,6 +41,12 @@ module Of_json = struct
 
   let list_of_json v_of_json json =
     List.map v_of_json (Yojson.Basic.Util.to_list json)
+
+  let result_of_json a_of_json b_of_json json =
+    match json with
+    | `List [ `String "Ok"; x ] -> Ok (a_of_json x)
+    | `List [ `String "Error"; x ] -> Error (b_of_json x)
+    | _ -> of_json_error "invalid JSON"
 end
 
 module Primitives = struct

ppx/test/example.ml

@@ -1,6 +1,7 @@
 type user = int [@@deriving json]
 type 'a param = 'a [@@deriving json]
 type opt = string option [@@deriving json]
+type res = (int, string) result [@@deriving json]
 type tuple = int * string [@@deriving json]
 type record = { name : string; age : int } [@@deriving json]
 type record_aliased = { name : string; [@json.key "my_name"] age : int; [@json.key "my_age"] [@json.default 100] } [@@deriving json]
@@ -23,6 +24,8 @@ module Cases = struct
     C ({|1|}, user_of_json, user_to_json, 1);
     C ({|"OK"|}, (param_of_json string_of_json), (param_to_json string_to_json), "OK");
     C ({|"some"|}, opt_of_json, opt_to_json, (Some "some"));
+    C ({|["Ok", 1]|}, res_of_json, res_to_json, Ok 1);
+    C ({|["Error", "oops"]|}, res_of_json, res_to_json, Error "oops");
     C ({|[42, "works"]|}, tuple_of_json, tuple_to_json, (42, "works"));
     C ({|{"name":"N","age":1}|}, record_of_json, record_to_json, {name="N"; age=1});
     C ({|["A"]|}, sum_of_json, sum_to_json, (A : sum));

ppx/test/ppx_deriving_json_js.e2e.t

@@ -32,6 +32,10 @@
   JSON REPRINT: "OK"
   JSON    DATA: "some"
   JSON REPRINT: "some"
+  JSON    DATA: ["Ok", 1]
+  JSON REPRINT: ["Ok",1]
+  JSON    DATA: ["Error", "oops"]
+  JSON REPRINT: ["Error","oops"]
   JSON    DATA: [42, "works"]
   JSON REPRINT: [42,"works"]
   JSON    DATA: {"name":"N","age":1}

ppx/test/ppx_deriving_json_native.e2e.t

@@ -23,6 +23,10 @@
   JSON REPRINT: "OK"
   JSON    DATA: "some"
   JSON REPRINT: "some"
+  JSON    DATA: ["Ok", 1]
+  JSON REPRINT: ["Ok",1]
+  JSON    DATA: ["Error", "oops"]
+  JSON REPRINT: ["Error","oops"]
   JSON    DATA: [42, "works"]
   JSON REPRINT: [42,"works"]
   JSON    DATA: {"name":"N","age":1}