ppx: document ppx_deriving_json

Author: hhugo

manual/menu.wiki

@@ -12,6 +12,7 @@
 =Syntaxes
 ==[[ppx|Ppx syntax extension]]
 ==[[camlp4|Camlp4 syntax extension]]
+==[[ppx-deriving|Ppx deriving json]]
 
 =Compiler
 ==[[options|Command line options]]

manual/ppx-deriving.wiki

@@ -0,0 +1,45 @@
+= Ppx deriver for serializing OCaml value to Json
+
+The deriver is provided by the js_of_ocaml-ppx_deriving_json opam package.
+
+The serialisation format follows js_of_ocaml's internal memory
+representation of OCaml values. It is not meant to be used to interact
+with 3rd party system.  In practice, it can be used to exchange data
+between a js_of_ocaml program and a server side OCaml application.
+
+The serialisation format allows a js_of_ocaml program to encode/decode
+OCaml value efficiently by leveraging JavaScript native Json
+support. See [Js_of_ocaml.Json.output] and [Js_of_ocaml.Json.output].
+
+== Syntax
+
+=== Generate serialisation from type definitions
+
+One can derive serialisation functions from type definitions using
+the {{{[@@deriving ..]}}} attribute.
+
+<<code language="ocaml"|
+
+type t = A | B
+[@@deriving json]
+
+val t_of_json : Deriving_Json_lexer.lexbuf -> t = <fun>
+val t_to_json : Buffer.t -> t -> unit = <fun>
+val t_json : t Deriving_Json.t = <abstr>
+
+>>
+
+=== Generate serialisation from types
+
+One can generate an expression to serialise/deserialise value of an arbitrary type
+with the following syntax:
+
+<<code language="ocaml"|
+
+let (_ : t Deriving_json.t) = [%json: t]
+
+let (_ : string -> t) = [%of_json: t]
+
+let (_ : t -> string) = [%to_json: t]
+
+>>

ppx/ppx_deriving_json/lib/ppx_deriving_json.ml

@@ -789,6 +789,19 @@ module Json_of = struct
   let deriver = Ppxlib.Deriving.add name ~extension
 end
 
+module To_json = struct
+  let name = "to_json"
+
+  let extension ~loc ~path:_ ctyp =
+    [%expr
+      fun x ->
+        let buf = Buffer.create 50 in
+        [%e write_of_type ctyp ~poly:false] buf x;
+        Buffer.contents buf]
+
+  let deriver = Ppxlib.Deriving.add name ~extension
+end
+
 module Json = struct
   let name = "json"
 
@@ -803,6 +816,8 @@ end
 
 let json_of = Json_of.deriver
 
+let to_json = To_json.deriver
+
 let of_json = Of_json.deriver
 
 let json = Json.deriver

ppx/ppx_deriving_json/lib/ppx_deriving_json.mli

@@ -19,6 +19,8 @@
 
 val json_of : Ppxlib.Deriving.t
 
+val to_json : Ppxlib.Deriving.t
+
 val of_json : Ppxlib.Deriving.t
 
 val json : Ppxlib.Deriving.t

ppx/ppx_deriving_json/tests/gen.mlt

@@ -520,3 +520,82 @@ val json :
   'a Deriving_Json.t -> 'b Deriving_Json.t -> ('a, 'b) t Deriving_Json.t =
   <fun>
 |}]
+
+
+type t = A | B [@@deriving json]
+[%%expect {|
+
+type t =
+  | A
+  | B [@@deriving json] let _ = fun (_ : t) -> ()
+let rec (of_json : Deriving_Json_lexer.lexbuf -> t) =
+  fun buf ->
+    match Deriving_Json_lexer.read_case buf with
+    | `Cst 1 -> B
+    | `Cst 0 -> A
+    | _ -> Deriving_Json_lexer.tag_error ~typename:"" buf let _ = of_json
+let rec (to_json : Buffer.t -> t -> unit) =
+  fun buf ->
+    function
+    | B -> Deriving_Json.Json_int.write buf 1
+    | A -> Deriving_Json.Json_int.write buf 0 let _ = to_json
+let (json : t Deriving_Json.t) = Deriving_Json.make to_json of_json
+let _ = json;;
+type t = A | B
+val of_json : Deriving_Json_lexer.lexbuf -> t = <fun>
+val to_json : Buffer.t -> t -> unit = <fun>
+val json : t Deriving_Json.t = <abstr>
+|}];;
+
+let x = [%json: t option]
+[%%expect {|
+
+let x =
+  Deriving_Json.make
+    (fun buf ->
+       fun a ->
+         Deriving_Json.write_option (fun buf -> fun a -> to_json buf a) buf a)
+    (fun buf -> Deriving_Json.read_option (fun buf -> of_json buf) buf);;
+val x : t option Deriving_Json.t = <abstr>
+|}];;
+
+let y = [%to_json: t list]
+[%%expect {|
+
+let y x =
+  let buf = Buffer.create 50 in
+  ((fun buf ->
+      fun a ->
+        Deriving_Json.write_list (fun buf -> fun a -> to_json buf a) buf a))
+    buf x;
+  Buffer.contents buf;;
+val y : t list -> string = <fun>
+|}];;
+
+let z = [%json_of: t array]
+[%%expect {|
+
+let z x =
+  let buf = Buffer.create 50 in
+  ((fun buf ->
+      fun a ->
+        Deriving_Json.write_array (fun buf -> fun a -> to_json buf a) buf a))
+    buf x;
+  Buffer.contents buf;;
+val z : t array -> string = <fun>
+|}];;
+
+let t = [%of_json: t * t]
+[%%expect {|
+
+let t s =
+  (fun buf ->
+     Deriving_Json_lexer.read_lbracket buf;
+     ignore (Deriving_Json_lexer.read_tag_1 0 buf);
+     Deriving_Json_lexer.read_comma buf;
+     (let a = of_json buf in
+      Deriving_Json_lexer.read_comma buf;
+      (let b = of_json buf in Deriving_Json_lexer.read_rbracket buf; (a, b))))
+    (Deriving_Json_lexer.init_lexer (Lexing.from_string s));;
+val t : string -> t * t = <fun>
+|}]