Enable auto-formatting (#5)

tarides · Feb 26, 2024 · 2426eaf · 2426eaf
1 parent 6a64fb1
commit 2426eaf
Show file tree

Hide file tree

Showing 11 changed files with 153 additions and 145 deletions.
diff --git a/.ocamlformat b/.ocamlformat
@@ -0,0 +1,2 @@
+version = 0.26.1
+profile = conventional
diff --git 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 "@[<v>%a@]@." Contributions.pp contribs
+  else Fmt.pr "@[<v>%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
@@ -1,6 +1,5 @@
 (lang dune 2.8)
 (name get-activity)
-(formatting disabled)
 (generate_opam_files true)
 (source (github tarides/get-activity))
 (authors "[email protected]")

diff --git 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 "  @,@[<hov>%a@]" Fmt.text body
-
-let pp_item f t =
-  Fmt.pf f "@[<v>%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 "  @,@[<hov>%a@]" Fmt.text body
 
+let pp_item f t = Fmt.pf f "@[<v>%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
@@ -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
@@ -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 "@[<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
+          Fmt.failwith "@[<v2>GitHub returned errors: %a@]"
+            (Yojson.Safe.pretty_print ~std:true)
+            json)
+  | err ->
+      Fmt.failwith "@[<v2>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
@@ -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