From eb54e29130d124a11cc4eb561f69bd93fbf365fc Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Mon, 30 May 2022 13:06:17 -0500
Subject: [PATCH] refactor: move predicate_with_id to engine

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

ps-id: 18932E72-064F-40DD-9DEF-BEB5F8E591C8
---
 src/dune_engine/action_exec.ml      |  4 +--
 src/dune_engine/dep.ml              |  7 +++---
 src/dune_engine/file_selector.ml    | 34 +++++++++++++++++++++++++
 src/dune_engine/file_selector.mli   | 24 ++++++++++++++++++
 src/dune_engine/import.ml           |  1 -
 src/dune_lang/dune_lang.ml          |  1 -
 src/dune_lang/glob.ml               |  8 ++----
 src/dune_lang/glob.mli              |  2 --
 src/dune_lang/predicate_lang.ml     | 12 ---------
 src/dune_lang/predicate_lang.mli    |  5 ----
 src/dune_lang/predicate_with_id.ml  | 32 -----------------------
 src/dune_lang/predicate_with_id.mli | 39 -----------------------------
 src/dune_rules/check_rules.ml       |  2 +-
 src/dune_rules/coq_rules.ml         |  5 ++--
 src/dune_rules/dep_conf_eval.ml     | 12 ++++-----
 src/dune_rules/foreign_rules.ml     |  2 +-
 src/dune_rules/gen_rules.ml         |  2 +-
 src/dune_rules/import.ml            |  2 +-
 src/dune_rules/lib_file_deps.ml     |  2 +-
 src/dune_rules/simple_rules.ml      |  7 ++----
 20 files changed, 79 insertions(+), 124 deletions(-)
 delete mode 100644 src/dune_lang/predicate_with_id.ml
 delete mode 100644 src/dune_lang/predicate_with_id.mli

diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml
index cc589e6637e..5e62f0debc5 100644
--- a/src/dune_engine/action_exec.ml
+++ b/src/dune_engine/action_exec.ml
@@ -17,9 +17,7 @@ module Dynamic_dep = struct
 
     let to_dep = function
       | File fn -> Dep.file fn
-      | Glob (dir, glob) ->
-        Glob.to_predicate_with_id glob
-        |> File_selector.create ~dir |> Dep.file_selector
+      | Glob (dir, glob) -> File_selector.of_glob ~dir glob |> Dep.file_selector
 
     let of_DAP_dep ~loc ~working_dir : DAP.Dependency.t -> t =
       let to_dune_path = Path.relative working_dir in
diff --git a/src/dune_engine/dep.ml b/src/dune_engine/dep.ml
index 34abdb4d83a..3eb7fb9ef62 100644
--- a/src/dune_engine/dep.ml
+++ b/src/dune_engine/dep.ml
@@ -312,7 +312,8 @@ module Set = struct
      depending on [(source_tree x)]. Otherwise, we wouldn't clean up stale
      directories in directories that contain no file. *)
   let dir_without_files_dep dir =
-    file_selector (File_selector.create ~dir Predicate_with_id.false_)
+    file_selector
+      (File_selector.create ~dir File_selector.Predicate_with_id.false_)
 
   module Source_tree_map_reduce =
     Source_tree.Dir.Make_map_reduce (Memo) (Monoid.Union (M))
@@ -345,9 +346,9 @@ module Set = struct
           | File f -> Path.Set.add acc f
           | File_selector fs ->
             assert (
-              Predicate_with_id.equal
+              File_selector.Predicate_with_id.equal
                 (File_selector.predicate fs)
-                Predicate_with_id.false_);
+                File_selector.Predicate_with_id.false_);
             acc
           | _ -> assert false)
     in
diff --git a/src/dune_engine/file_selector.ml b/src/dune_engine/file_selector.ml
index fd06f2cd15b..b2731ee3d48 100644
--- a/src/dune_engine/file_selector.ml
+++ b/src/dune_engine/file_selector.ml
@@ -1,5 +1,35 @@
 open Import
 
