define slack message generation logic for PRs and issues

Author: yasunariw

lib/github.atd

@@ -29,12 +29,23 @@ type github_user = {
   avatar_url: string;
 }
 
+type github_team = {
+  id: int;
+  name: string;
+  slug: string;
+  url: string;
+  html_url: string;
+  ~description <ocaml default="\"\"">: string;
+}
+
 type repository = {
   name: string;
   full_name: string;
   html_url <ocaml name="url"> : string;
   commits_url: string;
   contents_url: string;
+  pulls_url: string;
+  issues_url: string;
 }
 
 type commit_pushed_notification = {
@@ -55,13 +66,25 @@ type label = {
   name: string;
 }
 
+type abstract_issue_state = [
+| Open <json name="open">
+| Closed <json name="closed">
+] <ocaml repr="classic">
+
 type pull_request = {
   user: github_user;
   number: int;
   body: string;
   title: string;
   html_url: string;
   labels: label list;
+  state: abstract_issue_state;
+  ~requested_reviewers <ocaml default="[]">: github_user list;
+  ~requested_teams <ocaml default="[]">: github_team list;
+  ~assignees <ocaml default="[]">: github_user list;
+  ~merged <ocaml default="false">: bool;
+  ~draft <ocaml default="false">: bool;
+  ~comments <ocaml default="0">: int;
 }
 
 type issue = {
@@ -72,6 +95,9 @@ type issue = {
   html_url: string;
   labels: label list;
   ?pull_request: basic_json nullable;
+  state: abstract_issue_state;
+  ~assignees <ocaml default="[]">: github_user list;
+  ~comments <ocaml default="0">: int;
 }
 
 type pr_action = [

lib/github.ml

@@ -124,6 +124,8 @@ let gh_link_of_string url_str =
         url = html_base;
         commits_url = sprintf "%s/commits{/sha}" api_base;
         contents_url = sprintf "%s/contents/{+path}" api_base;
+        pulls_url = sprintf "%s/pulls{/number}" api_base;
+        issues_url = sprintf "%s/issues{/number}" api_base;
       }
     in
     begin

lib/slack_message.ml

@@ -5,6 +5,19 @@ open Slack_t
 open Common
 open Mrkdwn
 
+let color_of_state ?(draft = false) ?(merged = false) state =
+  match draft with
+  | true -> Colors.gray
+  | false ->
+  match merged with
+  | true -> Colors.purple
+  | false ->
+  match state with
+  | Open -> Colors.green
+  | Closed -> Colors.red
+
+let gh_name_of_string = sprintf "@%s"
+
 let empty_attachment =
   {
     mrkdwn_in = None;
@@ -27,6 +40,87 @@ let empty_attachment =
 let base_attachment (repository : repository) =
   { empty_attachment with footer = Some (sprintf "<%s|%s>" repository.url (escape_mrkdwn repository.full_name)) }
 
+let pp_label (label : label) = label.name
+
+let pp_github_user (user : github_user) = gh_name_of_string user.login
+
+let pp_github_team (team : github_team) = gh_name_of_string team.slug
+
+let populate_pull_request repository (pull_request : pull_request) =
+  let ({
+         body;
+         title;
+         number;
+         html_url;
+         user;
+         assignees;
+         comments;
+         labels;
+         requested_reviewers;
+         requested_teams;
+         state;
+         draft;
+         merged;
+         _;
+       }
+        : pull_request)
+    =
+    pull_request
+  in
+  let get_reviewers () =
+    List.concat [ List.map requested_reviewers ~f:pp_github_user; List.map requested_teams ~f:pp_github_team ]
+  in
+  let fields =
+    [
+      "Assignees", List.map assignees ~f:pp_github_user;
+      "Labels", List.map labels ~f:pp_label;
+      "Comments", [ Int.to_string comments ];
+      "Reviewers", get_reviewers ();
+    ]
+    |> List.filter_map ~f:(fun (t, v) -> if List.is_empty v then None else Some (t, String.concat v ~sep:","))
+    |> List.map ~f:(fun (t, v) -> { title = Some t; value = v })
+  in
+  let get_title () = sprintf "#%d %s" number (Mrkdwn.escape_mrkdwn title) in
+  {
+    (base_attachment repository) with
+    author_name = Some user.login;
+    author_link = Some user.html_url;
+    author_icon = Some user.avatar_url;
+    color = Some (color_of_state ~draft ~merged state);
+    fields = Some fields;
+    mrkdwn_in = Some [ "text" ];
+    title = Some (get_title ());
+    title_link = Some html_url;
+    fallback = Some (sprintf "[%s] %s" repository.full_name title);
+    text = Some (Mrkdwn.mrkdwn_of_markdown body);
+  }
+
+let populate_issue repository (issue : issue) =
+  let ({ body; title; number; html_url; user; assignees; comments; labels; state; _ } : issue) = issue in
+  let fields =
+    [
+      "Assignees", List.map assignees ~f:pp_github_user;
+      "Labels", List.map labels ~f:pp_label;
+      "Comments", [ Int.to_string comments ];
+    ]
+    |> List.filter_map ~f:(fun (t, v) -> if List.is_empty v then None else Some (t, String.concat v ~sep:","))
+    |> List.map ~f:(fun (t, v) -> { title = Some t; value = v })
+  in
+  let get_title () = sprintf "#%d %s" number (Mrkdwn.escape_mrkdwn title) in
+  {
+    (base_attachment repository) with
+    author_name = Some user.login;
+    author_link = Some user.html_url;
+    author_icon = Some user.avatar_url;
+    color = Some (color_of_state state);
+    fields = Some fields;
+    mrkdwn_in = Some [ "text" ];
+    title = Some (get_title ());
+    title_link = Some html_url;
+    fallback = Some (sprintf "[%s] %s" repository.full_name title);
+    text = Some (Mrkdwn.mrkdwn_of_markdown body);
+  }
+
 let populate_commit repository (commit : api_commit) =
   let ({ sha; commit; url; author; files; _ } : api_commit) = commit in
   let title =