Support alternative representations of variants

README.md

@@ -77,7 +77,7 @@ The following table summarizes the correspondence between OCaml types and JSON v
 | `Yojson.Safe.t`        | any        | Identity transformation          |
 | `unit`                 | Null       |                                  |
 
-Variants (regular and polymorphic) are represented using arrays; the first element is a string with the name of the constructor, the rest are the arguments. Note that the implicit tuple in a polymorphic variant is flattened. For example:
+By default, variants (regular and polymorphic) are represented using arrays; the first element is a string with the name of the constructor, the rest are the arguments. Note that the implicit tuple in a polymorphic variant is flattened. For example:
 
 ``` ocaml
 # type pvs = [ `A | `B of int | `C of int * string ] list [@@deriving yojson];;
@@ -97,7 +97,14 @@ Record variants are represented in the same way as if the nested structure was d
 ["X",{"v":0}]
 ```
 
-Record variants are currently not supported for extensible variant types.
+Alternative representations of variants can be chosen using the option `variants` (i.e. ``[@@deriving yojson { variants = `Adjacent ("tag", "contents") }]``). The following table lists the ones that are supported:
+
+| `type _ =`                | Value            | ``variants = `Array``  | ``variants = `External`` | ``variants = `Internal "type"`` | ``variants = `Adjacent ("tag", "contents")`` | ``variants = `Native`` |
+| ------------------------- | ---------------- | ---------------------- | ------------------------ | ------------------------------- | -------------------------------------------- | ---------------------- |
+| `\| RA`                   | `RA`             | `["RA"]`               | `"RA"`                   | `{"type": "RA"}`                | `{"tag": "RA"}`                              | `<"RA">`               |
+| `\| RB of int`            | `RB 42`          | `["RB", 42]`           | `{"RB": 42}`             | (not supported)                 | `{"tag": "RB", "contents": 42}`              | `<"RB":42>`            |
+| `\| RC of int * string`   | `RC (42, "foo")` | `["RC", 42, "foo"]`    | `{"RC": [42, "foo"]}`    | (not supported)                 | `{"tag": "RC", "contents": [42, "foo"]}`     | `<"RC":[42, "foo"]>`   |
+| `\| RD of { z : string }` | `RD {z = "foo"}` | `["RD", {"z": "foo"}]` | `{"RD": {"z": "foo"}}`   | `{"type": "RD", "z": "foo"}`    | `{"tag": "RD", "contents": {"z": "foo"}}`    | `<"RD":{"z": "foo"}>`  |
 
 By default, objects are deserialized strictly; that is, all keys in the object have to correspond to fields of the record. Passing `strict = false` as an option to the deriver  (i.e. `[@@deriving yojson { strict = false }]`) changes the behavior to ignore any unknown fields.
 

old.txt

@@ -0,0 +1,70 @@
+
+
+
+
+=======
+  is_strict : bool;
+  want_meta : bool;
+  want_exn : bool;
+  variants : variants;
+}
+
+let default_options = {
+  is_strict = true;
+  want_meta = false;
+  want_exn = false;
+  variants = `Array;
+}
+
+let parse_options options =
+  let get_bool = Ppx_deriving.Arg.(get_expr ~deriver bool) in
+  options |> List.fold_left (fun options (name, expr) ->
+    match name with
+    | "strict" -> {options with is_strict = get_bool expr}
+    | "meta" -> {options with want_meta = get_bool expr}
+    | "exn" -> {options with want_exn = get_bool expr}
+    | "variants" -> {options with variants = Ppx_deriving.Arg.get_expr ~deriver variants_conv expr}
+    | _ -> raise_errorf ~loc:expr.pexp_loc "%s does not support option %s" deriver name
+  ) default_options
+>>>>>>> b25db84 (Support alternative representations of variants)
+
+
+
+
+
+let variants_conv _ loc expr f =
+  match expr with
+  | { pexp_desc = Pexp_variant ("Array", None) } -> f `Array
+  | { pexp_desc = Pexp_variant ("External", None) } -> f `External
+  | { pexp_desc = Pexp_variant ("Internal", Some t_expr) } ->
+    (match Ppx_deriving.Arg.string t_expr with
+    | Ok t -> f (`Internal t)
+    | Error e -> raise (Ppxlib__.Ast_pattern0.Expected (loc, "`Internal _:" ^ e)))
+  | { pexp_desc = Pexp_variant ("Adjacent", Some { pexp_desc = Pexp_tuple [t_expr; c_expr] }) } ->
+    (match Ppx_deriving.Arg.string t_expr, Ppx_deriving.Arg.string c_expr with
+    | Ok t, Ok c -> f (`Adjacent (t, c))
+    | Error e, _ -> Location.Error.raise (Location.Error.make ~loc ~sub:[] ("`Adjacent (_, _):" ^ e))
+    | _, Error e -> Location.Error.raise (Location.Error.make ~loc ~sub:[] ("`Adjacent (_, _):" ^ e)))
+  | { pexp_desc = Pexp_variant ("Native", None) } -> f `Native
+  | _ -> Location.Error.raise (Location.Error.make ~loc ~sub:[] (Printf.sprintf "one of: `Array, `External, `Internal _, `Adjacent (_, _), `Native"))
+
+
+
+
+let variants_conv _ loc expr f =
+  match expr with
+  | { pexp_desc = Pexp_variant ("Array", None) } -> f `Array
+  | { pexp_desc = Pexp_variant ("External", None) } -> f `External
+  | { pexp_desc = Pexp_variant ("Internal", Some t_expr) } ->
+    (match Ppx_deriving.Arg.string t_expr with
+    | Ok t -> f (`Internal t)
+    | Error e -> raise (Ppxlib__.Ast_pattern0.Expected (loc, "`Internal _:" ^ e)))
+  | { pexp_desc = Pexp_variant ("Adjacent", Some { pexp_desc = Pexp_tuple [t_expr; c_expr] }) } ->
+    (match Ppx_deriving.Arg.string t_expr, Ppx_deriving.Arg.string c_expr with
+    | Ok t, Ok c -> f (`Adjacent (t, c))
+    | Error e, _ -> raise (Ppxlib__.Ast_pattern0.Expected (loc, "`Adjacent (_, _):" ^ e))
+    | _, Error e -> raise (Ppxlib__.Ast_pattern0.Expected (loc, "`Adjacent (_, _):" ^ e)))
+  | { pexp_desc = Pexp_variant ("Native", None) } -> f `Native
+  | _ -> raise (Ppxlib__.Ast_pattern0.Expected (loc, Printf.sprintf "one of: `Array, `External, `Internal _, `Adjacent (_, _), `Native"))
+
+