Use melange-json.2.0.0

.github/workflows/build-test.yml

@@ -28,10 +28,9 @@ jobs:
           node-version: current
 
       - name: Use OCaml ${{ matrix.ocaml-compiler }}
-        uses: ocaml/setup-ocaml@v2
+        uses: ocaml/setup-ocaml@v3
         with:
           ocaml-compiler: ${{ matrix.ocaml-compiler }}
-          opam-depext: false
 
       - name: Install all deps
         run: make install

CHANGES.md

@@ -1,5 +1,6 @@
 ## Next
 
+- Update to latest `melange-json` with unified runtime, [#53](https://github.com/ahrefs/melange-atdgen-codec-runtime/pull/53)
 - Add `2.16.0` as lower bound version of `atdgen`, [#54](https://github.com/ahrefs/melange-atdgen-codec-runtime/pull/54)
 
 ## 3.0.0 (2024-02-06)

README.md

@@ -21,10 +21,10 @@ To generate `ml` files from `atd` ones, add a couple of rules to your `dune` fil
 
 ```clojure
 (rule
- (targets test_bs.ml test_bs.mli)
+ (targets test_mel.ml test_mel.mli)
  (deps test.atd)
  (action
-  (run atdgen -bs %{deps})))
+  (run atdgen -mel %{deps})))
 
 (rule
  (targets test_t.ml test_t.mli)
@@ -67,7 +67,7 @@ let get = (url, decode) =>
 let v: Meetup_t.events =
   get(
     "http://localhost:8000/events",
-    Atdgen_codec_runtime.Decode.decode(Meetup_bs.read_events),
+    Atdgen_codec_runtime.Decode.decode(Meetup_mel.read_events),
   );
 ```
 

melange-atdgen-codec-runtime.opam

@@ -14,7 +14,7 @@ depends: [
   "melange" {>= "3.0.0"}
   "atd"
   "atdgen" {>= "2.16.0"}
-  "melange-json"
+  "melange-json" {>= "2.0.0"}
   "melange-jest" {with-test}
   "reason" {with-test}
   "opam-check-npm-deps" {with-test}

src/__tests__/errors_test.ml

@@ -1,66 +1,66 @@
 open Jest
 open Expect
 
-let wrap_exn exp = try let _ = exp () in "not called" with Json.Decode.DecodeError str -> str
+let wrap_exn exp = try let _ = exp () in "not called" with Melange_json.Of_json_error (Json_error str) -> str
 
 let () =
   describe "exceptions" (fun () ->
 
     test "unit" (fun () ->
-      let j = Json.parseOrRaise {|{}|} in
+      let j = Melange_json.of_string {|{}|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.unit j))
       |> toBe ("Expected null, got {}"));
 
     test "option_as_constr" (fun () ->
-      let j = Json.parseOrRaise {|{}|} in
+      let j = Melange_json.of_string {|{}|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.(option_as_constr int)j))
       |> toBe (
         "All decoders given to oneOf failed. Here are all the errors: \n\
-         - Expected string, got {}\n\
-         - Expected array, got {}\n\
+         - expected a string but got {}\n\
+         - expected an array but got {}\n\
          And the JSON being decoded: {}"));
 
     test "enum" (fun () ->
-      let j = Json.parseOrRaise {|{}|} in
+      let j = Melange_json.of_string {|{}|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.(enum []) j))
       |> toBe(
         "All decoders given to oneOf failed. Here are all the errors: \n\
-         - Expected string, got {}\n\
-         - Expected array, got {}\n\
+         - expected a string but got {}\n\
+         - expected an array but got {}\n\
          And the JSON being decoded: {}"));
 
     test "missing field in record" (fun () ->
-      let j = Json.parseOrRaise {|{"o": 44}|} in
+      let j = Melange_json.of_string {|{"o": 44}|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.decode Test_mel.read_ro j))
       |> toBe("Expected field 'c'"));
 
     test "optional field with default: wrong type throws exception" (fun () ->
-      let j = Json.parseOrRaise {|{"with_default": "not right"}|} in
+      let j = Melange_json.of_string {|{"with_default": "not right"}|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.decode Test_mel.read_optional_field j))
-      |> toBe({|with_default: Expected number, got "not right"|}));
+      |> toBe({|with_default: expected an integer but got "not right"|}));
 
     test "optional field: wrong type throws exception" (fun () ->
-      let j = Json.parseOrRaise {|{"no_default": "not right"}|} in
+      let j = Melange_json.of_string {|{"no_default": "not right"}|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.decode Test_mel.read_optional_field j))
-      |> toBe({|no_default: Expected number, got "not right"|}));
+      |> toBe({|no_default: expected an integer but got "not right"|}));
 
     test "error in variant" (fun () ->
-      let j = Json.parseOrRaise {|["A", "not right"]|} in
+      let j = Melange_json.of_string {|["A", "not right"]|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.decode Test_mel.read_v j))
-      |> toBe({|A: Expected number, got "not right"|}));
+      |> toBe({|A: expected an integer but got "not right"|}));
 
     test "deeply nested error (array element fails)" (fun () ->
-      let j = Json.parseOrRaise {|["A", [[1, "not right"], "Bool"]]|} in
+      let j = Melange_json.of_string {|["A", [[1, "not right"], "Bool"]]|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.decode Test_mel.read_deeply_nested j))
-      |> toBe({|A.0.1: Expected number, got "not right"|}));
+      |> toBe({|A.0.1: expected an integer but got "not right"|}));
 
     test "deeply nested error (tuple element fails)" (fun () ->
-      let j = Json.parseOrRaise {|["A", [[1, 2], "Boolean"]]|} in
+      let j = Melange_json.of_string {|["A", [[1, 2], "Boolean"]]|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.decode Test_mel.read_deeply_nested j))
       |> toBe({|A.1.Boolean: unknown constructor "Boolean"|}));
 
     test "deeply nested error (rec_list element fails deep enough)" (fun () ->
-      let j = Json.parseOrRaise {|["A", [[1, 2], ["List", ["Bool", "Fail"]]]]|} in
+      let j = Melange_json.of_string {|["A", [[1, 2], ["List", ["Bool", "Fail"]]]]|} in
       expect (wrap_exn (fun () -> Atdgen_codec_runtime.Decode.decode Test_mel.read_deeply_nested j))
       |> toBe({|A.1.List.1.Fail: unknown constructor "Fail"|}));
 

