Initial import

.gitignore

@@ -0,0 +1,2 @@
+.merlin
+_build

Makefile

@@ -0,0 +1,2 @@
+all:
+	dune build @install

README.md

@@ -0,0 +1,27 @@
+An experimental script to collect your recent activity from e.g. GitHub and format it as markdown.
+The idea is that you keep a journal (e.g. `log.md`) and instead of manually copying and pasting things
+into it, you just run a command in your text editor and it pastes in everything you did since the last
+paste. You can then edit this text as required.
+
+## Activity sources
+
+At the moment, GitHub activity is the only source it queries.
+
+### GitHub
+
+1. Go to <https://github.com/settings/tokens> and generate a new token.
+   It only needs read access; I selected `public_repo, read:discussion, read:org, read:user`.
+
+2. Save the generated token as `~/.github/github-activity-token`.
+
+## Editors
+
+### Vim
+
+Put this in your `~/.vimrc`:
+
+```
+au BufRead,BufNewFile **/log.md map \a G:r! github-activity<CR>
+```
+
+Then `\a` (in normal mode) will paste recent activity at the end of the file.

contributions.ml

@@ -0,0 +1,186 @@
+module Json = Yojson.Safe
+
+let ( / ) a b = Json.Util.member b a
+
+let query =
+  {| query($from: DateTime!) {
+   viewer { 
+    contributionsCollection(from: $from) {
+      issueContributions(first: 100) {
+        nodes {
+          occurredAt
+          issue {
+            url
+            title
+            body
+            repository { nameWithOwner }
+          }
+        }
+      }
+      pullRequestContributions(first: 100) {
+        nodes {
+          occurredAt
+          pullRequest {
+            url
+            title
+            body
+            repository { nameWithOwner }
+          }
+        }
+      }
+      pullRequestReviewContributions(first: 100) {
+        nodes {
+          occurredAt
+          pullRequestReview {
+            url
+            pullRequest { title }
+            body
+            state
+            comments(first: 100) { nodes { body } }
+            repository { nameWithOwner }
+          }
+        }
+      }
+      repositoryContributions(first: 100) {
+        nodes {
+          occurredAt
+          repository {
+            url
+            nameWithOwner
+          }
+        }
+      }
+    }
+  }
+}|}
+
+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 fetch ~from ~token =
+  Lwt_main.run begin
+    let variables = [
+      "from", `String (to_8601 from);
+    ] in
+    Graphql.exec token ~variables query
+  end
+
+module Datetime = struct
+  type t = string
+
+  let parse = function
+    | `String s -> s
+    | x -> Fmt.failwith "Invalid Datatime %a" Json.pp x
+end
+
+module Repo_map = Map.Make(String)
+
+type item = {
+  repo : string;
+  kind : [`Issue | `PR | `Review of string | `New_repo ];
+  date: Datetime.t;
+  url : string;
+  title : string;
+  body : string;
+}
+
+let read_issues json =
+  Json.Util.to_list (json / "nodes") |> List.map @@ fun node ->
+  let date = Datetime.parse (node / "occurredAt") in
+  let x = node / "issue" in
+  let url = x / "url" |> Json.Util.to_string in
+  let title = x / "title" |> Json.Util.to_string in
+  let body = x / "body" |> Json.Util.to_string in
+  let repo = x / "repository" / "nameWithOwner" |> Json.Util.to_string in
+  { kind = `Issue; date; url; title; body; repo }
+
+let read_prs json =
+  Json.Util.to_list (json / "nodes") |> List.filter ((<>) `Null) |> List.map @@ fun node ->
+  let date = Datetime.parse (node / "occurredAt") in
+  let pr = node / "pullRequest" in
+  let url = pr / "url" |> Json.Util.to_string in
+  let title = pr / "title" |> Json.Util.to_string in
+  let body = pr / "body" |> Json.Util.to_string in
+  let repo = pr / "repository" / "nameWithOwner" |> Json.Util.to_string in
+  { kind = `PR; date; url; title; body; repo }
+
+let read_reviews json =
+  Json.Util.to_list (json / "nodes") |> List.filter ((<>) `Null) |> List.map @@ fun node ->
+  let date = Datetime.parse (node / "occurredAt") in
+  let review = node / "pullRequestReview" in
+  let state = review / "state" |> Json.Util.to_string in
+  let url = review / "url" |> Json.Util.to_string in
+  let pr = review / "pullRequest" in
+  let title = pr / "title" |> Json.Util.to_string in
+  let body = review / "body" |> Json.Util.to_string in
+  let repo = review / "repository" / "nameWithOwner" |> Json.Util.to_string in
+  { kind = `Review state; date; url; title; body; repo }
+
+let read_repos ~from json =
+  Json.Util.to_list (json / "nodes") |> List.filter ((<>) `Null) |> List.filter_map @@ fun node ->
+  let date = Datetime.parse (node / "occurredAt") in
+  if date >= from then (
+    let repo = node / "repository" in
+    let url = repo / "url" |> Json.Util.to_string in
+    let repo = repo / "nameWithOwner" |> Json.Util.to_string in
+    Some { kind = `New_repo; date; url; title = "Created new repository"; body = ""; repo }
+  ) else (
+    (* GitHub seems to ignore the time part, so do the filtering for it. *)
+    None
+  )
+
+let of_json ~from json =
+  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") ~from
+  in
+  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 items
+
+let id url =
+  match Astring.String.cut ~sep:"/" ~rev:true url with
+  | None -> Fmt.failwith "Invalid URL %S" url
+  | Some (_, id) ->
+    match Astring.String.cut ~sep:"#" id with
+    | Some (id, _) -> id
+    | None -> id
+
+let pp_title f t =
+  match t.kind with
+  | `Issue -> Fmt.pf f "%s [#%s](%s)" t.title (id t.url) t.url
+  | `PR -> Fmt.pf f "%s [#%s](%s)" t.title (id t.url) t.url
+  | `Review s -> Fmt.pf f "%s %s [#%s](%s)" s t.title (id t.url) t.url
+  | `New_repo ->
+    begin match Astring.String.cuts ~sep:"/" t.url |> List.rev with
+      | repo :: org :: _ -> Fmt.pf f "Created repository [%s/%s](%s)" org repo t.url
+      | _ -> Fmt.failwith "Malformed URL %S" t.url
+    end
+
+let pp_body f = function
+  | "" -> ()
+  | body -> Fmt.pf f "  @,@[<hov>%a@]" Fmt.words body
+
+let pp_item f t =
+  Fmt.pf f "@[<v>%a%a@]" pp_title t pp_body t.body
+
+let pp_repo f (name, items) =
+  Fmt.pf f "### %s@,@,%a" name Fmt.(list ~sep:(cut ++ cut) pp_item) items
+
+let items_by_repo ~from json =
+  let t = of_json ~from:(to_8601 from) json in
+  Repo_map.bindings t
+
+let pp ~from = Fmt.(using (items_by_repo ~from) (list ~sep:(cut ++ cut) pp_repo))

contributions.mli

@@ -0,0 +1,4 @@
+val fetch : from:float -> token:Token.t -> Yojson.Safe.t
+val pp : from:float -> Yojson.Safe.t Fmt.t
+(** [pp ~from json] formats [json] as markdown.
+    We pass [from] again here so we can filter out anything that GitHub included by accident. *)

dune

@@ -0,0 +1,8 @@
+(executable
+ (name main)
+ (public_name get-activity)
+ (libraries
+  cohttp
+  cohttp-lwt
+  cohttp-lwt-unix
+  yojson))

dune-project

@@ -0,0 +1,12 @@
+(lang dune 2.3)
+(generate_opam_files true)
+(source (github talex5/get-activity))
+(authors "[email protected]")
+(maintainers "[email protected]")
+
+(package
+ (name get-activity)
+ (synopsis "collect activity as markdown")
+ (depends
+  cohttp-lwt-unix
+  yojson))

get-activity.opam

@@ -0,0 +1,27 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "collect activity as markdown"
+maintainer: ["[email protected]"]
+authors: ["[email protected]"]
+homepage: "https://github.com/talex5/get-activity"
+bug-reports: "https://github.com/talex5/get-activity/issues"
+depends: [
+  "dune" {>= "2.3"}
+  "cohttp-lwt-unix"
+  "yojson"
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/talex5/get-activity.git"

graphql.ml

@@ -0,0 +1,32 @@
+open Lwt.Infix
+
+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 body =
+    `Assoc (
+      ("query", `String query) ::
+      (match variables with
+       | None -> []
+       | Some v -> ["variables", `Assoc v])
+    )
+    |> Yojson.Safe.to_string
+    |> Cohttp_lwt.Body.of_string
+  in
+  let headers = Cohttp.Header.init_with "Authorization" ("bearer " ^ token) in
+  Cohttp_lwt_unix.Client.post ~headers ~body graphql_endpoint >>=
+  fun (resp, body) ->
+  Cohttp_lwt.Body.to_string body >|= fun body ->
+  match Cohttp.Response.status resp with
+  | `OK ->
+    let json = Yojson.Safe.from_string body in
+    begin match json / "errors" with
+      | `Null -> json
+      | _errors ->
+        Fmt.failwith "@[<v2>GitHub returned errors: %a@]" (Yojson.Safe.pretty_print ~std:true) json;
+    end
+  | err -> Fmt.failwith "@[<v2>Error performing GraphQL query on GitHub: %s@,%s@]"
+             (Cohttp.Code.string_of_status err)
+             body

main.ml

@@ -0,0 +1,58 @@
+let or_die = function
+  | Ok x -> x
+  | Error (`Msg m) ->
+    Fmt.epr "%s@." m;
+    exit 1
+
+let one_week = 60. *. 60. *. 24. *. 7.
+
+let last_fetch_file = ".github-activity-timestamp"
+
+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 get_token () =
+  let ( / ) = Filename.concat in
+  match Sys.getenv_opt "HOME" with
+  | None -> Error (`Msg "$HOME is not set - can't locate GitHub token!")
+  | Some home -> Token.load (home / ".github" / "github-activity-token")
+
+(* Run [fn timestamp], where [timestamp] is the last recorded timestamp (if any).
+   On success, update the timestamp to the start time. *)
+let with_timestamp fn =
+  let now = Unix.time () in
+  let last_fetch = mtime last_fetch_file in
+  fn last_fetch;
+  set_mtime last_fetch_file now
+
+let show ~from json =
+  Fmt.pr "@[<v>%a@]@." (Contributions.pp ~from) json
+
+let mode = `Normal
+
+let () =
+  match mode with
+  | `Normal ->
+    with_timestamp (fun last_fetch ->
+        let from = Option.value last_fetch ~default:(Unix.time () -. one_week) in
+        let token = get_token () |> or_die in
+        show ~from @@ Contributions.fetch ~from ~token
+      )
+  | `Save ->
+    with_timestamp (fun last_fetch ->
+        let from = Option.value last_fetch ~default:(Unix.time () -. one_week) in
+        let token = get_token () |> or_die in
+        Contributions.fetch ~from ~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 in
+    show ~from @@ Yojson.Safe.from_file "activity.json"

token.ml

@@ -0,0 +1,11 @@
+type t = string
+
+let load path =
+  match open_in path with
+  | ch ->
+    let len = in_channel_length ch in
+    let data = really_input_string ch len in
+    close_in ch;
+    Ok (String.trim data)
+  | exception Sys_error e ->
+    Fmt.error_msg "Can't open GitHub token file (%s).@,Go to https://github.com/settings/tokens to generate one." e

token.mli

@@ -0,0 +1,5 @@
+type t = string
+
+val load : string -> (t, [`Msg of string]) result
+(** [load path] loads the GitHub token from [path].
+    Returns an error if the token isn't found. *)