Display json errors instead of uncaught exception

tarides · Apr 2, 2024 · 9762ade · 9762ade
1 parent dc3fbcc
commit 9762ade
Show file tree

Hide file tree

Showing 2 changed files with 45 additions and 31 deletions.
diff --git 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
@@ -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]