ppx: derive signatures (#32)

Co-authored-by: Javier Chavarri <[email protected]>

CHANGES.md

@@ -1,5 +1,13 @@
 ## Unpublished
 
+- **[breaking]** PPX: Code to decode polyvariants doesn't use an additional
+  `_poly` function which was also generated by the PPX. Instead
+  `Unexpected_variant` error is used to signal that next decoder should be
+  tried.
+  ([#32](https://github.com/melange-community/melange-json/pull/32))
+- **[breaking]** Json.Decode.DecodeError exception now contains a variant type
+  as payload instead of a string.
+  ([#32](https://github.com/melange-community/melange-json/pull/32))
 - **[breaking]** PPX: Rename `[@json.as]` to `[@json.name]`
   ([#23](https://github.com/melange-community/melange-json/pull/23))
 - **[breaking]** PPX: Drop special encoding for enumeration-like variants (variants with each
@@ -10,6 +18,9 @@
   ([#27](https://github.com/melange-community/melange-json/pull/27))
 - **[breaking]** PPX: Consistent use of exceptions in runtime.
   ([#28](https://github.com/melange-community/melange-json/pull/28))
+- PPX: `[@@deriving json]` now can be used within signatures (this includes
+  `.mli` files).
+  ([#32](https://github.com/melange-community/melange-json/pull/32))
 - PPX: Add runtime for `result`
   ([#13](https://github.com/melange-community/melange-json/pull/13))
 - PPX: Add `yojson` as runtime dep for the native version

examples/decode.ml

@@ -25,4 +25,4 @@ let _ =
   let json = {|{ "y": 42 } |} |> Json.parseOrRaise in
   match Json.Decode.(field "x" int json) with
   | x -> Js.log x
-  | exception Json.Decode.DecodeError msg -> Js.log ("Error:" ^ msg)
+  | exception Json.Decode.DecodeError err -> Js.log ("Error:" ^ Json.Decode.error_to_string err)

ppx/browser/dune

@@ -3,7 +3,7 @@
  (name ppx_deriving_json_js)
  (modules :standard \ ppx_deriving_json_runtime ppx_deriving_json_js_test)
  (libraries ppxlib)
- (ppx_runtime_libraries melange-json.ppx-runtime)
+ (ppx_runtime_libraries melange-json melange-json.ppx-runtime)
  (preprocess
   (pps ppxlib.metaquot))
  (kind ppx_deriver))
@@ -39,7 +39,4 @@
  (files ../native/ppx_deriving_json_common.ml))
 
 (copy_files#
- (files ../tools/ppx_deriving_tools.ml))
-
-(copy_files#
- (files ../tools/ppx_deriving_tools.mli))
+ (files ../native/ppx_deriving_tools.{ml,mli}))

ppx/browser/ppx_deriving_json_runtime.ml

@@ -20,9 +20,16 @@ let of_string s =
     in
     raise (Of_string_error msg)
 
+type error = Json.Decode.error =
+  | Json_error of string
+  | Unexpected_variant of string
+
 exception Of_json_error = Json.Decode.DecodeError
 
-let of_json_error msg = raise (Of_json_error msg)
+let of_json_error msg = raise (Of_json_error (Json_error msg))
+
+let unexpected_variant_error tag =
+  raise (Of_json_error (Unexpected_variant tag))
 
 module To_json = struct
   external string_to_json : string -> t = "%identity"

ppx/native/dune

@@ -37,6 +37,3 @@
   (with-stdout-to
    %{target}
    (run echo "let () = Ppxlib.Driver.standalone ()"))))
-
-(copy_files#
- (files ../tools/ppx_deriving_tools.{ml,mli}))

ppx/native/ppx_deriving_json_native.ml

@@ -161,8 +161,6 @@ module Of_json = struct
   let deriving : Ppx_deriving_tools.deriving =
     deriving_of_match () ~name:"of_json"
       ~of_t:(fun ~loc -> [%type: Yojson.Basic.t])
-      ~error:(fun ~loc ->
-        [%expr Ppx_deriving_json_runtime.of_json_error "invalid JSON"])
       ~derive_of_tuple ~derive_of_record ~derive_of_variant_case
 end
 

ppx/native/ppx_deriving_json_runtime.ml

@@ -10,9 +10,11 @@ let of_string s =
   try Yojson.Basic.from_string s
   with Yojson.Json_error msg -> raise (Of_string_error msg)
 
-exception Of_json_error of string
+type error = Json_error of string | Unexpected_variant of string
 
-let of_json_error msg = raise (Of_json_error msg)
+exception Of_json_error of error
+
+let of_json_error msg = raise (Of_json_error (Json_error msg))
 
 let show_json_type = function
   | `Assoc _ -> "object"
@@ -24,9 +26,8 @@ let show_json_type = function
   | `String _ -> "string"
 
 let of_json_error_type_mismatch json expected =
-  raise
-    (Of_json_error
-       ("expected " ^ expected ^ " but got " ^ show_json_type json))
+  of_json_error
+    ("expected " ^ expected ^ " but got " ^ show_json_type json)
 
 module To_json = struct
   let string_to_json v = `String v