Remove VCS support from Dune cache

Signed-off-by: Andrey Mokhov <[email protected]>

src/dune_engine/build_system.ml

@@ -433,47 +433,6 @@ let set_rule_generators ~init ~gen_rules =
   Fdecl.set t.init_rules init_rules;
   Fdecl.set t.gen_rules gen_rules
 
-let set_vcs vcs =
-  let open Fiber.O in
-  let t = t () in
-  let () = Fdecl.set t.vcs vcs in
-  match t.caching with
-  | None -> Fiber.return ()
-  | Some ({ cache = (module Caching); _ } as caching) ->
-    let+ caching =
-      let+ with_repositories =
-        let f ({ Vcs.root; _ } as vcs) =
-          let+ commit = Memo.Build.run (Vcs.commit_id vcs) in
-          { Cache.directory = Path.to_absolute_filename root
-          ; remote = "" (* FIXME: fill or drop from the protocol *)
-          ; commit
-          }
-        in
-        let+ repositories = Fiber.parallel_map ~f (Fdecl.get t.vcs) in
-        Caching.Cache.with_repositories Caching.cache repositories
-      in
-      match with_repositories with
-      | Result.Ok cache ->
-        let cache =
-          (module struct
-            let cache = cache
-
-            module Cache = Caching.Cache
-          end : Cache.Caching)
-        in
-        Some { caching with cache }
-      | Result.Error e ->
-        User_warning.emit
-          [ Pp.textf "Unable to set cache repositiories, disabling cache: %s" e
-          ];
-        None
-    in
-    t.caching <- caching
-
-let get_vcs () =
-  let t = t () in
-  Fdecl.get t.vcs
-
 let get_cache () =
   let t = t () in
   t.caching
@@ -1720,7 +1679,7 @@ end = struct
                           ])
               | _ -> ()
             in
-            let* () =
+            let () =
               (* Promote *)
               match t.caching with
               | Some { cache = (module Caching : Cache.Caching); _ }
@@ -1734,18 +1693,10 @@ end = struct
                   Log.info
                     [ Pp.textf "promotion failed for %s: %s" targets msg ]
                 in
-                let+ repository =
-                  let+ dir = Memo.Build.run (Rule.find_source_dir rule) in
-                  let open Option.O in
-                  let* vcs = Source_tree.Dir.vcs dir in
-                  let f found = Path.equal found.Vcs.root vcs.Vcs.root in
-                  let+ _, i = get_vcs () |> List.findi ~f in
-                  i
-                in
                 Caching.Cache.promote Caching.cache targets_digests rule_digest
-                  [] ~repository ~duplication:None
+                  [] ~repository:None ~duplication:None
                 |> Result.map_error ~f:report |> ignore
-              | _ -> Fiber.return ()
+              | _ -> ()
             in
             let dynamic_deps_stages =
               List.map exec_result.dynamic_deps_stages

src/dune_engine/build_system.mli

@@ -85,9 +85,6 @@ val set_rule_generators :
            option)
   -> unit Fiber.t
 
-(** Set the list of VCS repositiories contained in the source tree *)
-val set_vcs : Vcs.t list -> unit Fiber.t
-
 (** All other functions in this section must be called inside the rule generator
     callback. *)
 

src/dune_rules/dune_load.ml

@@ -181,7 +181,6 @@ type conf =
   { dune_files : Dune_files.t
   ; packages : Package.t Package.Name.Map.t
   ; projects : Dune_project.t list
-  ; vcs : Vcs.t list
   }
 
 let interpret ~dir ~project ~(dune_file : Source_tree.Dune_file.t) =
@@ -194,11 +193,8 @@ let interpret ~dir ~project ~(dune_file : Source_tree.Dune_file.t) =
     Dune_files.Script { script = { dir; project; file }; from_parent = static }
   | Plain -> Literal (Dune_file.parse static ~dir ~file ~project)
 
-module Vcses_projects_and_dune_files =
-  Monoid.Product3
-    (Monoid.Appendable_list (struct
-      type t = Vcs.t
-    end))
+module Projects_and_dune_files =
+  Monoid.Product
     (Monoid.Appendable_list (struct
       type t = Dune_project.t
     end))
@@ -209,20 +205,14 @@ module Vcses_projects_and_dune_files =
 module Source_tree_map_reduce =
   Source_tree.Make_map_reduce_with_progress
     (Memo.Build)
-    (Vcses_projects_and_dune_files)
+    (Projects_and_dune_files)
 
 let load () =
   let open Fiber.O in
-  let+ vcs, projects, dune_files =
+  let+ projects, dune_files =
     Memo.Build.run
-      (let f dir : Vcses_projects_and_dune_files.t Memo.Build.t =
+      (let f dir : Projects_and_dune_files.t Memo.Build.t =
          let path = Source_tree.Dir.path dir in
-         let vcs =
-           match Source_tree.Dir.vcs dir with
-           | Some vcs when Path.equal vcs.root (Path.source path) ->
-             Appendable_list.singleton vcs
-           | _ -> Appendable_list.empty
-         in
          let project = Source_tree.Dir.project dir in
          let projects =
            if Path.Source.equal path (Dune_project.root project) then
@@ -235,14 +225,10 @@ let load () =
            | None -> Appendable_list.empty
            | Some d -> Appendable_list.singleton (path, project, d)
          in
-         Memo.Build.return (vcs, projects, dune_files)
+         Memo.Build.return (projects, dune_files)
        in
        Source_tree_map_reduce.map_reduce ~traverse:Sub_dirs.Status.Set.all ~f)
   in
-  let vcs =
-    Appendable_list.to_list vcs
-    |> Path.Map.of_list_map_exn ~f:(fun vcs -> (vcs.Vcs.root, vcs))
-  in
   let projects = Appendable_list.to_list projects in
   let packages =
     List.fold_left projects ~init:Package.Name.Map.empty
@@ -266,4 +252,4 @@ let load () =
     List.map (Appendable_list.to_list dune_files)
       ~f:(fun (dir, project, dune_file) -> interpret ~dir ~project ~dune_file)
   in
-  { dune_files; packages; projects; vcs = Path.Map.values vcs }
+  { dune_files; packages; projects }

src/dune_rules/dune_load.mli

@@ -17,7 +17,6 @@ type conf = private
   { dune_files : Dune_files.t
   ; packages : Package.t Package.Name.Map.t
   ; projects : Dune_project.t list
-  ; vcs : Vcs.t list
   }
 
 (** Initialize the file tree and load all dune files. *)

src/dune_rules/gen_rules.ml

@@ -409,7 +409,7 @@ let filter_out_stanzas_from_hidden_packages ~visible_pkgs =
 
 let init ~contexts ?only_packages conf =
   let open Fiber.O in
-  let { Dune_load.dune_files; packages; projects; vcs } = conf in
+  let { Dune_load.dune_files; packages; projects } = conf in
   let packages = Option.value only_packages ~default:packages in
   let* sctxs =
     let open Memo.Build.O in
@@ -468,7 +468,7 @@ let init ~contexts ?only_packages conf =
             (Path.Build.Map.find map path)
             ~default:Package.Id.Set.empty)
   in
-  let* () =
+  let+ () =
     Build_system.set_rule_generators
       ~init:(fun () ->
         Context_name.Map.iter sctxs ~f:Odoc.init |> Memo.Build.return)
@@ -480,5 +480,4 @@ let init ~contexts ?only_packages conf =
           Context_name.Map.find sctxs ctx
           |> Option.map ~f:(fun sctx -> gen_rules ~sctx))
   in
-  let+ () = Build_system.set_vcs vcs in
   sctxs