From b3dac5b7ceae28ff5d586cdcde335dcaf89d6bd3 Mon Sep 17 00:00:00 2001
From: "Guillaume \"Liam\" Petiot" <guillaume@tarides.com>
Date: Tue, 2 Apr 2024 17:03:14 +0100
Subject: [PATCH] Display json errors instead of uncaught exception (#34)

---
 lib/contributions.ml               | 67 +++++++++++++++++-------------
 lib/contributions_json_response.ml |  9 +++-
 test/lib/test_contributions.ml     | 33 +++++++++++++++
 3 files changed, 78 insertions(+), 31 deletions(-)

diff --git a/lib/contributions.ml b/lib/contributions.ml
index 6dc8b78..29d0c4d 100644
--- a/lib/contributions.ml
+++ b/lib/contributions.ml
@@ -136,36 +136,43 @@ let of_json ~period:(from, to_) ~user json =
     | 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. *)
-    items
-    |> List.filter (fun item -> item.date >= from && item.date <= to_)
-    |> 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
-  Ok { username; activity }
+  match json.data with
+  | Some data ->
+      let* root =
+        match user with
+        | User.Viewer ->
+            data.viewer |> Option.to_result ~none:(`Msg "viewer field missing")
+        | User.User _ ->
+            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. *)
+        items
+        |> List.filter (fun item -> item.date >= from && item.date <= to_)
+        |> 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
+      Ok { username; activity }
+  | None ->
+      Fmt.error_msg "@[%a@]" (Fmt.list Fmt.string)
+        (List.map (fun x -> x.Json.message) json.errors)
 
 let id url =
   match Astring.String.cut ~sep:"/" ~rev:true url with
diff --git a/lib/contributions_json_response.ml b/lib/contributions_json_response.ml
index 3da516a..11742bc 100644
--- a/lib/contributions_json_response.ml
+++ b/lib/contributions_json_response.ml
@@ -90,4 +90,11 @@ type data = {
 [@@deriving yojson]
 (** The key is either [viewer] or [user] depending on the request but the value associated is the same. *)
 
-type t = { data : data } [@@deriving yojson]
+type error = { message : string }
+[@@deriving yojson] [@@yojson.allow_extra_fields]
+
+type t = {
+  data : data option; [@yojson.option]
+  errors : error list; [@default []]
+}
+[@@deriving yojson]
diff --git a/test/lib/test_contributions.ml b/test/lib/test_contributions.ml
index 201151b..9b9540e 100644
--- a/test/lib/test_contributions.ml
+++ b/test/lib/test_contributions.ml
@@ -327,6 +327,35 @@ let activity_example ~user =
 let activity_example_json ~user =
   Yojson.Safe.from_string (activity_example ~user)
 
+let error_example =
+  {|
+  {
+  "errors": [
+    {
+      "path": [
+        "query",
+        "viewer",
+        "contributionsCollection",
+        "to"
+      ],
+      "extensions": {
+        "code": "argumentLiteralsIncompatible",
+        "typeName": "Field",
+        "argumentName": "to"
+      },
+      "locations": [
+        {
+          "line": 4,
+          "column": 5
+        }
+      ],
+      "message": "Error."
+    }
+  ]
+} |}
+
+let error_example_json = Yojson.Safe.from_string error_example
+
 let contributions_example1 ~user =
   let open Contributions in
   {
@@ -493,6 +522,10 @@ let test_of_json =
               username = user |> or_viewer;
               activity = Contributions.Repo_map.empty;
             }));
+    (let user = User.User "gpetiot" in
+     make_test "errors"
+       ~period:("2024-02-27T12:05:04Z", "2024-03-13T11:09:56Z")
+       ~user error_example_json ~expected:(Fmt.error_msg "Error."));
   ]
 
 let test_is_empty =