diff --git a/doc/jbuild.rst b/doc/jbuild.rst index 630d10fa..23abe375 100644 --- a/doc/jbuild.rst +++ b/doc/jbuild.rst @@ -927,6 +927,7 @@ The following constructions are available: ```` is one of: ``stdout``, ``stderr`` or ``outputs`` - ``(progn ...)`` to execute several commands in sequence - ``(echo )`` to output a string on stdout +- ``(write-file )`` writes ```` to ```` - ``(cat )`` to print the contents of a file to stdout - ``(copy )`` to copy a file - ``(copy# )`` to copy a file and add a line directive at diff --git a/src/action.ml b/src/action.ml index 70a5e21d..6fc9cbf2 100644 --- a/src/action.ml +++ b/src/action.ml @@ -56,6 +56,7 @@ struct Copy_and_add_line_directive (src, dst)) ; cstr "system" (string @> nil) (fun cmd -> System cmd) ; cstr "bash" (string @> nil) (fun cmd -> Bash cmd) + ; cstr "write-file" (path @> string @> nil) (fun fn s -> Write_file (fn, s)) ] sexp @@ -85,7 +86,7 @@ struct List [Atom "copy#"; path x; path y] | System x -> List [Atom "system"; string x] | Bash x -> List [Atom "bash"; string x] - | Update_file (x, y) -> List [Atom "update-file"; path x; string y] + | Write_file (x, y) -> List [Atom "write-file"; path x; string y] | Rename (x, y) -> List [Atom "rename"; path x; path y] | Remove_tree x -> List [Atom "remove-tree"; path x] | Mkdir x -> List [Atom "mkdir"; path x] @@ -118,7 +119,7 @@ module Make_mapper Copy_and_add_line_directive (f_path x, f_path y) | System x -> System (f_string x) | Bash x -> Bash (f_string x) - | Update_file (x, y) -> Update_file (f_path x, f_string y) + | Write_file (x, y) -> Write_file (f_path x, f_string y) | Rename (x, y) -> Rename (f_path x, f_path y) | Remove_tree x -> Remove_tree (f_path x) | Mkdir x -> Mkdir (f_path x) @@ -330,7 +331,7 @@ module Unexpanded = struct Copy_and_add_line_directive (E.path ~dir ~f x, E.path ~dir ~f y) | System x -> System (E.string ~dir ~f x) | Bash x -> Bash (E.string ~dir ~f x) - | Update_file (x, y) -> Update_file (E.path ~dir ~f x, E.string ~dir ~f y) + | Write_file (x, y) -> Write_file (E.path ~dir ~f x, E.string ~dir ~f y) | Rename (x, y) -> Rename (E.path ~dir ~f x, E.path ~dir ~f y) | Remove_tree x -> @@ -428,7 +429,7 @@ module Unexpanded = struct Copy_and_add_line_directive (E.path ~dir ~f x, E.path ~dir ~f y) | System x -> System (E.string ~dir ~f x) | Bash x -> Bash (E.string ~dir ~f x) - | Update_file (x, y) -> Update_file (E.path ~dir ~f x, E.string ~dir ~f y) + | Write_file (x, y) -> Write_file (E.path ~dir ~f x, E.string ~dir ~f y) | Rename (x, y) -> Rename (E.path ~dir ~f x, E.path ~dir ~f y) | Remove_tree x -> @@ -458,7 +459,7 @@ let fold_one_step t ~init:acc ~f = | Copy_and_add_line_directive _ | System _ | Bash _ - | Update_file _ + | Write_file _ | Rename _ | Remove_tree _ | Mkdir _ @@ -470,7 +471,7 @@ let updated_files = let rec loop acc t = let acc = match t with - | Update_file (fn, _) -> Path.Set.add fn acc + | Write_file (fn, _) -> Path.Set.add fn acc | _ -> acc in fold_one_step t ~init:acc ~f:loop @@ -523,6 +524,9 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to = | Setenv (var, value, t) -> exec t ~ectx ~dir ~stdout_to ~stderr_to ~env_extra:(Env_var_map.add env_extra ~key:var ~data:value) + | Redirect (Stdout, fn, Echo s) -> + Io.write_file (Path.to_string fn) s; + return () | Redirect (outputs, fn, t) -> redirect ~ectx ~dir outputs fn t ~env_extra ~stdout_to ~stderr_to | Ignore (outputs, t) -> @@ -579,12 +583,8 @@ let rec exec t ~ectx ~dir ~env_extra ~stdout_to ~stderr_to = run ~ectx ~dir ~env_extra ~stdout_to ~stderr_to (Utils.bash_exn ~needed_to:"interpret (bash ...) actions") ["-e"; "-u"; "-o"; "pipefail"; "-c"; cmd] - | Update_file (fn, s) -> - let fn = Path.to_string fn in - if Sys.file_exists fn && Io.read_file fn = s then - () - else - Io.write_file fn s; + | Write_file (fn, s) -> + Io.write_file (Path.to_string fn) s; return () | Rename (src, dst) -> Unix.rename (Path.to_string src) (Path.to_string dst); @@ -681,7 +681,7 @@ module Infer = struct | Run (prog, _) -> acc +< prog | Redirect (_, fn, t) -> infer (acc +@ fn) t | Cat fn -> acc +< fn - | Update_file (fn, _) -> acc +@ fn + | Write_file (fn, _) -> acc +@ fn | Rename (src, dst) -> acc +< src +@ dst | Copy (src, dst) | Copy_and_add_line_directive (src, dst) @@ -722,7 +722,7 @@ module Infer = struct | Run (_, _) -> acc | Redirect (_, fn, t) -> partial (acc +@? fn) t | Cat fn -> acc + acc +@? fn + | Write_file (fn, _) -> acc +@? fn | Rename (src, dst) -> acc + acc | Redirect (_, fn, t) -> partial_with_all_targets (acc +@? fn) t | Cat fn -> acc + acc +@? fn + | Write_file (fn, _) -> acc +@? fn | Rename (src, dst) -> acc + action | Some dir -> Action.Chdir (dir, action) -let update_file fn s = - action ~targets:[fn] (Update_file (fn, s)) +let write_file fn s = + action ~targets:[fn] (Write_file (fn, s)) -let update_file_dyn fn = +let write_file_dyn fn = Targets [fn] >>^ fun s -> - Action.Update_file (fn, s) + Action.Write_file (fn, s) let copy ~src ~dst = path src >>> diff --git a/src/build.mli b/src/build.mli index ba950ec1..e7c6dfcf 100644 --- a/src/build.mli +++ b/src/build.mli @@ -103,10 +103,9 @@ val action_dyn -> unit -> (Action.t, Action.t) t -(** Create a file with the given contents. Do not ovewrite the file if - it hasn't changed. *) -val update_file : Path.t -> string -> (unit, Action.t) t -val update_file_dyn : Path.t -> (string, Action.t) t +(** Create a file with the given contents. *) +val write_file : Path.t -> string -> (unit, Action.t) t +val write_file_dyn : Path.t -> (string, Action.t) t val copy : src:Path.t -> dst:Path.t -> (unit, Action.t) t diff --git a/src/build_system.ml b/src/build_system.ml index e9bbd10b..1219dcc2 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -253,7 +253,7 @@ module Build_exec = struct | Store_vfile (Vspec.T (fn, kind)) -> let file = get_file bs fn (Sexp_file kind) in file.data <- Some x; - Update_file (fn, vfile_to_string kind fn x) + Write_file (fn, vfile_to_string kind fn x) | Compose (a, b) -> exec dyn_deps a x |> exec dyn_deps b | First t -> diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 8a109458..699013ce 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -253,7 +253,7 @@ module Gen(P : Params) = struct main_module_name m.name m.name (Module.real_unit_name m)) |> String.concat ~sep:"\n") - >>> Build.update_file_dyn (Path.relative dir m.impl.name))); + >>> Build.write_file_dyn (Path.relative dir m.impl.name))); let requires, real_requires = SC.Libs.requires sctx ~dir ~dep_kind ~item:lib.name @@ -838,7 +838,7 @@ Add it to your jbuild file to remove this warning. Format.pp_print_flush ppf (); Buffer.contents buf) >>> - Build.update_file_dyn meta_path); + Build.write_file_dyn meta_path); if has_meta || has_meta_tmpl then Some pkg.name @@ -970,7 +970,7 @@ Add it to your jbuild file to remove this warning. >>^ (fun () -> Install.gen_install_file entries) >>> - Build.update_file_dyn fn) + Build.write_file_dyn fn) let () = let entries_per_package = diff --git a/src/merlin.ml b/src/merlin.ml index 7d351d28..67e42da5 100644 --- a/src/merlin.ml +++ b/src/merlin.ml @@ -36,7 +36,7 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) = SC.add_rule sctx (Build.path path >>> - Build.update_file (Path.relative dir ".merlin-exists") ""); + Build.write_file (Path.relative dir ".merlin-exists") ""); SC.add_rule sctx ( requires &&& flags >>^ (fun (libs, flags) -> @@ -77,7 +77,7 @@ let dot_merlin sctx ~dir ({ requires; flags; _ } as t) = |> List.map ~f:(Printf.sprintf "%s\n") |> String.concat ~sep:"") >>> - Build.update_file_dyn path + Build.write_file_dyn path ) | _ -> () diff --git a/src/odoc.ml b/src/odoc.ml index 934e4122..6aa401c8 100644 --- a/src/odoc.ml +++ b/src/odoc.ml @@ -89,7 +89,7 @@ let lib_index sctx ~odoc ~dir ~(lib : Library.t) ~lib_public_name ~doc_dir ~modu lib_public_name (String_map.keys modules |> String.concat ~sep:" ")))) >>> - Build.update_file_dyn generated_index_mld); + Build.write_file_dyn generated_index_mld); let html_file = doc_dir ++ lib_public_name ++ "index.html" in diff --git a/src/utop.ml b/src/utop.ml index c8cdc04e..d8c2706e 100644 --- a/src/utop.ml +++ b/src/utop.ml @@ -29,7 +29,7 @@ let add_module_rules sctx ~dir lib_requires = pp_ml fmt include_paths; Format.pp_print_flush fmt (); Buffer.contents b) - >>> Build.update_file_dyn path in + >>> Build.write_file_dyn path in Super_context.add_rule sctx utop_ml let utop_of_libs (libs : Library.t list) =