From 6a64fb1f70a06f760c5dffeeac00107bdf050339 Mon Sep 17 00:00:00 2001
From: "Guillaume \"Liam\" Petiot" <guillaume@tarides.com>
Date: Mon, 26 Feb 2024 13:22:24 +0000
Subject: [PATCH] Reorganize the code and expose get-activity-lib (#4)

---
 CHANGES.md                               | 12 ++++++
 bin/dune                                 |  5 +++
 main.ml => bin/main.ml                   | 47 +++---------------------
 main.mli => bin/main.mli                 |  0
 contributions.mli                        | 11 ------
 dune                                     |  4 --
 dune-project                             |  9 ++++-
 get-activity-lib.opam                    | 31 ++++++++++++++++
 get-activity.opam                        | 11 ++----
 contributions.ml => lib/contributions.ml | 31 +++++++++-------
 lib/contributions.mli                    | 26 +++++++++++++
 lib/dune                                 |  4 ++
 graphql.ml => lib/graphql.ml             |  2 +-
 lib/graphql.mli                          |  1 +
 lib/period.ml                            | 44 ++++++++++++++++++++++
 lib/period.mli                           | 12 ++++++
 token.ml => lib/token.ml                 |  0
 token.mli => lib/token.mli               |  0
 18 files changed, 172 insertions(+), 78 deletions(-)
 create mode 100644 bin/dune
 rename main.ml => bin/main.ml (67%)
 rename main.mli => bin/main.mli (100%)
 delete mode 100644 contributions.mli
 delete mode 100644 dune
 create mode 100644 get-activity-lib.opam
 rename contributions.ml => lib/contributions.ml (88%)
 create mode 100644 lib/contributions.mli
 create mode 100644 lib/dune
 rename graphql.ml => lib/graphql.ml (96%)
 create mode 100644 lib/graphql.mli
 create mode 100644 lib/period.ml
 create mode 100644 lib/period.mli
 rename token.ml => lib/token.ml (100%)
 rename token.mli => lib/token.mli (100%)

diff --git a/CHANGES.md b/CHANGES.md
index 727632f..1cf099c 100644
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,3 +1,15 @@
+## unreleased
+
+### Added
+
+Expose the library `get-activity-lib` as an opam package (#4, @gpetiot)
+- Expose `Get_ctivity.Period`
+- Expose `Get_ativity.Contributions.Datetime`
+- Expose `Get_activity.Contributions.Repo_map`
+- Expose `Get_activity.Contributions.item`
+- Add a `username` field to `Get_activity.Contributions.t`
+- Label the parameters of `Get_activity.Graphql.exec`
+
 ## 0.1
 
 (changes before Feb '24 not tracked)
diff --git a/bin/dune b/bin/dune
new file mode 100644
index 0000000..6f08743
--- /dev/null
+++ b/bin/dune
@@ -0,0 +1,5 @@
+(executable
+ (name main)
+ (public_name get-activity)
+ (package get-activity)
+ (libraries cmdliner get-activity-lib))
diff --git a/main.ml b/bin/main.ml
similarity index 67%
rename from main.ml
rename to bin/main.ml
index b8644ef..0c7743b 100644
--- a/main.ml
+++ b/bin/main.ml
@@ -1,3 +1,5 @@
+open Get_activity
+
 let ( / ) = Filename.concat
 
 let or_die = function
@@ -6,8 +8,6 @@ let or_die = function
     Fmt.epr "%s@." m;
     exit 1
 
-let one_week = 60. *. 60. *. 24. *. 7.
-
 let home =
   match Sys.getenv_opt "HOME" with
   | None -> Fmt.failwith "$HOME is not set!"
@@ -30,44 +30,9 @@ let mtime path =
   | info -> Some info.Unix.st_mtime
   | exception Unix.Unix_error(Unix.ENOENT, _, _) -> None
 
-let set_mtime path time =
-  if not (Sys.file_exists path) then
-    close_out @@ open_out_gen [Open_append; Open_creat] 0o600 path;
-  Unix.utimes path time time
-
 let get_token () =
   Token.load (home / ".github" / "github-activity-token")
 
-let to_8601 t =
-  let open Unix in
-  let t = gmtime t in
-  Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
-    (t.tm_year + 1900)
-    (t.tm_mon + 1)
-    (t.tm_mday)
-    (t.tm_hour)
-    (t.tm_min)
-    (t.tm_sec)
-
-(* Run [fn (start, finish)], where [(start, finish)] is the period specified by [period].
-   If [period] is [`Since_last_fetch] or [`Last_week] then update the last-fetch timestamp on success. *)
-let with_period period fn =
-  let now = Unix.time () in
-  let last_week = now -. one_week in
-  let range =
-    match period with
-    | `Since_last_fetch ->
-      let last_fetch = Option.value ~default:last_week (mtime last_fetch_file) in
-      (to_8601 last_fetch, to_8601 now)
-    | `Last_week ->
-      (to_8601 last_week, to_8601 now)
-    | `Range r -> r
-  in
-  fn range;
-  match period with
-  | `Since_last_fetch | `Last_week -> set_mtime last_fetch_file now
-  | `Range _ -> ()
-
 let show ~from json =
   let contribs = Contributions.of_json ~from json in
   if Contributions.is_empty contribs then
@@ -94,7 +59,7 @@ let last_week =
   Arg.(value & flag doc)
 
 let period =
-  let f from to_ last_week =
+  let f from to_ last_week : Period.t =
     if last_week then `Last_week
     else
       match (from, to_) with
@@ -109,20 +74,20 @@ let info = Cmd.info "get-activity"
 let run period : unit =
   match mode with
   | `Normal ->
-    with_period period (fun period ->
+    Period.with_period period ~last_fetch_file ~f:(fun period ->
         (* Fmt.pr "period: %a@." Fmt.(pair string string) period; *)
         let token = get_token () |> or_die in
         show ~from:(fst period) @@ Contributions.fetch ~period ~token
       )
   | `Save ->
-    with_period period (fun period ->
+    Period.with_period period ~last_fetch_file ~f:(fun period ->
         let token = get_token () |> or_die in
         Contributions.fetch ~period ~token
         |> Yojson.Safe.to_file "activity.json"
       )
   | `Load ->
     (* When testing formatting changes, it is quicker to fetch the data once and then load it again for each test: *)
-    let from = mtime last_fetch_file |> Option.value ~default:0.0 |> to_8601 in
+    let from = mtime last_fetch_file |> Option.value ~default:0.0 |> Period.to_8601 in
     show ~from @@ Yojson.Safe.from_file "activity.json"
 
 let term = Term.(const run $ period)
diff --git a/main.mli b/bin/main.mli
similarity index 100%
rename from main.mli
rename to bin/main.mli
diff --git a/contributions.mli b/contributions.mli
deleted file mode 100644
index aec24b5..0000000
--- a/contributions.mli
+++ /dev/null
@@ -1,11 +0,0 @@
-type t
-
-val fetch : period:(string * string) -> token:Token.t -> Yojson.Safe.t
-
-val of_json : from:string -> Yojson.Safe.t -> t
-(** We pass [from] again here so we can filter out anything that GitHub included by accident. *)
-
-val is_empty : t -> bool
-
-val pp : t Fmt.t
-(** [pp] formats as markdown. *)
diff --git a/dune b/dune
deleted file mode 100644
index b275bb5..0000000
--- a/dune
+++ /dev/null
@@ -1,4 +0,0 @@
-(executable
- (name main)
- (public_name get-activity)
- (libraries cohttp cohttp-lwt cohttp-lwt-unix yojson cmdliner))
diff --git a/dune-project b/dune-project
index 71f1bb5..f05dfb6 100644
--- a/dune-project
+++ b/dune-project
@@ -1,15 +1,22 @@
-(lang dune 2.3)
+(lang dune 2.8)
 (name get-activity)
 (formatting disabled)
 (generate_opam_files true)
 (source (github tarides/get-activity))
 (authors "talex5@gmail.com")
 (maintainers "Guillaume Petiot <guillaume@tarides.com>")
+
 (package
  (name get-activity)
  (synopsis "Collect activity as markdown")
  (depends
   (cmdliner (>= 1.1.1))
+  (get-activity (= :version))))
+
+(package
+ (name get-activity-lib)
+ (synopsis "Collect activity as markdown")
+ (depends
   cohttp
   cohttp-lwt
   cohttp-lwt-unix
diff --git a/get-activity-lib.opam b/get-activity-lib.opam
new file mode 100644
index 0000000..9f576d4
--- /dev/null
+++ b/get-activity-lib.opam
@@ -0,0 +1,31 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Collect activity as markdown"
+maintainer: ["Guillaume Petiot <guillaume@tarides.com>"]
+authors: ["talex5@gmail.com"]
+homepage: "https://github.com/tarides/get-activity"
+bug-reports: "https://github.com/tarides/get-activity/issues"
+depends: [
+  "dune" {>= "2.8"}
+  "cohttp"
+  "cohttp-lwt"
+  "cohttp-lwt-unix"
+  "yojson"
+  "ocaml" {>= "4.08"}
+  "odoc" {with-doc}
+]
+build: [
+  ["dune" "subst"] {dev}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/tarides/get-activity.git"
diff --git a/get-activity.opam b/get-activity.opam
index 4869022..fe2dadc 100644
--- a/get-activity.opam
+++ b/get-activity.opam
@@ -6,16 +6,13 @@ authors: ["talex5@gmail.com"]
 homepage: "https://github.com/tarides/get-activity"
 bug-reports: "https://github.com/tarides/get-activity/issues"
 depends: [
-  "dune" {>= "2.3"}
+  "dune" {>= "2.8"}
   "cmdliner" {>= "1.1.1"}
-  "cohttp"
-  "cohttp-lwt"
-  "cohttp-lwt-unix"
-  "yojson"
-  "ocaml" {>= "4.08"}
+  "get-activity" {= version}
+  "odoc" {with-doc}
 ]
 build: [
-  ["dune" "subst"] {pinned}
+  ["dune" "subst"] {dev}
   [
     "dune"
     "build"
diff --git a/contributions.ml b/lib/contributions.ml
similarity index 88%
rename from contributions.ml
rename to lib/contributions.ml
index 0ad1da1..5b7a9c6 100644
--- a/contributions.ml
+++ b/lib/contributions.ml
@@ -5,6 +5,7 @@ let ( / ) a b = Json.Util.member b a
 let query =
   {| query($from: DateTime!, $to: DateTime!) {
    viewer {
+    login
     contributionsCollection(from: $from, to: $to) {
       issueContributions(first: 100) {
         nodes {
@@ -60,7 +61,7 @@ let fetch ~period:(start, finish) ~token =
         "from", `String start;
         "to", `String finish;
     ] in
-    Graphql.exec token ~variables query
+    Graphql.exec ~token ~variables ~query ()
   end
 
 module Datetime = struct
@@ -82,6 +83,8 @@ type item = {
   body : string;
 }
 
+type t = { username : string; activity : item list Repo_map.t }
+
 let read_issues json =
   Json.Util.to_list (json / "nodes") |> List.filter ((<>) `Null) |> List.map @@ fun node ->
   let date = Datetime.parse (node / "occurredAt") in
@@ -123,6 +126,7 @@ let read_repos json =
   { kind = `New_repo; date; url; title = "Created new repository"; body = ""; repo }
 
 let of_json ~from json =
+  let username = json / "data" / "viewer" / "login" |> Json.Util.to_string in
   let contribs = json / "data" / "viewer" / "contributionsCollection" in
   let items =
     read_issues  (contribs / "issueContributions") @
@@ -130,13 +134,16 @@ let of_json ~from json =
     read_reviews (contribs / "pullRequestReviewContributions") @
     read_repos   (contribs / "repositoryContributions")
   in
-  (* GitHub seems to ignore the time part, so do the filtering here. *)
-  items
-  |> List.filter (fun item -> item.date >= from)
-  |> List.fold_left (fun acc item ->
-      let items = Repo_map.find_opt item.repo acc |> Option.value ~default:[] in
-      Repo_map.add item.repo (item :: items) acc
-    ) Repo_map.empty
+  let activity =
+    (* GitHub seems to ignore the time part, so do the filtering here. *)
+    items
+    |> List.filter (fun item -> item.date >= from)
+    |> List.fold_left (fun acc item ->
+        let items = Repo_map.find_opt item.repo acc |> Option.value ~default:[] in
+        Repo_map.add item.repo (item :: items) acc
+      ) Repo_map.empty
+  in
+  { username; activity }
 
 let id url =
   match Astring.String.cut ~sep:"/" ~rev:true url with
@@ -171,12 +178,10 @@ let pp_items = Fmt.(list ~sep:(cut ++ cut) pp_item)
 let pp_repo f (name, items) =
   Fmt.pf f "### %s@,@,%a" name pp_items items
 
-type t = item list Repo_map.t
-
-let is_empty = Repo_map.is_empty
+let is_empty { activity; _} = Repo_map.is_empty activity
 
-let pp f t =
-  let by_repo = Repo_map.bindings t in
+let pp f { activity; _ } =
+  let by_repo = Repo_map.bindings activity in
   match by_repo with
   | [] -> Fmt.string f "(no activity)"
   | [(_, items)] -> pp_items f items
diff --git a/lib/contributions.mli b/lib/contributions.mli
new file mode 100644
index 0000000..e58aa3e
--- /dev/null
+++ b/lib/contributions.mli
@@ -0,0 +1,26 @@
+module Datetime : sig
+  type t = string
+end
+
+type item = {
+  repo : string;
+  kind : [`Issue | `PR | `Review of string | `New_repo ];
+  date: Datetime.t;
+  url : string;
+  title : string;
+  body : string;
+}
+
+module Repo_map : Map.S with type key = string
+
+type t = { username : string; activity : item list Repo_map.t }
+
+val fetch : period:(string * string) -> token:Token.t -> Yojson.Safe.t
+
+val of_json : from:string -> Yojson.Safe.t -> t
+(** We pass [from] again here so we can filter out anything that GitHub included by accident. *)
+
+val is_empty : t -> bool
+
+val pp : t Fmt.t
+(** [pp] formats as markdown. *)
diff --git a/lib/dune b/lib/dune
new file mode 100644
index 0000000..cd7ce68
--- /dev/null
+++ b/lib/dune
@@ -0,0 +1,4 @@
+(library
+ (name get_activity)
+ (public_name get-activity-lib)
+ (libraries cohttp cohttp-lwt cohttp-lwt-unix yojson))
diff --git a/graphql.ml b/lib/graphql.ml
similarity index 96%
rename from graphql.ml
rename to lib/graphql.ml
index 0c8238d..36e4dec 100644
--- a/graphql.ml
+++ b/lib/graphql.ml
@@ -4,7 +4,7 @@ let graphql_endpoint = Uri.of_string "https://api.github.com/graphql"
 
 let ( / ) a b = Yojson.Safe.Util.member b a
 
-let exec ?variables token query =
+let exec ?variables ~token ~query () =
   let body =
     `Assoc (
       ("query", `String query) ::
diff --git a/lib/graphql.mli b/lib/graphql.mli
new file mode 100644
index 0000000..325aae8
--- /dev/null
+++ b/lib/graphql.mli
@@ -0,0 +1 @@
+val exec : ?variables:(string * Yojson.Safe.t) list -> token:string -> query:string -> unit -> Yojson.Safe.t Lwt.t
diff --git a/lib/period.ml b/lib/period.ml
new file mode 100644
index 0000000..3e4efb6
--- /dev/null
+++ b/lib/period.ml
@@ -0,0 +1,44 @@
+type t =
+  [ `Last_week
+  | `Range of string * string 
+  | `Since_last_fetch ]
+
+let one_week = 60. *. 60. *. 24. *. 7.
+
+let to_8601 t =
+  let open Unix in
+  let t = gmtime t in
+  Printf.sprintf "%04d-%02d-%02dT%02d:%02d:%02dZ"
+    (t.tm_year + 1900)
+    (t.tm_mon + 1)
+    (t.tm_mday)
+    (t.tm_hour)
+    (t.tm_min)
+    (t.tm_sec)
+
+let mtime path =
+  match Unix.stat path with
+  | info -> Some info.Unix.st_mtime
+  | exception Unix.Unix_error(Unix.ENOENT, _, _) -> None
+
+let set_mtime path time =
+  if not (Sys.file_exists path) then
+    close_out @@ open_out_gen [Open_append; Open_creat] 0o600 path;
+  Unix.utimes path time time
+
+let with_period period ~last_fetch_file ~f =
+  let now = Unix.time () in
+  let last_week = now -. one_week in
+  let range =
+    match period with
+    | `Since_last_fetch ->
+      let last_fetch = Option.value ~default:last_week (mtime last_fetch_file) in
+      (to_8601 last_fetch, to_8601 now)
+    | `Last_week ->
+      (to_8601 last_week, to_8601 now)
+    | `Range r -> r
+  in
+  f range;
+  match period with
+  | `Since_last_fetch | `Last_week -> set_mtime last_fetch_file now
+  | `Range _ -> ()
diff --git a/lib/period.mli b/lib/period.mli
new file mode 100644
index 0000000..1c2d083
--- /dev/null
+++ b/lib/period.mli
@@ -0,0 +1,12 @@
+type t =
+  [ `Last_week
+  | `Range of string * string 
+  | `Since_last_fetch ]
+
+val one_week : float
+
+val to_8601 : float -> string
+
+val with_period : t -> last_fetch_file:string -> f:(string * string -> unit) -> unit
+(** Run [f (start, finish)], where [(start, finish)] is the period specified by [period].
+   If [period] is [`Since_last_fetch] or [`Last_week] then update the last-fetch timestamp on success. *)
diff --git a/token.ml b/lib/token.ml
similarity index 100%
rename from token.ml
rename to lib/token.ml
diff --git a/token.mli b/lib/token.mli
similarity index 100%
rename from token.mli
rename to lib/token.mli