Commits

camlspotter committed ed5011a

added xjson

  • Participants
  • Parent commits 0bc6e93

Comments (0)

Files changed (5)

 
 FILES[] =
     xcurl
+    xjson
     common
     api
     hg
 open Printf
 open Common
 
-open Tiny_json
 open Json_conv  (* for conv(json) *)
 open Ocaml_conv (* for conv(ocaml) *)
-open Meta_conv.Result.Open
 
 (* field of type Json.t mc_leftovers is automatically handled for Json, but not for ocaml *)
 type 'target mc_leftovers = (string * 'target) list with conv(ocaml)
 (* CR jfuruse: mc_fields should be supported in Ocaml_conv *)
 type 'target mc_fields = (string * 'target) list with conv(ocaml)
 
-(* CR jfuruse: can be shared with other json apps *)
-module Json = struct
-  include Json
-
-  let ocaml_of_t : Json.t Ocaml_conv.encoder = fun j -> Ocaml.String (Json.show j)
-  let t_of_ocaml : Json.t Ocaml_conv.decoder = fun o ->
-    try match o with
-    | Ocaml.String s -> `Ok (Json.parse s)
-    | _ -> failwith "Ocaml.String expected"
-    with e -> `Error (Meta_conv.Error.Deconstruction_error e, o)
-
-  let parse s = try `Ok (parse s) with e -> `Error (`Json_parse e)
-end
-
 (** { 6 Types } *)
 
 module Scheme = struct
           (Json.show v)
 end
 
-let curl_get_and_parse (convf : 'a Json_conv.decoder) curlf = 
-  Curl.get_string curlf >>= Json.parse >>= Error.wrap_json_conv convf
-
 module Data = struct
 
   (* CR jfuruse: It seems we should use classes since there are so many name overloads *)
 
     let get ~accountname ~repo_slug = 
       Format.eprintf "%s : %s...@." accountname repo_slug;
-      curl_get_and_parse 
+      Json.curl_get_and_parse 
         t_of_json
         (fun h ->
           (* ~user ~password  *)
 module User = struct
 
   let get ~user ~password = 
-    curl_get_and_parse
+    Json.curl_get_and_parse
       Data.User.t_of_json
       (fun h ->
         h#set_url "https://api.bitbucket.org/1.0/user";
   module Repositories = struct
 
     let get ~user ~password = 
-      curl_get_and_parse
+      Json.curl_get_and_parse
         Data.UserRepo.ts_of_json
         (fun h ->
           h#set_url "https://api.bitbucket.org/1.0/user/repositories/";
   include Xcurl
 end
 
+module Json = struct
+  include Tiny_json.Json
+  include Xjson
+end
+
 external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+open Spotlib.Spot
+open Meta_conv.Result.Open
+open Tiny_json
+
+(* CR jfuruse: can be shared with other json apps *)
+let ocaml_of_t : Json.t Ocaml_conv.encoder = fun j -> Ocaml.String (Json.show j)
+let t_of_ocaml : Json.t Ocaml_conv.decoder = fun o ->
+  try match o with
+  | Ocaml.String s -> `Ok (Json.parse s)
+  | _ -> failwith "Ocaml.String expected"
+  with e -> `Error (Meta_conv.Error.Deconstruction_error e, o)
+
+let parse s = try `Ok (Json.parse s) with e -> `Error (`Json_parse e)
+
+(* CR jfuruse: can be shared with other json apps *)
+module Error = struct
+  open Format
+
+  let wrap_json_conv (convf : 'a Json_conv.decoder) s = match convf s with
+    | `Ok v -> `Ok v
+    | `Error e -> `Error (`Json_conv e)
+
+  let format ppf = function
+    | `Http (n, _err) -> fprintf ppf "HTTP Error %d@." n
+    | `Json_parse exn -> fprintf ppf "Error at Json parse: %s@." (Printexc.to_string exn)
+    | `Other exn      -> fprintf ppf "Error: %s@." (Printexc.to_string exn)
+    | `Json_conv e -> Json_conv.format_error_with_source Format.stderr e 
+
+  let from_Ok = function
+    | `Ok v -> v
+    | `Error e -> failwith (Format.sprintf "%a" format e)
+end
+
+let curl_get_and_parse (convf : 'a Json_conv.decoder) curlf = 
+  Xcurl.get_string curlf >>= parse >>= Error.wrap_json_conv convf
+
+open Spotlib.Spot
+open Tiny_json
+
+val ocaml_of_t : Json.t Ocaml_conv.encoder
+val t_of_ocaml : Json.t Ocaml_conv.decoder
+val parse : string -> [> `Error of [> `Json_parse of exn ] | `Ok of Json.t ]
+
+module Error : sig
+
+  val wrap_json_conv : 
+    'a Json_conv.decoder 
+    -> Json.t 
+    ->  ('a, [> `Json_conv of Json.t Meta_conv.Error.t]) Meta_conv.Result.t
+
+  val format : Format.t 
+    -> [< `Http of int * 'a
+       | `Json_conv of Json.t Meta_conv.Error.t
+       | `Json_parse of exn
+       | `Other of exn ] 
+    -> unit
+  val from_Ok :
+    [< `Error of [< `Http of int * 'a
+                 | `Json_conv of Json.t Meta_conv.Error.t
+                 | `Json_parse of exn
+                 | `Other of exn ]
+    | `Ok of 'b ] 
+    -> 'b
+end
+
+val curl_get_and_parse :
+  'a Json_conv.decoder 
+  -> (Curl.handle -> unit) 
+  -> ('a, [> `Http of int * string
+          | `Json_conv of Json.t Meta_conv.Error.t
+          | `Json_parse of exn ]) Meta_conv.Result.t