add simple CLI generator for github metadata in this repo

Author: avsm

.gitignore

@@ -0,0 +1,4 @@
+.*.swp
+*.exe
+*.native
+_build/

_tags

@@ -0,0 +1,2 @@
+true: annot, bin_annot, debug
+true: package(github.unix), package(cmdliner), package(fmt.tty)

jar_cli.mli

@@ -0,0 +1,19 @@
+(*
+ * Copyright (c) 2014 David Sheets <sheets@alum.mit.edu>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *
+ *)
+
+val repos : ?doc_append:string -> unit -> string list Cmdliner.Term.t
+val cookie : ?doc_append:string -> unit -> Github.Token.t Cmdliner.Term.t

list_issues.ml

@@ -1,18 +1,16 @@
-#!/usr/bin/env ocamlscript
-Ocaml.packs := ["github.unix"; "cmdliner"] ;;
-Ocaml.sources := ["jar_cli.ml"] ;;
---
-
 open Lwt
 open Cmdliner
 open Printf
 
 module T = Github_t
 
-let ask_github fn = Github.(Monad.run (fn ()))
+let ocl_classes_of_labels labels =
+  let names = List.map (fun { T.label_name } -> label_name) labels in
+  List.map Ocamllabs.of_string names
 
 let string_of_labels labels =
   let names = List.map (fun { T.label_name } -> label_name) labels in
+  let _ocl_classes (* TODO *) = List.map Ocamllabs.of_string names in
   String.concat ", " names
 
 let print_issue user repo issue =
@@ -25,34 +23,85 @@ let print_issue user repo issue =
     issue_created_at;
     issue_closed_at;
   } = issue in
