Implement hub in Ocaml

CHANGES.md

@@ -4,6 +4,8 @@
 - Support for 4.12 and fixing recent compiler warnings (@tmcgilchrist #246 and @emillon #250 #247)
 - Add a new package `github-data` which contains just the serialisation logic
   without a dependency on the web stack (#248 @emillon)
+- Add OCaml 4.08 as lower bound (#253 @tmcgilchrist)
+- Implement hub cli in OCaml (#253 @tmcgilchrist)
 
 ## 4.3.2 (2020-09-21)
 

dune-project

@@ -15,7 +15,7 @@
  (name github)
  (tags (org:mirage org:xapi-project git))
  (depends
-  (ocaml (>= 4.03.0))
+  (ocaml (>= 4.08.0))
   (dune (>= 1.10))
   (uri (>= 1.9.0))
   (cohttp (and (>= 0.99.0) (< 3.0.0)))
@@ -35,7 +35,7 @@ JavaScript via [js_of_ocaml](http://ocsigen.org/js_of_ocaml)."))
  (name github-jsoo)
  (tags (org:mirage org:xapi-project git))
  (depends
-  (ocaml (>= 4.03.0))
+  (ocaml (>= 4.08.0))
   (dune (>= 1.10))
   (github (= :version))
   (cohttp (and (>= 0.99.0) (< 3.0.0)))
@@ -49,12 +49,13 @@ JavaScript via [js_of_ocaml](http://ocsigen.org/js_of_ocaml)."))
  (name github-unix)
  (tags (org:mirage org:xapi-project git))
  (depends
-  (ocaml (>= 4.03.0))
+  (ocaml (>= 4.08.0))
   (dune (>= 1.10))
   (github (= :version))
   (cohttp (and (>= 0.99.0) (< 3.0.0)))
   (cohttp-lwt-unix (and (>= 0.99.0) (< 3.0.0)))
   stringext
+  (yaml (>= 2.0.0))
   (cmdliner (>= 0.9.8))
   base-unix
   lwt)
@@ -66,7 +67,7 @@ JavaScript via [js_of_ocaml](http://ocsigen.org/js_of_ocaml)."))
  (name github-data)
  (tags (org:mirage org:xapi-project git))
  (depends
-   (ocaml (>= 4.03.0))
+   (ocaml (>= 4.08.0))
    (dune (>= 1.10))
    (yojson (>= 1.6.0))
    (atdgen (>= 2.0.0)))

github-data.opam

@@ -28,7 +28,7 @@ description: """
 This library provides an OCaml interface to the [GitHub APIv3](https://docs.github.com/rest/)
 (JSON).  This package installs the data conversion library."""
 depends: [
-  "ocaml" {>= "4.03.0"}
+  "ocaml" {>= "4.08.0"}
   "dune" {>= "1.10"}
   "yojson" {>= "1.6.0"}
   "atdgen" {>= "2.0.0"}

github-jsoo.opam

@@ -28,7 +28,7 @@ description: """
 This library provides an OCaml interface to the [GitHub APIv3](https://docs.github.com/rest/)
 (JSON). This library installs the JavaScript version, which uses [js_of_ocaml](http://ocsigen.org/js_of_ocaml)."""
 depends: [
-  "ocaml" {>= "4.03.0"}
+  "ocaml" {>= "4.08.0"}
   "dune" {>= "1.10"}
   "github" {= version}
   "cohttp" {>= "0.99.0" & < "3.0.0"}

github-unix.opam

@@ -28,12 +28,13 @@ description: """
 This library provides an OCaml interface to the [GitHub APIv3](https://docs.github.com/rest/)
 (JSON).  This package installs the Unix (Lwt) version."""
 depends: [
-  "ocaml" {>= "4.03.0"}
+  "ocaml" {>= "4.08.0"}
   "dune" {>= "1.10"}
   "github" {= version}
   "cohttp" {>= "0.99.0" & < "3.0.0"}
   "cohttp-lwt-unix" {>= "0.99.0" & < "3.0.0"}
   "stringext"
+  "yaml" {>= "2.0.0"}
   "cmdliner" {>= "0.9.8"}
   "base-unix"
   "lwt"

github.opam

@@ -31,7 +31,7 @@ This library provides an OCaml interface to the
 It is compatible with [MirageOS](https://mirage.io) and also compiles to pure
 JavaScript via [js_of_ocaml](http://ocsigen.org/js_of_ocaml)."""
 depends: [
-  "ocaml" {>= "4.03.0"}
+  "ocaml" {>= "4.08.0"}
   "dune" {>= "1.10"}
   "uri" {>= "1.9.0"}
   "cohttp" {>= "0.99.0" & < "3.0.0"}

hub/dune

@@ -0,0 +1,6 @@
+(executables
+ (libraries cohttp-lwt-unix github-unix cmdliner yaml yaml.unix)
+  (package github-unix)
+  (public_names hub)
+  (names hub))
+

hub/hub.ml

@@ -0,0 +1,150 @@
+(** See https://hub.github.com/hub.1.html *)
+open Cmdliner
+open Printf
+
+type configuration = {
+    token: Github.Token.t;
+    user: string
+  }
+
+exception Config of string
+
+(** Read hub configuration from ~/.config/hub. *)
+let config_from_file () =
+  let home = Unix.getenv "HOME" in
+  let fpath = home ^ "/.config/hub" in
+  let result = Yaml_unix.of_file Fpath.(v fpath) in
+  let config_err = Config "Expected ~/.config/hub to be readable and exist as created by man hub(1)."  in
+  match result with
+  | Ok (`O [("github.com", `A [`O [("user", `String user_str);
+                                   ("oauth_token", `String token_str);
+                                   ("protocol", _)]])]) ->
+     { token = (Github.Token.of_string token_str)
+     ; user = user_str }
+  | Error _ | Ok _ -> raise config_err
+
+let release token user repo () =
+  let print_releases pl =
+    let open Github in
+    let open Monad in
+    Stream.iter (fun m ->
+        printf "%s\n" (Github_j.string_of_release m);
+        return ()
+      ) pl
+  in
+  Lwt_main.run begin
+      let open Github in
+      let open Monad in
+      run (
+          return (Release.for_repo ~token ~user ~repo ())
+          >>= print_releases
+        )
+  end
+
+let release_show token user repo tag show_downloads () =
+  let open Github in
+  let open Monad in
+  Lwt_main.run begin
+      run (
+          Release.get_by_tag_name ~token ~user ~repo ~tag ()
+          >>~ fun release -> 
+              printf "\n\n%s\n" (Option.value ~default:"" release.Github_j.release_body);
+              if show_downloads then List.iter (fun r -> printf "### Downloads\n\n%s\n" r.Github_j.release_asset_browser_download_url) release.Github_j.release_assets;
+              printf "%s\n%s\n"release.Github_j.release_tarball_url release.Github_j.release_zipball_url;
+              return ()
+        )
+    end
+
+let pr_list token user repo state () =
+  let open Github in
+  let open Monad in
+
+  let print_pulls pl =
+    Stream.iter (fun m -> printf "    #%d  %s\n" m.Github_t.pull_number m.Github_t.pull_title;
+                          return ()) pl
+  in
+  Lwt_main.run begin
+      run (
+          return (Pull.for_repo ~token ~user ~repo ?state:(Some state) ())
+          >>= print_pulls
+        )
+    end  
+
+(** CommandLine options parsing module. 
+    Reusable pieces between different commands.
+*)
+module CommandLine = struct
+  let repo =
+    let doc = "Github Repository" in
+    Arg.(required
+         & opt (some string) None
+         & info ["r"; "repository"] ~docv:"REPOSITORY" ~doc)
+
+  let owner =
+    let doc = "Github Owner" in
+    Arg.(required
+         & opt (some string) None
+         & info ["o"; "owner"] ~docv:"OWNER" ~doc)
+
+  let release_name =
+    let doc = "Release Tag" in
+    Arg.(required
+         & opt (some string) None
+         & info ["t"; "tag"] ~docv:"TAG" ~doc)
+
+  let show_downlods =
+    Arg.(value
+         & flag
+         & info ["show-downloads"] ~doc:"With --show-downloads, include the \"Downloads\" section.")
+
+  let state =
+    let doc = "Pull request state. Either open, closed, or all to filter by state." in
+    let states = 
+      [("open", `Open); ("closed", `Closed); ("all", `All)] in
+
+    Arg.(value @@ opt (enum states) `Open @@ 
+         info ["s"] ~docv:"STATE" ~doc)
+end
+
+(* Executable commands from the cli. *)
+let release_cmd =
+  let config = config_from_file () in
+  Term.(pure release $ pure config.token $ CommandLine.owner $ CommandLine.repo $ pure ()),
+  Term.info "release" ~doc:"Manage GitHub Releases for the current repository."
+
+let release_show_cmd =
+  let config = config_from_file () in
+  Term.(pure release_show $ pure config.token $ CommandLine.owner $ CommandLine.repo $ CommandLine.release_name $ CommandLine.show_downlods $ pure ()),
+  Term.info "release-show" ~doc:"Show GitHub release notes for TAG."
+
+let pr_list_cmd =
+  let config = config_from_file () in
+  Term.(pure pr_list $ (pure config.token) $ CommandLine.owner $ CommandLine.repo $ CommandLine.state $ pure ()),
+  Term.info "pr-list" ~doc:"List pull requests in the current repository."
+
+let default_cmd =
+  let doc = "make git easier with GitHub" in
+  Term.(ret (pure (`Help (`Pager, None)))),
+  let man = [
+      `S "DESCRIPTION";
+      `P "Hub is a tool that wraps git in order to extend it with extra functionality that makes it better when working with GitHub.";
+      `S "BUGS";
+      `P "<https://github.com/mirage/ocaml-github/issues>";
+      `S "AUTHORS";
+      `P "<https://github.com/mirage/ocaml-github>"
+    ] in
+  Term.info "hub" ~version:"0.1" ~doc ~man
+
+(* All supported commands. *)
+let cmds = [ release_cmd
+           ; release_show_cmd
+           ; pr_list_cmd ]
+
+let () =
+  try
+    match Term.eval_choice ~catch:false default_cmd cmds with
+    | `Error _ -> exit 1 | _ -> exit 0
+  with
+  | Github.Message (_,m) ->
+     Printf.eprintf "GitHub API error: %s\n" (Github.API.string_of_message m);
+     exit 1

lib/github_core.ml

@@ -234,6 +234,7 @@ module Make(Env : Github_s.Env)(Time : Github_s.Time)(CL : Cohttp_lwt.S.Client)
       Uri.of_string (Printf.sprintf "%s/repos/%s/%s/git/tags/%s" api user repo sha)
     let repo_tag_name ~user ~repo ~tag =
       Uri.of_string (Printf.sprintf "%s/repos/%s/%s/releases/tags/%s" api user repo tag)
+
     let repo_branches ~user ~repo =
       Uri.of_string (Printf.sprintf "%s/repos/%s/%s/branches" api user repo)
 

lib_data/github.atd

@@ -469,7 +469,7 @@ type repository_issue_search = {
 } <ocaml field_prefix="repository_issue_search_">
 
 type branch = {
-  label: string;
+  label: string nullable;
   ref: string;
   sha: string;
   ?user: user option;
@@ -1136,6 +1136,9 @@ type release = {
   html_url: string;
   assets_url: string;
   upload_url: string;
+  assets: release_assets;
+  tarball_url: string;
+  zipball_url: string;
 } <ocaml field_prefix="release_">
 
 type releases = release list

lib_test/dune

@@ -10,7 +10,6 @@
     repo_info
     repo_stats
     contributors
-    releases
     user_type))
 
 (rule (copy config.ml.in config.ml))
@@ -26,6 +25,5 @@
     get_token.exe
     repo_info.exe
     repo_stats.exe
-    releases.exe
     contributors.exe
     user_type.exe))