Add a (env var) dependency

Signed-off-by: Etienne Millon <me@emillon.org>

CHANGES.md

@@ -42,6 +42,9 @@ next
   wrapped modules but keep unwrapped modules with a deprecation message to
   preserve compatibility. (#1188, fix #985, @rgrinberg)
 
+- Add `(env var)` to add a dependency to an environment variable.
+  (#1186, @emillon)
+
 1.1.1 (08/08/2018)
 ------------------
 

bin/main.ml

@@ -1003,7 +1003,7 @@ let rules =
                   Format.pp_print_string ppf (Path.to_string p)))
                (Path.Set.to_list rule.targets)
                (fun ppf ->
-                  Dependencies.iter rule.deps ~on_file:(fun dep ->
+                  Dependencies.iter_paths rule.deps ~f:(fun dep ->
                     Format.fprintf ppf "@ %s" (Path.to_string dep)))
                Dsexp.pp_split_strings (sexp_of_action rule.action))
          end else begin

doc/dune-files.rst

@@ -1250,6 +1250,9 @@ syntax:
 - ``(package <pkg>)`` depend on all files installed by ``<package>``, as well
   as on the transitive package dependencies of ``<package>``. This can be used
   to test a command against the files that will be installed
+- ``(env <var>)``: depend on the value of the environment variable ``<var>``.
+  If this variable becomes set, becomes unset, or changes value, the target
+  will be rebuilt.
 
 In all these cases, the argument supports `Variables expansion`_.
 

src/action.ml

@@ -791,9 +791,9 @@ end
 
 let symlink_managed_paths sandboxed deps =
   let steps =
-    Dependencies.fold deps
+    Dependencies.fold_paths deps
       ~init:[]
