action and gh api: refactored handling api returns and cleaned up unused types

Author: dombong

lib/action.ml

@@ -317,32 +317,30 @@ module Action (Github_api : Api.Github) (Slack_api : Api.Slack) = struct
         Lwt.return_none
     in
     let process link =
+      let with_gh_result_populate_slack (type a) ~(api_result : (a, string) Result.t)
+        ~(populate : repository -> a -> Slack_t.message_attachment) ~repo
+        =
+        match api_result with
+        | Error _ -> Lwt.return_none
+        | Ok item -> Lwt.return_some @@ (link, populate repo item)
+      in
       match Github.gh_link_of_string link with
       | None -> Lwt.return_none
       | Some gh_link ->
       match gh_link with
       | Pull_request (repo, number) ->
-        ( match%lwt Github_api.get_pull_request ~ctx ~repo ~number with
-        | Error _ -> Lwt.return_none
-        | Ok pr -> Lwt.return_some @@ (link, Slack_message.populate_pull_request repo pr)
-        )
+        let%lwt result = Github_api.get_pull_request ~ctx ~repo ~number in
+        with_gh_result_populate_slack ~api_result:result ~populate:Slack_message.populate_pull_request ~repo
       | Issue (repo, number) ->
-        ( match%lwt Github_api.get_issue ~ctx ~repo ~number with
-        | Error _ -> Lwt.return_none
-        | Ok issue -> Lwt.return_some @@ (link, Slack_message.populate_issue repo issue)
-        )
+        let%lwt result = Github_api.get_issue ~ctx ~repo ~number in
+        with_gh_result_populate_slack ~api_result:result ~populate:Slack_message.populate_issue ~repo
       | Commit (repo, sha) ->
-        ( match%lwt Github_api.get_api_commit ~ctx ~repo ~sha with
-        | Error _ -> Lwt.return_none
-        | Ok commit -> Lwt.return_some @@ (link, Slack_message.populate_commit repo commit)
-        )
-      | Compare (repo, (base, merge)) ->
-        ( match%lwt Github_api.get_compare ~ctx ~repo ~basehead:(base, merge) with
-        | Error _ -> Lwt.return_none
-        | Ok compare -> Lwt.return_some @@ (link, Slack_message.populate_compare repo compare)
-        )
+        let%lwt result = Github_api.get_api_commit ~ctx ~repo ~sha in
+        with_gh_result_populate_slack ~api_result:result ~populate:Slack_message.populate_commit ~repo
+      | Compare (repo, basehead) ->
+        let%lwt result = Github_api.get_compare ~ctx ~repo ~basehead in
+        with_gh_result_populate_slack ~api_result:result ~populate:Slack_message.populate_compare ~repo
     in
-
     let%lwt bot_user_id =
       match State.get_bot_user_id ctx.state with
       | Some id -> Lwt.return_some id

lib/api.ml

@@ -4,12 +4,10 @@ open Slack_t
 
 module type Github = sig
   val get_config : ctx:Context.t -> repo:repository -> (Config_t.config, string) Result.t Lwt.t
-  val get_branch : ctx:Context.t -> repo:repository -> name:string -> (branch, string) Result.t Lwt.t
   val get_api_commit : ctx:Context.t -> repo:repository -> sha:string -> (api_commit, string) Result.t Lwt.t
   val get_pull_request : ctx:Context.t -> repo:repository -> number:int -> (pull_request, string) Result.t Lwt.t
   val get_issue : ctx:Context.t -> repo:repository -> number:int -> (issue, string) Result.t Lwt.t
   val get_compare : ctx:Context.t -> repo:repository -> basehead:Github.basehead -> (compare, string) Result.t Lwt.t
-  val get_release_tag : ctx:Context.t -> repo:repository -> release_tag:string -> (release_tag, string) Result.t Lwt.t
 
   val request_reviewers
     :  ctx:Context.t ->

lib/api_local.ml

@@ -34,9 +34,6 @@ module Github : Api.Github = struct
     let url = Caml.Filename.concat cwd ctx.config_filename in
     with_cache_file url Config_j.config_of_string
 
-  let get_branch ~ctx:_ ~(repo : Github_t.repository) ~name =
-    get_repo_member_cache ~repo ~kind:"branch" ~ref_:name ~of_string:Github_j.branch_of_string
-
   let get_api_commit ~ctx:_ ~repo ~sha =
     get_repo_member_cache ~repo ~kind:"commit" ~ref_:sha ~of_string:Github_j.api_commit_of_string
 
@@ -50,9 +47,6 @@ module Github : Api.Github = struct
     get_repo_member_cache ~repo ~kind:"compare" ~ref_:(sprintf "%s...%s" base merge)
       ~of_string:Github_j.compare_of_string
 
-  let get_release_tag ~ctx:_ ~(repo : Github_t.repository) ~release_tag =
-    get_repo_member_cache ~repo ~kind:"release_tag" ~ref_:release_tag ~of_string:Github_j.release_tag_of_string
-
   let request_reviewers ~ctx:_ ~repo:_ ~number:_ ~reviewers:_ = Lwt.return @@ Error "undefined for local setup"
 end
 

