Commits

camlspotter committed a535346

added mc_fields converters

Comments (0)

Files changed (2)

 
 let errorf fmt = Printf.ksprintf (fun s -> raise (Failure s)) fmt
 
-module Decode = Meta_conv.Internal.Make_Decode_Adrs(struct
-  type t = Json.t
+module Decode = struct
   let tuple = function 
     | Array ts -> ts
     | _ -> errorf "Array expected for tuple"
   let record = function
     | Object alist -> alist
     | _ -> errorf "Object expected for record"
-end)
+end
 
 open Printf
 
 type 'a decoder_exn = ('a, Json.t) Decoder.t_exn
 exception Error of Json.t Error.t
 
-let errorf v adrs fmt = 
-  kprintf (fun s -> `Error (Primitive_decoding_failure s, v, adrs)) fmt
+let errorf v fmt = 
+  kprintf (fun s -> `Error (Primitive_decoding_failure s, v)) fmt
 
-let string_of_json ?(adrs=Address.top) = function
+let string_of_json = function
   | String s -> `Ok s
-  | v -> errorf v adrs "string_of_json: String expected"
+  | v -> errorf v "string_of_json: String expected"
 
-let char_of_json ?(adrs=Address.top) = function
+let char_of_json = function
   | String s when String.length s = 1 -> `Ok s.[0]
-  | v -> errorf v adrs "char_of_json: a char expected"
+  | v -> errorf v "char_of_json: a char expected"
 
-let int_check name min max conv ?(adrs=Address.top) v = match v with
+let int_check name min max conv v = match v with
   | Number n -> 
       begin match integer_of_float min max conv n with
       | `Ok i -> `Ok i
-      | `Error s -> errorf v adrs "%s_of_json: %s" name s
+      | `Error s -> errorf v "%s_of_json: %s" name s
       end
-  | _ -> errorf v adrs "%s_of_json: Number expected" name
+  | _ -> errorf v "%s_of_json: Number expected" name
 
 let int_of_json =
   int_check "int" (float min_int) (float max_int) int_of_float
   let open Nativeint in
   int_check "nativeint" (to_float min_int) (to_float max_int) of_float
       
-let float_of_json ?(adrs=Address.top) = function
+let float_of_json = function
   | Number n -> `Ok n
-  | n -> errorf n adrs "float_of_json: Number expected"
+  | n -> errorf n "float_of_json: Number expected"
 
-let bool_of_json ?(adrs=Address.top) = function
+let bool_of_json = function
   | Bool b -> `Ok b
-  | v -> errorf v adrs "bool_of_json: Bool expected"
+  | v -> errorf v "bool_of_json: Bool expected"
 
-let unit_of_json ?(adrs=Address.top) = function
+let unit_of_json = function
   | Null -> `Ok ()
-  | v -> errorf v adrs "unit_of_json: Null expected"
+  | v -> errorf v "unit_of_json: Null expected"
   
 let list_of_json d = generic_list_of (function
   | Array xs -> Some xs
 
 type 'a named_list = (string * 'a) list
 
-let json_of_named_list enc xs = Object (List.map (fun (name, a) -> (name, enc a)) xs)
+let json_of_mc_fields enc xs = Object (List.map (fun (name, a) -> (name, enc a)) xs)
 
-(* CR jfuruse: this should be available in Meta_conv *)
-let list_mapi f xs =
-  List.rev (fst (List.fold_left (fun (rev,i) x ->
-    (f x i :: rev), i+1) ([],0) xs))
-
-let named_list_of_json dec ?(adrs=[]) xs =
-  let string_a_decoder : (string * 'a) decoder = fun ?adrs (name, a) -> 
-    match dec a with
-    | `Ok v -> `Ok (name, v)
-    | `Error e -> `Error e
-  in
-  generic_list_of 
-    (function Object xs -> Some xs | _ -> None)
-    string_a_decoder
+let mc_fields_of_json dec = generic_mc_fields_of (function Object js -> Some js | _ -> None) dec

lib/json_conv.mli

 val json_of_option : ('a -> Json.t) -> 'a option -> Json.t
 
 module Decode : sig
-  val tuple : Json.t * Address.t -> (Json.t * Address.t) list
-  val variant : Json.t * Address.t -> string * (Json.t * Address.t) list
-  val record : Json.t * Address.t -> (string * (Json.t * Address.t)) list
+  val tuple   : Json.t -> Json.t list
+  val variant : Json.t -> string * Json.t list
+  val record  : Json.t -> (string * Json.t) list
 end
 
 type 'a decoder = ('a, Json.t) Decoder.t
 
 type 'a named_list = (string * 'a) list
 
-val json_of_named_list : ('a -> Json.t) -> 'a named_list -> Json.t
-val named_list_of_json : 'a decoder -> 'a named_list decoder
-val named_list_of_json_exn : 'a decoder -> 'a named_list decoder_exn
-
-
+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) Result.t