Commits

camlspotter committed ff0f2d9

fix for meta_conv 0.11.1

  • Participants
  • Parent commits 284126e

Comments (0)

Files changed (2)

File lib/json_conv.ml

 open Tiny_json
-open Json
+open Tiny_json.Json
 
-open Meta_conv.Types
 open Meta_conv.Types.Error
 open Meta_conv.Internal
 
-module Encode = struct
-  let int n       = Number (float n)
-  let int32 n     = Number (Int32.to_float n)
-  let int64 n     = Number (Int64.to_float n)
-  let nativeint n = Number (Nativeint.to_float n)
-  let char c      = String (String.make 1 c)
-  let string s    = String s
-  let float n     = Number n
-  let list f xs   = Array (List.map f xs)
-  let array f xs  = Array (List.map f (Array.to_list xs))
-  let bool b      = Bool b
-  let lazy_t f v  = f (Lazy.force v)
-  let option f    = function
-    | None -> Null
-    | Some v -> f v
-  let unit ()     = Null
+include MakeMinimumCoders(struct
+    
+  type target = Json.t
 
-  let tuple ts       = Array ts
-  let variant tag = function
-    | [] -> String tag
-    | ts -> Object [tag, Array ts]
-  let record tag_ts  = Object tag_ts
-  let poly_variant = variant
-  let object_ = record
-end
+  module Encode = struct
+    let tuple ts       = Array ts
+    let variant tag = function
+      | [] -> String tag
+      | ts -> Object [tag, Array ts]
+    let record tag_ts  = Object tag_ts
+    let poly_variant = variant
+    let object_ = record
+  end
+  
+  module Decode = struct
+    let tuple = function 
+      | Array ts -> ts
+      | _ -> failwith "Array expected for tuple"
+  
+    let variant = function 
+      | String tag -> tag, [] 
+      | Object [tag, Array ts] -> tag, ts
+      | _ -> failwith "Object expected for variant"
+  
+    let record = function
+      | Object alist -> alist
+      | _ -> failwith "Object expected for record"
+  
+    let poly_variant = variant
+    let object_ = record
+  end
+end)
 
-let json_of_int       = Encode.int
-let json_of_int32     = Encode.int32
-let json_of_int64     = Encode.int64
-let json_of_nativeint = Encode.nativeint
-let json_of_char      = Encode.char
-let json_of_string    = Encode.string
-let json_of_float     = Encode.float
-let json_of_list      = Encode.list
-let json_of_array     = Encode.array
-let json_of_bool      = Encode.bool
-let json_of_lazy_t    = Encode.lazy_t
-let json_of_option    = Encode.option
-let json_of_unit      = Encode.unit
-
-let errorf fmt = Printf.ksprintf (fun s -> raise (Failure s)) fmt
-
-module Decode = struct
-  let tuple = function 
-    | Array ts -> ts
-    | _ -> errorf "Array expected for tuple"
-
-  let variant = function 
-    | String tag -> tag, [] 
-    | Object [tag, Array ts] -> tag, ts
-    | _ -> errorf "Object expected for variant"
-
-  let record = function
-    | Object alist -> alist
-    | _ -> errorf "Object expected for record"
-
-  let poly_variant = variant
-  let object_ = record
-end
+let json_of_int n       = Number (float n)
+let json_of_int32 n     = Number (Int32.to_float n)
+let json_of_int64 n     = Number (Int64.to_float n)
+let json_of_nativeint n = Number (Nativeint.to_float n)
+let json_of_char c      = String (String.make 1 c)
+let json_of_string s    = String s
+let json_of_float n     = Number n
+let json_of_list f xs   = Array (List.map f xs)
+let json_of_array f xs  = Array (List.map f (Array.to_list xs))
+let json_of_bool b      = Bool b
+let json_of_lazy_t f v  = f (Lazy.force v)
+let json_of_option f    = function
+  | None -> Null
+  | Some v -> f v
+let json_of_unit ()     = Null
 
 open Printf
 