+module Predicate_with_id = struct
+  open Stdune
+  open Dune_sexp
+
+  type 'a t =
+    { id : Dyn.t Lazy.t
+    ; f : 'a Predicate.t
+    }
+
+  let compare x y = Dyn.compare (Lazy.force x.id) (Lazy.force y.id)
+
+  let equal x y = compare x y = Ordering.Eq
+
+  let hash t = Dyn.hash (Lazy.force t.id)
+
+  let to_dyn t =
+    let open Dyn in
+    Record [ ("id", Lazy.force t.id) ]
+
+  let encode _ = Encoder.string "predicate <opaque>"
+
+  let create ~id ~f = { id; f = Predicate.create f }
+
+  let true_ = { id = lazy (String "true_"); f = Predicate.true_ }
+
+  let false_ = { id = lazy (String "false_"); f = Predicate.false_ }
+
+  let test t e = Predicate.test t.f e
+end
+
 type t =
   { dir : Path.t
   ; predicate : Filename.t Predicate_with_id.t
@@ -21,6 +51,10 @@ let compare { dir; predicate; only_generated_files } t =
 let create ~dir ?(only_generated_files = false) predicate =
   { dir; predicate; only_generated_files }
 
+let of_glob ~dir glob =
+  let id = lazy (Glob.to_dyn glob) in
+  create ~dir (Predicate_with_id.create ~id ~f:(Glob.test glob))
+
 let to_dyn { dir; predicate; only_generated_files } =
   Dyn.Record
     [ ("dir", Path.to_dyn dir)
diff --git a/src/dune_engine/file_selector.mli b/src/dune_engine/file_selector.mli
index a71ccc6e22d..562e6cafd85 100644
--- a/src/dune_engine/file_selector.mli
+++ b/src/dune_engine/file_selector.mli
@@ -3,6 +3,28 @@
 
 open Import
 
+(** TODO get rid of this *)
+module Predicate_with_id : sig
+  (** Predicates are functions from 'a -> bool along with a uniquely identifying
+      string. The uniquely identifying string allows us to safely memoize on the
+      predicate *)
+
+  type 'a t
+
+  val equal : 'a t -> 'a t -> bool
+
+  (**[create id ~f] creates a predicate defined by [f] identified uniquely with
+     [id]. [id] is used to safely compare predicates for equality for
+     memoization *)
+  val create : id:Dyn.t Lazy.t -> f:('a -> bool) -> 'a t
+
+  (** The predicate that evaluates to [true] for any query. *)
+  val true_ : _ t
+
+  (** The predicate that evaluates to [false] for any query. *)
+  val false_ : _ t
+end
+
 type t
 
 val dir : t -> Path.t
@@ -11,6 +33,8 @@ val predicate : t -> Filename.t Predicate_with_id.t
 
 val only_generated_files : t -> bool
 
+val of_glob : dir:Path.t -> Glob.t -> t
+
 val create :
      dir:Path.t
   -> ?only_generated_files:bool
diff --git a/src/dune_engine/import.ml b/src/dune_engine/import.ml
index ba2356ccd02..176695bc686 100644
--- a/src/dune_engine/import.ml
+++ b/src/dune_engine/import.ml
@@ -10,7 +10,6 @@ module Cm_kind = Ocaml.Cm_kind
 module Mode = Ocaml.Mode
 module Config = Dune_util.Config
 module Predicate_lang = Dune_lang.Predicate_lang
-module Predicate_with_id = Dune_lang.Predicate_with_id
 module Glob = Dune_lang.Glob
 include No_io
 
diff --git a/src/dune_lang/dune_lang.ml b/src/dune_lang/dune_lang.ml
index 9c12c3beb73..1fb9eccf4f0 100644
--- a/src/dune_lang/dune_lang.ml
+++ b/src/dune_lang/dune_lang.ml
@@ -2,7 +2,6 @@ include Dune_sexp
 module Format = Format
 module Stanza = Stanza
 module Predicate_lang = Predicate_lang
-module Predicate_with_id = Predicate_with_id
 module Glob = Glob
 
 (* TODO remove the [Dune] prefix *)
diff --git a/src/dune_lang/glob.ml b/src/dune_lang/glob.ml
index 0daea91412a..4f3ef8774b1 100644
--- a/src/dune_lang/glob.ml
+++ b/src/dune_lang/glob.ml
@@ -6,14 +6,14 @@ let of_string = `shadowed
 
 let _ = of_string
 
+let to_dyn t = Dyn.variant "Glob" [ Dyn.string (to_string t) ]
+
 let compare x y = String.compare (to_string x) (to_string y)
 
 let equal x y = String.equal (to_string x) (to_string y)
 
 let hash t = String.hash (to_string t)
 
-let to_dyn t = Dyn.string (to_string t)
-
 let of_string_exn loc repr =
   match of_string_result repr with
   | Error (_, msg) -> User_error.raise ~loc [ Pp.textf "invalid glob: %s" msg ]
@@ -30,7 +30,3 @@ let decode =
 let filter t = List.filter ~f:(test t)
 
 let to_predicate t = Predicate.create (test t)
-
-let to_predicate_with_id t =
-  let id = lazy (Dyn.variant "Glob" [ String (to_string t) ]) in
-  Predicate_with_id.create ~id ~f:(test t)
diff --git a/src/dune_lang/glob.mli b/src/dune_lang/glob.mli
index 55a44685061..fd123061f0f 100644
--- a/src/dune_lang/glob.mli
+++ b/src/dune_lang/glob.mli
@@ -26,5 +26,3 @@ val universal : t
 val of_string_exn : Loc.t -> string -> t
 
 val to_predicate : t -> Filename.t Predicate.t
-
-val to_predicate_with_id : t -> Filename.t Predicate_with_id.t
diff --git a/src/dune_lang/predicate_lang.ml b/src/dune_lang/predicate_lang.ml
index 1840c221c54..64354525241 100644
--- a/src/dune_lang/predicate_lang.ml
+++ b/src/dune_lang/predicate_lang.ml
@@ -115,18 +115,6 @@ let to_predicate (type a) (t : a Predicate.t t) ~standard : a Predicate.t =
   Predicate.create (fun a ->
       exec t ~standard (fun pred -> Predicate.test pred a))
 
-let to_predicate_with_id (type a) (t : a Predicate_with_id.t t) ~standard :
-    a Predicate_with_id.t =
-  let id =
-    lazy
-      (Dyn.variant "Predicate_lang.to_predicate"
-         [ to_dyn Predicate_with_id.to_dyn standard
-         ; to_dyn Predicate_with_id.to_dyn t
-         ])
-  in
-  Predicate_with_id.create ~id ~f:(fun a ->
-      exec t ~standard (fun pred -> Predicate_with_id.test pred a))
-
 module Glob = struct
   type glob = string -> bool
 
diff --git a/src/dune_lang/predicate_lang.mli b/src/dune_lang/predicate_lang.mli
index 0b0c111872a..1cf0d5e49af 100644
--- a/src/dune_lang/predicate_lang.mli
+++ b/src/dune_lang/predicate_lang.mli
@@ -36,11 +36,6 @@ val empty : 'a t
 
 val map : 'a t -> f:('a -> 'b) -> 'b t
 
-val to_predicate_with_id :
-     'a Predicate_with_id.t t
-  -> standard:'a Predicate_with_id.t t
-  -> 'a Predicate_with_id.t
-
 val to_predicate :
   'a Predicate.t t -> standard:'a Predicate.t t -> 'a Predicate.t
 
diff --git a/src/dune_lang/predicate_with_id.ml b/src/dune_lang/predicate_with_id.ml
deleted file mode 100644
index 5eaf44bae11..00000000000
--- a/src/dune_lang/predicate_with_id.ml
+++ /dev/null
@@ -1,32 +0,0 @@
-open Stdune
-open Dune_sexp
-
-type 'a t =
-  { id : Dyn.t Lazy.t
-  ; f : 'a Predicate.t
-  }
-
-let predicate t = t.f
-
-let compare x y = Dyn.compare (Lazy.force x.id) (Lazy.force y.id)
-
-let equal x y = compare x y = Ordering.Eq
-
-let hash t = Dyn.hash (Lazy.force t.id)
-
-let to_dyn t =
-  let open Dyn in
-  Record [ ("id", Lazy.force t.id) ]
-
-let encode _ = Encoder.string "predicate <opaque>"
-
-let create ~id ~f = { id; f = Predicate.create f }
-
-let true_ = { id = lazy (String "true_"); f = Predicate.true_ }
-
-let false_ = { id = lazy (String "false_"); f = Predicate.false_ }
-
-let test t e = Predicate.test t.f e
-
-let contramap t ~f ~map_id =
-  { f = Predicate.contramap t.f ~f; id = lazy (map_id (Lazy.force t.id)) }
diff --git a/src/dune_lang/predicate_with_id.mli b/src/dune_lang/predicate_with_id.mli
deleted file mode 100644
index 73585052b2a..00000000000
--- a/src/dune_lang/predicate_with_id.mli
+++ /dev/null
@@ -1,39 +0,0 @@
-(** Predicates are functions from 'a -> bool along with a uniquely identifying
-    string. The uniquely identifying string allows us to safely memoize on the
-    predicate *)
-
-(* TODO move back to dune_engine? this is really only needed for
-   [File_selector.t] *)
-
-open Stdune
-open Dune_sexp
-
-type 'a t
-
-val predicate : 'a t -> 'a Predicate.t
-
-val equal : 'a t -> 'a t -> bool
-
-val compare : 'a t -> 'a t -> Ordering.t
-
-val hash : _ t -> int
-
-val encode : _ t Encoder.t
-
-val to_dyn : _ t -> Dyn.t
-
-(**[create id ~f] creates a predicate defined by [f] identified uniquely with
-   [id]. [id] is used to safely compare predicates for equality for memoization *)
-val create : id:Dyn.t Lazy.t -> f:('a -> bool) -> 'a t
-
-(** The predicate that evaluates to [true] for any query. *)
-val true_ : _ t
-
-(** The predicate that evaluates to [false] for any query. *)
-val false_ : _ t
-
-val test : 'a t -> 'a -> bool
-
-(** the user of this function must take care not to break the uniqueness of the
-    underlying representation *)
-val contramap : 'a t -> f:('b -> 'a) -> map_id:(Dyn.t -> Dyn.t) -> 'b t
diff --git a/src/dune_rules/check_rules.ml b/src/dune_rules/check_rules.ml
index ad17c51a95e..a536d2f467e 100644
--- a/src/dune_rules/check_rules.ml
+++ b/src/dune_rules/check_rules.ml
@@ -7,7 +7,7 @@ let dev_files =
       (let open Dyn in
       variant "dev_files" (List.map ~f:string exts))
   in
-  Dune_lang.Predicate_with_id.create ~id ~f:(fun p ->
+  Predicate_with_id.create ~id ~f:(fun p ->
       let ext = Filename.extension p in
       List.mem exts ext ~equal:String.equal)
 
diff --git a/src/dune_rules/coq_rules.ml b/src/dune_rules/coq_rules.ml
index 3448ae02d7a..1569c190121 100644
--- a/src/dune_rules/coq_rules.ml
+++ b/src/dune_rules/coq_rules.ml
@@ -431,9 +431,8 @@ let coqdoc_rule (cctx : _ Context.t) ~sctx ~name:(_, name) ~file_flags ~mode
             let+ theory_dirs = Context.directories_of_lib ~sctx theory in
             Dep.Set.of_list_map theory_dirs ~f:(fun dir ->
                 (* TODO *)
-                Glob.of_string_exn Loc.none "*.{glob}"
-                |> Glob.to_predicate_with_id
-                |> File_selector.create ~dir:(Path.build dir)
+                Glob.of_string_exn Loc.none "*.glob"
+                |> File_selector.of_glob ~dir:(Path.build dir)
                 |> Dep.file_selector))
       in
       Command.Args.Hidden_deps (Dep.Set.union_all deps)
diff --git a/src/dune_rules/dep_conf_eval.ml b/src/dune_rules/dep_conf_eval.ml
index d5f20745536..78d2e4c7e6f 100644
--- a/src/dune_rules/dep_conf_eval.ml
+++ b/src/dune_rules/dep_conf_eval.ml
@@ -140,15 +140,13 @@ let rec dep expander = function
     Other
       (let loc = String_with_vars.loc s in
        let* path = Expander.expand_path expander s in
-       let pred =
-         Path.basename path |> Glob.of_string_exn loc
-         |> Glob.to_predicate_with_id
-       in
-       let dir = Path.parent_exn path in
-       let files_in dir =
-         Action_builder.paths_matching ~loc (File_selector.create ~dir pred)
+       let files_in =
+         let glob = Path.basename path |> Glob.of_string_exn loc in
+         fun dir ->
+           Action_builder.paths_matching ~loc (File_selector.of_glob ~dir glob)
        in
        let+ files =
+         let dir = Path.parent_exn path in
          if recursive then collect_source_files_recursively dir ~f:files_in
          else files_in dir
        in
diff --git a/src/dune_rules/foreign_rules.ml b/src/dune_rules/foreign_rules.ml
index 1e5d0df3d0d..ffe15c7ef5a 100644
--- a/src/dune_rules/foreign_rules.ml
+++ b/src/dune_rules/foreign_rules.ml
@@ -63,7 +63,7 @@ let include_dir_flags ~expander ~dir (stubs : Foreign.Stubs.t) =
                    Dep.Set.singleton
                      (Dep.file_selector
                         (File_selector.create ~dir:include_dir
-                           Dune_lang.Predicate_with_id.true_))
+                           Predicate_with_id.true_))
                  in
                  Command.Args.Hidden_deps deps
                | Some (build_dir, source_dir) ->
diff --git a/src/dune_rules/gen_rules.ml b/src/dune_rules/gen_rules.ml
index 8d02087e044..52bc256155e 100644
--- a/src/dune_rules/gen_rules.ml
+++ b/src/dune_rules/gen_rules.ml
@@ -192,7 +192,7 @@ let define_all_alias ~dir ~scope ~js_targets =
             (List.exists js_targets ~f:(fun js_target ->
                  String.equal (Path.Build.basename js_target) basename))
       in
-      Dune_lang.Predicate_with_id.create ~id ~f
+      Predicate_with_id.create ~id ~f
     in
     let only_generated_files =
       Dune_project.dune_version (Scope.project scope) >= (3, 0)
diff --git a/src/dune_rules/import.ml b/src/dune_rules/import.ml
index d59434fae18..300569e4d1e 100644
--- a/src/dune_rules/import.ml
+++ b/src/dune_rules/import.ml
@@ -11,6 +11,6 @@ include Ocaml
 module Re = Dune_re
 module Stanza = Dune_lang.Stanza
 module Predicate_lang = Dune_lang.Predicate_lang
-module Predicate_with_id = Dune_lang.Predicate_with_id
+module Predicate_with_id = Dune_engine.File_selector.Predicate_with_id
 module Glob = Dune_lang.Glob
 include Dune_engine.No_io
diff --git a/src/dune_rules/lib_file_deps.ml b/src/dune_rules/lib_file_deps.ml
index 0c10772b3ac..f99c7479daf 100644
--- a/src/dune_rules/lib_file_deps.ml
+++ b/src/dune_rules/lib_file_deps.ml
@@ -30,7 +30,7 @@ module Group = struct
               variant "Lib_file_deps" [ string ext ])
           in
           let pred =
-            Dune_lang.Predicate_with_id.create ~id ~f:(fun p ->
+            Predicate_with_id.create ~id ~f:(fun p ->
                 String.equal (Filename.extension p) ext)
           in
           (g, pred))
diff --git a/src/dune_rules/simple_rules.ml b/src/dune_rules/simple_rules.ml
index 48a6c166a54..d4dee8dfc85 100644
--- a/src/dune_rules/simple_rules.ml
+++ b/src/dune_rules/simple_rules.ml
@@ -159,10 +159,7 @@ let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) =
            (Path.to_string_maybe_quoted glob_in_src)
            (Path.Source.to_string_maybe_quoted src_dir));
   let src_in_src = Path.parent_exn glob_in_src in
-  let pred =
-    Path.basename glob_in_src |> Glob.of_string_exn loc
-    |> Glob.to_predicate_with_id
-  in
+  let glob = Path.basename glob_in_src |> Glob.of_string_exn loc in
   let src_in_build =
     match Path.as_in_source_tree src_in_src with
     | None -> src_in_src
@@ -190,7 +187,7 @@ let copy_files sctx ~dir ~expander ~src_dir (def : Copy_files.t) =
       ];
   (* add rules *)
   let* files =
-    Build_system.eval_pred (File_selector.create ~dir:src_in_build pred)
+    Build_system.eval_pred (File_selector.of_glob ~dir:src_in_build glob)
   in
   (* CR-someday amokhov: We currently traverse the set [files] twice: first, to
      add the corresponding rules, and then to convert the files to [targets]. To