src/__tests__/test.atd

@@ -1,6 +1,6 @@
 (*
   atdgen -t test.atd
-  atdgen -bs test.atd -open Test_t
+  atdgen -mel test.atd -open Test_t
 *)
 
 type myInt = int <ocaml repr="int64">

src/atdgen_codec_decode.ml

@@ -1,8 +1,8 @@
-include Json.Decode
+include Melange_json.Of_json
 
 exception DecodeErrorPath of string list * string
 
-type 'a t = 'a decoder
+type 'a t = 'a Melange_json.of_json
 
 let make f = f
 
@@ -12,17 +12,19 @@ let decode f json =
   try f json
   with DecodeErrorPath (path, msg) ->
     let path = String.concat "." path in
-    raise (DecodeError {j|$path: $msg|j})
+    raise (Melange_json.Of_json_error (Json_error {j|$path: $msg|j}))
 
 let with_segment segment f json =
   try f json with
-  | DecodeError msg -> raise (DecodeErrorPath ([ segment ], msg))
+  | Melange_json.Of_json_error (Json_error msg) -> raise (DecodeErrorPath ([ segment ], msg))
   | DecodeErrorPath (path, msg) ->
       raise (DecodeErrorPath (segment :: path, msg))
 
 let unit j =
   if Js.Json.test j Null then ()
-  else raise (DecodeError ("Expected null, got " ^ Js.Json.stringify j))
+  else raise (Melange_json.Of_json_error (Json_error ("Expected null, got " ^ Js.Json.stringify j)))
+
+let optional = try_or_none
 
 let int32 j = Int32.of_string (string j)
 
@@ -36,13 +38,13 @@ let array decode json =
     for i = 0 to length - 1 do
       let value =
         try with_segment (string_of_int i) decode (Array.unsafe_get source i)
-        with DecodeError msg ->
-          raise @@ DecodeError (msg ^ "\n\tin array at index " ^ string_of_int i)
+        with Melange_json.Of_json_error (Json_error msg) ->
+          raise @@ Melange_json.Of_json_error (Json_error (msg ^ "\n\tin array at index " ^ string_of_int i))
       in
       Array.unsafe_set target i value
     done;
     target)
-  else raise @@ DecodeError ("Expected array, got " ^ Js.Json.stringify json)
+  else raise @@ Melange_json.Of_json_error (Json_error ("expected an array but got " ^ Js.Json.stringify json))
 
 let list decode json = json |> array decode |> Array.to_list
 
@@ -54,13 +56,13 @@ let pair decodeA decodeB json =
       try
         ( with_segment "0" decodeA (Array.unsafe_get source 0),
           with_segment "1" decodeB (Array.unsafe_get source 1) )
-      with DecodeError msg -> raise @@ DecodeError (msg ^ "\n\tin pair/tuple2")
+      with Melange_json.Of_json_error (Json_error msg) -> raise @@ Melange_json.Of_json_error (Json_error (msg ^ "\n\tin pair/tuple2"))
     else
       let length_str = string_of_int length in
       raise
