diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..6ce8d7e --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +.merlin +_build diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..ab8ed27 --- /dev/null +++ b/Makefile @@ -0,0 +1,2 @@ +all: + dune build @install diff --git a/README.md b/README.md new file mode 100644 index 0000000..bad00a7 --- /dev/null +++ b/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 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 +``` + +Then `\a` (in normal mode) will paste recent activity at the end of the file. diff --git a/contributions.ml b/contributions.ml new file mode 100644 index 0000000..8292958 --- /dev/null +++ b/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 " @,@[%a@]" Fmt.words body + +let pp_item f t = + Fmt.pf f "@[%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)) diff --git a/contributions.mli b/contributions.mli new file mode 100644 index 0000000..9cd1979 --- /dev/null +++ b/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. *) diff --git a/dune b/dune new file mode 100644 index 0000000..79452f3 --- /dev/null +++ b/dune @@ -0,0 +1,8 @@ +(executable + (name main) + (public_name get-activity) + (libraries + cohttp + cohttp-lwt + cohttp-lwt-unix + yojson)) diff --git a/dune-project b/dune-project new file mode 100644 index 0000000..115d3f7 --- /dev/null +++ b/dune-project @@ -0,0 +1,12 @@ +(lang dune 2.3) +(generate_opam_files true) +(source (github talex5/get-activity)) +(authors "talex5@gmail.com") +(maintainers "talex5@gmail.com") + +(package + (name get-activity) + (synopsis "collect activity as markdown") + (depends + cohttp-lwt-unix + yojson)) diff --git a/get-activity.opam b/get-activity.opam new file mode 100644 index 0000000..2074b42 --- /dev/null +++ b/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: ["talex5@gmail.com"] +authors: ["talex5@gmail.com"] +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" diff --git a/graphql.ml b/graphql.ml new file mode 100644 index 0000000..0c8238d --- /dev/null +++ b/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 "@[GitHub returned errors: %a@]" (Yojson.Safe.pretty_print ~std:true) json; + end + | err -> Fmt.failwith "@[Error performing GraphQL query on GitHub: %s@,%s@]" + (Cohttp.Code.string_of_status err) + body diff --git a/main.ml b/main.ml new file mode 100644 index 0000000..0356cdc --- /dev/null +++ b/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 "@[%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" diff --git a/main.mli b/main.mli new file mode 100644 index 0000000..e69de29 diff --git a/token.ml b/token.ml new file mode 100644 index 0000000..4f54e7b --- /dev/null +++ b/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 diff --git a/token.mli b/token.mli new file mode 100644 index 0000000..46ee55b --- /dev/null +++ b/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. *)