-type 'a decoder = ('a, Json.t) Meta_conv.Types.Decoder.t
-type 'a decoder_exn = ('a, Json.t) Decoder.t_exn
-exception Error of Json.t Error.t
-
 let errorf v fmt = 
   kprintf (fun s -> `Error (Primitive_decoding_failure s, v)) fmt
 
 let lazy_t_of_json f = generic_lazy_t_of (fun e -> raise (Error e)) f
 let mc_lazy_t_of_json = generic_mc_lazy_t_of 
 
-type 'a named_list = (string * 'a) list
-
 let json_of_mc_fields enc xs = Object (List.map (fun (name, a) -> (name, enc a)) xs)
 
 let mc_fields_of_json dec = generic_mc_fields_of (function Object js -> Some js | _ -> None) dec

File lib/json_conv.mli

 open Tiny_json
-open Meta_conv.Types
+open Meta_conv.Open
 
-module Encode : sig
-  val tuple : Json.t list -> Json.t
-  val variant : string -> Json.t list -> Json.t
-  val record : Json.obj -> Json.t
-  val poly_variant : string -> Json.t list -> Json.t
-  val object_ : Json.obj -> Json.t
-end
+include Meta_conv.Internal.MinimumCoders with type target = Json.t
 
-val json_of_int : int -> Json.t
-val json_of_int32 : int32 -> Json.t
-val json_of_int64 : int64 -> Json.t
+val json_of_int       : int -> Json.t
+val json_of_int32     : int32 -> Json.t
+val json_of_int64     : int64 -> Json.t
 val json_of_nativeint : nativeint -> Json.t
-val json_of_char : char -> Json.t
-val json_of_string : string -> Json.t
-val json_of_float : float -> Json.t
-val json_of_bool : bool -> Json.t
-val json_of_unit : unit -> Json.t
-val json_of_list : ('a -> Json.t) -> 'a list -> Json.t
-val json_of_array : ('a -> Json.t) -> 'a array -> Json.t
-val json_of_lazy_t : ('a -> 'b) -> 'a Lazy.t -> 'b
-val json_of_option : ('a -> Json.t) -> 'a option -> Json.t
-
-module Decode : sig
-  val tuple   : Json.t -> Json.t list
-  val variant : Json.t -> string * Json.t list
-  val record  : Json.t -> (string * Json.t) list
-  val poly_variant : Json.t -> string * Json.t list
-  val object_ : Json.t -> (string * Json.t) list
-end
-
-type 'a decoder = ('a, Json.t) Decoder.t
-type 'a decoder_exn = ('a, Json.t) Decoder.t_exn
-exception Error of Json.t Error.t
+val json_of_char      : char -> Json.t
+val json_of_string    : string -> Json.t
+val json_of_float     : float -> Json.t
+val json_of_bool      : bool -> Json.t
+val json_of_unit      : unit -> Json.t
+val json_of_list      : ('a -> Json.t) -> 'a list -> Json.t
+val json_of_array     : ('a -> Json.t) -> 'a array -> Json.t
+val json_of_lazy_t    : ('a -> 'b) -> 'a Lazy.t -> 'b
+val json_of_option    : ('a -> Json.t) -> 'a option -> Json.t
 
 val string_of_json    : string decoder
 val char_of_json      : char decoder
 val lazy_t_of_json    : 'a decoder -> 'a lazy_t decoder
 val mc_lazy_t_of_json : 'a decoder -> ('a, Json.t) mc_lazy_t decoder
 
-type 'a named_list = (string * 'a) list
-
 val json_of_mc_fields : ('a -> Json.t) -> (string * 'a) list -> Json.t
-val mc_fields_of_json : 
-  ('a, Json.t) Decoder.t 
-  -> Json.t 
-  -> ((string * 'a) list, Json.t Error.t) Result.t
+val mc_fields_of_json : 'a decoder -> (string * 'a) list decoder