diff --git a/.github/workflows/build-test.yml b/.github/workflows/build-test.yml index ee080d7..ec4ed6d 100644 --- a/.github/workflows/build-test.yml +++ b/.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 diff --git a/CHANGES.md b/CHANGES.md index 72c868f..48d05eb 100644 --- a/CHANGES.md +++ b/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) diff --git a/README.md b/README.md index 7967f05..0302117 100644 --- a/README.md +++ b/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), ); ``` diff --git a/melange-atdgen-codec-runtime.opam b/melange-atdgen-codec-runtime.opam index d4162aa..1efbc25 100644 --- a/melange-atdgen-codec-runtime.opam +++ b/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} diff --git a/src/__tests__/errors_test.ml b/src/__tests__/errors_test.ml index 4a4be72..217f2b2 100644 --- a/src/__tests__/errors_test.ml +++ b/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"|})); diff --git a/src/__tests__/test.atd b/src/__tests__/test.atd index 425804c..c15b80c 100644 --- a/src/__tests__/test.atd +++ b/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 diff --git a/src/atdgen_codec_decode.ml b/src/atdgen_codec_decode.ml index 31801ef..0f087d6 100644 --- a/src/atdgen_codec_decode.ml +++ b/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,12 +111,12 @@ 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 @@ -122,10 +124,10 @@ let field key decode json = 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,20 +181,20 @@ 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) () @@ -201,11 +202,11 @@ 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) diff --git a/src/atdgen_codec_encode.ml b/src/atdgen_codec_encode.ml index e61b40c..fd937c6 100644 --- a/src/atdgen_codec_encode.ml +++ b/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 \ No newline at end of file diff --git a/src/atdgen_json_adapter.ml b/src/atdgen_json_adapter.ml index e462d44..2f435b7 100644 --- a/src/atdgen_json_adapter.ml +++ b/src/atdgen_json_adapter.ml @@ -28,7 +28,7 @@ module Type_field = struct match o |> Js.Json.classify with | JSONObject obj -> Js.Dict.set obj type_field_name v; - Json.Encode.jsonDict obj + Melange_json.To_json.json_dict obj | _ -> json) | _ -> json end