From a523c63c7f64d914c3f97101edf034309596d148 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Thu, 27 Feb 2014 00:45:23 +0100
Subject: [PATCH] added a conversion example: Json (with yojson type)

---
 conv.ml  | 41 +++++++++++++++++++++++++++++++++++++++++
 conv.mli | 23 +++++++++++++++++++++++
 2 files changed, 64 insertions(+)

diff --git a/conv.ml b/conv.ml
index dc1ecfa9..bf22c700 100644
--- a/conv.ml
+++ b/conv.ml
@@ -351,6 +351,46 @@ let rec into : type a b. a Source.t -> b Sink.universal -> a -> b =
 
 let from (src:'a Source.universal) (sink:'b Sink.t) (x:'a) : 'b = src#visit sink x
 
+(** {6 Exemples} *)
+
+module Json = struct
+  type t = [
+    | `Int of int
+    | `Float of float
+    | `Bool of bool
+    | `Null
+    | `String of string
+    | `List of t list
+    | `Assoc of (string * t) list
+  ]
+
+  let source = object(self)
+    inherit [t] Source.universal
+    method visit sink (x:t) = match x with
+    | `Int i -> self#int_ sink i
+    | `Float f -> self#float_ sink f
+    | `Bool b -> self#bool_ sink b
+    | `Null -> self#unit_ sink
+    | `String s -> self#string_ sink s
+    | `List l -> self#list_ sink l
+    | `Assoc l -> self#record sink l
+  end
+
+  let sink : t Sink.universal = object
+    method unit_ = `Null
+    method bool_ b = `Bool b
+    method float_ f = `Float f
+    method int_ i = `Int i
+    method string_ s = `String s
+    method list_ l = `List l
+    method record l = `Assoc l
+    method tuple l = `List l
+    method sum name l = match l with
+      | [] -> `String name
+      | _::_ -> `List (`String name :: l)
+  end
+end
+
 (* test for records *)
 
 type point = {
@@ -378,4 +418,5 @@ let point_source : point Source.t =
 
 let p = {x=1; y=42; color="yellow"; }
 
+let p2 = into point_source Json.sink p
 (* TODO tests *)
diff --git a/conv.mli b/conv.mli
index 399490ff..664d26e6 100644
--- a/conv.mli
+++ b/conv.mli
@@ -28,6 +28,8 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 exception ConversionFailure of string
 
+(** {6 Sinks}
+A sink is used to traverse values of some type 'a *)
 module Sink : sig
   (** A specific sink that requires a given shape to produce
    * a value of type 'a *)
@@ -94,6 +96,8 @@ module Sink : sig
   end
 end
 
+(** {6 Sources}
+A source is used to build values of some type 'a *)
 module Source : sig
   (** A specific source that follows the shape of the type 'a *)
   type 'a t =
@@ -166,8 +170,27 @@ module Source : sig
   end
 end
 
+(** {6 Conversion Functions} *)
+
 val into : 'a Source.t -> 'b Sink.universal -> 'a -> 'b
   (** Conversion to universal sink *)
 
 val from : 'a Source.universal -> 'b Sink.t -> 'a -> 'b
   (** Conversion from universal source *)
+
+(** {6 Exemples} *)
+
+module Json : sig
+  type t = [
+    | `Int of int
+    | `Float of float
+    | `Bool of bool
+    | `Null
+    | `String of string
+    | `List of t list
+    | `Assoc of (string * t) list
+  ]
+
+  val source : t Source.universal
+  val sink : t Sink.universal
+end