Commits

camlspotter committed d5035b3

json-wheel bigint

  • Participants
  • Parent commits 9d63cf6

Comments (0)

Files changed (2)

 open Common
 open Json_wrap
+open Meta_conv.Conv
 open Json_conv
 open Sexplib.Conv
 
     | _ -> assert false
 end
 
+module Address = struct
+  include Address
+  let sexp_of_t _ = Sexplib.Sexp.Atom ""
+  let t_of_sexp _ = top
+end
+
+type 'target fields = (string * ('target * Address.t)) list with sexp
+
 module Scheme = struct
   type t = Hg(:"hg":) | Git(:"git":) with conv(json)
 end
 
   type resp = {
     user : user;
-    rest (: Rest_in_raw :) : (string * Json.t) list
+    rest (: Rest_in_raw :) : Json.t fields;
   } with conv(json), sexp
 
   let get ~user ~password = 
       h#set_url "https://api.bitbucket.org/1.0/user";
       h#set_userpwd (Printf.sprintf "%s:%s" user password))
     in
-    try resp_of_json (Json_io.json_of_string s) with e -> 
+    try resp_of_json_exn (Json_io.json_of_string s) with e -> 
       prerr_endline (Printexc.to_string e);
       prerr_endline s;
       raise e
       | Array of t list
       | String of string
       | Int of int
+      | Bigint of string
       | Float of float
       | Bool of bool
       | Null
     let record tag_ts  = Object tag_ts
   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_int n       = Int n
+  let json_of_int32 n     = Bigint (Int32.to_string n)
+  let json_of_int64 n     = Bigint (Int64.to_string n)
+  let json_of_nativeint n = Bigint (Nativeint.to_string 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_float n     = Float 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
     | v -> errorf v adrs "char_of_json: a char expected"
   
   let int_check name min max conv ?(adrs=Address.top) v = match v with
-    | Number n -> 
+    | Int n -> `Ok (conv (float_of_int n))
+    | Bigint n -> (* only works inside the float expressive power *)
+        begin match integer_of_float min max conv (float_of_string n) with
+        | `Ok v -> `Ok v
+        | `Error s -> errorf v adrs "%s_of_json: %s" name s
+        end
+    | Float n -> 
         begin match integer_of_float min max conv n with
         | `Ok v -> `Ok v
         | `Error s -> errorf v adrs "%s_of_json: %s" name s
     int_check "nativeint" (to_float min_int) (to_float max_int) of_float
         
   let float_of_json ?(adrs=Address.top) = function
-    | Number n -> `Ok n
+    | Float n -> `Ok n
+    | Int n -> `Ok (float_of_int n)
+    | Bigint n -> `Ok (float_of_string n)
     | n -> errorf n adrs "float_of_json: Number expected"
   
   let bool_of_json ?(adrs=Address.top) = function