1. camlspotter
  2. ocaml-bitbucket

Source

ocaml-bitbucket / api.ml

Diff from to

File api.ml

 open Printf
 open Common
+
 open Tiny_json
 open Meta_conv.Open
-open Json_conv
-open Ocaml_conv
+open Meta_conv.Types.Result.Open (* I use >>= only for Result here *)
+open Json_conv  (* for conv(json) *)
+open Ocaml_conv (* for conv(ocaml) *)
 
-open Meta_conv.Types.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)
 
 module Json = struct
   include Json
-  let ocaml_of_t j = Ocaml.String (Json.show j)
-  let t_of_ocaml = function
+
+  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)
-    | _ -> assert false
+    | _ -> failwith "Ocaml.String expected"
+    with e -> `Error (Meta_conv.Types.Error.Deconstruction_error e, o)
+
+  let parse s = try `Ok (parse s) with e -> `Error (`Json_parse e)
 end
 
 module Scheme = struct
-  type t = Hg(:"hg":) | Git(:"git":) with conv(json), conv(ocaml)
+  type t = 
+    | Hg(:"hg":) 
+    | Git(:"git":) 
+  with conv(json), conv(ocaml)
 end
 
 module LocalTime = struct
+  (* CRv2 jfuruse: this should be lazily parsed date *)
   type t = string with conv(json), conv(ocaml)
 end
 
 module UTCTime = struct
+  (* CRv2 jfuruse: this should be lazily parsed date *)
   type t = string with conv(json), conv(ocaml)
 end
 
 module Error = struct
   open Format
 
-  let wrap_json_conv = function
+  let wrap_json_conv convf 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 ((_,v) as e) -> 
+        (* CR jfuruse: This is bit strange. Meta_conv.Types.Error.format should print [v] too? *)
         Format.eprintf "%a@.Error input: %s@." 
           (Meta_conv.Types.Error.format (fun _ _ -> ())) e
           (Json.show v)
-    | `Json_parse exn -> fprintf ppf "Error at Json parse: %s@." (Printexc.to_string exn)
-    | `Other exn -> fprintf ppf "Error: %s@." (Printexc.to_string exn)
 end
 
-let curl_get_and_parse convf curlf = 
-  Curl.get_string curlf |> Curl.ok200 >>= fun s ->
-  (try `Ok (Json.parse s) with e -> `Error (`Json_parse e)) >>= fun j ->
-  convf j |> Error.wrap_json_conv
+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