add rg option for filtering

lib/configuration/command_configuration.ml

@@ -226,6 +226,8 @@ type user_input_options =
   ; exclude_file_prefix : string list
   ; custom_matcher : string option
   ; override_matcher : string option
+  ; regex_pattern : bool
+  ; ripgrep_args : string option
   }
 
 type run_options =
@@ -647,6 +649,26 @@ let select_matcher custom_matcher override_matcher file_filters omega =
   else
     of_extension engine file_filters
 
+let regex_of_specifications specifications =
+  Format.sprintf "(%s)"
+  @@ String.concat ~sep:")|("
+  @@ List.map specifications ~f:Specification.to_regex
+
+let ripgrep_file_filters specifications args : string list =
+  let regex = regex_of_specifications specifications in
+  let args =
+    String.split_on_chars args ~on:[' '; '\t'; '\r'; '\n']
+    |> List.filter ~f:(String.(<>) "")
+  in
+  let result = Ripgrep.run ~pattern:regex ~args in
+  match result with
+  | Ok result ->
+    if debug then Format.printf "Ripgrep result: %s@." @@ String.concat ~sep:"\n" result;
+    result
+  | Error e ->
+    Format.eprintf "%s@." (Error.to_string_hum e);
+    exit 1
+
 let create
     ({ input_options =
          { rule
@@ -662,6 +684,8 @@ let create
          ; exclude_file_prefix
          ; custom_matcher
          ; override_matcher
+         ; regex_pattern
+         ; ripgrep_args
          }
      ; run_options =
          { sequential
@@ -713,7 +737,8 @@ let create
         { spec with match_template =
                       String.substr_replace_all match_template ~pattern:"..." ~with_:":[_]" })
   in
-  let file_filters =
+  if regex_pattern then (Format.printf "%s@." (regex_of_specifications specifications); exit 0);
+  let file_filters_from_anonymous_args =
     match anonymous_arguments with
     | None -> file_filters
     | Some { file_filters = None; _ } -> file_filters
@@ -724,6 +749,11 @@ let create
       | None ->
         Some anonymous_file_filters
   in
+  let file_filters =
+    match ripgrep_args with
+    | Some args -> Some (ripgrep_file_filters specifications args)
+    | None -> file_filters_from_anonymous_args
+  in
   let input_source =
     match stdin, zip_file with
     | true, _ -> Stdin

lib/configuration/command_configuration.mli

@@ -53,6 +53,8 @@ type user_input_options =
   ; exclude_file_prefix : string list
   ; custom_matcher : string option
   ; override_matcher : string option
+  ; regex_pattern : bool
+  ; ripgrep_args : string option
   }
 
 type run_options =

lib/configuration/dune

@@ -2,4 +2,4 @@
   (name configuration)
   (public_name comby.configuration)
   (preprocess (pps ppx_deriving.show ppx_sexp_conv ppx_sexp_message ppx_deriving_yojson bisect_ppx --conditional))
-  (libraries camlzip comby.statistics comby.parsers comby.match comby.language ppxlib core core.uuid mparser mparser.pcre yojson ppx_deriving_yojson hack_parallel toml))
+  (libraries camlzip comby.statistics comby.parsers comby.match comby.language ppxlib core core.uuid mparser mparser.pcre yojson ppx_deriving_yojson hack_parallel toml lwt lwt.unix))

lib/configuration/ripgrep.ml

@@ -0,0 +1,27 @@
+open Core
+open Lwt
+
+let debug =
+  Sys.getenv "DEBUG_COMBY"
+  |> Option.is_some
+
+let run ~pattern ~args =
+  let options = ["--files-with-matches"; "--multiline"] in
+  let pattern = Format.sprintf {|'%s'|} pattern in
+  let command = ("rg" :: options @ args @ [pattern]) |> String.concat ~sep:" " in
+  if debug then Format.printf "Executing: %s@." command;
+  let lwt_command = Lwt_process.shell command in
+  let recv proc =
+    let ic = proc#stdout in
+    Lwt.finalize
+      (fun () -> Lwt_io.read ic)
+      (fun () -> Lwt_io.close ic)
+  in
+  let f () =
+    Lwt_process.with_process_in lwt_command (fun proc ->
+        recv proc >>= fun result ->
+        proc#status >>= function
+        | WEXITED v when v <> 0 -> return @@ Or_error.errorf "Error executing rg, exit status %d." v
+        | _ -> return (Ok (String.split ~on:'\n' result |> List.filter ~f:(String.(<>) ""))))
+  in
+  try Lwt_main.run (f ()) with Sys.Break -> exit 0

lib/configuration/ripgrep.mli

@@ -0,0 +1,6 @@
+open Core
+
+(* [run pattern args] accepts a [pattern] and list of extra ripgrep-compatible
+   arguments [args], for example, ["-g"; "*.go"; "-g"; "*.ts"]. Returns a list
+   of files if the commands succeeds. *)
+val run : pattern:string -> args:string list -> string list Or_error.t

lib/configuration/specification.ml

@@ -1,3 +1,6 @@
+open Core
+open Angstrom
+
 open Language
 
 type t =
@@ -6,5 +9,133 @@ type t =
   ; rewrite_template : string option
   }
 
+let (|>>) p f =
+  p >>= fun x -> return (f x)
+
+let alphanum =
+  satisfy (function
+      | 'a' .. 'z'
+      | 'A' .. 'Z'
+      | '0' .. '9' -> true
+      | _ -> false)
+
+let blank =
+  choice
+    [ char ' '
+    ; char '\t'
+    ]
+
+let identifier_parser () =
+  many (alphanum <|> char '_')
+  |>> String.of_char_list
+
+let single_hole_parser () =
+  string ":[[" *> identifier_parser () <* string "]]" |>> fun _ -> None
+
+let everything_hole_parser () =
+  string ":[" *> identifier_parser () <* string "]" |>> fun _ -> None
+
+let expression_hole_parser () =
+  string ":[" *> identifier_parser () <* string ":e" <* string "]" |>> fun _ -> None
+
+let non_space_hole_parser () =
+  string ":[" *> identifier_parser () <* string ".]" |>> fun _ -> None
+
+let line_hole_parser () =
+  string ":[" *> identifier_parser () <* string "\\n]" |>> fun _ -> None
+
+let blank_hole_parser () =
+  string ":["
+  *> many1 blank
+  *> identifier_parser ()
+  <* string "]"
+  |>> fun _ -> None
+
+let any_char_except ~reserved =
+  List.fold reserved
+    ~init:(return `OK)
+    ~f:(fun acc reserved_sequence ->
+        option `End_of_input
+          (peek_string (String.length reserved_sequence)
+           >>= fun s ->
+           if String.equal s reserved_sequence then
+             return `Reserved_sequence
+           else
+             acc))
+  >>= function
+  | `OK -> any_char
+  | `End_of_input -> any_char
+  | `Reserved_sequence -> fail "reserved sequence hit"
+
+let regex_body () =
+  fix (fun expr ->
+      (choice
+         [ ((char '[' *> (many1 expr) <* char ']')
+            |>> fun char_class -> Format.sprintf "[%s]" @@ String.concat char_class)
+         ; (char '\\' *> any_char |>> fun c -> (Format.sprintf "\\%c" c))
+         ; ((any_char_except ~reserved:["]"])) |>> Char.to_string
+         ]
+      ))
+
+let regex_hole_parser () =
+  string ":["
+  *> identifier_parser ()
+  *> char '~'
+  *> (many1 @@ regex_body ()) >>= fun regex ->
+  string "]" >>= fun _ -> return (Some (String.concat regex))
+
+type extracted =
+  | Regex of string
+  | Constant of string
+
+let extract : extracted list Angstrom.t =
+  let hole =
+    choice
+      [ single_hole_parser ()
+      ; everything_hole_parser ()
+      ; expression_hole_parser ()
+      ; non_space_hole_parser ()
+      ; line_hole_parser ()
+      ; blank_hole_parser ()
+      ; regex_hole_parser ()
+      ]
+  in
+  many @@ choice
+    [ (hole >>= fun v -> return (Option.map v ~f:(fun v -> Regex v)))
+    ; ((many1 @@ any_char_except ~reserved:[":["])) >>= fun c ->
+      return (Some (Constant (String.of_char_list c)))
+    ]
+  >>= fun result -> return (List.filter_opt result)
+
+let escape s =
+  let rec aux chars =
+    match chars with
+    | [] -> []
+    | x :: xs ->
+      match x with
+      | '\\' | '.' | '+' | '*' | '?' | '(' | ')' | '|' | '[' | ']' | '{' | '}' | '^' | '$' as c ->
+        '\\' :: c :: (aux xs)
+      | c -> c :: (aux xs)
+  in
+  aux (String.to_list s)
+  |> String.of_char_list
+
+let to_regex { match_template; _ } =
+  let state = Buffered.parse extract in
+  let state = Buffered.feed state (`String match_template) in
+  let extracted =
+    match Buffered.feed state `Eof with
+    | Buffered.Done (_, result) -> result
+    | _ -> failwith "Could not parse template for ripgrep"
+  in
+  (* Escape regex metachars *)
+  let extracted = List.map extracted ~f:(function | Constant s -> escape s | Regex s -> s) in
+  (* Replace contiguous spaces with the regex \s+ *)
+  let match_spaces = Str.regexp "[ \t\r\n]+" in
+  let extracted = List.map extracted ~f:(fun part -> Str.global_replace match_spaces {|\s+|} part) in
+  (* ?s is modifier metasyntax where . matches all chars including newlines. See
+     regular-expressions.info/modifier.html *)
+  Format.sprintf "(%s)" @@ String.concat extracted ~sep:")(?s:.)*?("
+
 let create ?rewrite_template ?rule ~match_template () =
   { match_template; rule; rewrite_template }

src/main.ml

@@ -104,6 +104,8 @@ let base_command_parameters : (unit -> 'result) Command.Param.t =
     and omega = flag "omega" no_arg  ~doc:"Use Omega matcher engine."
     and fast_offset_conversion = flag "fast-offset-conversion" no_arg ~doc:"Enable fast offset conversion. This is experimental and will become the default once vetted."
     and match_newline_toplevel = flag "match-newline-at-toplevel" no_arg ~aliases:[] ~doc:"Enable matching newlines at the top level for :[hole]."
+    and regex_pattern = flag "regex" no_arg ~doc:"print a regex that a file must satisfy in order for a pattern to be run"
+    and ripgrep_args = flag "ripgrep" (optional string) ~aliases:["rg"] ~doc:"flags Activate ripgrep for filtering files. Add flags like '-g *.go' to include or exclude file extensions."
     and anonymous_arguments =
       anon
         (maybe
@@ -193,6 +195,8 @@ let base_command_parameters : (unit -> 'result) Command.Param.t =
             ; exclude_file_prefix
             ; custom_matcher
             ; override_matcher
+            ; regex_pattern
+            ; ripgrep_args
             }
         ; run_options =
             { sequential

test/common/dune

@@ -2,6 +2,7 @@
  (name common_test_integration)
  (modules
   test_helpers
+  test_extract_regex
   test_alpha
   test_omega
   test_cli

test/common/test_extract_regex.ml

@@ -0,0 +1,10 @@
+open Core
+
+open Configuration
+
+let%expect_test "basic" =
+  let match_template = "for :[i], :[x] := range :[list] {:[body]}" in
+  let spec = Specification.create ~match_template () in
+  let result = Specification.to_regex spec in
+  print_string result;
+  [%expect_exact {|(for\s+)(?s:.)*?(,\s+)(?s:.)*?(\s+:=\s+range\s+)(?s:.)*?(\s+\{)(?s:.)*?(\})|}];