From 37d7131a119ce9d3d912909de7cc7bdd8eddb982 Mon Sep 17 00:00:00 2001
From: Jeremie Dimino <jeremie@dimino.org>
Date: Thu, 25 May 2017 16:57:29 +0100
Subject: [PATCH] Simplify hack for not deleting odoc files

---
 src/build.ml        |  2 +-
 src/build.mli       |  2 +-
 src/build_system.ml | 38 +++++++++++++++++++++-----------------
 src/config.ml       |  2 ++
 src/config.mli      |  3 +++
 src/odoc.ml         | 23 +++++++++++++----------
 6 files changed, 41 insertions(+), 29 deletions(-)

diff --git a/src/build.ml b/src/build.ml
index c75b5f15..d4d0db1b 100644
--- a/src/build.ml
+++ b/src/build.ml
@@ -229,7 +229,7 @@ let action_context_independent ?dir ~targets action =
     | Some dir -> Chdir (dir, action)
   in
   Targets targets
-  >>^ fun () ->
+  >>^ fun _ ->
   { Action. context = None; action  }
 
 let update_file fn s =
diff --git a/src/build.mli b/src/build.mli
index 3648e3d9..732b4d5f 100644
--- a/src/build.mli
+++ b/src/build.mli
@@ -116,7 +116,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 -> (unit, Action.t) t
+val create_file : 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/build_system.ml b/src/build_system.ml
index 31ab4546..cb0860a5 100644
--- a/src/build_system.ml
+++ b/src/build_system.ml
@@ -617,23 +617,27 @@ let create ~contexts ~file_tree ~rules =
 let remove_old_artifacts t =
   let rec walk dir =
     let keep =
-      Path.readdir dir
-      |> List.filter ~f:(fun fn ->
-        let fn = Path.relative dir fn in
-        match Unix.lstat (Path.to_string fn) with
-        | { st_kind = S_DIR; _ } ->
-          walk fn
-        | exception _ ->
-          let keep = Hashtbl.mem t.files fn in
-          if not keep then Path.unlink fn;
-          keep
-        | _ ->
-          let keep = Hashtbl.mem t.files fn in
-          if not keep then Path.unlink fn;
-          keep)
-      |> function
-      | [] -> false
-      | _  -> true
+      if Hashtbl.mem t.files (Path.relative dir Config.jbuilder_keep_fname) then
+        true
+      else begin
+        Path.readdir dir
+        |> List.filter ~f:(fun fn ->
+            let fn = Path.relative dir fn in
+            match Unix.lstat (Path.to_string fn) with
+            | { st_kind = S_DIR; _ } ->
+              walk fn
+            | exception _ ->
+              let keep = Hashtbl.mem t.files fn in
+              if not keep then Path.unlink fn;
+              keep
+            | _ ->
+              let keep = Hashtbl.mem t.files fn in
+              if not keep then Path.unlink fn;
+              keep)
+        |> function
+        | [] -> false
+        | _  -> true
+      end
     in
     if not keep then Path.rmdir dir;
     keep
diff --git a/src/config.ml b/src/config.ml
index 334d7219..4a5c78b9 100644
--- a/src/config.ml
+++ b/src/config.ml
@@ -16,3 +16,5 @@ let local_install_lib_dir ~context ~package =
     package
 
 let dev_null = Path.of_string (if Sys.win32 then "nul" else "/dev/null")
+
+let jbuilder_keep_fname = ".jbuilder-keep"
diff --git a/src/config.mli b/src/config.mli
index df18701d..2ec04462 100644
--- a/src/config.mli
+++ b/src/config.mli
@@ -11,3 +11,6 @@ val local_install_lib_dir : context:string -> package:string -> Path.t
 
 val dev_null : Path.t
 
+(** When this file is present in a directory jbuilder will delete
+    nothing in it if it knows to generate this file. *)
+val jbuilder_keep_fname : string
diff --git a/src/odoc.ml b/src/odoc.ml
index 710d2afd..b8fb440b 100644
--- a/src/odoc.ml
+++ b/src/odoc.ml
@@ -39,21 +39,24 @@ let compile_module sctx (m : Module.t) ~odoc ~dir ~includes ~dep_graph ~modules
 let to_html sctx (m : Module.t) odoc_file ~doc_dir ~odoc ~dir ~includes
       ~lib_public_name ~(lib : Library.t) =
   let context = SC.context sctx in
-  let html_file =
-    doc_dir ++ lib_public_name ++ String.capitalize m.obj_name ++ "index.html"
-  in
+  let html_dir = doc_dir ++ lib_public_name ++ String.capitalize m.obj_name in
+  let html_file = html_dir ++ "index.html" in
   SC.add_rule sctx
     (SC.Libs.static_file_deps (dir, lib) ~ext:odoc_ext
      >>>
      includes
      >>>
-     Build.run ~context ~dir odoc ~extra_targets:[html_file]
-       [ A "html"
-       ; Dyn (fun x -> x)
-       ; A "-I"; Path dir
-       ; A "-o"; Path doc_dir
-       ; Dep odoc_file
-       ]);
+     Build.progn
+       [ Build.run ~context ~dir odoc ~extra_targets:[html_file]
+           [ A "html"
+           ; Dyn (fun x -> x)
+           ; A "-I"; Path dir
+           ; A "-o"; Path doc_dir
+           ; Dep odoc_file
+           ]
+       ; Build.create_file (html_dir ++ Config.jbuilder_keep_fname)
+       ]
+    );
   html_file
 
 let lib_index sctx ~odoc ~dir ~(lib : Library.t) ~lib_public_name ~doc_dir ~modules