Reorganize the code and expose get-activity-lib (#4)

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)

bin/dune

@@ -0,0 +1,5 @@
+(executable
+ (name main)
+ (public_name get-activity)
+ (package get-activity)
+ (libraries cmdliner get-activity-lib))

main.ml → 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)

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 "[email protected]")
 (maintainers "Guillaume Petiot <[email protected]>")
+
 (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

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 <[email protected]>"]
+authors: ["[email protected]"]
+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"

get-activity.opam

@@ -6,16 +6,13 @@ authors: ["[email protected]"]
 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"

contributions.ml → 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,20 +126,24 @@ 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") @
     read_prs     (contribs / "pullRequestContributions") @
     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

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. *)

lib/dune

@@ -0,0 +1,4 @@
+(library
+ (name get_activity)
+ (public_name get-activity-lib)
+ (libraries cohttp cohttp-lwt cohttp-lwt-unix yojson))

graphql.ml → 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) ::

lib/graphql.mli

@@ -0,0 +1 @@
+val exec : ?variables:(string * Yojson.Safe.t) list -> token:string -> query:string -> unit -> Yojson.Safe.t Lwt.t

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 _ -> ()

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. *)