mbarbin / crs / 276

Committed 22 Dec 2025 10:00AM UTC coverage: 99.845%. First build

Build # 276

Build Type

Pull #105

github

Committed by

web-flow

Commit Message

Merge 1066537ea into 88abc0f42

Pull Request Pull Request #105: Remove some ppx deps

Run Details

35 of 38 new or added lines in 5 files covered. (92.11%)

1929 of 1932 relevant lines covered (99.84%)

140.92 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

97.33

/lib/crs_cli/src/summary_table.ml

(********************************************************************************)
(*  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.        *)
(********************************************************************************)

module By_type = struct
  module Type = struct
    type t =
      | Invalid
      | CR
      | XCR
      | Soon
      | Someday

    let variant_constructor_name = function
      | Invalid -> "Invalid"
      | CR -> "CR"
      | XCR -> "XCR"
      | Soon -> "Soon"
      | Someday -> "Someday"
    ;;

    let variant_constructor_rank = function
      | Invalid -> 0
      | CR -> 1
      | XCR -> 2
      | Soon -> 3
      | Someday -> 4
    ;;

    let compare t1 t2 =
      Int.compare (variant_constructor_rank t1) (variant_constructor_rank t2)
    ;;

    let to_string = variant_constructor_name

    let of_cr (cr : Cr_comment.t) =
      match Cr_comment.header cr with
      | Error _ -> Invalid
      | Ok h ->
        (match Cr_comment.Header.status h with
         | XCR -> XCR
         | CR ->
           (match Cr_comment.Header.qualifier h with
            | None -> CR
            | Soon -> Soon
            | Someday -> Someday))
    ;;
  end

  module Row = struct
    type t =
      { type_ : Type.t
      ; count : int
      }
  end

  type t = { rows : Row.t list }

  let make (crs : Cr_comment.t list) =
    let rows =
      List.map crs ~f:Type.of_cr
      |> List.sort_and_group ~compare:Type.compare
      |> List.map ~f:(function
        | [] -> assert false
        | type_ :: _ as list -> { Row.type_; count = List.length list })
    in
    { rows }
  ;;

  let columns =
    Print_table.O.
      [ Column.make ~header:"CR Type" (fun (row : Row.t) ->
          Cell.text (Type.to_string row.type_))
      ; Column.make ~header:"Count" ~align:Right (fun (row : Row.t) ->
          Cell.text
            ~style:
              (match row.type_ with
               | Invalid -> Style.fg_red
               | CR | XCR | Soon | Someday -> Style.default)
            (Base.Int.to_string_hum row.count))
      ]
  ;;

  let to_print_table t =
    if List.is_empty t.rows then None else Some (Print_table.make ~columns ~rows:t.rows)
  ;;
end

module Type = struct
  type t =
    | CR
    | XCR
    | Soon
    | Someday

  let of_header h =
    match Cr_comment.Header.status h with
    | XCR -> XCR
    | CR ->
      (match Cr_comment.Header.qualifier h with
       | None -> CR
       | Soon -> Soon
       | Someday -> Someday)
  ;;
end

module Key = struct
  type t =
    { reporter : Vcs.User_handle.t
    ; recipient : Vcs.User_handle.t option
    }

  let compare t ({ reporter; recipient } as t2) =
    if phys_equal t t2
    then 0
    else (
      let r = Vcs.User_handle.compare t.reporter reporter in
      if r <> 0 then r else Option.compare Vcs.User_handle.compare t.recipient recipient)
  ;;

  let of_header (h : Cr_comment.Header.t) =
    { reporter = Cr_comment.Header.reporter h; recipient = Cr_comment.Header.recipient h }
  ;;
end

module Row = struct
  type t =
    { reporter : Vcs.User_handle.t
    ; recipient : Vcs.User_handle.t option
    ; cr_count : int
    ; xcr_count : int
    ; soon_count : int
    ; someday_count : int
    ; total_count : int
    }
end

type t = { rows : Row.t list }

let make (crs : Cr_comment.t list) =
  let rows =
    List.filter_map crs ~f:(fun cr ->
      match Cr_comment.header cr with
      | Error _ -> None
      | Ok h ->
        let key = Key.of_header h in
        let type_ = Type.of_header h in
        Some (key, type_))
    |> List.sort_and_group ~compare:(fun (k1, _) (k2, _) -> Key.compare k1 k2)
    |> List.map ~f:(function
      | [] -> assert false
      | ({ Key.reporter; recipient }, _) :: _ as list ->
        let cr_count = ref 0 in
        let xcr_count = ref 0 in
        let soon_count = ref 0 in
        let someday_count = ref 0 in
        let total_count = ref 0 in
        List.iter list ~f:(fun (_, type_) ->
          Int.incr total_count;
          match (type_ : Type.t) with
          | CR -> Int.incr cr_count
          | XCR -> Int.incr xcr_count
          | Soon -> Int.incr soon_count
          | Someday -> Int.incr someday_count);
        { Row.reporter
        ; recipient
        ; cr_count = !cr_count
        ; xcr_count = !xcr_count
        ; soon_count = !soon_count
        ; someday_count = !someday_count
        ; total_count = !total_count
        })
  in
  { rows }
