Source file annotation.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
(********************************************************************************)
(*  crs - A tool for managing code review comments embedded in source code      *)
(*  Copyright (C) 2024-2025 Mathieu Barbin <mathieu.barbin@gmail.com>           *)
(*                                                                              *)
(*  This file is part of crs.                                                   *)
(*                                                                              *)
(*  crs is free software; you can redistribute it and/or modify it under the    *)
(*  terms of the GNU Lesser General Public License as published by the Free     *)
(*  Software Foundation either version 3 of the License, or any later version,  *)
(*  with the LGPL-3.0 Linking Exception.                                        *)
(*                                                                              *)
(*  crs is distributed in the hope that it will be useful, but WITHOUT ANY      *)
(*  WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS   *)
(*  FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and     *)
(*  the file `NOTICE.md` at the root of this repository for more details.       *)
(*                                                                              *)
(*  You should have received a copy of the GNU Lesser General Public License    *)
(*  and the LGPL-3.0 Linking Exception along with this library. If not, see     *)
(*  <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively.        *)
(********************************************************************************)

open! Import

module Severity = struct
  type t = Config.Annotation_severity.t =
    | Error
    | Warning
    | Info
  [@@deriving enumerate, sexp_of]

  let to_string t =
    match sexp_of_t t with
    | Atom s -> s
    | List _ -> assert false
  ;;

  let to_github : t -> Github_annotation.Severity.t = function
    | Error -> Error
    | Warning -> Warning
    | Info -> Notice
  ;;

  let to_reviewdog : t -> Reviewdog.Severity.t = function
    | Error -> Error
    | Warning -> Warning
    | Info -> Info
  ;;
end

type t =
  { cr : Cr_comment.t
  ; severity : Severity.t
  ; assignee : Assignee.t
  ; with_user_mention : bool
  ; title : string
  ; message : string
  }
[@@deriving sexp_of]

let message t = t.message
let severity t = t.severity
let assignee t = t.assignee
let with_user_mention t = t.with_user_mention

let write_username ~user ~with_user_mention =
  (if with_user_mention then "@" else "") ^ Vcs.User_handle.to_string user
;;

let of_cr ~cr ~(config : Config.t) ~review_mode ~with_user_mentions =
  match Cr_comment.priority cr with
  | Soon | Someday -> None
  | Now ->
    let header = Cr_comment.header cr in
    let severity : Severity.t =
      match header with
      | Error _ ->
        Option.value (Config.invalid_crs_annotation_severity config) ~default:Warning
      | Ok _ -> Option.value (Config.crs_due_now_annotation_severity config) ~default:Info
    in
    let title =
      match header with
      | Error _ -> "Invalid CR"
      | Ok h -> Cr_comment.Status.to_string (Cr_comment.Header.status h)
    in
    let assignee = Assignee.compute ~cr ~config ~review_mode in
    let with_user_mention =
      match with_user_mentions with
      | false -> false
      | true ->
        (match assignee.user with
         | None -> false
         | Some user ->
           (match Config.user_mentions_allowlist config with
            | None -> false
            | Some list -> List.mem list user ~equal:Vcs.User_handle.equal))
    in
    let message =
      String.concat
        ~sep:" "
        [ "This"
        ; (match header with
           | Error _ -> "invalid CR"
           | Ok h -> Cr_comment.Status.to_string (Cr_comment.Header.status h))
        ; "is"
        ; (match assignee.user with
           | None -> "unassigned"
           | Some user ->
             Printf.sprintf "assigned to %s" (write_username ~user ~with_user_mention))
        ; Printf.sprintf "(%s)." (Assignee.Reason.to_string_hum assignee.reason)
        ]
    in
    Some { cr; severity; assignee; with_user_mention; title; message }
;;

let to_github_annotation t : Github_annotation.t =
  Github_annotation.create
    ~loc:(Cr_comment.whole_loc t.cr)
    ~severity:(Severity.to_github t.severity)
    ~title:t.title
    ~message:t.message
;;

let to_reviewdog_diagnostic t : Reviewdog.Diagnostic.t =
  { Reviewdog.Diagnostic.message = t.message
  ; location = Cr_comment.whole_loc t.cr |> Reviewdog_utils.make_location
  ; severity = Some (Severity.to_reviewdog t.severity)
  ; source = None
  ; code = None
  ; suggestions = []
  ; original_output = Some (Cr_comment.reindented_content t.cr)
  ; related_locations = []
  }
;;