From f96f7cfd66c292152c56b8b7211af58491e39b6a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= <n.oje.bar@gmail.com>
Date: Mon, 23 Oct 2023 21:42:02 +0200
Subject: [PATCH] Only clear known cache directories
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Signed-off-by: Nicolás Ojeda Bär <n.oje.bar@gmail.com>
---
 bin/cache.ml                                  |  2 +-
 src/dune_cache/dune_cache.ml                  |  2 --
 src/dune_cache_storage/dune_cache_storage.ml  | 19 +++++++++++++++++++
 src/dune_cache_storage/dune_cache_storage.mli |  2 ++
 4 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/bin/cache.ml b/bin/cache.ml
index 2f8735b3cdae..4e3a4e770367 100644
--- a/bin/cache.ml
+++ b/bin/cache.ml
@@ -98,7 +98,7 @@ let clear =
     let man = [ `P "Remove any traces of the Dune cache." ] in
     Cmd.info "clear" ~doc ~man
   in
-  Cmd.v info @@ Term.(const Dune_cache.clear $ const ())
+  Cmd.v info @@ Term.(const Dune_cache_storage.clear $ const ())
 ;;
 
 let command =
diff --git a/src/dune_cache/dune_cache.ml b/src/dune_cache/dune_cache.ml
index 3d8b23becc9c..623e0ab249c1 100644
--- a/src/dune_cache/dune_cache.ml
+++ b/src/dune_cache/dune_cache.ml
@@ -1,5 +1,3 @@
 module Config = Config
 module Local = Local
 module Trimmer = Trimmer
-
-let clear () = Stdune.Path.rm_rf ~allow_external:true Dune_cache_storage.Layout.root_dir
diff --git a/src/dune_cache_storage/dune_cache_storage.ml b/src/dune_cache_storage/dune_cache_storage.ml
index f812adfc3641..7aabbd183395 100644
--- a/src/dune_cache_storage/dune_cache_storage.ml
+++ b/src/dune_cache_storage/dune_cache_storage.ml
@@ -338,3 +338,22 @@ let with_temp_file ?(prefix = "dune") ~suffix f =
 let with_temp_dir ?(prefix = "dune") ~suffix f =
   Fiber_util.Temp.with_temp_dir ~parent_dir:Layout.temp_dir ~prefix ~suffix ~f
 ;;
+
+let clear () =
+  let rm_rf path = Path.rm_rf ~allow_external:true path in
+  let rmdir path =
+    try Path.rmdir path with
+    | Unix.Unix_error ((ENOENT | ENOTEMPTY), _, _) -> ()
+  in
+  let rm_rf_all versions dir =
+    List.iter versions ~f:(fun version ->
+      let dir = dir version in
+      rm_rf dir;
+      Option.iter ~f:rmdir (Path.parent dir))
+  in
+  rm_rf_all Version.Metadata.all Layout.Versioned.metadata_storage_dir;
+  rm_rf_all Version.File.all Layout.Versioned.file_storage_dir;
+  rm_rf_all Version.Value.all Layout.Versioned.value_storage_dir;
+  rm_rf Layout.temp_dir;
+  Path.rmdir Layout.root_dir
+;;
diff --git a/src/dune_cache_storage/dune_cache_storage.mli b/src/dune_cache_storage/dune_cache_storage.mli
index c1c69748f461..855038863453 100644
--- a/src/dune_cache_storage/dune_cache_storage.mli
+++ b/src/dune_cache_storage/dune_cache_storage.mli
@@ -138,3 +138,5 @@ module Raw_value : sig
     -> content_digest:Digest.t
     -> Util.Write_result.t
 end
+
+val clear : unit -> unit