;;

let columns =
  let count ~header count =
    Print_table.O.(
      Column.make ~header ~align:Right (fun (row : Row.t) ->
        let count = count row in
        if count = 0 then Cell.empty else Cell.text (Base.Int.to_string_hum count)))
  in
  Print_table.O.
    [ Column.make ~header:"Reporter" (fun (row : Row.t) ->
        Cell.text (Vcs.User_handle.to_string row.reporter))
    ; Column.make ~header:"For" (fun (row : Row.t) ->
        match row.recipient with
        | None -> Cell.empty
        | Some user -> Cell.text (Vcs.User_handle.to_string user))
    ; count ~header:"CRs" (fun row -> row.cr_count)
    ; count ~header:"XCRs" (fun row -> row.xcr_count)
    ; count ~header:"Soon" (fun row -> row.soon_count)
    ; count ~header:"Someday" (fun row -> row.someday_count)
    ; count ~header:"Total" (fun row -> row.total_count)
    ]
;;

let to_print_table t =
  if List.is_empty t.rows then None else Some (Print_table.make ~columns ~rows:t.rows)
;;

1	(********************************************************************************)
2	(* crs - A tool for managing code review comments embedded in source code *)
3	(* Copyright (C) 2024-2025 Mathieu Barbin <mathieu.barbin@gmail.com> *)
4	(* *)
5	(* This file is part of crs. *)
6	(* *)
7	(* crs is free software; you can redistribute it and/or modify it under the *)
8	(* terms of the GNU Lesser General Public License as published by the Free *)
9	(* Software Foundation either version 3 of the License, or any later version, *)
10	(* with the LGPL-3.0 Linking Exception. *)
11	(* *)
12	(* crs is distributed in the hope that it will be useful, but WITHOUT ANY *)
13	(* WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS *)
14	(* FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License and *)
15	(* the file `NOTICE.md` at the root of this repository for more details. *)
16	(* *)
17	(* You should have received a copy of the GNU Lesser General Public License *)
18	(* and the LGPL-3.0 Linking Exception along with this library. If not, see *)
19	(* <http://www.gnu.org/licenses/> and <https://spdx.org>, respectively. *)
20	(********************************************************************************)
21
22	module By_type = struct
23	module Type = struct
24	type t =
25	\| Invalid
26	\| CR
27	\| XCR
28	\| Soon
29	\| Someday
30
31	let variant_constructor_name = function
32	\| Invalid -> "Invalid"	2✔
33	\| CR -> "CR"	5✔
34	\| XCR -> "XCR"	5✔
35	\| Soon -> "Soon"	3✔
36	\| Someday -> "Someday"	2✔
37	;;
38
39	let variant_constructor_rank = function
40	\| Invalid -> 0	14✔
41	\| CR -> 1	49✔
42	\| XCR -> 2	16✔
43	\| Soon -> 3	14✔
44	\| Someday -> 4	7✔
45	;;
46
47	let compare t1 t2 =
48	Int.compare (variant_constructor_rank t1) (variant_constructor_rank t2)	50✔
49	;;
50
51	let to_string = variant_constructor_name
52
53	let of_cr (cr : Cr_comment.t) =
54	match Cr_comment.header cr with	26✔
55	\| Error _ -> Invalid	4✔
56	\| Ok h ->	22✔
57	(match Cr_comment.Header.status h with
58	\| XCR -> XCR	5✔
59	\| CR ->	17✔
60	(match Cr_comment.Header.qualifier h with
61	\| None -> CR	12✔
62	\| Soon -> Soon	3✔
63	\| Someday -> Someday))	2✔
64	;;
65	end
66
67	module Row = struct
68	type t =
69	{ type_ : Type.t
70	; count : int
71	}
72	end
73
74	type t = { rows : Row.t list }
75
76	let make (crs : Cr_comment.t list) =
77	let rows =	9✔
78	List.map crs ~f:Type.of_cr
79	\|> List.sort_and_group ~compare:Type.compare	9✔
80	\|> List.map ~f:(function	9✔
81	\| [] -> assert false
82	\| type_ :: _ as list -> { Row.type_; count = List.length list })	17✔
83	in
84	{ rows }	9✔
85	;;
86
87	let columns =
88	Print_table.O.
89	[ Column.make ~header:"CR Type" (fun (row : Row.t) ->	98✔
90	Cell.text (Type.to_string row.type_))	17✔
91	; Column.make ~header:"Count" ~align:Right (fun (row : Row.t) ->	98✔
92	Cell.text	17✔
93	~style:
94	(match row.type_ with
95	\| Invalid -> Style.fg_red	2✔
96	\| CR \| XCR \| Soon \| Someday -> Style.default)	2✔
97	(Base.Int.to_string_hum row.count))	17✔
98	]
99	;;
100
101	let to_print_table t =
102	if List.is_empty t.rows then None else Some (Print_table.make ~columns ~rows:t.rows)	2✔
103	;;
104	end
105
106	module Type = struct
107	type t =
108	\| CR
109	\| XCR
110	\| Soon
111	\| Someday
112
113	let of_header h =
114	match Cr_comment.Header.status h with	36✔
115	\| XCR -> XCR	10✔
116	\| CR ->	26✔
117	(match Cr_comment.Header.qualifier h with
118	\| None -> CR	16✔
119	\| Soon -> Soon	6✔
120	\| Someday -> Someday)	4✔
121	;;
122	end
123
124	module Key = struct
125	type t =
126	{ reporter : Vcs.User_handle.t
127	; recipient : Vcs.User_handle.t option
128	}
129
130	let compare t ({ reporter; recipient } as t2) =
131	if phys_equal t t2	74✔
NEW 132	then 0	×
133	else (	74✔
134	let r = Vcs.User_handle.compare t.reporter reporter in
NEW 135	if r <> 0 then r else Option.compare Vcs.User_handle.compare t.recipient recipient)	×
136	;;
137
138	let of_header (h : Cr_comment.Header.t) =
139	{ reporter = Cr_comment.Header.reporter h; recipient = Cr_comment.Header.recipient h }	36✔
140	;;
141	end
142
143	module Row = struct
144	type t =
145	{ reporter : Vcs.User_handle.t
146	; recipient : Vcs.User_handle.t option
147	; cr_count : int
148	; xcr_count : int
149	; soon_count : int
150	; someday_count : int
151	; total_count : int
152	}
153	end
154
155	type t = { rows : Row.t list }
156
157	let make (crs : Cr_comment.t list) =
158	let rows =	13✔
159	List.filter_map crs ~f:(fun cr ->
160	match Cr_comment.header cr with	43✔
161	\| Error _ -> None	7✔
162	\| Ok h ->	36✔
163	let key = Key.of_header h in
164	let type_ = Type.of_header h in	36✔
165	Some (key, type_))	36✔
166	\|> List.sort_and_group ~compare:(fun (k1, _) (k2, _) -> Key.compare k1 k2)	13✔
167	\|> List.map ~f:(function	13✔
168	\| [] -> assert false
169	\| ({ Key.reporter; recipient }, _) :: _ as list ->	20✔
170	let cr_count = ref 0 in
171	let xcr_count = ref 0 in
172	let soon_count = ref 0 in
173	let someday_count = ref 0 in
174	let total_count = ref 0 in
175	List.iter list ~f:(fun (_, type_) ->
176	Int.incr total_count;	36✔
177	match (type_ : Type.t) with	36✔
178	\| CR -> Int.incr cr_count	16✔
179	\| XCR -> Int.incr xcr_count	10✔
180	\| Soon -> Int.incr soon_count	6✔
181	\| Someday -> Int.incr someday_count);	4✔
182	{ Row.reporter	20✔
183	; recipient
184	; cr_count = !cr_count
185	; xcr_count = !xcr_count
186	; soon_count = !soon_count
187	; someday_count = !someday_count
188	; total_count = !total_count
189	})
190	in
191	{ rows }	13✔
192	;;
193
194	let columns =
195	let count ~header count =
196	Print_table.O.(	490✔
197	Column.make ~header ~align:Right (fun (row : Row.t) ->
198	let count = count row in	130✔
199	if count = 0 then Cell.empty else Cell.text (Base.Int.to_string_hum count)))	55✔
200	in
201	Print_table.O.
202	[ Column.make ~header:"Reporter" (fun (row : Row.t) ->	98✔
203	Cell.text (Vcs.User_handle.to_string row.reporter))	26✔
204	; Column.make ~header:"For" (fun (row : Row.t) ->	98✔
205	match row.recipient with	26✔
206	\| None -> Cell.empty	13✔
207	\| Some user -> Cell.text (Vcs.User_handle.to_string user))	13✔
208	; count ~header:"CRs" (fun row -> row.cr_count)	26✔
209	; count ~header:"XCRs" (fun row -> row.xcr_count)	26✔
210	; count ~header:"Soon" (fun row -> row.soon_count)	26✔
211	; count ~header:"Someday" (fun row -> row.someday_count)	26✔
212	; count ~header:"Total" (fun row -> row.total_count)	26✔
213	]
214	;;
215
216	let to_print_table t =
217	if List.is_empty t.rows then None else Some (Print_table.make ~columns ~rows:t.rows)	3✔
218	;;

mbarbin / crs / 276

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous