Factor out shared rewrite pipeline for CLI and server

lib/dune

@@ -7,9 +7,10 @@
    core 
    mparser 
    mparser.pcre 
+   comby.language
+   comby.match
    comby.matchers
+   comby.pipeline
    comby.replacement
    comby.rewriter
-   comby.match
-   comby.language
    comby.statistics))

lib/language/rule.ml

@@ -10,6 +10,8 @@ open Rewriter
 open Ast
 open Parser
 
+type t = Ast.t
+
 type result = bool * environment option
 
 let sat = fst

lib/language/rule.mli

@@ -5,6 +5,8 @@ open Match
 
 open Ast
 
+type t = Ast.t
+
 type result = bool * environment option
 
 val sat : result -> bool

lib/matchers/matcher.ml

@@ -318,10 +318,9 @@ module Make (Syntax : Syntax.S) (Info : Info.S) = struct
          let environment =
            if Environment.exists environment identifier then
              let fresh_hole_id =
-               Format.sprintf "equal_%s_%s" identifier Uuid_unix.(Fn.compose Uuid.to_string create ())
+               Format.sprintf "equal~%s_%s" identifier Uuid_unix.(Fn.compose Uuid.to_string create ())
              in
-             (
-               Environment.add ~range environment fresh_hole_id (String.concat matched))
+             Environment.add ~range environment fresh_hole_id (String.concat matched)
            else
              Environment.add ~range environment identifier (String.concat matched)
          in

lib/pipeline/dune

@@ -0,0 +1,5 @@
+(library
+  (name pipeline)
+  (public_name comby.pipeline)
+  (preprocess (pps ppx_deriving.show ppx_sexp_conv ppx_sexp_message ppx_deriving_yojson bisect_ppx -conditional -no-comment-parsing))
+  (libraries comby.parsers comby.match comby.language ppxlib core core.uuid mparser mparser.pcre yojson ppx_deriving_yojson))

lib/pipeline/pipeline.ml

@@ -0,0 +1,32 @@
+open Core
+
+open Match
+open Language
+
+let infer_equality_constraints environment =
+  let vars = Environment.vars environment in
+  List.fold vars ~init:[] ~f:(fun acc var ->
+      if String.is_prefix var ~prefix:"equal~" then
+        match String.split var ~on:'~' with
+        | _equal :: target :: _uuid ->
+          let expression = Language.Ast.Equal (Variable var, Variable target) in
+          expression::acc
+        | _ -> acc
+      else
+        acc)
+
+let apply_rule ?(newline_separated = false) matcher rule matches =
+  let open Option in
+  List.filter_map matches ~f:(fun ({ environment; _ } as matched) ->
+      let rule = rule @ infer_equality_constraints environment in
+      let sat, env =  Rule.apply ~newline_separated ~matcher rule environment in
+      (if sat then env else None)
+      >>| fun environment -> { matched with environment })
+
+let run
+    ((module Matcher : Matchers.Matcher) as matcher)
+    ?newline_separated ?rule configuration template source =
+  let matches = Matcher.all ~configuration ~template ~source in
+  match rule with
+  | Some rule -> apply_rule ?newline_separated matcher rule matches
+  | None -> matches

src/command_configuration.ml

@@ -78,6 +78,14 @@ let parse_template_directories paths =
       None
     | Some match_template ->
       let rule = read_optional (path ^/ "rule") in
+      let rule =
+        match Option.map rule ~f:Rule.create with
+        | None -> None
+        | Some Ok rule -> Some rule
+        | Some Error error ->
+          Format.eprintf "Rule parse error: %s@." (Error.to_string_hum error);
+          exit 1
+      in
       let rewrite_template = read_optional (path ^/ "rewrite") in
       Specification.create ~match_template ?rule ?rewrite_template ()
       |> Option.some
@@ -466,6 +474,7 @@ let create
   let open Or_error in
   validate_errors configuration >>= fun () ->
   emit_warnings configuration >>= fun () ->
+  let rule = Rule.create rule |> Or_error.ok_exn in
   let specifications =
     match specification_directories, anonymous_arguments with
     | None, Some { match_template; rewrite_template; _ } ->

src/dune

@@ -5,13 +5,13 @@
  (names main))
 
 (executables
- (libraries core opium comby ppx_deriving_yojson ppx_deriving_yojson.runtime hack_parallel)
+ (libraries comby core opium ppx_deriving_yojson ppx_deriving_yojson.runtime hack_parallel)
  (preprocess (pps ppx_deriving_yojson ppx_let ppx_deriving.show))
  (modules server)
  (names server))
 
 (executables
- (libraries core opium comby ppx_deriving_yojson ppx_deriving_yojson.runtime hack_parallel)
+ (libraries comby core opium ppx_deriving_yojson ppx_deriving_yojson.runtime hack_parallel)
  (preprocess (pps ppx_deriving_yojson ppx_let ppx_deriving.show))
  (modules benchmark)
  (names benchmark))

src/main.ml

@@ -6,8 +6,6 @@ open Hack_parallel
 open Command_configuration
 open Command_input
 open Matchers
-open Match
-open Language
 open Rewriter
 open Statistics
 
@@ -28,36 +26,6 @@ let debug =
 
 let verbose_out_file = "/tmp/comby.out"
 
-let get_matches (module Matcher : Matchers.Matcher) configuration match_template rule source =
-  let rule = Rule.create rule |> Or_error.ok_exn in
-  Matcher.all ~configuration ~template:match_template ~source
-  |> List.filter ~f:(fun { environment; _ } -> Rule.(sat @@ apply rule ~matcher:(module Matcher) environment))
-
-let apply_rewrite_rule newline_separated matcher rewrite_rule matches =
-  let open Option in
-  match rewrite_rule with
-  | "" -> matches
-  | rewrite_rule ->
-    match Rule.create rewrite_rule with
-    | Ok rule ->
-      List.filter_map matches ~f:(fun ({ environment; _ } as match_) ->
-          let inferred_equality_constraints =
-            let vars = Environment.vars environment in
-            List.fold vars ~init:[] ~f:(fun acc var ->
-                if String.is_prefix var ~prefix:"equal_" then
-                  match String.split var ~on:'_' with
-                  | _equal :: target :: _uuid ->
-                    let expression = Language.Ast.Equal (Variable var, Variable target) in
-                    expression::acc
-                  | _ -> assert false
-                else
-                  acc)
-          in
-          let sat, env = Rule.apply (rule @ inferred_equality_constraints) ~newline_separated ~matcher environment in
-          (if sat then env else None)
-          >>| fun environment -> { match_ with environment })
-    | Error _ -> []
-
 let process_single_source
     ((module Matcher : Matchers.Matcher) as matcher)
     newline_separate_rule_rewrites
@@ -83,27 +51,7 @@ let process_single_source
       } ->
       let matches =
         try
-          let f () =
-            let get_matches (module Matcher : Matchers.Matcher) configuration match_template rule source =
-              let rule = Rule.create rule |> Or_error.ok_exn in
-              Matcher.all ~configuration ~template:match_template ~source
-              |> List.filter ~f:(fun { environment; _ } ->
-                  let inferred_equality_constraints =
-                    let vars = Environment.vars environment in
-                    List.fold vars ~init:[] ~f:(fun acc var ->
-                        if String.is_prefix var ~prefix:"equal_" then
-                          match String.split var ~on:'_' with
-                          | _equal :: target :: _uuid ->
-                            let expression = Language.Ast.Equal (Variable var, Variable target) in
-                            expression::acc
-                          | _ -> assert false
-                        else
-                          acc)
-                  in
-                  Rule.(sat @@ apply (rule @ inferred_equality_constraints) ~matcher:(module Matcher) environment))
-            in
-            get_matches matcher configuration match_template rule input_text
-          in
+          let f () = Pipeline.run ?rule matcher configuration match_template input_text in
           Statistics.Time.time_out ~after:match_timeout f ();
         with Statistics.Time.Time_out ->
           Format.eprintf "Timeout for input: %s!@." (show_input_kind source);
@@ -118,11 +66,9 @@ let process_single_source
       let result =
         try
           let f () =
-            Matcher.all ~configuration ~template:match_template ~source:input_text
-            |> fun matches ->
-            (* TODO(RVT): merge match and rewrite rule application. *)
-            apply_rewrite_rule newline_separate_rule_rewrites matcher rule matches
-            |> fun matches ->
+            let matches =
+              Pipeline.run ?rule matcher ~newline_separated:newline_separate_rule_rewrites configuration match_template input_text
+            in
             if matches = [] then
               (* If there are no matches, return the original source (for editor support). *)
               Some (Some (Replacement.{ rewritten_source = input_text; in_place_substitutions = [] }), [])
@@ -130,7 +76,7 @@ let process_single_source
               Some (Rewrite.all ~source:input_text ~rewrite_template matches, matches)
           in
           Statistics.Time.time_out ~after:match_timeout f ();
-        with Statistics__Time.Time_out ->
+        with Statistics.Time.Time_out ->
           Format.eprintf "Timeout for input: %s!@." (show_input_kind source);
           Out_channel.with_file ~append:true verbose_out_file ~f:(fun out_channel ->
               Out_channel.output_lines out_channel [Format.sprintf "TIMEOUT: FOR %s@." (show_input_kind source) ]);

src/server.ml

@@ -52,40 +52,10 @@ type json_rewrite_result =
   }
 [@@deriving yojson]
 
-let get_matches (module Matcher : Matchers.Matcher) source match_template =
-  let configuration = Configuration.create ~match_kind:Fuzzy () in
-  Matcher.all ~configuration ~template:match_template ~source
-
 let matches_to_json source id matches =
   Format.sprintf "%s"
     (Yojson.Safe.pretty_to_string (json_match_result_to_yojson { matches; source; id }))
 
-let apply_rule substitute_in_place matcher rule =
-  let open Option in
-  let open Match in
-  List.filter_map ~f:(fun ({ environment; _ } as matched) ->
-      let inferred_equality_constraints =
-        let vars = Environment.vars environment in
-        List.fold vars ~init:[] ~f:(fun acc var ->
-            if String.is_prefix var ~prefix:"equal_" then
-              match String.split var ~on:'_' with
-              | _equal :: target :: _uuid ->
-                let expression = Language.Ast.Equal (Variable var, Variable target) in
-                expression::acc
-              | _ -> assert false
-            else
-              acc)
-      in
-      let sat, env =
-        Rule.apply
-          ~newline_separated:(not substitute_in_place)
-          (rule @ inferred_equality_constraints)
-          ~matcher
-          environment
-      in
-      (if sat then env else None)
-      >>| fun environment -> { matched with environment })
-
 let check_too_long s =
   let n = String.length s in
   if n > max_request_length then
@@ -111,8 +81,8 @@ let perform_match request =
     if debug then Format.printf "Received %s@." (Yojson.Safe.pretty_to_string (match_request_to_yojson request));
     let matcher = Matchers.select_with_extension language in
     let run ?rule () =
-      get_matches matcher source match_template
-      |> Option.value_map rule ~default:ident ~f:(apply_rule false matcher)
+      let configuration = Configuration.create ~match_kind:Fuzzy () in
+      Pipeline.run matcher ?rule configuration match_template source
       |> matches_to_json source id
     in
     let code, result =
@@ -163,8 +133,8 @@ let perform_rewrite request =
       |> Yojson.Safe.pretty_to_string
     in
     let run ?rule () =
-      get_matches matcher source match_template
-      |> Option.value_map rule ~default:ident ~f:(apply_rule substitute_in_place matcher)
+      let configuration = Configuration.create ~match_kind:Fuzzy () in
+      Pipeline.run matcher ?rule ~newline_separated:(not substitute_in_place) configuration match_template source
       |> Rewrite.all ?source:source_substitution ~rewrite_template
       |> Option.value_map ~default ~f:(rewrite_to_json id)
     in
@@ -202,7 +172,7 @@ let () =
   Lwt.async_exception_hook := (function
       | Unix.Unix_error (error, func, arg) ->
         Logs.warn (fun m ->
-            m  "Client connection error %s: %s(%S)"
+            m "Client connection error %s: %s(%S)"
               (Unix.error_message error) func arg
           )
       | exn -> Logs.err (fun m -> m "Unhandled exception: %a" Fmt.exn exn)

src/specification.ml

@@ -1,28 +1,23 @@
 open Core
 
+open Language
+
 type match_specification =
   { match_template : string
-  ; rule : string
+  ; rule : Rule.t option
   }
-[@@deriving show]
 
 type rewrite_specification =
   { rewrite_template : string
-  ; rule : string
+  ; rule : Rule.t option
   }
-[@@deriving show]
 
 type t =
   { match_specification : match_specification
   ; rewrite_specification : rewrite_specification option
   }
-[@@deriving show]
 
-let create
-    ?rewrite_template
-    ?(rule = "where true")
-    ~match_template
-    () =
+let create ?rewrite_template ?rule ~match_template () =
   let match_specification = { match_template; rule } in
   let rewrite_specification =
     Option.map rewrite_template ~f:(fun rewrite_template ->