Remove ppx_deriving_json_runtime libs, use melange-json instead

melange-community · Dec 16, 2024 · 9ecc0d4 · 9ecc0d4
1 parent b145688
commit 9ecc0d4
Show file tree

Hide file tree

Showing 20 changed files with 633 additions and 632 deletions.
diff --git a/ppx/browser/dune b/ppx/browser/dune
@@ -1,21 +1,13 @@
 (library
  (public_name melange-json.ppx)
  (name ppx_deriving_json_js)
- (modules :standard \ ppx_deriving_json_runtime ppx_deriving_json_js_test)
+ (modules :standard \ ppx_deriving_json_js_test)
  (libraries ppxlib)
- (ppx_runtime_libraries melange-json melange-json.ppx-runtime)
+ (ppx_runtime_libraries melange-json)
  (preprocess
   (pps ppxlib.metaquot))
  (kind ppx_deriver))
 
-(library
- (public_name melange-json.ppx-runtime)
- (name ppx_deriving_json_js_runtime)
- (modules ppx_deriving_json_runtime)
- (libraries melange-json)
- (wrapped false)
- (modes melange))
-
 (executable
  (name ppx_deriving_json_js_test)
  (modules ppx_deriving_json_js_test)

diff --git a/ppx/browser/ppx_deriving_json_js.ml b/ppx/browser/ppx_deriving_json_js.ml
@@ -7,6 +7,13 @@ open Ppx_deriving_tools.Conv
 open Ppx_deriving_json_common
 
 module Of_json = struct
+  let of_json_error ~loc fmt =
+    ksprintf
+      (fun msg ->
+        let msg = estring ~loc msg in
+        [%expr raise (Json.Of_json_error (Json_error [%e msg]))])
+      fmt
+
   let build_tuple ~loc derive si (ts : core_type list) e =
     pexp_tuple ~loc
       (List.mapi ts ~f:(fun i t ->
@@ -38,12 +45,7 @@ module Of_json = struct
               [%e
                 match ld_attr_default ld with
                 | Some default -> default
-                | None ->
-                    [%expr
-                      Ppx_deriving_json_runtime.of_json_error
-                        [%e
-                          estring ~loc (sprintf "missing field %S" n.txt)]]]]
-      )
+                | None -> of_json_error ~loc "missing field: %S" n.txt]] )
     in
     [%expr
       let fs = (Obj.magic [%e x] : [%t build_js_type ~loc fs]) in
@@ -65,15 +67,12 @@ module Of_json = struct
   let ensure_json_object ~loc x =
     [%expr
       if Stdlib.not [%e eis_json_object ~loc x] then
-        Ppx_deriving_json_runtime.of_json_error
-          [%e estring ~loc (sprintf "expected a JSON object")]]
+        [%e of_json_error ~loc "expected a JSON object"]]
 
   let ensure_json_array_len ~loc n len =
     [%expr
       if Stdlib.( <> ) [%e len] [%e eint ~loc n] then
-        Ppx_deriving_json_runtime.of_json_error
-          [%e
-            estring ~loc (sprintf "expected a JSON array of length %i" n)]]
+        [%e of_json_error ~loc "expected a JSON array of length %i" n]]
 
   let derive_of_tuple derive t x =
     let loc = t.tpl_loc in
@@ -88,10 +87,7 @@ module Of_json = struct
       then
         let es = (Obj.magic [%e x] : Js.Json.t array) in
         [%e build_tuple ~loc derive 0 t.tpl_types [%expr es]]
-      else
-        Ppx_deriving_json_runtime.of_json_error
-          [%e
-            estring ~loc (sprintf "expected a JSON array of length %i" n)]]
+      else [%e of_json_error ~loc "expected a JSON array of length %i" n]]
 
   let derive_of_record derive t x =
     let loc = t.rcd_loc in
@@ -111,15 +107,12 @@ module Of_json = struct
             let tag = (Obj.magic tag : string) in
             [%e body]
           else