-      ~on_file:(fun path acc ->
+      ~f:(fun path acc ->
         if Path.is_managed path then
           Symlink (path, sandboxed path)::acc
         else

src/build.ml

@@ -29,6 +29,7 @@ module Repr = struct
     | Memo : 'a memo -> (unit, 'a) t
     | Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
     | Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
+    | Env_var : string -> ('a, 'a) t
 
   and 'a memo =
     { name          : string
@@ -118,6 +119,8 @@ let dyn_paths t = Dyn_paths (t >>^ Path.Set.of_list)
 let dyn_path_set t = Dyn_paths t
 let paths_for_rule ps = Paths_for_rule ps
 
+let env_var s = Env_var s
+
 let catch t ~on_error = Catch (t, on_error)
 
 let contents p = Contents p

src/build.mli

@@ -66,6 +66,10 @@ val path_set : Path.Set.t -> ('a, 'a) t
     of the action produced by the build arrow. *)
 val paths_glob : loc:Loc.t -> dir:Path.t -> Re.re -> ('a, Path.Set.t) t
 
+(** [env_var v] records [v] as an environment variable that is read by the
+    action produced by the build arrow. *)
+val env_var : string -> ('a, 'a) t
+
 (** Compute the set of source of all files present in the sub-tree
     starting at [dir] and record them as dependencies. *)
 val source_tree
@@ -197,6 +201,7 @@ module Repr : sig
     | Memo : 'a memo -> (unit, 'a) t
     | Catch : ('a, 'b) t * (exn -> 'b) -> ('a, 'b) t
     | Lazy_no_targets : ('a, 'b) t Lazy.t -> ('a, 'b) t
+    | Env_var : string -> ('a, 'a) t
 
   and 'a memo =
     { name          : string

src/build_interpret.ml

@@ -122,6 +122,7 @@ let static_deps t ~all_targets ~file_tree =
     | Memo m -> loop m.t acc targets_allowed
     | Catch (t, _) -> loop t acc targets_allowed
     | Lazy_no_targets t -> loop (Lazy.force t) acc false
+    | Env_var var -> { acc with action_deps = Dependencies.add_env_var acc.action_deps var }
   in
   loop (Build.repr t)
     { rule_deps = Dependencies.empty
@@ -155,6 +156,7 @@ let lib_deps =
       | Memo m -> loop m.t acc
       | Catch (t, _) -> loop t acc
       | Lazy_no_targets t -> loop (Lazy.force t) acc
+      | Env_var _ -> acc
   in
   fun t -> loop (Build.repr t) Lib_name.Map.empty
 
@@ -198,6 +200,7 @@ let targets =
     | Memo m -> loop m.t acc
     | Catch (t, _) -> loop t acc
     | Lazy_no_targets _ -> acc
+    | Env_var _ -> acc
   in
   fun t -> loop (Build.repr t) []
 

src/build_system.ml

@@ -533,6 +533,8 @@ module Build_exec = struct
         end
       | Lazy_no_targets t ->
         exec dyn_deps (Lazy.force t) x
+      | Env_var _ ->
+        x
       | Memo m ->
         match m.state with
         | Evaluated (x, deps) ->
@@ -648,7 +650,7 @@ let make_local_parent_dirs t paths ~map_path =
   Path.Set.iter paths ~f:(make_local_parent_dirs_for t ~map_path)
 
 let make_local_parent_dirs_deps t paths ~map_path =
-  Dependencies.iter paths ~on_file:(make_local_parent_dirs_for t ~map_path)
+  Dependencies.iter_paths paths ~f:(make_local_parent_dirs_for t ~map_path)
 
 let sandbox_dir = Path.relative Path.build_dir ".sandbox"
 
@@ -752,9 +754,14 @@ let rec compile_rule t ?(copy_source=false) pre_rule =
     make_local_parent_dirs t targets ~map_path:(fun x -> x);
     let all_deps = Dependencies.union static_deps dyn_deps in
     let targets_as_list  = Path.Set.to_list targets  in
+    let env =
+      match context with
+      | None -> Env.empty
+      | Some c -> c.env
+    in
     let hash =
       let trace =
-        ( Dependencies.trace all_deps,
+        ( Dependencies.trace all_deps env,
           List.map targets_as_list ~f:Path.to_string,
           Option.map context ~f:(fun c -> c.name),
           Action.for_shell action)
@@ -1149,7 +1156,7 @@ and wait_for_file_found fn (File_spec.T file) =
       Fiber.Future.wait rule_execution)
 
 and wait_for_deps ~loc t deps =
-  Dependencies.parallel_iter deps ~on_file:(wait_for_file ~loc t)
+  Dependencies.parallel_iter_paths deps ~f:(wait_for_file ~loc t)
 
 let stamp_file_for_files_of t ~dir ~ext =
   let files_of_dir =
@@ -1256,7 +1263,7 @@ let eval_request t ~request ~process_target =
   in
 
   let process_targets ts =
-    Dependencies.parallel_iter ts ~on_file:process_target
+    Dependencies.parallel_iter_paths ts ~f:process_target
   in
 
   Fiber.fork_and_join_unit
@@ -1292,7 +1299,7 @@ let do_build t ~request =
 module Ir_set = Set.Make(Internal_rule)
 
 let rules_for_files t deps =
-  Dependencies.fold deps ~init:[] ~on_file:(fun path acc ->
+  Dependencies.fold_paths deps ~init:[] ~f:(fun path acc ->
     if Path.is_in_build_dir path then
       load_dir t ~dir:(Path.parent_exn path);
     match Path.Table.find t.files path with
@@ -1375,7 +1382,7 @@ end
 module Rule_set = Set.Make(Rule)
 
 let rules_for_files rules paths =
-  Dependencies.fold paths ~init:Rule_set.empty ~on_file:(fun path acc ->
+  Dependencies.fold_paths paths ~init:Rule_set.empty ~f:(fun path acc ->
     match Path.Map.find rules path with
     | None -> acc
     | Some rule -> Rule_set.add acc rule)
@@ -1428,7 +1435,7 @@ let build_rules_internal ?(recursive=false) t ~request =
         Fiber.return ()
       else
         Fiber.Future.wait rule >>= fun rule ->
-        Dependencies.parallel_iter rule.deps ~on_file:loop
+        Dependencies.parallel_iter_paths rule.deps ~f:loop
     end
   in
   let targets = ref Dependencies.empty in
@@ -1495,9 +1502,9 @@ let package_deps t pkg files =
             Option.value_exn (Fiber.Future.peek rule_evaluation)
           | Not_started _ -> assert false
         in
-        Dependencies.fold
+        Dependencies.fold_paths
           (Dependencies.union (Lazy.force ir.static_deps).action_deps dyn_deps)
-          ~init:acc ~on_file:loop
+          ~init:acc ~f:loop
       end
   in
   let open Build.O in

src/dependencies.ml

@@ -2,42 +2,73 @@ open! Import
 
 type t =
   { paths : Path.Set.t
+  ; vars : String.Set.t
   }
 
-let parallel_iter {paths} ~on_file =
-  Fiber.parallel_iter (Path.Set.to_list paths) ~f:on_file
+let parallel_iter_paths {paths; _} ~f =
+  Fiber.parallel_iter (Path.Set.to_list paths) ~f
 
-let iter {paths} ~on_file =
-  Path.Set.iter paths ~f:on_file
+let iter_paths {paths; _} ~f =
+  Path.Set.iter paths ~f
 
 let trace_path fn =
   (Path.to_string fn, Utils.Cached_digest.file fn)
 
-let trace {paths} =
-  List.map ~f:trace_path @@ Path.Set.to_list paths
+let trace_var env var =
+  let value =
+    match Env.get env var with
+    | None -> "unset"
+    | Some v -> Digest.string v |> Digest.to_hex
+  in
+  (var, value)
 
-let union {paths = paths_a} {paths = paths_b} =
+let trace {paths; vars} env =
+  List.concat
+    [ List.map ~f:trace_path @@ Path.Set.to_list paths
+    ; List.map ~f:(trace_var env) @@ String.Set.to_list vars
+    ]
+
+let union {paths = paths_a; vars = vars_a} {paths = paths_b; vars = vars_b} =
   { paths = Path.Set.union paths_a paths_b
+  ; vars = String.Set.union vars_a vars_b
   }
 
-let diff {paths = paths_a} {paths = paths_b} =
+let diff {paths = paths_a; vars = vars_a} {paths = paths_b; vars = vars_b} =
   { paths = Path.Set.diff paths_a paths_b
+  ; vars = String.Set.diff vars_a vars_b
   }
 
 let empty =
   { paths = Path.Set.empty
+  ; vars = String.Set.empty
+  }
+
+let add_path t path =
+  { t with
+    paths = Path.Set.add t.paths path
   }
 
-let add_path {paths} path =
-  { paths = Path.Set.add paths path
+let add_paths t fns =
+  { t with
+    paths = Path.Set.union t.paths fns
   }
 
-let add_paths {paths} fns =
-  { paths = Path.Set.union paths fns
+let add_env_var t var =
+  { t with
+    vars = String.Set.add t.vars var
   }
 
-let fold {paths} ~init ~on_file =
-  Path.Set.fold paths ~init ~f:on_file
+let fold_paths {paths; _} ~init ~f =
+  Path.Set.fold paths ~init ~f
 
-let to_sexp {paths} =
-  Dsexp.To_sexp.list Path_dsexp.dgen (Path.Set.to_list paths)
+let to_sexp {paths; vars} =
+  let sexp_paths =
+    Dsexp.To_sexp.list Path_dsexp.dgen (Path.Set.to_list paths)
+  in
+  let sexp_vars =
+    Dsexp.To_sexp.list Dsexp.To_sexp.string (String.Set.to_list vars)
+  in
+  Dsexp.To_sexp.record
+    [ ("paths", sexp_paths)
+    ; ("vars", sexp_vars)
+    ]

src/dependencies.mli

@@ -8,16 +8,28 @@ val diff : t -> t -> t
 
 val union : t -> t -> t
 
-val trace : t -> (string * string) list
+val trace : t -> Env.t -> (string * string) list
 
-val iter : t -> on_file:(Path.t -> unit) -> unit
+val iter_paths :
+  t
+  -> f:(Path.t -> unit)
+  -> unit
 
-val parallel_iter : t -> on_file:(Path.t -> unit Fiber.t) -> unit Fiber.t
+val parallel_iter_paths :
+  t
+  -> f:(Path.t -> unit Fiber.t)
+  -> unit Fiber.t
 
 val add_path : t -> Path.t -> t
 
 val add_paths : t -> Path.Set.t -> t
 
-val fold : t -> init:'a -> on_file:(Path.t -> 'a -> 'a) -> 'a
+val add_env_var : t -> string -> t
+
+val fold_paths :
+  t
+  -> init:'a
+  -> f:(Path.t -> 'a -> 'a)
+  -> 'a
 
 val to_sexp : t -> Dsexp.t

src/dune_file.ml

@@ -308,6 +308,7 @@ module Dep_conf = struct
     | Source_tree of String_with_vars.t
     | Package of String_with_vars.t
     | Universe
+    | Env_var of String_with_vars.t
 
   let remove_locs = function
     | File sw -> File (String_with_vars.remove_locs sw)
@@ -317,6 +318,7 @@ module Dep_conf = struct
     | Source_tree sw -> Source_tree (String_with_vars.remove_locs sw)
     | Package sw -> Package (String_with_vars.remove_locs sw)
     | Universe -> Universe
+    | Env_var sw -> Env_var sw
 
   let dparse =
     let dparse =
@@ -337,6 +339,7 @@ module Dep_conf = struct
           (let%map () = Syntax.since Stanza.syntax (1, 0)
            and x = sw in
            Source_tree x)
+        ; "env_var", (sw >>| fun x -> Env_var x)
         ]
     in
     if_list
@@ -365,6 +368,9 @@ module Dep_conf = struct
            ; String_with_vars.dgen t]
     | Universe ->
       Dsexp.unsafe_atom_of_string "universe"
+    | Env_var t ->
+      List [ Dsexp.unsafe_atom_of_string "env_var"
+           ; String_with_vars.dgen t]
 
   let to_sexp t = Dsexp.to_sexp (dgen t)
 end

src/dune_file.mli

@@ -119,6 +119,7 @@ module Dep_conf : sig
     | Source_tree of String_with_vars.t
     | Package of String_with_vars.t
     | Universe
+    | Env_var of String_with_vars.t
 
   val remove_locs : t -> t
 

src/env.ml

@@ -79,3 +79,6 @@ let update t ~var ~f =
 
 let of_string_map m =
   make (String.Map.foldi ~init:Map.empty ~f:(fun k v acc -> Map.add acc k v) m)
+
+let iter t =
+  Map.iteri t.vars

src/env.mli

@@ -31,3 +31,5 @@ val update : t -> var:string -> f:(string option -> string option) -> t
 val to_sexp : t -> Sexp.t
 
 val of_string_map : string String.Map.t -> t
+
+val iter : t -> f:(string -> string -> unit) -> unit

src/super_context.ml

@@ -739,6 +739,10 @@ module Deps = struct
     | Universe ->
       Build.path Build_system.universe_file
       >>^ fun () -> []
+    | Env_var var_sw ->
+      let var = expand_vars_string t ~scope ~dir var_sw in
+      Build.env_var var
+      >>^ fun () -> []
 
   let interpret t ~scope ~dir l =
     List.map l ~f:(dep t ~scope ~dir)