mbarbin / crs / 97

Committed 22 Jun 2025 01:37AM UTC coverage: 97.54% (-2.5%) from 100.0%

Build # 97

Build Type

Pull #36

github

Committed by

web-flow

Commit Message

Merge 6fb89cb70 into f32812f9e

Pull Request Pull Request #36: GitHub Workflow Annotations (experimental)

Run Details

3 of 23 new or added lines in 1 file covered. (13.04%)

793 of 813 relevant lines covered (97.54%)

29.32 hits per line

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

13.04

/lib/crs_cli/src/cmd__tools__github_workflow_annotations.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.        *)
(********************************************************************************)

(* CR mbarbin: After an initial experimentation, create an typed API to manage
   annotations. *)

(* CR-mbarbin: This is an invalid CR to try it out in the CI. *)

(* Example:
   {[
     ::notice file={name},line={line},endLine={endLine},title={title}::{message}
     ::warning file={name},line={line},endLine={endLine},title={title}::{message}
   ]}
*)

let main =
  Command.make
    ~summary:"Output GitHub Workflow Annotations for CRs in the repo."
    ~readme:(fun () ->
      {|
This command searches for CRs in the tree and prints GitHub Workflow Annotations for them to $(b,stdout) for use in CIs.
|})
    (let open Command.Std in
     let+ () = Arg.return () in
     let cwd = Unix.getcwd () |> Absolute_path.v in
     let { Enclosing_repo.vcs_kind = _; repo_root; vcs } =
       Common_helpers.find_enclosing_repo ~from:cwd
     in
     let crs =
       Crs_parser.grep ~vcs ~repo_root ~below:Vcs.Path_in_repo.root |> Cr_comment.sort
     in
     List.iter crs ~f:(fun cr ->
       match Cr_comment.work_on cr with
       | Soon | Someday -> ()
       | Now ->
         let level =
           match Cr_comment.header cr with
           | Error _ -> `Invalid
           | Ok _ -> `Now
         in
         let annotation =
           match level with
           | `Invalid -> "warning"
           | `Now -> "notice"
         in
         let title =
           match level with
           | `Invalid -> "Invalid CR"
           | `Now -> "Pending CR"
         in
         let message =
           match level with
           | `Invalid -> "This CR is not well formatted. Please attend."
           | `Now -> "This CR is pending. Please attend."
         in
         let start_pos = Cr_comment.whole_loc cr |> Loc.start in
         print_endline
           (Printf.sprintf
              "::%s file=%s,line=%d,col=%d,title=%s::%s"
              annotation
              (Vcs.Path_in_repo.to_string (Cr_comment.path cr))
              start_pos.pos_lnum
              (start_pos.pos_cnum - start_pos.pos_bol + 1)
              title
              message);
         ());
     ())
;;

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	(* CR mbarbin: After an initial experimentation, create an typed API to manage
23	annotations. *)
24
25	(* CR-mbarbin: This is an invalid CR to try it out in the CI. *)
26
27	(* Example:
28	{[
29	::notice file={name},line={line},endLine={endLine},title={title}::{message}
30	::warning file={name},line={line},endLine={endLine},title={title}::{message}
31	]}
32	*)
33
34	let main =
35	Command.make	33✔
36	~summary:"Output GitHub Workflow Annotations for CRs in the repo."
37	~readme:(fun () ->
38	{\|	32✔
39	This command searches for CRs in the tree and prints GitHub Workflow Annotations for them to $(b,stdout) for use in CIs.
40	\|})
41	(let open Command.Std in
42	let+ () = Arg.return () in	33✔
NEW 43	let cwd = Unix.getcwd () \|> Absolute_path.v in	×
NEW 44	let { Enclosing_repo.vcs_kind = _; repo_root; vcs } =	×
45	Common_helpers.find_enclosing_repo ~from:cwd
46	in
47	let crs =
48	Crs_parser.grep ~vcs ~repo_root ~below:Vcs.Path_in_repo.root \|> Cr_comment.sort
49	in
NEW 50	List.iter crs ~f:(fun cr ->	×
NEW 51	match Cr_comment.work_on cr with	×
NEW 52	\| Soon \| Someday -> ()	×
NEW 53	\| Now ->	×
54	let level =
55	match Cr_comment.header cr with
NEW 56	\| Error _ -> `Invalid	×
NEW 57	\| Ok _ -> `Now	×
58	in
59	let annotation =
60	match level with
NEW 61	\| `Invalid -> "warning"	×
NEW 62	\| `Now -> "notice"	×
63	in
64	let title =
65	match level with
NEW 66	\| `Invalid -> "Invalid CR"	×
NEW 67	\| `Now -> "Pending CR"	×
68	in
69	let message =
70	match level with
NEW 71	\| `Invalid -> "This CR is not well formatted. Please attend."	×
NEW 72	\| `Now -> "This CR is pending. Please attend."	×
73	in
NEW 74	let start_pos = Cr_comment.whole_loc cr \|> Loc.start in	×
NEW 75	print_endline	×
NEW 76	(Printf.sprintf	×
77	"::%s file=%s,line=%d,col=%d,title=%s::%s"
78	annotation
NEW 79	(Vcs.Path_in_repo.to_string (Cr_comment.path cr))	×
80	start_pos.pos_lnum
81	(start_pos.pos_cnum - start_pos.pos_bol + 1)
82	title
83	message);
NEW 84	());	×
NEW 85	())	×
86	;;

mbarbin / crs / 97

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