-            Ppx_deriving_json_runtime.of_json_error
-              "expected a non empty JSON array with element being a \
-               string"
-        else
-          Ppx_deriving_json_runtime.of_json_error
-            "expected a non empty JSON array"
-      else
-        Ppx_deriving_json_runtime.of_json_error
-          "expected a non empty JSON array"]
+            [%e
+              of_json_error ~loc
+                "expected a non empty JSON array with element being a \
+                 string"]
+        else [%e of_json_error ~loc "expected a non empty JSON array"]
+      else [%e of_json_error ~loc "expected a non empty JSON array"]]
 
   let derive_of_variant_case derive make c next =
     match c with
@@ -152,8 +145,7 @@ module Of_json = struct
 
   let deriving : Ppx_deriving_tools.deriving =
     deriving_of () ~name:"of_json"
-      ~error:(fun ~loc ->
-        [%expr Ppx_deriving_json_runtime.of_json_error "invalid JSON"])
+      ~error:(fun ~loc -> of_json_error ~loc "invalid JSON")
       ~of_t:(fun ~loc -> [%type: Js.Json.t])
       ~derive_of_tuple ~derive_of_record ~derive_of_variant
       ~derive_of_variant_case

diff --git a/ppx/browser/ppx_deriving_json_runtime.ml b/ppx/browser/ppx_deriving_json_runtime.ml
diff --git a/ppx/native/dune b/ppx/native/dune
@@ -1,24 +1,13 @@
 (library
  (public_name melange-json-native.ppx)
  (name ppx_deriving_json_native)
- (modules
-  :standard
-  \
-  ppx_deriving_json_runtime
-  ppx_deriving_json_native_test)
+ (modules :standard \ ppx_deriving_json_native_test)
  (libraries ppxlib)
- (ppx_runtime_libraries melange-json-native.ppx-runtime yojson)
+ (ppx_runtime_libraries melange-json-native yojson)
  (preprocess
   (pps ppxlib.metaquot))
  (kind ppx_deriver))
 
-(library
- (public_name melange-json-native.ppx-runtime)
- (name ppx_deriving_json_native_runtime)
- (wrapped false)
- (modules ppx_deriving_json_runtime)
- (libraries yojson))
-
 (executable
  (name ppx_deriving_json_native_test)
  (modules ppx_deriving_json_native_test)

diff --git a/ppx/native/ppx_deriving_json_common.ml b/ppx/native/ppx_deriving_json_common.ml
@@ -119,9 +119,7 @@ module Of_json_string = struct
   let expand =
     expand_via ~what:(Expansion_helpers.Suffix "of_json_string")
       ~through:(Expansion_helpers.Suffix "of_json") (fun ~loc of_json ->
-        [%expr
-          fun _json ->
-            [%e of_json] (Ppx_deriving_json_runtime.of_string _json)])
+        [%expr fun _json -> [%e of_json] (Json.of_string _json)])
 
   let register ~of_json () =
     Deriving.add "of_json_string"
@@ -134,9 +132,7 @@ module To_json_string = struct
   let expand =
     expand_via ~what:(Expansion_helpers.Suffix "to_json_string")
       ~through:(Expansion_helpers.Suffix "to_json") (fun ~loc to_json ->
-        [%expr
-          fun _data ->
-            Ppx_deriving_json_runtime.to_string ([%e to_json] _data)])
+        [%expr fun _data -> Json.to_string ([%e to_json] _data)])
 
   let register ~to_json () =
     Deriving.add "to_json_string"

diff --git a/ppx/native/ppx_deriving_json_native.ml b/ppx/native/ppx_deriving_json_native.ml
@@ -7,6 +7,13 @@ open Ppx_deriving_tools.Conv
 open Ppx_deriving_json_common
 
 module Of_json = struct
+  let of_json_error ~loc fmt =
+    ksprintf
+      (fun msg ->
+        let msg = estring ~loc msg in
+        [%expr raise (Json.Of_json_error (Json_error [%e msg]))])
+      fmt
+
   let with_refs ~loc prefix fs inner =
     let gen_name n = sprintf "%s_%s" prefix n in
     let gen_expr (n : label loc) =
@@ -45,10 +52,7 @@ module Of_json = struct
         [%pat? name]
         -->
         if allow_extra_fields then [%expr ()]
-        else
-          [%expr
-            Ppx_deriving_json_runtime.of_json_error
-              (Stdlib.Printf.sprintf "unknown field: %s" name)]
+        else of_json_error ~loc "unknown field: %s" "name"
       in
       let cases =
         List.fold_left (List.rev fs) ~init:[ fail_case ]
@@ -80,11 +84,7 @@ module Of_json = struct
                       match default with
                       | Some default -> default
                       | None ->
-                          [%expr
-                            Ppx_deriving_json_runtime.of_json_error
-                              [%e
-                                estring ~loc:key.loc
-                                  (sprintf "missing field %S" key.txt)]]]]
+                          of_json_error ~loc "missing field: %S" key.txt]]
             ))
       in
       pexp_record ~loc fields None
@@ -108,11 +108,7 @@ module Of_json = struct
       [
         xpatt --> build_tuple ~loc derive xexprs t.tpl_types;
         [%pat? _]
-        --> [%expr
-              Ppx_deriving_json_runtime.of_json_error
-                [%e
-                  estring ~loc
-                    (sprintf "expected a JSON array of length %i" n)]];
+        --> of_json_error ~loc "expected a JSON array of length %i" n;
       ]
 
   let derive_of_record derive t x =
@@ -125,10 +121,7 @@ module Of_json = struct
         [%pat? `Assoc fs]
         --> build_record ~allow_extra_fields ~loc derive t.rcd_fields
               [%expr fs] Fun.id;
-        [%pat? _]
-        --> [%expr
-              Ppx_deriving_json_runtime.of_json_error
-                [%e estring ~loc (sprintf "expected a JSON object")]];
+        [%pat? _] --> of_json_error ~loc "expected a JSON object";
       ]
 
   let derive_of_variant_case derive make vcs =

diff --git a/ppx/native/ppx_deriving_tools.ml b/ppx/native/ppx_deriving_tools.ml
@@ -436,9 +436,8 @@ module Conv = struct
              ~init:
                ( [%expr
                    raise
-                     (Ppx_deriving_json_runtime.Of_json_error
-                        (Ppx_deriving_json_runtime.Unexpected_variant
-                           "unexpected variant"))],
+                     (Json.Of_json_error
+                        (Json.Unexpected_variant "unexpected variant"))],
                  [] )
              ~f:(fun (next, cases) (c, r) ->
                let ctx = Vcs_ctx_polyvariant c in
@@ -466,9 +465,8 @@ module Conv = struct
                        match [%e maybe_e] with
                        | e -> (e :> [%t t])
                        | exception
-                           Ppx_deriving_json_runtime.Of_json_error
-                             (Ppx_deriving_json_runtime.Unexpected_variant
-                                _) ->
+                           Json.Of_json_error (Json.Unexpected_variant _)
+                         ->
                            [%e next]]
                    in
                    next, cases)
@@ -511,9 +509,8 @@ module Conv = struct
                  [%pat? _]
                  --> [%expr
                        raise
-                         (Ppx_deriving_json_runtime.Of_json_error
-                            (Ppx_deriving_json_runtime.Unexpected_variant
-                               "unexpected variant"))];
+                         (Json.Of_json_error
+                            (Json.Unexpected_variant "unexpected variant"))];
                ]
              ~f:(fun next (c : constructor_declaration) ->
                let ctx = Vcs_ctx_variant c in
@@ -565,9 +562,8 @@ module Conv = struct
                  ~init:
                    [%expr
                      raise
-                       (Ppx_deriving_json_runtime.Of_json_error
-                          (Ppx_deriving_json_runtime.Unexpected_variant
-                             "unexpected variant"))]
+                       (Json.Of_json_error
+                          (Json.Unexpected_variant "unexpected variant"))]
                  ~f:(fun next (n, ts) ->
                    let maybe =
                      self#derive_type_ref ~loc self#name n ts x
@@ -577,9 +573,7 @@ module Conv = struct
                      match [%e maybe] with
                      | x -> (x :> [%t t])
                      | exception
-                         Ppx_deriving_json_runtime.Of_json_error
-                           (Ppx_deriving_json_runtime.Unexpected_variant _)
-                       ->
+                         Json.Of_json_error (Json.Unexpected_variant _) ->
                          [%e next]])
          in
          let cases =