camlspotter avatar camlspotter committed e7a867f

data type cleanup and result monads

Comments (0)

Files changed (4)

 open Common
 open Tiny_json
 open Json_conv
-open Meta_conv.Open
 open Sexplib.Conv
 
+open Meta_conv.Types.Result.Open
+
 type 'target mc_fields = (string * 'target) list with sexp
 type 'target mc_leftovers = 'target mc_fields with sexp
 
   type t = string with conv(json), sexp
 end
 
-(** repositories Endpoint *)
-module Repositories = struct
+module Error = struct
+  open Format
 
+  let wrap_json_conv = function
+    | `Ok v -> `Ok v
+    | `Error e -> `Error (`Json_conv e)
+
+  let format ppf = function
+    | `Http (n, _err) -> fprintf ppf "HTTP Error %d@." n
+    | `Json_conv e -> Meta_conv.Types.Error.format (fun _ _ -> ()) ppf e
+    | `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
+
+module Data = struct
+
+  (* CR jfuruse: It seems we should use classes since there are so many name overloads *)
+    
+  (** Full repository information *)
   module Repository = struct
     type t = {
       name              : string;
     } with conv(json), sexp
   end
 
+  (** Commited file *)  
+  module File = struct
+    type t = {
+      type_ as "type" : string;
+      file : string;
+    } with conv(json), sexp
+  end
+
+  (** Branch info *)    
+  module Branch = struct
+
+    type t = {
+      node         : string;
+      raw_node     : string;
+      author       : string;
+      raw_author   : string;
+      utctimestamp : UTCTime.t;
+      timestamp    : LocalTime.t;
+      message      : string;
+      files        : File.t list;
+      size         : int64;
+      revision     : int64;
+      parents      : string list;
+      branch       : string;
+      unknown      : Json.t mc_leftovers;
+    } with conv(json), sexp
+
+  end
+
+  (** User identity info *)
+  module UserID = struct
+    type t = {
+      username     : string;
+      display_name : string;
+      first_name   : string;
+      last_name    : string;
+      is_team      : bool;
+      avatar       : string;
+      resource_uri : string;
+      user_rest    : Json.t mc_leftovers;
+    } with conv(json), sexp
+  end
+
+  module User = struct
+    type t = {
+      user : UserID.t;
+      repositories : Repository.t list;
+      rest (: Leftovers :) : Json.t mc_fields;
+    } with conv(json), sexp
+  end
+
+  module UserRepo = struct
+
+    (** Small version of Repository.t *)  
+    type t = { 
+      owner      : string;
+      scm        : Scheme.t;
+      slug       : string;
+      is_private : bool;
+      name       : string
+    }
+
+    and ts = t list with conv(json)
+  end
+
+end
+
+(** repositories Endpoint *)
+module Repositories = struct
 
   (* https://api.bitbucket.org/1.0/repositories/{accountname}/{repo_slug}/branches *)
   module Branches = struct
 
-    type file = {
-      type_ as "type" : string;
-      file : string;
-    } with conv(json), sexp
-
-    type branch = {
-      node : string;
-      raw_node : string;
-      author : string;
-      raw_author : string;
-      utctimestamp : UTCTime.t;
-      timestamp : LocalTime.t;
-      message : string;
-      files : file list;
-      size : int64;
-      revision : int64;
-      parents : string list;
-      branch : string;
-      unknown : Json.t mc_leftovers;
-    } with conv(json), sexp
-
-    type t = branch mc_fields with conv(json), sexp
+    type t = Data.Branch.t mc_fields with conv(json), sexp
 
     let get ~accountname ~repo_slug = 
       Format.eprintf "%s : %s...@." accountname repo_slug;
-      let code, s  = Curl.get_string (fun h ->
-        (* ~user ~password  *)
-        (* h#set_userpwd (Printf.sprintf "%s:%s" user password)) *)
-        h#set_url (sprintf "https://api.bitbucket.org/1.0/repositories/%s/%s/branches" accountname repo_slug);
-        (* h#set_userpwd (Printf.sprintf "%s:%s" user password) *))
-      in
-      try t_of_json_exn (Json.parse s) with e -> 
-        prerr_endline (Printexc.to_string e);
-        Format.eprintf "%d: %S@." code s;
-        raise e
-      
+      curl_get_and_parse 
+        t_of_json
+        (fun h ->
+          (* ~user ~password  *)
+          (* h#set_userpwd (Printf.sprintf "%s:%s" user password)) *)
+          h#set_url (sprintf "https://api.bitbucket.org/1.0/repositories/%s/%s/branches" accountname repo_slug)
+          (* h#set_userpwd (Printf.sprintf "%s:%s" user password) *) )
   end
 end
 
 (** user Endpoint *)
 module User = struct
 
-  type user = {
-    username     : string;
-    first_name   : string;
-    last_name    : string;
-    is_team      : bool;
-    avatar       : string;
-    resource_uri : string
-  } with conv(json), sexp
-
-  type t = {
-    user : user;
-    repositories : Repositories.Repository.t list;
-    rest (: Leftovers :) : Json.t mc_fields;
-  } with conv(json), sexp
-
   let get ~user ~password = 
-    let _code, s = Curl.get_string (fun h ->
-      h#set_url "https://api.bitbucket.org/1.0/user";
-      h#set_userpwd (Printf.sprintf "%s:%s" user password))
-    in
-    try t_of_json_exn (Json.parse s) with e -> 
-      prerr_endline (Printexc.to_string e);
-      prerr_endline s;
-      raise e
+    curl_get_and_parse
+      Data.User.t_of_json
+      (fun h ->
+        h#set_url "https://api.bitbucket.org/1.0/user";
+        h#set_userpwd (Printf.sprintf "%s:%s" user password))
 
   module Repositories = struct
 
-    type repo = { 
-      owner      : string;
-      scm        : Scheme.t;
-      slug       : string;
-      is_private : bool;
-      name       : string
-    } 
-
-    and resp = repo list with conv(json)
-
     let get ~user ~password = 
-      let _code, s = Curl.get_string (fun h ->
-        h#set_url "https://api.bitbucket.org/1.0/user/repositories/";
-        h#set_userpwd (Printf.sprintf "%s:%s" user password))
-      in
-      resp_of_json (Json.parse s)
+      curl_get_and_parse
+        Data.UserRepo.ts_of_json
+        (fun h ->
+          h#set_url "https://api.bitbucket.org/1.0/user/repositories/";
+          h#set_userpwd (Printf.sprintf "%s:%s" user password))
   end
 
 end
   include Curl
   include Xcurl
 end
+
+external (|>) : 'a -> ('a -> 'b) -> 'b = "%revapply"
+
+module Result = struct
+  type ('a, 'b) t = [ `Ok of 'a | `Error of 'b ]
+  let return a = `Ok a
+  let fail b = `Error b
+  let bind t f = match t with
+    | `Error b -> `Error b
+    | `Ok a -> f a
+  let (>>=) = bind
+  module Open = struct
+    let (>>=) = bind
+  end
+end
   h#perform;
   h#get_httpcode, Buffer.contents buf
 
+let ok200 = function
+  | 200, v -> `Ok v
+  | n, mes -> `Error (`Http (n, mes))
 val get_string : (Curl.handle -> unit) -> int * string
   (** [get_string init] initializes curl handle by [init] then add a write function for the simple string retrieval and perform it.
       It returns the obtained string. *)
+
+val ok200 : (int * string) -> [`Ok of string | `Error of [> `Http of (int * string) ]]
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.