diff --git a/.ocamlformat b/.ocamlformat new file mode 100644 index 0000000..076a668 --- /dev/null +++ b/.ocamlformat @@ -0,0 +1,2 @@ +version = 0.26.1 +profile = conventional diff --git a/bin/main.ml b/bin/main.ml index 0c7743b..e42e3fb 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -5,8 +5,8 @@ let ( / ) = Filename.concat let or_die = function | Ok x -> x | Error (`Msg m) -> - Fmt.epr "%s@." m; - exit 1 + Fmt.epr "%s@." m; + exit 1 let home = match Sys.getenv_opt "HOME" with @@ -15,9 +15,8 @@ let home = let ensure_dir_exists ~mode path = match Unix.stat path with - | exception Unix.Unix_error(Unix.ENOENT, _, _) -> - Unix.mkdir path mode - | Unix.{ st_kind = S_DIR; _} -> () + | exception Unix.Unix_error (Unix.ENOENT, _, _) -> Unix.mkdir path mode + | Unix.{ st_kind = S_DIR; _ } -> () | _ -> Fmt.failwith "%S is not a directory!" path let last_fetch_file = @@ -28,17 +27,15 @@ let last_fetch_file = let mtime path = match Unix.stat path with | info -> Some info.Unix.st_mtime - | exception Unix.Unix_error(Unix.ENOENT, _, _) -> None + | exception Unix.Unix_error (Unix.ENOENT, _, _) -> None -let get_token () = - Token.load (home / ".github" / "github-activity-token") +let get_token () = Token.load (home / ".github" / "github-activity-token") let show ~from json = let contribs = Contributions.of_json ~from json in if Contributions.is_empty contribs then Fmt.epr "(no activity found since %s)@." from - else - Fmt.pr "@[%a@]@." Contributions.pp contribs + else Fmt.pr "@[%a@]@." Contributions.pp contribs let mode = `Normal @@ -74,21 +71,21 @@ let info = Cmd.info "get-activity" let run period : 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 () |> or_die in - show ~from:(fst period) @@ Contributions.fetch ~period ~token - ) + 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 -> - 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" - ) + 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 |> Period.to_8601 in - show ~from @@ Yojson.Safe.from_file "activity.json" + (* 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" let term = Term.(const run $ period) let cmd = Cmd.v info term diff --git a/dune-project b/dune-project index f05dfb6..07fd81f 100644 --- a/dune-project +++ b/dune-project @@ -1,6 +1,5 @@ (lang dune 2.8) (name get-activity) -(formatting disabled) (generate_opam_files true) (source (github tarides/get-activity)) (authors "talex5@gmail.com") diff --git a/lib/contributions.ml b/lib/contributions.ml index 5b7a9c6..581b2e6 100644 --- a/lib/contributions.ml +++ b/lib/contributions.ml @@ -56,13 +56,9 @@ let query = }|} let fetch ~period:(start, finish) ~token = - Lwt_main.run begin - let variables = [ - "from", `String start; - "to", `String finish; - ] in - Graphql.exec ~token ~variables ~query () - end + Lwt_main.run + (let variables = [ ("from", `String start); ("to", `String finish) ] in + Graphql.exec ~token ~variables ~query ()) module Datetime = struct type t = string @@ -72,12 +68,12 @@ module Datetime = struct | x -> Fmt.failwith "Invalid Datatime %a" Json.pp x end -module Repo_map = Map.Make(String) +module Repo_map = Map.Make (String) type item = { repo : string; - kind : [`Issue | `PR | `Review of string | `New_repo ]; - date: Datetime.t; + kind : [ `Issue | `PR | `Review of string | `New_repo ]; + date : Datetime.t; url : string; title : string; body : string; @@ -86,103 +82,120 @@ type item = { 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 - 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 } + Json.Util.to_list (json / "nodes") + |> List.filter (( <> ) `Null) + |> 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 } + 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 } + 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 json = - Json.Util.to_list (json / "nodes") |> List.filter ((<>) `Null) |> List.map @@ fun node -> - let date = Datetime.parse (node / "occurredAt") in - let repo = node / "repository" in - let url = repo / "url" |> Json.Util.to_string in - let repo = repo / "nameWithOwner" |> Json.Util.to_string in - { kind = `New_repo; date; url; title = "Created new repository"; body = ""; repo } + Json.Util.to_list (json / "nodes") + |> List.filter (( <> ) `Null) + |> List.map @@ fun node -> + let date = Datetime.parse (node / "occurredAt") in + let repo = node / "repository" in + let url = repo / "url" |> Json.Util.to_string in + let repo = repo / "nameWithOwner" |> Json.Util.to_string in + { + 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") + read_issues (contribs / "issueContributions") + @ read_prs (contribs / "pullRequestContributions") + @ read_reviews (contribs / "pullRequestReviewContributions") + @ read_repos (contribs / "repositoryContributions") in 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 + |> 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 | None -> Fmt.failwith "Invalid URL %S" url - | Some (_, id) -> - match Astring.String.cut ~sep:"#" id with - | Some (id, _) -> id - | None -> id + | 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 + | `New_repo -> ( + 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) let pp_body f = function | "" -> () | body -> - let body = body |> String.split_on_char (Char.chr 13) |> String.concat "" in - Fmt.pf f " @,@[%a@]" Fmt.text body - -let pp_item f t = - Fmt.pf f "@[%a.%a@]" pp_title t pp_body t.body + let body = + body |> String.split_on_char (Char.chr 13) |> String.concat "" + in + Fmt.pf f " @,@[%a@]" Fmt.text body +let pp_item f t = Fmt.pf f "@[%a.%a@]" pp_title t pp_body t.body 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 - -let is_empty { activity; _} = Repo_map.is_empty activity +let pp_repo f (name, items) = Fmt.pf f "### %s@,@,%a" name pp_items items +let is_empty { activity; _ } = Repo_map.is_empty activity 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 + | [ (_, items) ] -> pp_items f items | repos -> Fmt.(list ~sep:(cut ++ cut)) pp_repo f repos diff --git a/lib/contributions.mli b/lib/contributions.mli index e58aa3e..c3e7bb3 100644 --- a/lib/contributions.mli +++ b/lib/contributions.mli @@ -4,8 +4,8 @@ end type item = { repo : string; - kind : [`Issue | `PR | `Review of string | `New_repo ]; - date: Datetime.t; + kind : [ `Issue | `PR | `Review of string | `New_repo ]; + date : Datetime.t; url : string; title : string; body : string; @@ -15,7 +15,7 @@ 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 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. *) diff --git a/lib/graphql.ml b/lib/graphql.ml index 36e4dec..01a5eda 100644 --- a/lib/graphql.ml +++ b/lib/graphql.ml @@ -1,32 +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) :: + `Assoc + (("query", `String query) + :: (match variables with - | None -> [] - | Some v -> ["variables", `Assoc v]) - ) - |> Yojson.Safe.to_string - |> Cohttp_lwt.Body.of_string + | 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_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 + | `OK -> ( + let json = Yojson.Safe.from_string body in + 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 + Fmt.failwith "@[GitHub returned errors: %a@]" + (Yojson.Safe.pretty_print ~std:true) + json) + | err -> + Fmt.failwith "@[Error performing GraphQL query on GitHub: %s@,%s@]" + (Cohttp.Code.string_of_status err) + body diff --git a/lib/graphql.mli b/lib/graphql.mli index 325aae8..fc457bb 100644 --- a/lib/graphql.mli +++ b/lib/graphql.mli @@ -1 +1,6 @@ -val exec : ?variables:(string * Yojson.Safe.t) list -> token:string -> query:string -> unit -> Yojson.Safe.t Lwt.t +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 index 3e4efb6..7f519b4 100644 --- a/lib/period.ml +++ b/lib/period.ml @@ -1,29 +1,21 @@ -type t = - [ `Last_week - | `Range of string * string - | `Since_last_fetch ] +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) + 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 + | 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; + close_out @@ open_out_gen [ Open_append; Open_creat ] 0o600 path; Unix.utimes path time time let with_period period ~last_fetch_file ~f = @@ -32,10 +24,11 @@ let with_period period ~last_fetch_file ~f = 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) + 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; diff --git a/lib/period.mli b/lib/period.mli index 1c2d083..14806bd 100644 --- a/lib/period.mli +++ b/lib/period.mli @@ -1,12 +1,9 @@ -type t = - [ `Last_week - | `Range of string * string - | `Since_last_fetch ] +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 +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/lib/token.ml b/lib/token.ml index 4f54e7b..142cf94 100644 --- a/lib/token.ml +++ b/lib/token.ml @@ -3,9 +3,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) + 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 + Fmt.error_msg + "Can't open GitHub token file (%s).@,\ + Go to https://github.com/settings/tokens to generate one." e diff --git a/lib/token.mli b/lib/token.mli index 46ee55b..2894e20 100644 --- a/lib/token.mli +++ b/lib/token.mli @@ -1,5 +1,5 @@ type t = string -val load : string -> (t, [`Msg of string]) result +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. *)