diff --git a/dune-project b/dune-project index 382cddc..7e7f63c 100644 --- a/dune-project +++ b/dune-project @@ -22,5 +22,6 @@ astring curly (fmt (>= 0.8.7)) + ppx_yojson_conv (yojson (>= 1.6)) (ocaml (>= 4.08)))) diff --git a/get-activity-lib.opam b/get-activity-lib.opam index a9abbcb..9a58268 100644 --- a/get-activity-lib.opam +++ b/get-activity-lib.opam @@ -12,6 +12,7 @@ depends: [ "astring" "curly" "fmt" {>= "0.8.7"} + "ppx_yojson_conv" "yojson" {>= "1.6"} "ocaml" {>= "4.08"} "odoc" {with-doc} diff --git a/lib/contributions.ml b/lib/contributions.ml index e7c8c2a..c9c631a 100644 --- a/lib/contributions.ml +++ b/lib/contributions.ml @@ -1,7 +1,6 @@ -module Json = Yojson.Safe +module Json = Contributions_json_response let ( let* ) = Result.bind -let ( / ) a b = Json.Util.member b a let query user = Format.asprintf @@ -46,10 +45,7 @@ let query user = repositoryContributions(first: 100) { nodes { occurredAt - repository { - url - nameWithOwner - } + repository { url nameWithOwner } } } } @@ -73,10 +69,6 @@ let request ~period:(start, finish) ~user ~token = module Datetime = struct type t = string - - let parse = function - | `String s -> Ok s - | x -> Error (`Msg (Fmt.str "Invalid Datatime %a" Json.pp x)) end module Repo_map = Map.Make (String) @@ -92,94 +84,74 @@ type item = { type t = { username : string; activity : item list Repo_map.t } -let to_string x = - Json.Util.to_string_option x - |> Option.to_result ~none:(`Msg (Fmt.str "Expected string, got %a" Json.pp x)) - -let combine lx = - List.fold_left - (fun acc x -> - let* acc = acc in - let* x = x in - Ok (x :: acc)) - (Ok []) lx - -let read_issues json = - Json.Util.to_list (json / "nodes") - |> List.filter (( <> ) `Null) - |> List.map (fun node -> - let* date = node / "occurredAt" |> Datetime.parse in - let x = node / "issue" in - let* url = x / "url" |> to_string in - let* title = x / "title" |> to_string in - let* body = x / "body" |> to_string in - let* repo = x / "repository" / "nameWithOwner" |> to_string in - Ok { kind = `Issue; date; url; title; body; repo }) - |> combine - -let read_issue_comments json = - Json.Util.to_list (json / "nodes") - |> List.filter (( <> ) `Null) - |> List.map (fun node -> - let* date = node / "publishedAt" |> Datetime.parse in - let* url = node / "url" |> to_string in - let* title = node / "issue" / "title" |> to_string in - let* body = node / "body" |> to_string in - let* repo = node / "repository" / "nameWithOwner" |> to_string in - Ok { kind = `Issue_comment; date; url; title; body; repo }) - |> combine - -let read_prs json = - Json.Util.to_list (json / "nodes") - |> List.filter (( <> ) `Null) - |> List.map (fun node -> - let* date = node / "occurredAt" |> Datetime.parse in - let pr = node / "pullRequest" in - let* url = pr / "url" |> to_string in - let* title = pr / "title" |> to_string in - let* body = pr / "body" |> to_string in - let* repo = pr / "repository" / "nameWithOwner" |> to_string in - Ok { kind = `PR; date; url; title; body; repo }) - |> combine - -let read_reviews json = - Json.Util.to_list (json / "nodes") - |> List.filter (( <> ) `Null) - |> List.map (fun node -> - let* date = node / "occurredAt" |> Datetime.parse in - let review = node / "pullRequestReview" in - let* state = review / "state" |> to_string in - let* url = review / "url" |> to_string in - let pr = review / "pullRequest" in - let* title = pr / "title" |> to_string in - let* body = review / "body" |> to_string in - let* repo = review / "repository" / "nameWithOwner" |> to_string in - Ok { kind = `Review state; date; url; title; body; repo }) - |> combine - -let read_repos json = - Json.Util.to_list (json / "nodes") - |> List.filter (( <> ) `Null) - |> List.map (fun node -> - let* date = node / "occurredAt" |> Datetime.parse in - let repo = node / "repository" in - let* url = repo / "url" |> to_string in - let* repo = repo / "nameWithOwner" |> to_string in - let title = "Created new repository" in - Ok { kind = `New_repo; date; url; title; body = ""; repo }) - |> combine +let read_issues = + List.map (fun (c : Json.issueContribution) -> + let date = c.occurredAt in + let url = c.issue.url in + let title = c.issue.title in + let body = c.issue.body in + let repo = c.issue.repository.nameWithOwner in + { kind = `Issue; date; url; title; body; repo }) + +let read_issue_comments = + List.map (fun (c : Json.issueComment) -> + let date = c.publishedAt in + let url = c.url in + let title = c.issue.title in + let body = c.body in + let repo = c.repository.nameWithOwner in + { kind = `Issue_comment; date; url; title; body; repo }) + +let read_prs = + List.map (fun (c : Json.pullRequestContribution) -> + let date = c.occurredAt in + let url = c.pullRequest.url in + let title = c.pullRequest.title in + let body = c.pullRequest.body in + let repo = c.pullRequest.repository.nameWithOwner in + { kind = `PR; date; url; title; body; repo }) + +let read_reviews = + List.map (fun (c : Json.pullRequestReviewContribution) -> + let date = c.occurredAt in + let state = c.pullRequestReview.state in + let url = c.pullRequestReview.url in + let title = c.pullRequestReview.pullRequest.title in + let body = c.pullRequestReview.body in + let repo = c.pullRequestReview.repository.nameWithOwner in + { kind = `Review state; date; url; title; body; repo }) + +let read_repos = + List.map (fun (c : Json.repositoryContribution) -> + let date = c.occurredAt in + let url = c.repository.url in + let repo = c.repository.nameWithOwner in + let title = "Created new repository" in + { kind = `New_repo; date; url; title; body = ""; repo }) let of_json ~from ~user json = - let root = json / "data" / User.response_field user in - let* username = root / "login" |> to_string in - let contribs = root / "contributionsCollection" in - let* items = - let* issues = read_issues (contribs / "issueContributions") in - let* issue_comments = read_issue_comments (root / "issueComments") in - let* prs = read_prs (contribs / "pullRequestContributions") in - let* reviews = read_reviews (contribs / "pullRequestReviewContributions") in - let* repos = read_repos (contribs / "repositoryContributions") in - Ok (issues @ issue_comments @ prs @ reviews @ repos) + let* json = + match Json.t_of_yojson json with + | x -> Ok x + | exception Ppx_yojson_conv_lib.Yojson_conv.Of_yojson_error (exn, _) -> + Error (`Msg (Printexc.to_string exn)) + in + let* root = + match user with + | User.Viewer -> + json.data.viewer |> Option.to_result ~none:(`Msg "viewer field missing") + | User.User _ -> + json.data.user |> Option.to_result ~none:(`Msg "user field missing") + in + let username = root.login in + let contribs = root.contributionsCollection in + let items = + let issues = read_issues contribs.issueContributions.nodes in + let issue_comments = read_issue_comments root.issueComments.nodes in + let prs = read_prs contribs.pullRequestContributions.nodes in + let reviews = read_reviews contribs.pullRequestReviewContributions.nodes in + let repos = read_repos contribs.repositoryContributions.nodes in + issues @ issue_comments @ prs @ reviews @ repos in let activity = (* GitHub seems to ignore the time part, so do the filtering here. *) diff --git a/lib/contributions_json_response.ml b/lib/contributions_json_response.ml new file mode 100644 index 0000000..9e6fb91 --- /dev/null +++ b/lib/contributions_json_response.ml @@ -0,0 +1,98 @@ +open Ppx_yojson_conv_lib.Yojson_conv.Primitives + +type repository_name = { nameWithOwner : string } [@@deriving yojson] +type repository = { url : string; nameWithOwner : string } [@@deriving yojson] + +type issue = { + url : string; + title : string; + body : string; + repository : repository_name; +} +[@@deriving yojson] + +type issueContribution = { occurredAt : string; issue : issue } +[@@deriving yojson] + +type issueContributions = { nodes : issueContribution list } [@@deriving yojson] + +type pullRequest = { + url : string; + title : string; + body : string; + repository : repository_name; +} +[@@deriving yojson] + +type pullRequestContribution = { + occurredAt : string; + pullRequest : pullRequest; +} +[@@deriving yojson] + +type pullRequestContributions = { nodes : pullRequestContribution list } +[@@deriving yojson] + +type pullRequest_title = { title : string } [@@deriving yojson] + +type pullRequestReview = { + url : string; + pullRequest : pullRequest_title; + body : string; + state : string; + repository : repository_name; +} +[@@deriving yojson] + +type pullRequestReviewContribution = { + occurredAt : string; + pullRequestReview : pullRequestReview; +} +[@@deriving yojson] + +type pullRequestReviewContributions = { + nodes : pullRequestReviewContribution list; +} +[@@deriving yojson] + +type repositoryContribution = { occurredAt : string; repository : repository } +[@@deriving yojson] + +type repositoryContributions = { nodes : repositoryContribution list } +[@@deriving yojson] + +type contributionsCollection = { + issueContributions : issueContributions; + pullRequestContributions : pullRequestContributions; + pullRequestReviewContributions : pullRequestReviewContributions; + repositoryContributions : repositoryContributions; +} +[@@deriving yojson] + +type issue_title = { title : string } [@@deriving yojson] + +type issueComment = { + url : string; + publishedAt : string; + issue : issue_title; + repository : repository_name; + body : string; +} +[@@deriving yojson] + +type issueComments = { nodes : issueComment list } [@@deriving yojson] + +type user_data = { + login : string; + contributionsCollection : contributionsCollection; + issueComments : issueComments; +} +[@@deriving yojson] + +type data = { + user : user_data option; [@yojson.option] + viewer : user_data option; [@yojson.option] +} +[@@deriving yojson] + +type t = { data : data } [@@deriving yojson] diff --git a/lib/dune b/lib/dune index c7e5189..f99f432 100644 --- a/lib/dune +++ b/lib/dune @@ -4,4 +4,4 @@ (libraries astring curly fmt yojson) (inline_tests) (preprocess - (pps ppx_expect))) + (pps ppx_expect ppx_yojson_conv))) diff --git a/test/lib/test_contributions.ml b/test/lib/test_contributions.ml index a532b29..fee29eb 100644 --- a/test/lib/test_contributions.ml +++ b/test/lib/test_contributions.ml @@ -131,10 +131,7 @@ let request ~user = repositoryContributions(first: 100) { nodes { occurredAt - repository { - url - nameWithOwner - } + repository { url nameWithOwner } } } }