-  printf "%s/%s#%d %s\n" user repo issue_number issue_title;
-  printf "  Labels: %s\n" (string_of_labels issue_labels);
-  printf "  Comments: %d\n" issue_comments;
+  (* box drawing from https://en.wikipedia.org/wiki/Box-drawing_character *)
+  printf "┏ #%d %s\n%!" issue_number issue_title;
+  printf "┣    Labels: %s\n%!" (string_of_labels issue_labels);
+  printf "┣   Comments: %d\n%!" issue_comments;
   (match issue_state with
-   | `Open   -> printf "  Created at %s\n" issue_created_at
+   | `Open   -> printf "┗    Created at %s\n" issue_created_at
    | `Closed -> match issue_closed_at with
-     | Some timestamp -> printf "  Closed at %s\n" timestamp
-     | None -> printf "  Closed timestamp missing!"
+     | Some timestamp -> printf "┗    Closed at %s\n" timestamp
+     | None -> printf "┗    Closed timestamp missing!"
   )
 
-let list_issues token repos ~all ~closed ~prs ~issues =
-  let repos = List.map (fun r ->
+let get_user_repos =
+  List.map (fun r ->
     match Stringext.split ~max:2 ~on:'/' r with
     | [user;repo] -> (user,repo)
     | _ -> eprintf "Repositories must be in username/repo format"; exit 1
-  ) repos in
-  (* Get the issues per repo *)
+  ) 
+
+let print_milestone m = 
+  let open Github_t in
+  Fmt.(pf stdout "╳ %a (%a/%d issues)\n%!"
+    (styled `Bold string) m.milestone_title
+    (styled `Green int) m.milestone_closed_issues
+    m.milestone_open_issues)
+
+let list_issues token repos ~all ~closed ~milestone =
+ (* Get the issues per repo *)
   Lwt_list.iter_s (fun (user,repo) ->
     let state = if all then `All else if closed then `Closed else `Open in
     Github.(Monad.(run (
-      let issues_s = Issue.for_repo ~token ~state ~user ~repo () in
+      let issues_s = Issue.for_repo ~token ~state ~user ~repo ~milestone () in
       Stream.to_list issues_s (* TODO: bound?!?! *)
-      >>= fun list -> return (List.iter (fun i -> match i with
-        | { T.issue_pull_request=None } when issues -> print_issue user repo i
-        | { T.issue_pull_request=Some _ } when prs -> print_issue user repo i
-        | _ -> ()
+      >>= fun list -> return (List.iter (fun i -> print_issue user repo i
       ) list))))
-  ) repos
+  ) (get_user_repos repos)
+
+let github_map_s fn l =
+  let open Github.Monad in
+  let rec iter acc =
+     function
+     | hd::tl ->
+         fn hd >>= fun r ->
+         iter (r :: acc) tl
+     | [] ->  return acc
+  in
+  iter [] l
+
+let github_iter_s fn l =
+  let open Github.Monad in
+  let rec iter = function
+    | hd::tl -> fn hd >>= fun () -> iter tl
+    | [] ->  return ()
+  in
+  iter l
+
+let list_one_milestone token user repo ~all ~closed =
+  let open Github in
+  let open Github.Monad in
+  let milestone_s = Milestone.for_repo ~token ~user ~repo () in
+  Stream.to_list milestone_s
+  >>= fun list -> 
+  github_iter_s (fun m ->
+    print_milestone m;
+    let state = if all then `All else if closed then `Closed else `Open in
+    let milestone = `Num m.Github_t.milestone_number in
+    let issues_s = Issue.for_repo ~token ~state ~milestone ~user ~repo () in
+    Stream.to_list issues_s
+    >>= fun list ->
+    github_iter_s (fun i ->
+      Github.Monad.return (print_issue user repo i)
+    ) list
+  ) list
+
+let list_milestones token repos ~all ~closed =
+  Lwt_list.iter_s (fun (user,repo) ->
+    Github.(Monad.(run (
+      list_one_milestone token user repo ~all ~closed
+    )))
+  ) (get_user_repos repos)
 
 let cmd =
   let cookie = Jar_cli.cookie () in
@@ -65,25 +114,18 @@ let cmd =
   let docv = "ALL" in
   let all = Arg.(value & flag & info ["all"] ~docv ~doc) in
 
-  let doc = "show PRs" in
-  let docv = "PRS" in
-  let no_prs = Arg.(value & flag & info ["prs"] ~docv ~doc) in
-  let doc = "show regular (non-PR) issues" in
-  let docv = "ISSUES" in
-  let no_issues = Arg.(value & flag & info ["issues"] ~docv ~doc) in
-
   let doc = "list issues on GitHub repositories (open only by default)" in
   let man = [
     `S "BUGS";
     `P "Email bug reports to <mirageos-devel@lists.xenproject.org>.";
   ] in
-  Term.((pure (fun t r all closed prs_flag issues_flag ->
-    let prs = prs_flag || (not issues_flag) in
-    let issues = issues_flag || (not prs_flag) in
-    Lwt_main.run (list_issues t r ~all ~closed ~prs ~issues)
-  ) $ cookie $ repos $ all $ closed $ no_prs $ no_issues)),
+  Term.((pure (fun t r all closed ->
+    Lwt_main.run (list_milestones t r ~all ~closed)
+  ) $ cookie $ repos $ all $ closed)),
   Term.info "git-list-issues" ~version:"1.0.0" ~doc ~man
 
+let () = Fmt_tty.setup_std_outputs ()
+
 let () = match Term.eval cmd with `Error _ -> exit 1 | _ -> exit 0
 
 (*

ocamllabs.ml

@@ -0,0 +1,21 @@
+(* Conventions for labelling in ocamllabs/Projects repos *)
+
+type t =
+ | Event of string
+ | Project of string
+ | Task of string
+ | Other of string
+
+let of_string s =
+  match Stringext.split ~max:2 ~on:':' (String.lowercase_ascii s) with
+  |["event";x] -> Event (Stringext.trim_left x)
+  |["project";x] -> Project (Stringext.trim_left x)
+  |["task";x] -> Task (Stringext.trim_left x)
+  |_ -> Other s
+
+let to_string = function
+  | Event s -> "Event: " ^ s
+  | Project s -> "Project: " ^ s
+  | Task s -> "Task: " ^ s
+  | Other s -> s
+

run.sh

@@ -0,0 +1,3 @@
+#!/bin/sh
+ocamlbuild -use-ocamlfind list_issues.native 
+./list_issues.native -c private ocamllabs/Projects