diff --git a/src/action.ml b/src/action.ml index 0712d136..8b566a32 100644 --- a/src/action.ml +++ b/src/action.ml @@ -80,8 +80,9 @@ module Mini_shexp = struct | Copy_and_add_line_directive of 'path * 'path | System of 'a | Bash of 'a - | Update_file of 'path * 'a + | Update_file of 'path * 'a | Rename of 'path * 'path + | Remove_tree of 'path let rec t a p sexp = sum @@ -137,6 +138,7 @@ module Mini_shexp = struct | Bash x -> List [Atom "bash"; f x] | Update_file (x, y) -> List [Atom "update-file"; g x; f y] | Rename (x, y) -> List [Atom "rename"; g x; g y] + | Remove_tree x -> List [Atom "remove-tree"; g x] let rec fold t ~init:acc ~f = match t with @@ -156,6 +158,7 @@ module Mini_shexp = struct | Bash x -> f acc x | Update_file (x, y) -> f (f acc x) y | Rename (x, y) -> f (f acc x) y + | Remove_tree x -> f acc x let fold_one_step t ~init:acc ~f = match t with @@ -174,7 +177,8 @@ module Mini_shexp = struct | System _ | Bash _ | Update_file _ - | Rename _ -> acc + | Rename _ + | Remove_tree _ -> acc let rec map : 'a 'b 'c 'd. ('a, 'b) t -> f1:('a -> 'c) -> f2:('b -> 'd) -> ('c, 'd) t @@ -203,6 +207,7 @@ module Mini_shexp = struct | Bash x -> Bash (f1 x) | Update_file (x, y) -> Update_file (f2 x, f1 y) | Rename (x, y) -> Rename (f2 x, f2 y) + | Remove_tree x -> Remove_tree (f2 x) end open Ast @@ -277,6 +282,8 @@ module Mini_shexp = struct | Update_file (x, y) -> Update_file (expand_path ~dir ~f x, expand_str ~dir ~f y) | Rename (x, y) -> Rename (expand_path ~dir ~f x, expand_path ~dir ~f y) + | Remove_tree x -> + Remove_tree (expand_path ~dir ~f x) end open Future @@ -376,6 +383,9 @@ module Mini_shexp = struct | Rename (src, dst) -> Unix.rename (Path.to_string src) (Path.to_string dst); return () + | Remove_tree path -> + Path.rm_rf path; + return () and redirect outputs fn t ~purpose ~dir ~env ~env_extra ~stdout_to ~stderr_to = let fn = Path.to_string fn in diff --git a/src/action.mli b/src/action.mli index fc730fa4..f5403961 100644 --- a/src/action.mli +++ b/src/action.mli @@ -30,6 +30,7 @@ module Mini_shexp : sig | Bash of 'a | Update_file of 'path * 'a | Rename of 'path * 'path + | Remove_tree of 'path val t : 'a Sexp.Of_sexp.t -> 'b Sexp.Of_sexp.t -> ('a, 'b) t Sexp.Of_sexp.t val sexp_of_t : 'a Sexp.To_sexp.t -> 'b Sexp.To_sexp.t -> ('a, 'b) t Sexp.To_sexp.t end diff --git a/src/build.ml b/src/build.ml index d4d0db1b..af8beee6 100644 --- a/src/build.ml +++ b/src/build.ml @@ -254,6 +254,10 @@ let symlink ~src ~dst = let create_file fn = action_context_independent ~targets:[fn] (Create_file fn) +let remove_tree dir = + arr (fun _ -> + { Action. context = None; action = Remove_tree dir }) + let progn ts = all ts >>^ fun (actions : Action.t list) -> let rec loop context acc actions = diff --git a/src/build.mli b/src/build.mli index 732b4d5f..e15dbe30 100644 --- a/src/build.mli +++ b/src/build.mli @@ -117,6 +117,7 @@ val copy : src:Path.t -> dst:Path.t -> (unit, Action.t) t val symlink : src:Path.t -> dst:Path.t -> (unit, Action.t) t val create_file : Path.t -> (_, Action.t) t +val remove_tree : Path.t -> (_, Action.t) t (** Merge a list of actions *) val progn : ('a, Action.t) t list -> ('a, Action.t) t diff --git a/src/odoc.ml b/src/odoc.ml index b8fb440b..7d1d6556 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -47,7 +47,8 @@ let to_html sctx (m : Module.t) odoc_file ~doc_dir ~odoc ~dir ~includes includes >>> Build.progn - [ Build.run ~context ~dir odoc ~extra_targets:[html_file] + [ Build.remove_tree html_dir + ; Build.run ~context ~dir odoc ~extra_targets:[html_file] [ A "html" ; Dyn (fun x -> x) ; A "-I"; Path dir