-      @@ DecodeError
-           {j|Expected array of length 2, got array of length $length_str|j}
-  else raise @@ DecodeError ("Expected array, got " ^ Js.Json.stringify json)
+      @@ Melange_json.Of_json_error
+           (Json_error {j|Expected array of length 2, got array of length $length_str|j})
+  else raise @@ Melange_json.Of_json_error (Json_error ("expected an array but got " ^ Js.Json.stringify json))
 
 let tuple2 = pair
 
@@ -73,13 +75,13 @@ let tuple3 decodeA decodeB decodeC json =
         ( with_segment "0" decodeA (Array.unsafe_get source 0),
           with_segment "1" decodeB (Array.unsafe_get source 1),
           with_segment "2" decodeC (Array.unsafe_get source 2) )
-      with DecodeError msg -> raise @@ DecodeError (msg ^ "\n\tin tuple3")
+      with Melange_json.Of_json_error (Json_error msg) -> raise @@ Melange_json.Of_json_error (Json_error (msg ^ "\n\tin tuple3"))
     else
       let length_str = string_of_int length in
       raise
-      @@ DecodeError
-           {j|Expected array of length 3, got array of length $length_str|j}
-  else raise @@ DecodeError ("Expected array, got " ^ Js.Json.stringify json)
+      @@ Melange_json.Of_json_error
+           (Json_error {j|Expected array of length 3, got array of length $length_str|j})
+  else raise @@ Melange_json.Of_json_error (Json_error ("expected an array but got " ^ Js.Json.stringify json))
 
 let tuple4 decodeA decodeB decodeC decodeD json =
   if Js.Array.isArray json then
@@ -91,13 +93,13 @@ let tuple4 decodeA decodeB decodeC decodeD json =
           with_segment "2" decodeB (Array.unsafe_get source 1),
           with_segment "3" decodeC (Array.unsafe_get source 2),
           with_segment "4" decodeD (Array.unsafe_get source 3) )
-      with DecodeError msg -> raise @@ DecodeError (msg ^ "\n\tin tuple4")
+      with Melange_json.Of_json_error (Json_error msg) -> raise @@ Melange_json.Of_json_error (Json_error (msg ^ "\n\tin tuple4"))
     else
       let length_str = string_of_int length in
       raise
-      @@ DecodeError
-           {j|Expected array of length 4, got array of length $length_str|j}
-  else raise @@ DecodeError ("Expected array, got " ^ Js.Json.stringify json)
+      @@ Melange_json.Of_json_error
+           (Json_error {j|Expected array of length 4, got array of length $length_str|j})
+  else raise @@ Melange_json.Of_json_error (Json_error ("expected an array but got " ^ Js.Json.stringify json))
 
 let dict decode json =
   if Js.Json.test json Object then (
@@ -109,23 +111,23 @@ let dict decode json =
       let key = Array.unsafe_get keys i in
       let value =
         try with_segment key decode (Js.Dict.unsafeGet source key)
-        with DecodeError msg -> raise @@ DecodeError (msg ^ "\n\tin dict")
+        with Melange_json.Of_json_error (Json_error msg) -> raise @@ Melange_json.Of_json_error (Json_error (msg ^ "\n\tin dict"))
       in
       Js.Dict.set target key value
     done;
     target)
-  else raise @@ DecodeError ("Expected object, got " ^ Js.Json.stringify json)
+  else raise @@ Melange_json.Of_json_error (Json_error ("Expected object, got " ^ Js.Json.stringify json))
 
 let field key decode json =
   if Js.Json.test json Object then
     let dict = (Obj.magic (json : Js.Json.t) : Js.Json.t Js.Dict.t) in
     match Js.Dict.get dict key with
     | Some value -> (
         try with_segment key decode value
-        with DecodeError msg ->
-          raise @@ DecodeError (msg ^ "\n\tat field '" ^ key ^ "'"))
-    | None -> raise @@ DecodeError {j|Expected field '$(key)'|j}
-  else raise @@ DecodeError ("Expected object, got " ^ Js.Json.stringify json)
+        with Melange_json.Of_json_error (Json_error msg) ->
+          raise @@ Melange_json.Of_json_error (Json_error (msg ^ "\n\tat field '" ^ key ^ "'")))
+    | None -> raise @@ Melange_json.Of_json_error (Json_error {j|Expected field '$(key)'|j})
+  else raise @@ Melange_json.Of_json_error (Json_error ("Expected object, got " ^ Js.Json.stringify json))
 
 let obj_array f json = dict f json |> Js.Dict.entries
 
