From 7c9dcbf2848761515e0e187da92d6587c78c2a49 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?J=C3=A9r=C3=A9mie=20Dimino?= <jeremie@dimino.org>
Date: Sun, 28 May 2017 02:46:07 +0100
Subject: [PATCH] Added deps/targets inference

---
 src/action.ml                | 45 ++++++++++++++++++++++++++++++++++++
 src/action.mli               | 12 ++++++++++
 src/path.ml                  | 15 ++++++++++++
 src/path.mli                 |  1 +
 test/expect-tests/action.mlt | 38 ++++++++++++++++++++++++++++++
 test/expect-tests/jbuild     |  7 ++++++
 6 files changed, 118 insertions(+)
 create mode 100644 test/expect-tests/action.mlt

diff --git a/src/action.ml b/src/action.ml
index 973fd568..ab63e25a 100644
--- a/src/action.ml
+++ b/src/action.ml
@@ -444,3 +444,48 @@ let sandbox t ~sandboxed ~deps ~targets =
         else
           None))
     ]
+
+module Infer = struct
+  module S = Path.Set
+  module Outcome = struct
+    type t =
+      { deps    : S.t
+      ; targets : S.t
+      }
+  end
+  open Outcome
+
+  let ( +@ ) acc fn = { acc with targets = S.add fn acc.targets }
+  let ( +< ) acc fn =
+    if S.mem fn acc.targets then
+      acc
+    else
+      { acc with deps = S.add fn acc.deps }
+  let ( -@ ) acc fn = { acc with targets = S.remove fn acc.targets }
+
+  let rec infer acc t =
+    match t with
+    | Run (prog, _)       -> acc +< prog
+    | Redirect (_, fn, t) -> infer (acc +@ fn) t
+    | Cat fn              -> acc +< fn
+    | Create_file fn      -> acc +@ fn
+    | Update_file (fn, _) -> acc +@ fn
+    | Rename (src, dst)   -> acc +< src +@ dst -@ src
+    | Copy (src, dst)
+    | Copy_and_add_line_directive (src, dst)
+    | Symlink (src, dst) -> acc +< src +@ dst
+    | Chdir (_, t)
+    | Setenv (_, _, t)
+    | Ignore (_, t) -> infer acc t
+    | Progn l -> List.fold_left l ~init:acc ~f:infer
+    | Echo _
+    | System _
+    | Bash _ -> acc
+    | Remove_tree dir ->
+      { acc with targets = S.filter acc.targets ~f:(fun fn ->
+          not (Path.is_descendant fn ~of_:dir))
+      }
+
+  let infer t =
+    infer { deps = S.empty; targets = S.empty } t
+end
diff --git a/src/action.mli b/src/action.mli
index ba584f9b..0b60d8c0 100644
--- a/src/action.mli
+++ b/src/action.mli
@@ -21,6 +21,18 @@ val updated_files : t -> Path.Set.t
 (** Return the list of directories the action chdirs to *)
 val chdirs : t -> Path.Set.t
 
+(** Infer dependencies and targets *)
+module Infer : sig
+  module Outcome : sig
+    type t =
+      { deps    : Path.Set.t
+      ; targets : Path.Set.t
+      }
+  end
+
+  val infer : t -> Outcome.t
+end
+
 module Unexpanded : sig
   type action = t
 
diff --git a/src/path.ml b/src/path.ml
index 1c8b15a5..e7d2a1b8 100644
--- a/src/path.ml
+++ b/src/path.ml
@@ -192,6 +192,15 @@ module Local = struct
       else
         None
 
+  let is_descendant t ~of_ =
+    match of_ with
+    | "" -> true
+    | _ ->
+      let of_len = String.length of_ in
+      let t_len = String.length t in
+      (t_len = of_len && t = of_) ||
+      (t_len >= of_len && t.[of_len] = '/' && String.is_prefix t ~prefix:of_)
+
   let reach t ~from =
     let rec loop t from =
       match t, from with
@@ -290,6 +299,12 @@ let descendant t ~of_ =
   else
     None
 
+let is_descendant t ~of_ =
+  if is_local t && is_local of_ then
+    Local.is_descendant t ~of_
+  else
+    false
+
 let append a b =
   if not (is_local b) then
     Sexp.code_error "Path.append called with non-local second path"
diff --git a/src/path.mli b/src/path.mli
index 08997397..3cc9d9cb 100644
--- a/src/path.mli
+++ b/src/path.mli
@@ -59,6 +59,7 @@ val reach : t -> from:t -> string
 val reach_for_running : t -> from:t -> string
 
 val descendant : t -> of_:t -> t option
+val is_descendant : t -> of_:t -> bool
 
 val append : t -> t -> t
 
diff --git a/test/expect-tests/action.mlt b/test/expect-tests/action.mlt
new file mode 100644
index 00000000..73bcb0f9
--- /dev/null
+++ b/test/expect-tests/action.mlt
@@ -0,0 +1,38 @@
+(* -*- tuareg -*- *)
+
+#warnings "-40";;
+
+open Jbuilder;;
+open Import;;
+open Action.Infer.Outcome;;
+
+let p = Path.of_string;;
+let infer a =
+  let x = Action.Infer.infer a in
+  (List.map (Path.Set.elements x.deps) ~f:Path.to_string,
+   List.map (Path.Set.elements x.targets) ~f:Path.to_string)
+[%%expect{|
+val p : string -> Jbuilder.Path.t = <fun>
+val infer : Jbuilder__Action.t -> string list * string list = <fun>
+|}]
+
+infer (Copy (p "a", p "b"));;
+[%%expect{|
+- : string list * string list = (["a"], ["b"])
+|}]
+
+infer (Progn
+         [ Copy (p "a", p "b")
+         ; Copy (p "b", p "c")
+         ]);;
+[%%expect{|
+- : string list * string list = (["a"], ["b"; "c"])
+|}]
+
+infer (Progn
+         [ Copy (p "a", p "b")
+         ; Rename (p "b", p "c")
+         ]);;
+[%%expect{|
+- : string list * string list = (["a"], ["c"])
+|}]
diff --git a/test/expect-tests/jbuild b/test/expect-tests/jbuild
index d77f5b37..520d29cd 100644
--- a/test/expect-tests/jbuild
+++ b/test/expect-tests/jbuild
@@ -29,3 +29,10 @@
          (glob_files ${ROOT}/src/*.cmi)
          (glob_files ${ROOT}/vendor/re/*.cmi)))
   (action (chdir ${ROOT} (run ${exe:expect_test.bc} ${<})))))
+
+(alias
+ ((name runtest)
+  (deps (action.mlt
+         (glob_files ${ROOT}/src/*.cmi)
+         (glob_files ${ROOT}/vendor/re/*.cmi)))
+  (action (chdir ${ROOT} (run ${exe:expect_test.bc} ${<})))))