lib/api_remote.ml

@@ -16,15 +16,9 @@ module Github : Api.Github = struct
   let issues_url ~(repo : Github_t.repository) ~number =
     String.substr_replace_first ~pattern:"{/number}" ~with_:(sprintf "/%d" number) repo.issues_url
 
-  let branches_url ~(repo : Github_t.repository) ~name =
-    String.substr_replace_first ~pattern:"{/branch}" ~with_:(sprintf "/%s" name) repo.branches_url
-
   let compare_url ~(repo : Github_t.repository) ~basehead:(base, merge) =
     String.substr_replace_first ~pattern:"{/basehead}" ~with_:(sprintf "/%s...%s" base merge) repo.compare_url
 
-  let releases_tags_url ~(repo : Github_t.repository) ~release_tag =
-    String.substr_replace_first ~pattern:"{/release_tag}" ~with_:(sprintf "/tags/%s" release_tag) repo.releases_url
-
   let build_headers ?token () =
     let headers = [ "Accept: application/vnd.github.v3+json" ] in
     Option.value_map token ~default:headers ~f:(fun v -> sprintf "Authorization: token %s" v :: headers)
@@ -72,10 +66,6 @@ module Github : Api.Github = struct
     let%lwt res = commits_url ~repo ~sha |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url in
     Lwt.return @@ Result.map res ~f:Github_j.api_commit_of_string
 
-  let get_branch ~(ctx : Context.t) ~(repo : Github_t.repository) ~name =
-    let%lwt res = branches_url ~repo ~name |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url in
-    Lwt.return @@ Result.map res ~f:Github_j.branch_of_string
-
   let get_pull_request ~(ctx : Context.t) ~(repo : Github_t.repository) ~number =
     let%lwt res = pulls_url ~repo ~number |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url in
     Lwt.return @@ Result.map res ~f:Github_j.pull_request_of_string
@@ -90,12 +80,6 @@ module Github : Api.Github = struct
     in
     Lwt.return @@ Result.map res ~f:Github_j.compare_of_string
 
-  let get_release_tag ~(ctx : Context.t) ~(repo : Github_t.repository) ~release_tag =
-    let%lwt res =
-      releases_tags_url ~repo ~release_tag |> get_resource ~secrets:(Context.get_secrets_exn ctx) ~repo_url:repo.url
-    in
-    Lwt.return @@ Result.map res ~f:Github_j.release_tag_of_string
-
   let request_reviewers ~(ctx : Context.t) ~(repo : Github_t.repository) ~number ~reviewers =
     let body = Github_j.string_of_request_reviewers_req reviewers in
     let%lwt res =

lib/github.atd

@@ -59,12 +59,10 @@ type repository = {
   full_name: string;
   html_url <ocaml name="url"> : string;
   commits_url: string;
-  branches_url: string;
   contents_url: string;
   pulls_url: string;
   issues_url: string;
   compare_url: string;
-  releases_url: string;
 }
 
 type commit_pushed_notification = {
@@ -135,11 +133,6 @@ type compare = {
   files: file list;
 }
 
-type release_tag = {
-  url: string;
-  name: string;
-}
-
 type pr_action = [
   Assigned <json name="assigned">
   | Unassigned <json name="unassigned">

lib/github.ml

@@ -134,8 +134,6 @@ let gh_link_of_string url_str =
         pulls_url = sprintf "%s/pulls{/number}" api_base;
         issues_url = sprintf "%s/issues{/number}" api_base;
         compare_url = sprintf "%s/compare{/basehead}" api_base;
-        branches_url = sprintf "%s/branches{/branch}" api_base;
-        releases_url = sprintf "%s/releases{/release_tag}" api_base;
       }
     in
     let repo = make_repo owner name in

test/github_link_test.ml

@@ -14,8 +14,6 @@ let mk_repo ?(owner = "ahrefs") ?(scheme = "https") prefix prefix_api : reposito
     pulls_url = sprintf "%s://%s/repos/%s/monorepo/pulls{/number}" scheme prefix_api owner;
     issues_url = sprintf "%s://%s/repos/%s/monorepo/issues{/number}" scheme prefix_api owner;
     compare_url = sprintf "%s://%s/repos/%s/monorepo/compare{/basehead}" scheme prefix_api owner;
-    branches_url = sprintf "%s://%s/repos/%s/monorepo/branches{/branch}" scheme prefix_api owner;
-    releases_url = sprintf "%s://%s/repos/%s/monorepo/releases{/release_tag}" scheme prefix_api owner;
   }
 
 let enterprise_repo1 = mk_repo "example.org" "example.org/api/v3"

test/test.ml

@@ -86,8 +86,6 @@ let () =
       pulls_url = "";
       issues_url = "";
       compare_url = "";
-      branches_url = "";
-      releases_url = "";
     }
   in
   let ctx = Context.make ~state_filepath:"state.json" () in