@@ -144,9 +146,9 @@ let fieldOptional key decode json =
     | Some value when (Js.Json.test value Null) -> None
     | Some value -> (
         try Some (with_segment key decode value)
-        with DecodeError msg ->
-          raise @@ DecodeError (msg ^ "\n\tat field '" ^ key ^ "'"))
-  else raise @@ DecodeError ("Expected object, got " ^ Js.Json.stringify json)
+        with Melange_json.Of_json_error (Json_error msg) ->
+          raise @@ Melange_json.Of_json_error (Json_error (msg ^ "\n\tat field '" ^ key ^ "'")))
+  else raise @@ Melange_json.Of_json_error (Json_error ("Expected object, got " ^ Js.Json.stringify json))
 
 let fieldDefault s default f =
   fieldOptional s f |> map (function None -> default | Some s -> s)
@@ -157,13 +159,12 @@ let tuple1 f x =
     let length = Js.Array.length source in
     if length = 1 then
       try with_segment "0" f (Array.unsafe_get source 0)
-      with DecodeError msg -> raise @@ DecodeError (msg ^ "\n\tin tuple1")
+      with Melange_json.Of_json_error (Json_error msg) -> raise @@ Melange_json.Of_json_error (Json_error (msg ^ "\n\tin tuple1"))
     else
       let length_str = string_of_int length in
       raise
-      @@ DecodeError
-           {j|Expected array of length 1, got array of length $length_str|j}
-  else raise @@ DecodeError ("Expected array, got " ^ Js.Json.stringify x)
+      @@ Melange_json.Of_json_error (Json_error {j|Expected array of length 1, got array of length $length_str|j})
+  else raise @@ Melange_json.Of_json_error (Json_error ("expected an array but got " ^ Js.Json.stringify x))
 
 let enum l json =
   let constr0 j =
@@ -180,32 +181,32 @@ let enum l json =
         (fun () ->
           match List.assoc s l with
           | exception Not_found ->
-              raise @@ DecodeError {j|unknown constructor "$s"|j}
+              raise @@ Melange_json.Of_json_error (Json_error {j|unknown constructor "$s"|j})
           | `Single a -> a
           | `Decode _ ->
-              raise @@ DecodeError {j|constructor "$s" expects arguments|j})
+              raise @@ Melange_json.Of_json_error (Json_error {j|constructor "$s" expects arguments|j}))
         ()
   | `Constr (s, args) ->
       with_segment s
         (fun () ->
           match List.assoc s l with
           | exception Not_found ->
-              raise @@ DecodeError {j|unknown constructor "$s"|j}
+              raise @@ Melange_json.Of_json_error (Json_error {j|unknown constructor "$s"|j})
           | `Single _ ->
               raise
-              @@ DecodeError {j|constructor "$s" doesn't expect arguments|j}
+              @@ Melange_json.Of_json_error (Json_error {j|constructor "$s" doesn't expect arguments|j})
           | `Decode d -> decode' d args)
         ()
 
 let option_as_constr f =
   either
     (fun x ->
       if string x = "None" then None
-      else raise (DecodeError ("Expected None, got " ^ Js.Json.stringify x)))
+      else raise (Melange_json.Of_json_error (Json_error ("Expected None, got " ^ Js.Json.stringify x))))
     (fun x ->
       match pair string f x with
       | "Some", v -> Some v
-      | _ -> raise (DecodeError ("Expected Some _, got " ^ Js.Json.stringify x)))
+      | _ -> raise (Melange_json.Of_json_error (Json_error ("Expected Some _, got " ^ Js.Json.stringify x))))
 
 let adapter (normalize : Js.Json.t -> Js.Json.t) (reader : 'a t) json =
   reader (normalize json)

src/atdgen_codec_encode.ml

@@ -1,12 +1,12 @@
-include Json.Encode
+include Melange_json.To_json
 
-type 'a t = 'a encoder
+type 'a t = 'a Melange_json.to_json
 
 let make f = f
 
 let encode f x = f x
 
-let unit () = null
+let unit () = Js.Json.null
 
 let int32 s = string (Int32.to_string s)
 
@@ -42,20 +42,22 @@ let obj fields =
               if s = default then acc else (name, encode s) :: acc
           | Some s, None -> (name, encode s) :: acc))
     [] fields
-  |> object_
+  |> Js.Dict.fromList |> json_dict
 
-let tuple1 f x = jsonArray [| f x |]
+let tuple1 f x = json_array [| f x |]
 
 let contramap f g b = g (f b)
 
 let constr0 = string
 
-let constr1 s f x = pair string f (s, x)
+let constr1 s f x = tuple2 string f (s, x)
 
 let option_as_constr f = function
   | None -> string "None"
-  | Some s -> pair string f ("Some", s)
+  | Some s -> tuple2 string f ("Some", s)
 
 let adapter (restore : Js.Json.t -> Js.Json.t) (writer : 'a t) x =
   let encoded = writer x in
   restore encoded
+
+let nullable = option