Add a '--user' option to extract the activity of an engineer that is not the current user

CHANGES.md

@@ -3,6 +3,7 @@
 ### Added
 
 - Add the `--version` command-line option (#13, @gpetiot)
+- Add a `--user` option to extract the activity of an engineer that is not the current user (#14, @gpetiot)
 
 ### Changed
 
@@ -11,6 +12,7 @@
 - Redesign the graphql requests (#12, @gpetiot)
   + `Graphql.exec` now takes a `request`
   + `Contributions.fetch` has been replaced by `Contributions.request` that builds a `request`
+- Add a `~user:User.t` parameter to `Contributions.request` and `Contributions.of_json` (#14, @gpetiot)
 
 ## 0.2.0
 

bin/main.ml

@@ -33,8 +33,8 @@ let mtime path =
 
 let get_token () = Token.load (home / ".github" / "github-activity-token")
 
-let show ~from json =
-  let contribs = Contributions.of_json ~from json in
+let show ~from ~user json =
+  let contribs = Contributions.of_json ~from ~user json in
   if Contributions.is_empty contribs then
     Fmt.epr "(no activity found since %s)@." from
   else Fmt.pr "@[<v>%a@]@." Contributions.pp contribs
@@ -68,35 +68,48 @@ let period =
   in
   Term.(const f $ from $ to_ $ last_week)
 
+let user : User.t Term.t =
+  let str_parser, str_printer = Arg.string in
+  let parser x =
+    match str_parser x with `Ok x -> `Ok (User.User x) | `Error e -> `Error e
+  in
+  let printer fs = function
+    | User.Viewer -> str_printer fs "viewer"
+    | User x -> str_printer fs x
+  in
+  let user_conv = (parser, printer) in
+  let doc = Arg.info ~doc:"User name" [ "user" ] in
+  Arg.(value & opt user_conv Viewer & doc)
+
 let version =
   match Build_info.V1.version () with
   | None -> "dev"
   | Some v -> Build_info.V1.Version.to_string v
 
 let info = Cmd.info "get-activity" ~version
 
-let run period : unit =
+let run period user : unit =
   match mode with
   | `Normal ->
       Period.with_period period ~last_fetch_file ~f:(fun period ->
           (* Fmt.pr "period: %a@." Fmt.(pair string string) period; *)
           let* token = get_token () in
-          let request = Contributions.request ~period ~token in
+          let request = Contributions.request ~period ~user ~token in
           let* contributions = Graphql.exec request in
-          show ~from:(fst period) contributions)
+          show ~from:(fst period) ~user contributions)
   | `Save ->
       Period.with_period period ~last_fetch_file ~f:(fun period ->
           let* token = get_token () in
-          let request = Contributions.request ~period ~token in
+          let request = Contributions.request ~period ~user ~token in
           let* contributions = Graphql.exec request in
           Yojson.Safe.to_file "activity.json" contributions)
   | `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 |> Period.to_8601
       in
-      show ~from @@ Yojson.Safe.from_file "activity.json"
+      show ~from ~user @@ Yojson.Safe.from_file "activity.json"
 
-let term = Term.(const run $ period)
+let term = Term.(const run $ period $ user)
 let cmd = Cmd.v info term
 let () = Stdlib.exit @@ Cmd.eval cmd

lib/contributions.ml

@@ -2,9 +2,10 @@ module Json = Yojson.Safe
 
 let ( / ) a b = Json.Util.member b a
 
-let query =
-  {|query($from: DateTime!, $to: DateTime!) {
-   viewer {
+let query user =
+  Format.asprintf
+    {|query($from: DateTime!, $to: DateTime!) {
+   %a {
     login
     contributionsCollection(from: $from, to: $to) {
       issueContributions(first: 100) {
@@ -54,9 +55,11 @@ let query =
     }
   }
 }|}
+    User.query user
 
-let request ~period:(start, finish) ~token =
+let request ~period:(start, finish) ~user ~token =
   let variables = [ ("from", `String start); ("to", `String finish) ] in
+  let query = query user in
   Graphql.request ~token ~variables ~query ()
 
 module Datetime = struct
@@ -137,9 +140,13 @@ let read_repos json =
        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 of_json ~from ~user json =
+  let username =
+    json / "data" / User.response_field user / "login" |> Json.Util.to_string
+  in
+  let contribs =
+    json / "data" / User.response_field user / "contributionsCollection"
+  in
   let items =
     read_issues (contribs / "issueContributions")
     @ read_prs (contribs / "pullRequestContributions")

lib/contributions.mli

@@ -15,9 +15,10 @@ module Repo_map : Map.S with type key = string
 
 type t = { username : string; activity : item list Repo_map.t }
 
-val request : period:string * string -> token:Token.t -> Graphql.request
+val request :
+  period:string * string -> user:User.t -> token:Token.t -> Graphql.request
 
-val of_json : from:string -> Yojson.Safe.t -> t
+val of_json : from:string -> user:User.t -> 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

lib/user.ml

@@ -0,0 +1,7 @@
+type t = Viewer | User of string
+
+let query fs = function
+  | User u -> Format.fprintf fs "user(login: %S)" u
+  | Viewer -> Format.fprintf fs "viewer"
+
+let response_field = function User _ -> "user" | Viewer -> "viewer"

lib/user.mli

@@ -0,0 +1,7 @@
+type t = Viewer | User of string
+
+val query : Format.formatter -> t -> unit
+(** Prints graphql query fragment that requests the given user. *)
+
+val response_field : t -> string
+(** The field in the graphql response that contains the user fields. *)

test/lib/test_contributions.ml

@@ -83,29 +83,10 @@ module Testable = struct
   let contributions = Contributions.testable
 end
 
-let test_request =
-  let make_test name ~period ~token ~expected =
-    let name = Printf.sprintf "request: %s" name in
-    let test_fun () =
-      let actual = Contributions.request ~period ~token in
-      Alcotest.(check Alcotest_ext.request) name expected actual
-    in
-    (name, `Quick, test_fun)
-  in
-  [
-    make_test "no token" ~token:"" ~period:("", "")
-      ~expected:
-        {
-          meth = `POST;
-          url = "https://api.github.com/graphql";
-          headers = [ ("Authorization", "bearer ") ];
-          body =
-            `Assoc
-              [
-                ( "query",
-                  `String
-                    {|query($from: DateTime!, $to: DateTime!) {
-   viewer {
+let request ~user =
+  Format.asprintf
+    {|query($from: DateTime!, $to: DateTime!) {
+   %a {
     login
     contributionsCollection(from: $from, to: $to) {
       issueContributions(first: 100) {
@@ -155,19 +136,59 @@ let test_request =
     }
   }
 }|}
-                );
-                ( "variables",
-                  `Assoc [ ("from", `String ""); ("to", `String "") ] );
-              ];
-        };
+    User.query user
+
+let test_request =
+  let make_test name ~period ~user ~token ~expected =
+    let name = Printf.sprintf "request: %s" name in
+    let test_fun () =
+      let actual = Contributions.request ~period ~user ~token in
+      Alcotest.(check Alcotest_ext.request) name expected actual
+    in
+    (name, `Quick, test_fun)
+  in
+  [
+    (let user = User.Viewer in
+     make_test "no token" ~user ~token:"" ~period:("", "")
+       ~expected:
+         {
+           meth = `POST;
+           url = "https://api.github.com/graphql";
+           headers = [ ("Authorization", "bearer ") ];
+           body =
+             `Assoc
+               [
+                 ("query", `String (request ~user));
+                 ( "variables",
+                   `Assoc [ ("from", `String ""); ("to", `String "") ] );
+               ];
+         });
+    (let user = User.User "me" in
+     make_test "no token" ~user ~token:"" ~period:("", "")
+       ~expected:
+         {
+           meth = `POST;
+           url = "https://api.github.com/graphql";
+           headers = [ ("Authorization", "bearer ") ];
+           body =
+             `Assoc
+               [
+                 ("query", `String (request ~user));
+                 ( "variables",
+                   `Assoc [ ("from", `String ""); ("to", `String "") ] );
+               ];
+         });
   ]
 
-let activity_example =
-  {|
+let or_viewer = function User.User u -> u | Viewer -> "gpetiot"
+
+let activity_example ~user =
+  Format.sprintf
+    {|
 {
   "data": {
-    "viewer": {
-      "login": "gpetiot",
+    %S: {
+      "login": %S,
       "contributionsCollection": {
         "issueContributions": {
           "nodes": [
@@ -282,13 +303,15 @@ let activity_example =
   }
 }
 |}
+    (User.response_field user) (user |> or_viewer)
 
-let activity_example_json = Yojson.Safe.from_string activity_example
+let activity_example_json ~user =
+  Yojson.Safe.from_string (activity_example ~user)
 
-let contributions_example =
+let contributions_example ~user =
   let open Contributions in
   {
-    username = "gpetiot";
+    username = user |> or_viewer;
     activity =
       Repo_map.empty
       |> Repo_map.add "gpetiot/config.ml"
@@ -379,17 +402,23 @@ let contributions_example =
   }
 
 let test_of_json =
-  let make_test name ~from json ~expected =
+  let make_test name ~from ~user json ~expected =
     let name = Printf.sprintf "of_json: %s" name in
     let test_fun () =
-      let actual = Contributions.of_json ~from json in
+      let actual = Contributions.of_json ~from ~user json in
       Alcotest.(check Testable.contributions) name expected actual
     in
     (name, `Quick, test_fun)
   in
   [
-    make_test "no token" ~from:"" activity_example_json
-      ~expected:contributions_example;
+    (let user = User.Viewer in
+     make_test "no token" ~from:"" ~user
+       (activity_example_json ~user)
+       ~expected:(contributions_example ~user));
+    (let user = User.User "gpetiot" in
+     make_test "no token" ~from:"" ~user
+       (activity_example_json ~user)
+       ~expected:(contributions_example ~user));
   ]
 
 let test_is_empty =
@@ -406,7 +435,9 @@ let test_is_empty =
       ~input:
         { Contributions.username = ""; activity = Contributions.Repo_map.empty }
       ~expected:true;
-    make_test "not empty" ~input:contributions_example ~expected:false;
+    make_test "not empty"
+      ~input:(contributions_example ~user:Viewer)
+      ~expected:false;
   ]
 
 let test_pp =
@@ -423,7 +454,8 @@ let test_pp =
       ~input:
         { Contributions.username = ""; activity = Contributions.Repo_map.empty }
       ~expected:"(no activity)";
-    make_test "not empty" ~input:contributions_example
+    make_test "not empty"
+      ~input:(contributions_example ~user:Viewer)
       ~expected:
         "### gpetiot/config.ml\n\
          Created repository \