Merge pull request #108 from xhtmlboi/attempt-to-erase-files

Add Action `remove_residuals`

Author: xhtmlboi

CHANGES.md

@@ -1,3 +1,22 @@
+### unreleased
+
+#### Yocaml 
+
+- Add `Action.remove_residuals` for erasing residuals files (by [xvw](https://xvw.lol))
+
+#### Yocaml_git
+
+- Add `Action.remove_residuals` for erasing residuals files (by [xvw](https://xvw.lol))
+
+#### Yocaml_unix
+
+- Add `Action.remove_residuals` for erasing residuals files (by [xvw](https://xvw.lol))
+
+#### Yocaml_eio
+
+- Add `Action.remove_residuals` for erasing residuals files (by [xvw](https://xvw.lol))
+
+
 ### v2.7.0 2025-11-18 Nantes (France)
 
 #### Yocaml_git

lib/core/action.ml

@@ -64,6 +64,7 @@ let perform target task ~when_creation ~when_update cache =
   let open Eff.Syntax in
   let deps, eff, has_dynamic_deps = Task.destruct task in
   let* now = Eff.get_time () in
+  let cache = Cache.mark cache target in
   let* interaction = need_update cache has_dynamic_deps deps target in
   match interaction with
   | Nothing ->
@@ -185,6 +186,9 @@ let batch_list list action cache =
   in
   cache
 
+let mark_cache on cache path =
+  match on with `Source -> cache | `Target -> Cache.mark cache path
+
 let restore_cache ?(on = `Target) path =
   let open Eff.Syntax in
   let* exists = Eff.file_exists ~on path in
@@ -205,7 +209,7 @@ let restore_cache ?(on = `Target) path =
               Eff.log ~src:Eff.yocaml_log_src ~level:`Debug
               @@ Lexicon.cache_restored path
             in
-            cache)
+            mark_cache on cache path)
           ~error:(fun _ ->
             let+ () =
               Eff.log ~src:Eff.yocaml_log_src ~level:`Warning
@@ -226,6 +230,26 @@ let store_cache ?(on = `Target) path cache =
   let* () = Eff.write_file ~on path sexp_str in
   Eff.log ~src:Eff.yocaml_log_src ~level:`Debug @@ Lexicon.cache_stored path
 
+let remove_residuals ~target cache =
+  let on = `Target in
+  let open Eff.Syntax in
+  let trace = Cache.trace cache in
+  let* () =
+    Eff.logf ~src:Eff.yocaml_log_src ~level:`Info "Remove residuals for %a"
+      Path.pp target
+  in
+  let* target_trace = Trace.from_directory ~on target in
+  let residuals = Trace.diff ~target:target_trace trace in
+  let+ _ =
+    Eff.List.traverse
+      (fun residual ->
+        let* () = Eff.erase_file ~on residual in
+        Eff.logf ~src:Eff.yocaml_log_src ~level:`Info "%a deleted!" Path.pp
+          residual)
+      residuals
+  in
+  cache
+
 let with_cache ?on path f =
   let open Eff in
   restore_cache ?on path >>= f >>= store_cache ?on path

lib/core/action.mli

@@ -32,16 +32,20 @@ type t = Cache.t -> Cache.t Eff.t
     production phases, an action is a function that takes a cache and returns
     the modified cache, wrapped in an effect. *)
 
+val remove_residuals : target:Path.t -> t
+(** [remove_residuals ~target] deletes files that were not created by any of the
+    actions performed. *)
+
 val restore_cache : ?on:Eff.filesystem -> Path.t -> Cache.t Eff.t
 (** [restore_cache ?on path] Reads or initiates the cache in a given [path]. *)
 
 val store_cache : ?on:Eff.filesystem -> Path.t -> Cache.t -> unit Eff.t
 (** [store_cache ?on path cache] saves the [cache] in a given [path]. *)
 
 val with_cache : ?on:Eff.filesystem -> Path.t -> t -> unit Eff.t
-(** [with_cache ?on path f] restores the cache from the given [path], executes
-    the action [f] using the cache, and then stores the updated cache back to
-    the same [path].
+(** [with_cache ?on ?remove_residuals_in path f] restores the cache from the
+    given [path], executes the action [f] using the cache, and then stores the
+    updated cache back to the same [path].
 
     This helps avoid repeating [restore_cache] and [store_cache] calls manually
     when chaining multiple cache-aware actions. *)

lib/core/cache.ml

@@ -20,23 +20,27 @@ type entry = {
   ; last_build_date : int option
 }
 
-type t = entry Path.Map.t
+type t = { entries : entry Path.Map.t; trace : Trace.t }
 
 let entry ?last_build_date hashed_content dynamic_dependencies =
   { hashed_content; dynamic_dependencies; last_build_date }
 
-let empty = Path.Map.empty
-let from_list = Path.Map.of_list
+let make ~entries ~trace = { entries; trace }
+let empty = make ~entries:Path.Map.empty ~trace:Trace.empty
+
+let from_list ?(trace = Trace.empty) entries =
+  let entries = entries |> Path.Map.of_list in
+  make ~entries ~trace
 
 let update cache path ?(deps = Deps.empty) ~now content =
   let entry = entry ~last_build_date:now content deps in
-  Path.Map.add path entry cache
+  { cache with entries = Path.Map.add path entry cache.entries }
 
 let get cache path =
   Option.map
     (fun { hashed_content; dynamic_dependencies; last_build_date } ->
       (hashed_content, dynamic_dependencies, last_build_date))
-    (Path.Map.find_opt path cache)
+    (Path.Map.find_opt path cache.entries)
 
 let entry_to_sexp { hashed_content; dynamic_dependencies; last_build_date } =
   let open Sexp in
@@ -70,13 +74,13 @@ let entry_from_sexp sexp =
           make hashed_content potential_deps (Some lbd))
   | _ -> Error (Sexp.Invalid_sexp (sexp, "cache"))
 
-let to_sexp cache =
+let to_sexp { entries; _ } =
   Path.Map.fold
     (fun key entry acc ->
       let k = Path.to_sexp key in
       let v = entry_to_sexp entry in
       Sexp.node [ k; v ] :: acc)
-    cache []
+    entries []
   |> Sexp.node
 
 let key_value_from_sexp sexp =
@@ -95,7 +99,8 @@ let from_sexp sexp =
           Result.bind acc (fun acc ->
               line |> key_value_from_sexp |> Result.map (fun x -> x :: acc)))
         (Ok []) entries
-      |> Result.map Path.Map.of_list
+      |> Result.map (fun e ->
+             make ~entries:(Path.Map.of_list e) ~trace:Trace.empty)
   | _ -> Error (Sexp.Invalid_sexp (sexp, "cache"))
 
 let entry_equal
@@ -113,17 +118,22 @@ let entry_equal
   && Deps.equal deps_a deps_b
   && Option.equal Int.equal lbd_a lbd_b
 
-let equal = Path.Map.equal entry_equal
+let equal { entries; trace } b =
+  Path.Map.equal entry_equal entries b.entries && Trace.equal trace b.trace
 
 let pp_kv ppf (key, { hashed_content; dynamic_dependencies; last_build_date }) =
-  Format.fprintf ppf "%a => deps: @[<v 0>%a@]@hash:%s (%a)" Path.pp key Deps.pp
+  Format.fprintf ppf "%a => deps: @[<v 0>%a@] hash:%s (%a)" Path.pp key Deps.pp
     dynamic_dependencies hashed_content
     (Format.pp_print_option Format.pp_print_int)
     last_build_date
 
+let trace { trace; _ } = trace
+let mark cache path = { cache with trace = Trace.add path (trace cache) }
+
 let pp ppf cache =
-  Format.fprintf ppf "Cache [@[<v 0>%a@]]"
+  Format.fprintf ppf "Cache [@[<v 0>%a@]]@ @[<v 1>%a@]"
     (Format.pp_print_list
        ~pp_sep:(fun ppf () -> Format.fprintf ppf ";@ ")
        pp_kv)
-    (Path.Map.to_list cache)
+    (Path.Map.to_list cache.entries)
+    Trace.pp (trace cache)

lib/core/cache.mli

@@ -34,7 +34,7 @@ val entry : ?last_build_date:int -> string -> Deps.t -> entry
 val empty : t
 (** [empty] returns an empty cache. *)
 
-val from_list : (Path.t * entry) list -> t
+val from_list : ?trace:Trace.t -> (Path.t * entry) list -> t
 (** [from_list l] creates a cache from a list. *)
 
 (** {1 Cache interaction} *)
@@ -47,6 +47,12 @@ val get : t -> Path.t -> (string * Deps.t * int option) option
 (** [get cache path] returns the associated hash content, deps set and the last
     build date for a given path. *)
 
+val trace : t -> Trace.t
+(** Returns the trace of built artifact. *)
+
+val mark : t -> Path.t -> t
+(** [mark path] add [path] into the trace. *)
+
 (** {1 Serialization/Deserialization}
 
     Supports serialization and deserialization of cache. *)

lib/core/eff.ml

@@ -109,6 +109,7 @@ type _ Effect.t +=
   | Yocaml_get_mtime : filesystem * Path.t -> int Effect.t
   | Yocaml_hash_content : string -> string Effect.t
   | Yocaml_write_file : filesystem * Path.t * string -> unit Effect.t
+  | Yocaml_erase_file : filesystem * Path.t -> unit Effect.t
   | Yocaml_is_directory : filesystem * Path.t -> bool Effect.t
   | Yocaml_is_file : filesystem * Path.t -> bool Effect.t
   | Yocaml_read_dir : filesystem * Path.t -> Path.fragment list Effect.t
@@ -210,6 +211,13 @@ let write_file ~on path content =
   let* () = create_directory ~on parent in
   perform @@ Yocaml_write_file (on, path, content)
 
+let erase_file ~on path =
+  let* file = is_file ~on path in
+  if file then perform @@ Yocaml_erase_file (on, path)
+  else
+    logf ~src:yocaml_log_src ~level:`Warning
+      "%a is not a file (or does not exists)" Path.pp path
+
 let read_directory ~on ?(only = `Both) ?(where = fun _ -> true) path =
   let* is_dir = is_directory ~on path in
   if is_dir then

lib/core/eff.mli

@@ -258,6 +258,8 @@ type _ Effect.t +=
             transformation). *)
   | Yocaml_write_file : filesystem * Path.t * string -> unit Effect.t
         (** Effect which describes the writing of a file *)
+  | Yocaml_erase_file : filesystem * Path.t -> unit Effect.t
+        (** Effect whicj describes the erasing of a file *)
   | Yocaml_is_directory : filesystem * Path.t -> bool Effect.t
         (** Effect that returns check if a path is a directory or not. *)
   | Yocaml_is_file : filesystem * Path.t -> bool Effect.t
@@ -410,13 +412,17 @@ val write_file : on:filesystem -> Path.t -> string -> unit t
     {!val:Yocaml.Eff.create_directory} for creating intermediate directory in
     the path. *)
 
+val erase_file : on:filesystem -> Path.t -> unit t
+(** [erase_file ~on target] performs the effect [Yocaml_erase_file] that should
+    erase a file, if the file exists. *)
+
 val is_directory : on:filesystem -> Path.t -> bool t
 (** [is_directory ~on target] performs the effect [Yocaml_is_directory] that
     should check if a file is a directory or not. *)
 
 val is_file : on:filesystem -> Path.t -> bool t
-(** [is_file ~on target] performs the effect [Yocaml_is_directory] and if the
-    file is not a directory, it return [true], [false] otherwise. *)
+(** [is_file ~on target] performs the effect [Yocaml_is_file] and if the file is
+    not a directory, it return [true], [false] otherwise. *)
 
 val read_directory :
      on:filesystem

lib/core/required.mli

@@ -202,12 +202,16 @@ module type RUNTIME = sig
   (** [get_time ()] returns the current timestamp. *)
 
   val file_exists : on:[ `Source | `Target ] -> Path.t -> bool t
-  (** [file_exists ~on:source -> path] returns [true] if the file exists, false
+  (** [file_exists ~on:source path] returns [true] if the file exists, false
       otherwise. *)
 
   val read_file :
     on:[ `Source | `Target ] -> Path.t -> (string, runtime_error) result t
-  (** [read_file ~on:source -> path] returns the content of a file. *)
+  (** [read_file ~on:source path] returns the content of a file. *)
+
+  val erase_file :
+    on:[ `Source | `Target ] -> Path.t -> (unit, runtime_error) result t
+  (** [erase_file ~on:source path] erase the given file *)
 
   val get_mtime :
     on:[ `Source | `Target ] -> Path.t -> (int, runtime_error) result t

lib/core/runtime.ml

@@ -107,6 +107,13 @@ module Make (Runtime : Required.RUNTIME) = struct
                         (function
                           | Ok x -> continue k x | Error err -> runtimec err)
                         (Runtime.create_directory ~on:filesystem path))
+              | Eff.Yocaml_erase_file (filesystem, path) ->
+                  Some
+                    (fun (k : (a, _) continuation) ->
+                      Runtime.bind
+                        (function
+                          | Ok () -> continue k () | Error err -> runtimec err)
+                        (Runtime.erase_file ~on:filesystem path))
               | Eff.Yocaml_is_directory (filesystem, path) ->
                   Some
                     (fun (k : (a, _) continuation) ->

lib/core/trace.ml

@@ -0,0 +1,43 @@
+(* YOCaml a static blog generator.
+   Copyright (C) 2025 The Funkyworkers and The YOCaml's developers
+
+   This program is free software: you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation, either version 3 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program.  If not, see <https://www.gnu.org/licenses/>. *)
+
+type t = Path.Set.t
+
+let empty = Path.Set.empty
+let add = Path.Set.add
+let from_list = Path.Set.of_list
+let diff ~target computed = Path.Set.diff target computed |> Path.Set.to_list
+
+let from_directory ~on target =
+  let open Eff.Syntax in
+  let rec aux trace parent =
+    let* children = Eff.read_directory ~on ~only:`Both parent in
+    Stdlib.List.fold_left
+      (fun trace child ->
+        let* trace = trace in
+        let* as_file = Eff.is_file ~on child in
+        if as_file then Eff.return (add child trace) else aux trace child)
+      (Eff.return trace) children
+  in
+  aux empty target
+
+let equal = Path.Set.equal
+
+let pp ppf trace =
+  Format.fprintf ppf "Trace[@[%a@]]"
+    (Format.pp_print_list (fun ppf p ->
+         Format.fprintf ppf "%S" (Path.to_string p)))
+    (trace |> Path.Set.to_list)