diff --git a/bin/print_rules.ml b/bin/print_rules.ml index 2d71ccf7577..28147cc531f 100644 --- a/bin/print_rules.ml +++ b/bin/print_rules.ml @@ -71,6 +71,8 @@ let rec encode_action : Action.For_shell.t -> Dune_lang.t = ] | Ignore (outputs, r) -> List [ atom (sprintf "ignore-%s" (Outputs.to_string outputs)); encode_action r ] + | If_file_exists (path, action) -> + List [ atom "if-file-exists"; Encoder.string path; encode_action action ] | Progn l -> List (atom "progn" :: List.map l ~f:encode_action) | Concurrent l -> List (atom "concurrent" :: List.map l ~f:encode_action) | Echo xs -> List (atom "echo" :: List.map xs ~f:string) diff --git a/doc/changes/added/16209.md b/doc/changes/added/16209.md new file mode 100644 index 00000000000..a51b30ff043 --- /dev/null +++ b/doc/changes/added/16209.md @@ -0,0 +1,3 @@ +- Format generated corrections before optional text diffs compare or promote + them, according to the source's formatting configuration, starting in Dune + 3.25. (#16209, @rgrinberg) diff --git a/src/dune_engine/action.ml b/src/dune_engine/action.ml index 8436adf5e6d..b5e77aa1046 100644 --- a/src/dune_engine/action.ml +++ b/src/dune_engine/action.ml @@ -47,6 +47,7 @@ struct let ignore_stdout t = Ignore (Stdout, t) let ignore_stderr t = Ignore (Stderr, t) let ignore_outputs t = Ignore (Outputs, t) + let if_file_exists path t = If_file_exists (path, t) let progn ts = Progn ts let concurrent ts = Concurrent ts let echo s = Echo s @@ -309,6 +310,10 @@ let digest = | System command -> int d 22; string d command + | If_file_exists (path, t) -> + int d 23; + digest_path d ~dir path; + loop d t ~dir in fun d t -> loop d t ~dir:Path.root ;; @@ -320,6 +325,7 @@ let fold_one_step t ~init:acc ~f = | Redirect_out (_, _, _, t) | Redirect_in (_, _, t) | Ignore (_, t) + | If_file_exists (_, t) | With_accepted_exit_codes (_, t) -> f acc t | Progn l | Pipe (_, l) | Concurrent l -> List.fold_left l ~init:acc ~f | Run _ @@ -367,6 +373,7 @@ let exists t ~leaf ~extension = | Redirect_out (_, _, _, t) | Redirect_in (_, _, t) | Ignore (_, t) + | If_file_exists (_, t) | With_accepted_exit_codes (_, t) -> loop t | Progn l | Pipe (_, l) | Concurrent l -> List.exists l ~f:loop | Extension extension_ -> extension extension_ @@ -423,7 +430,7 @@ let is_useful_to memoize = | Setenv (_, _, t) -> loop t | Redirect_out (_, _, _, t) -> memoize || loop t | Redirect_in (_, _, t) -> loop t - | Ignore (_, t) | With_accepted_exit_codes (_, t) -> loop t + | Ignore (_, t) | If_file_exists (_, t) | With_accepted_exit_codes (_, t) -> loop t | Progn l | Pipe (_, l) | Concurrent l -> List.exists l ~f:loop | Echo _ -> false | Cat _ -> memoize diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml index 6c52000ac02..d4e287b8022 100644 --- a/src/dune_engine/action_exec.ml +++ b/src/dune_engine/action_exec.ml @@ -128,6 +128,8 @@ let rec exec t ~ectx ~eenv : Done_or_more_deps.t Fiber.t = redirect_out t ~ectx ~eenv outputs ~perm fn | Redirect_in (inputs, fn, t) -> redirect_in t ~ectx ~eenv inputs fn | Ignore (outputs, t) -> redirect_out t ~ectx ~eenv ~perm:Normal outputs Dev_null.path + | If_file_exists (path, t) -> + if Fpath.exists (Path.to_string path) then exec t ~ectx ~eenv else Fiber.return Done | Progn ts -> exec_list ts ~ectx ~eenv | Concurrent ts -> Fiber.parallel_map ts ~f:(fun t -> diff --git a/src/dune_engine/action_intf.ml b/src/dune_engine/action_intf.ml index 3544a8c337a..a55fbc31ca7 100644 --- a/src/dune_engine/action_intf.ml +++ b/src/dune_engine/action_intf.ml @@ -47,6 +47,7 @@ module type Ast = sig | Redirect_out of Outputs.t * target * File_perm.t * t | Redirect_in of Inputs.t * path * t | Ignore of Outputs.t * t + | If_file_exists of path * t | Progn of t list | Concurrent of t list | Echo of string list @@ -82,6 +83,7 @@ module type Helpers = sig val ignore_stdout : t -> t val ignore_stderr : t -> t val ignore_outputs : t -> t + val if_file_exists : path -> t -> t val progn : t list -> t val concurrent : t list -> t val echo : string list -> t diff --git a/src/dune_engine/action_mapper.ml b/src/dune_engine/action_mapper.ml index 14713ad2639..94d25312bbc 100644 --- a/src/dune_engine/action_mapper.ml +++ b/src/dune_engine/action_mapper.ml @@ -29,6 +29,7 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct Redirect_out (outputs, f_target ~dir fn, perm, f t ~dir) | Redirect_in (inputs, fn, t) -> Redirect_in (inputs, f_path ~dir fn, f t ~dir) | Ignore (outputs, t) -> Ignore (outputs, f t ~dir) + | If_file_exists (path, t) -> If_file_exists (f_path ~dir path, f t ~dir) | Progn l -> Progn (List.map l ~f:(fun t -> f t ~dir)) | Concurrent l -> Concurrent (List.map l ~f:(fun t -> f t ~dir)) | Echo xs -> Echo (List.map xs ~f:(f_string ~dir)) diff --git a/src/dune_lang/format.ml b/src/dune_lang/format.ml index 895b40ce7ea..a762dfe9f4f 100644 --- a/src/dune_lang/format.ml +++ b/src/dune_lang/format.ml @@ -78,5 +78,17 @@ let format_to_channel ~version ~src oc = ;; let format_action ~version ~src ~dst = - Path.build dst |> Io.with_file_out ~f:(format_to_channel ~version ~src) + let dst = Path.build dst in + if Path.equal src dst + then + Temp.with_temp_file + ~dir:(Path.parent_exn dst) + ~prefix:"dune-format" + ~suffix:"output" + ~f:(function + | Error exn -> raise exn + | Ok temporary -> + Io.with_file_out temporary ~f:(format_to_channel ~version ~src); + Fpath.rename_exn (Path.to_string temporary) (Path.to_string dst)) + else Io.with_file_out dst ~f:(format_to_channel ~version ~src) ;; diff --git a/src/dune_rules/action_unexpanded.ml b/src/dune_rules/action_unexpanded.ml index 0d72246536b..c6968b2f8dc 100644 --- a/src/dune_rules/action_unexpanded.ml +++ b/src/dune_rules/action_unexpanded.ml @@ -51,6 +51,7 @@ module Action_expander : sig -> 'a Action_builder.With_targets.t Memo.t val with_expander : (Expander.t -> 'a t Memo.t) -> 'a t + val bind_action_builder : 'a t -> f:('a -> 'b Action_builder.t) -> 'b t (* String with vars expansion *) module E : sig @@ -124,6 +125,11 @@ end = struct f env acc ;; + let bind_action_builder t ~f env acc = + let+! action, acc = t env acc in + Action_builder.bind action ~f, acc + ;; + let map t ~f env acc = let+! b, acc = t env acc in Action_builder.map b ~f, acc @@ -465,11 +471,27 @@ end = struct end end -let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = +type format_generated_diffs = + | Do_not_format + | Format of Super_context.t + +let combine_actions actions ~f = + let action_values = + List.map actions ~f:(fun (action : Action.Full.t) -> action.action) + in + Action.Full.make Action.empty :: actions + |> Action.Full.reduce + |> Action.Full.map ~f:(fun (_ : Action.t) -> f action_values) +;; + +let rec expand_action ~format_generated_diffs (t : Dune_lang.Action.t) + : Action.Full.t Action_expander.t + = let module A = Action_expander in let module E = Action_expander.E in let open Action_expander.O in let module O (* [O] for "outcome" *) = Action in + let expand = expand_action ~format_generated_diffs in let expand_run ~force_host prog args = let+ args = A.all (List.map args ~f:E.strings) and+ prog, more_args = E.prog_and_args ~force_host prog in @@ -490,6 +512,7 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = | prog :: args -> let+ prog, args = expand_run ~force_host prog args in O.Run { prog; args = Appendable_list.of_list args; can_run_in_action_runner = true } + |> Action.Full.make | [] -> User_error.raise [ Pp.textf "\"%s\" action must have at least one argument" action_name ] @@ -499,44 +522,44 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = | Runexec args -> expand_run_action ~force_host:true ~action_name:"runexec" args | With_accepted_exit_codes (pred, t) -> let+ t = expand t in - O.With_accepted_exit_codes (pred, t) + Action.Full.map t ~f:(fun t -> O.With_accepted_exit_codes (pred, t)) | Dynamic_run (prog, args) -> let+ prog, args = expand_run ~force_host:false prog args in - Action_plugin.action ~prog ~args + Action_plugin.action ~prog ~args |> Action.Full.make | Chdir (fn, t) -> E.At_rule_eval_stage.path fn ~f:(fun dir -> A.chdir (Expander0.as_in_build_dir dir ~loc:(String_with_vars.loc fn) ~what:"Directory") (let+ t = expand t in - O.Chdir (dir, t))) + Action.Full.map t ~f:(fun t -> O.Chdir (dir, t)))) | Setenv (var, value, t) -> E.At_rule_eval_stage.string var ~f:(fun var -> A.set_env ~var ~value:(E.string value) (let+ t = expand t in - fun ~value -> O.Setenv (var, value, t))) + fun ~value -> Action.Full.map t ~f:(fun t -> O.Setenv (var, value, t)))) | Redirect_out (outputs, fn, perm, t) -> let+ fn = E.target fn and+ t = expand t in - O.Redirect_out (outputs, fn, perm, t) + Action.Full.map t ~f:(fun t -> O.Redirect_out (outputs, fn, perm, t)) | Redirect_in (inputs, fn, t) -> let+ fn = E.dep fn and+ t = expand t in - O.Redirect_in (inputs, fn, t) + Action.Full.map t ~f:(fun t -> O.Redirect_in (inputs, fn, t)) | Ignore (outputs, t) -> let+ t = expand t in - O.Ignore (outputs, t) + Action.Full.map t ~f:(fun t -> O.Ignore (outputs, t)) | Progn l -> let+ l = A.all (List.map l ~f:expand) in - O.Progn l + combine_actions l ~f:(fun l -> O.Progn l) | Concurrent l -> let+ l = A.all (List.map l ~f:expand) in - O.Concurrent l + combine_actions l ~f:(fun l -> O.Concurrent l) | Echo xs -> let+ l = A.all (List.map xs ~f:E.strings) in let l = List.concat l in - O.Echo l + O.Echo l |> Action.Full.make | Cat xs -> A.with_expander (fun expander -> let version = Expander.project expander |> Dune_project.dune_version in @@ -545,18 +568,18 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = (if version >= (3, 10) then let+ xs = A.all (List.map xs ~f:E.deps) in - O.Cat (List.concat xs) + O.Cat (List.concat xs) |> Action.Full.make else let+ xs = A.all (List.map xs ~f:E.dep) in - O.Cat xs)) + O.Cat xs |> Action.Full.make)) | Copy (x, y) -> let+ x = E.dep x and+ y = E.target y in - O.Copy (x, y) + O.Copy (x, y) |> Action.Full.make | Symlink (x, y) -> let+ x = E.dep x and+ y = E.target y in - O.Symlink (x, y) + O.Symlink (x, y) |> Action.Full.make | Copy_and_add_line_directive (x, y) -> A.with_expander (fun expander -> Expander.context expander @@ -564,24 +587,24 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = |> Memo.map ~f:(fun context -> let+ x = E.dep x and+ y = E.target y in - Copy_line_directive.action context ~src:x ~dst:y)) + Copy_line_directive.action context ~src:x ~dst:y |> Action.Full.make)) | System x -> let+ x = E.string x in - O.System x + O.System x |> Action.Full.make | Bash x -> let+ script = E.string x in - O.Bash { script; can_run_in_action_runner = true } + O.Bash { script; can_run_in_action_runner = true } |> Action.Full.make | Write_file (fn, perm, s) -> let+ fn = E.target fn and+ s = E.string s in - O.Write_file (fn, perm, s) + O.Write_file (fn, perm, s) |> Action.Full.make | Mkdir x -> (* This code path should in theory be unreachable too, but we don't delete it to remember about the check in in case we expose [mkdir] in the syntax one day. *) let+ path = E.path x in (match Path.as_in_build_dir path with - | Some path -> O.Mkdir path + | Some path -> O.Mkdir path |> Action.Full.make | None -> User_error.raise ~loc:(String_with_vars.loc x) @@ -595,23 +618,44 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = ])) ]) | Diff { optional; file1; file2; mode; directory_diffs } -> - let+ file1 = E.dep_if_exists file1 - and+ () = E.source_tree_if_directory file1 - and+ file2 = - if optional - then E.consume_file file2 - else - let+ p = E.dep file2 in - Expander0.as_in_build_dir p ~loc:(String_with_vars.loc file2) ~what:"File" - in - Action.diff ~optional ~mode ~directory_diffs file1 file2 + A.with_expander (fun expander -> + Memo.return + (let paths = + let+ file1 = E.dep_if_exists file1 + and+ () = E.source_tree_if_directory file1 + and+ file2 = + if optional + then E.consume_file file2 + else + let+ p = E.dep file2 in + Expander0.as_in_build_dir p ~loc:(String_with_vars.loc file2) ~what:"File" + in + file1, file2 + in + A.bind_action_builder paths ~f:(fun (file1, file2) -> + let diff = Action.diff ~optional ~mode ~directory_diffs file1 file2 in + match format_generated_diffs, optional, mode with + | Format sctx, true, Text -> + let source_dir = + Path.as_in_build_dir file1 + |> Option.map ~f:Path.Build.parent_exn + |> Option.value ~default:(Expander.dir expander) + in + Format_generated.format_diff + sctx + ~dir:source_dir + ~source:file1 + ~target:file2 + ~diff + | (Do_not_format | Format _), _, _ -> + Action_builder.return (Action.Full.make diff)))) | No_infer t -> A.no_infer (expand t) | Pipe (outputs, l) -> let+ l = A.all (List.map l ~f:expand) in - O.Pipe (outputs, l) + combine_actions l ~f:(fun l -> O.Pipe (outputs, l)) | Cram script -> let+ script = E.dep script in - Cram_exec.action script + Cram_exec.action script |> Action.Full.make | Format_dune_file (src, dst) -> A.with_expander (fun expander -> let version = Expander.project expander |> Dune_project.dune_version in @@ -619,13 +663,22 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = Memo.return (let+ src = E.dep src and+ dst = E.target dst in - Format_dune_file.action ~version src dst)) + Format_dune_file.action ~version src dst |> Action.Full.make)) | Withenv _ | Substitute _ | Patch _ | When _ -> (* these can only be provided by the package language which isn't expanded here *) assert false ;; -let expand_no_targets t sandbox ~loc ~chdir ~deps:deps_written_by_user ~expander ~what = +let expand_no_targets_internal + ~format_generated_diffs + t + sandbox + ~loc + ~chdir + ~deps:deps_written_by_user + ~expander + ~what + = let open Action_builder.O in let env, expander, sandbox = Dep_conf_eval.named ~expander sandbox deps_written_by_user @@ -634,7 +687,7 @@ let expand_no_targets t sandbox ~loc ~chdir ~deps:deps_written_by_user ~expander Expander.set_expanding_what expander (User_action_without_targets { what }) in let* { Action_builder.With_targets.build = action; targets } = - expand t + expand_action ~format_generated_diffs t |> Action_expander.run ~chdir ~targets_dir:None ~expander |> Action_builder.of_memo in @@ -651,11 +704,46 @@ let expand_no_targets t sandbox ~loc ~chdir ~deps:deps_written_by_user ~expander let+ sandbox and+ env and+ action in - let action = Action.Chdir (Path.build chdir, action) in - Action.Full.make action ~sandbox |> Action.Full.add_env env + Action.Full.map action ~f:(fun action -> Action.Chdir (Path.build chdir, action)) + |> Action.Full.add_sandbox sandbox + |> Action.Full.add_env env +;; + +let expand_no_targets t sandbox ~loc ~chdir ~deps ~expander ~what = + expand_no_targets_internal + ~format_generated_diffs:Do_not_format + t + sandbox + ~loc + ~chdir + ~deps + ~expander + ~what ;; -let expand +let expand_no_targets_with_formatted_diffs + sctx + t + sandbox + ~loc + ~chdir + ~deps + ~expander + ~what + = + expand_no_targets_internal + ~format_generated_diffs:(Format sctx) + t + sandbox + ~loc + ~chdir + ~deps + ~expander + ~what +;; + +let expand_internal + ~format_generated_diffs t sandbox ~loc @@ -691,7 +779,8 @@ let expand Expander.set_expanding_what expander (User_action targets_written_by_user) in let+! { Action_builder.With_targets.build = action; targets } = - expand t |> Action_expander.run ~chdir ~targets_dir:(Some targets_dir) ~expander + expand_action ~format_generated_diffs t + |> Action_expander.run ~chdir ~targets_dir:(Some targets_dir) ~expander in let targets = match (targets_written_by_user : _ Targets_spec.t) with @@ -712,13 +801,49 @@ let expand let+ sandbox and+ env and+ action in - Action.Chdir (Path.build chdir, action) - |> Action.Full.make ~sandbox + Action.Full.map action ~f:(fun action -> Action.Chdir (Path.build chdir, action)) + |> Action.Full.add_sandbox sandbox |> Action.Full.add_env env in Action_builder.with_targets ~targets build ;; +let expand t sandbox ~loc ~chdir ~deps ~targets_dir ~targets ~expander = + expand_internal + ~format_generated_diffs:Do_not_format + t + sandbox + ~loc + ~chdir + ~deps + ~targets_dir + ~targets + ~expander +;; + +let expand_with_formatted_diffs + sctx + t + sandbox + ~loc + ~chdir + ~deps + ~targets_dir + ~targets + ~expander + = + expand_internal + ~format_generated_diffs:(Format sctx) + t + sandbox + ~loc + ~chdir + ~deps + ~targets_dir + ~targets + ~expander +;; + (* We re-export [Dune_lang.Action] in the end to avoid polluting the inferred types in this module with all the various t's *) include Dune_lang.Action diff --git a/src/dune_rules/action_unexpanded.mli b/src/dune_rules/action_unexpanded.mli index 4e9b3036070..e01d4d8ecad 100644 --- a/src/dune_rules/action_unexpanded.mli +++ b/src/dune_rules/action_unexpanded.mli @@ -28,6 +28,18 @@ val expand -> expander:Expander.t -> Action.Full.t Action_builder.With_targets.t Memo.t +val expand_with_formatted_diffs + : Super_context.t + -> t + -> Sandbox_config.t + -> loc:Loc.t + -> chdir:Path.Build.t + -> deps:Dep_conf.t Bindings.t + -> targets_dir:Path.Build.t + -> targets:Path.Build.t Targets_spec.t + -> expander:Expander.t + -> Action.Full.t Action_builder.With_targets.t Memo.t + (** [what] as the same meaning as the argument of [Expander.Expanding_what.User_action_without_targets] *) val expand_no_targets @@ -39,3 +51,14 @@ val expand_no_targets -> expander:Expander.t -> what:string -> Action.Full.t Action_builder.t + +val expand_no_targets_with_formatted_diffs + : Super_context.t + -> t + -> Sandbox_config.t + -> loc:Loc.t + -> chdir:Path.Build.t + -> deps:Dep_conf.t Bindings.t + -> expander:Expander.t + -> what:string + -> Action.Full.t Action_builder.t diff --git a/src/dune_rules/cinaps.ml b/src/dune_rules/cinaps.ml index fd8ce4f2df7..d607ae4d4c0 100644 --- a/src/dune_rules/cinaps.ml +++ b/src/dune_rules/cinaps.ml @@ -257,23 +257,34 @@ let gen_rules sctx t ~dir ~scope = in Dep_conf_eval.unnamed sandbox ~expander t.runtime_deps in + let checks = + List.map cinapsed_files ~f:(fun source -> + let target = + Path.Build.extend_basename source ~suffix:Filename.cinaps_corrected + in + let source = Path.build source in + let diff = Action.diff ~optional:true source target in + Format_generated.format_diff sctx ~dir ~source ~target ~diff) + |> Action_builder.all + in let+ () = cinaps_exe :: List.rev_map cinapsed_files ~f:Path.build |> Dep.Set.of_files |> Action_builder.deps - and+ env in - Action.Full.make ~sandbox - @@ Action.chdir - (Path.build dir) - (Action.progn - [ Action.run (Ok cinaps_exe) [ "-diff-cmd"; "-" ] - ; Action.concurrent - @@ List.map cinapsed_files ~f:(fun fn -> - Action.diff - ~optional:true - (Path.build fn) - (Path.Build.extend_basename fn ~suffix:Filename.cinaps_corrected)) - ]) + and+ env + and+ checks in + let check_actions = + List.map checks ~f:(fun (check : Action.Full.t) -> check.action) + in + Action.Full.reduce checks + |> Action.Full.map ~f:(fun _ -> + Action.chdir + (Path.build dir) + (Action.progn + [ Action.run (Ok cinaps_exe) [ "-diff-cmd"; "-" ] + ; Action.concurrent check_actions + ])) + |> Action.Full.add_sandbox sandbox |> Action.Full.add_env env in Super_context.add_alias_action sctx ~dir ~loc [ cinaps_alias ] action diff --git a/src/dune_rules/format_generated.ml b/src/dune_rules/format_generated.ml new file mode 100644 index 00000000000..a3269b75b7d --- /dev/null +++ b/src/dune_rules/format_generated.ml @@ -0,0 +1,162 @@ +open Import +open Memo.O + +type t = + | Dune of Dune_lang.Syntax.Version.t + | Ocamlformat of Ml_kind.t + +let rec subdirs_until_root dir = + match Path.parent dir with + | None -> [ dir ] + | Some parent -> dir :: subdirs_until_root parent +;; + +let ocamlformat_flag = function + | Ml_kind.Impl -> "--impl" + | Intf -> "--intf" +;; + +let ocamlformat_dev_tool_lock_dir_exists () = + match Config.get Compile_time.lock_dev_tools with + | `Enabled -> Memo.return true + | `Disabled -> + let path = Lock_dir.dev_tool_external_lock_dir Ocamlformat in + Fs_memo.dir_exists (Path.Outside_build_dir.External path) +;; + +let ocamlformat_config_deps ~dir = + let names = [ ".ocamlformat"; ".ocamlformat-ignore"; ".ocamlformat-enable" ] in + subdirs_until_root (Path.build dir) + |> List.concat_map ~f:(fun dir -> List.map names ~f:(Path.relative dir)) + |> Action_builder.paths_existing +;; + +let format_config ~dir = + let+ value = + Env_stanza_db.value_opt ~dir ~f:(fun (config : Dune_env.config) -> + Memo.return config.format_config) + and+ default = + Path.Build.drop_build_context_exn dir + |> Source_tree.nearest_dir + >>| Source_tree.Dir.project + >>| Dune_project.format_config + in + Option.value value ~default +;; + +let dialect_formatter config project source = + let open Option.O in + let dialects = Dune_project.dialects project in + let* dialect, kind = + Path.extension source + |> Filename.Extension.Or_empty.extension + |> Option.bind ~f:(Dialect.DB.find_by_extension dialects) + in + let* () = + Option.some_if (Format_config.includes config (Dialect (Dialect.name dialect))) () + in + let* format = + match Dialect.format dialect kind with + | Some format -> Some format + | None -> + (match Dialect.preprocess dialect kind with + | None -> Dialect.format Dialect.ocaml kind + | Some _ -> None) + in + match format with + | Ocamlformat -> Some (Ocamlformat kind) + | Action _ -> None +;; + +let source_path path = + match Path.as_in_source_tree path with + | Some path -> Some path + | None -> Path.as_in_build_dir path |> Option.bind ~f:Path.Build.drop_build_context +;; + +let for_source ~dir source = + let* project = Dune_load.find_project ~dir in + let version = Dune_project.dune_version project in + if version < (3, 25) + then Memo.return None + else ( + match source_path source with + | None -> Memo.return None + | Some source_path -> + let* source_exists = + Fs_memo.file_exists (Path.Outside_build_dir.In_source_dir source_path) + in + if not source_exists + then Memo.return None + else + let+ config = format_config ~dir in + if Filename.equal (Path.Source.basename source_path) Filename.dune + then + Option.some_if + (Format_config.includes config Format_config.Language.Dune) + (Dune version) + else dialect_formatter config project source) +;; + +let ocamlformat_action ~expander ~dir ~source ~target kind = + let open Action_builder.O in + let cwd = Path.Build.parent_exn target in + let args = + [ ocamlformat_flag kind + ; "--inplace" + ; "--name" + ; Path.reach source ~from:(Path.build cwd) + ; Filename.to_string (Path.Build.basename target) + ] + in + let action program = + Action.chdir (Path.build cwd) (Action.run program args) + |> Action.Full.make + |> Action.Full.add_sandbox Sandbox_config.needs_sandboxing + in + let* ocamlformat_is_locked = + Action_builder.of_memo (ocamlformat_dev_tool_lock_dir_exists ()) + and* () = ocamlformat_config_deps ~dir in + if ocamlformat_is_locked + then ( + let path = Path.build (Pkg_dev_tool.exe_path Ocamlformat) in + let+ () = Action_builder.path path + and+ env = Action_builder.of_memo (Pkg_rules.dev_tool_env Ocamlformat) in + action (Ok path) |> Action.Full.add_env env) + else ( + let program = + let open Memo.O in + let* artifacts = Expander.artifacts expander in + Artifacts.binary + artifacts + ~hint:"opam install ocamlformat" + ~where:Original_path + ~dir + ~loc:None + (Pkg_dev_tool.exe_name Ocamlformat) + in + let+ program = Action_builder.of_memo program in + action program) +;; + +let action sctx ~dir ~source ~target = + let open Action_builder.O in + Action_builder.of_memo (for_source ~dir source) + >>= function + | None -> Action_builder.return Action.Full.empty + | Some (Dune version) -> + Format_dune_file.action ~version (Path.build target) target + |> Action.Full.make + |> Action_builder.return + | Some (Ocamlformat kind) -> + let* expander = Action_builder.of_memo (Super_context.expander sctx ~dir) in + ocamlformat_action ~expander ~dir ~source ~target kind +;; + +let format_diff sctx ~dir ~source ~target ~diff = + let open Action_builder.O in + let+ formatter = action sctx ~dir ~source ~target in + Action.Full.reduce [ Action.Full.make Action.empty; formatter ] + |> Action.Full.map ~f:(fun formatter -> + Action.progn [ Action.if_file_exists (Path.build target) formatter; diff ]) +;; diff --git a/src/dune_rules/format_generated.mli b/src/dune_rules/format_generated.mli new file mode 100644 index 00000000000..6a2fb90d187 --- /dev/null +++ b/src/dune_rules/format_generated.mli @@ -0,0 +1,21 @@ +(** Select an in-place formatter for a generated correction. *) + +open Import + +val format_config : dir:Path.Build.t -> Format_config.t Memo.t +val ocamlformat_flag : Ml_kind.t -> string +val ocamlformat_dev_tool_lock_dir_exists : unit -> bool Memo.t + +(** Dependencies that affect OCamlFormat's result. *) +val ocamlformat_config_deps : dir:Path.Build.t -> unit Action_builder.t + +(** Format a generated correction in place when formatting is enabled for its + source, then run [diff]. The generated path is deliberately not added as a + dependency. *) +val format_diff + : Super_context.t + -> dir:Path.Build.t + -> source:Path.t + -> target:Path.Build.t + -> diff:Action.t + -> Action.Full.t Action_builder.t diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml index d8c9d3acb0d..70ebd8df129 100644 --- a/src/dune_rules/format_rules.ml +++ b/src/dune_rules/format_rules.ml @@ -1,18 +1,6 @@ open Import open Memo.O -let rec subdirs_until_root dir = - match Path.parent dir with - | None -> [ dir ] - | Some d -> dir :: subdirs_until_root d -;; - -let depend_on_files ~named dir = - subdirs_until_root dir - |> List.concat_map ~f:(fun dir -> List.map named ~f:(Path.relative dir)) - |> Action_builder.paths_existing -;; - let formatter_diff_action = let dep_on_alias_action alias ~loc action = let action = @@ -43,35 +31,6 @@ let formatter_diff_action = ;; module Ocamlformat = struct - let dev_tool_lock_dir_exists () = - (* we assume that if lock_dev_tools is set, then the lock dir was created - via locking and can expect it to exist. If it doesn't, it's a bug - *) - match Config.get Compile_time.lock_dev_tools with - | `Enabled -> Memo.return true - | `Disabled -> - (* even if lock_dev_tools might be disabled, there might be a lock dir - created by `dune tools install` *) - let path = Lock_dir.dev_tool_external_lock_dir Ocamlformat in - Fs_memo.dir_exists (Path.Outside_build_dir.External path) - ;; - - (* Config files for ocamlformat. When these are changed, running - `dune fmt` should cause ocamlformat to re-format the ocaml files - in the project. *) - let config_files = [ ".ocamlformat"; ".ocamlformat-ignore"; ".ocamlformat-enable" ] - - let extra_deps dir = - (* Set up the dependency on ocamlformat config files so changing - these files triggers ocamlformat to run again. *) - depend_on_files ~named:config_files (Path.build dir) - ;; - - let flag_of_kind = function - | Ml_kind.Impl -> "--impl" - | Intf -> "--intf" - ;; - let action_when_ocamlformat_is_locked ~input kind = let open Action_builder.O in let dir = Path.Build.parent_exn input in @@ -87,23 +46,28 @@ module Ocamlformat = struct (Path.build dir) (Action.run (Ok path) - [ flag_of_kind kind; Path.Build.basename input |> Filename.to_string ]) + [ Format_generated.ocamlformat_flag kind + ; Path.Build.basename input |> Filename.to_string + ]) |> Action.Full.make in - (* Depend on [extra_deps] so if the ocamlformat config file - changes then ocamlformat will run again. *) - extra_deps dir >>> action >>| Action.Full.add_sandbox Sandbox_config.needs_sandboxing + (* Re-run OCamlFormat when its configuration changes. *) + Format_generated.ocamlformat_config_deps ~dir + >>> action + >>| Action.Full.add_sandbox Sandbox_config.needs_sandboxing ;; let action_when_ocamlformat_isn't_locked ~input kind = let open Action_builder.O in let module S = String_with_vars in - let+ () = Path.Build.parent_exn input |> extra_deps in + let+ () = + Format_generated.ocamlformat_config_deps ~dir:(Path.Build.parent_exn input) + in Dune_lang.Action.chdir (S.make_pform Loc.none (Var Workspace_root)) (Dune_lang.Action.run (S.make_text Loc.none (Pkg_dev_tool.exe_name Ocamlformat)) - [ S.make_text Loc.none (flag_of_kind kind) + [ S.make_text Loc.none (Format_generated.ocamlformat_flag kind) ; S.make_pform Loc.none (Var Input_file) ]) ;; @@ -226,7 +190,7 @@ let gen_format_alias sctx (config : Format_config.t) ~version ~dialects ~expande | None -> Action_builder.return () | Some source_dir -> let* ocamlformat_is_locked = - Action_builder.of_memo (Ocamlformat.dev_tool_lock_dir_exists ()) + Action_builder.of_memo (Format_generated.ocamlformat_dev_tool_lock_dir_exists ()) in let alias = Alias.make Alias0.fmt ~dir in let+ () = @@ -243,22 +207,8 @@ let gen_format_alias sctx (config : Format_config.t) ~version ~dialects ~expande () ;; -let format_config ~dir = - let+ value = - Env_stanza_db.value_opt ~dir ~f:(fun (t : Dune_env.config) -> - Memo.return t.format_config) - and+ default = - (* we always force the default for error checking *) - Path.Build.drop_build_context_exn dir - |> Source_tree.nearest_dir - >>| Source_tree.Dir.project - >>| Dune_project.format_config - in - Option.value value ~default -;; - let with_config ~dir f = - let* config = format_config ~dir in + let* config = Format_generated.format_config ~dir in if Format_config.is_empty config then (* CR-someday rgrinberg: this [is_empty] check is weird. We should use [None] diff --git a/src/dune_rules/simple_rules.ml b/src/dune_rules/simple_rules.ml index 11f2a397f80..5677b9e84b3 100644 --- a/src/dune_rules/simple_rules.ml +++ b/src/dune_rules/simple_rules.ml @@ -172,7 +172,8 @@ let user_rule sctx ~dir ~expander (rule : Rule_conf.t) = let () = validate_corrections ~rule in let* action = let chdir = Expander.dir expander in - Action_unexpanded.expand + Action_unexpanded.expand_with_formatted_diffs + sctx (snd rule.action) sandbox ~loc:(fst rule.action) @@ -356,7 +357,8 @@ let alias sctx ~dir ~expander (alias_conf : Alias_conf.t) = | Some (action_loc, action) -> let action = let chdir = Expander.dir expander in - Action_unexpanded.expand_no_targets + Action_unexpanded.expand_no_targets_with_formatted_diffs + sctx action Sandbox_config.no_special_requirements ~loc:action_loc diff --git a/test/blackbox-tests/test-cases/cinaps/dune b/test/blackbox-tests/test-cases/cinaps/dune index aa3a2be4dfb..9518d9f6def 100644 --- a/test/blackbox-tests/test-cases/cinaps/dune +++ b/test/blackbox-tests/test-cases/cinaps/dune @@ -1,4 +1,9 @@ +(env + (_ + (binaries ../../utils/ocamlformat.exe))) + (cram (applies_to :whole_subtree) (deps - (package cinaps))) + (package cinaps) + %{bin:ocamlformat})) diff --git a/test/blackbox-tests/test-cases/cinaps/format-generated.t b/test/blackbox-tests/test-cases/cinaps/format-generated.t new file mode 100644 index 00000000000..224df55a2fa --- /dev/null +++ b/test/blackbox-tests/test-cases/cinaps/format-generated.t @@ -0,0 +1,63 @@ +Cinaps corrections are formatted before being diffed starting in Dune 3.25. + +OCaml sources are formatted when OCaml formatting is enabled: + + $ mkdir ocaml-3.25 + $ cd ocaml-3.25 + $ make_cinaps_project 3.25 1.0 + $ cat > dune <<'EOF' + > (cinaps (files *.ml)) + > EOF + $ cat > test.ml <<'EOF' + > (*$ print_endline "\nlet generated = 1" *) + > (*$*) + > EOF + $ dune build @cinaps --auto-promote 2>&1 | grep 'fake ocamlformat is running' + fake ocamlformat is running: "--impl" "--inplace" "--name" "test.ml" "test.ml.cinaps-corrected" + [1] + $ cat test.ml + (* fake ocamlformat output *) + $ dune build @cinaps + +The behavior is gated by the Dune language version: + + $ cd .. + $ mkdir ocaml-3.24 + $ cd ocaml-3.24 + $ make_cinaps_project 3.24 1.0 + $ cat > dune <<'EOF' + > (cinaps (files *.ml)) + > EOF + $ cat > test.ml <<'EOF' + > (*$ print_endline "\nlet generated = 1" *) + > (*$*) + > EOF + $ dune build @cinaps --auto-promote >/dev/null 2>&1 + [1] + $ cat test.ml + (*$ print_endline "\nlet generated = 1" *) + let generated = 1 + (*$*) + +Explicitly disabling formatting retains the generated contents: + + $ cd .. + $ mkdir disabled + $ cd disabled + $ make_cinaps_project 3.25 1.0 + $ cat >> dune-project <<'EOF' + > (formatting disabled) + > EOF + $ cat > dune <<'EOF' + > (cinaps (files *.ml)) + > EOF + $ cat > test.ml <<'EOF' + > (*$ print_endline "\nlet generated = 1" *) + > (*$*) + > EOF + $ dune build @cinaps --auto-promote >/dev/null 2>&1 + [1] + $ cat test.ml + (*$ print_endline "\nlet generated = 1" *) + let generated = 1 + (*$*) diff --git a/test/blackbox-tests/test-cases/formatting/generated-diff.t b/test/blackbox-tests/test-cases/formatting/generated-diff.t new file mode 100644 index 00000000000..ce99f40a1df --- /dev/null +++ b/test/blackbox-tests/test-cases/formatting/generated-diff.t @@ -0,0 +1,69 @@ +Generated corrections are formatted as part of the diff action. + +OCamlFormat receives the original source name and formats the correction in +place: + + $ mkdir ocaml + $ cd ocaml + $ make_dune_project 3.25 + $ echo 'let original = 0' > source.ml + $ cat > dune <<'EOF' + > (rule + > (alias generate) + > (action + > (progn + > (with-stdout-to source.ml.generated + > (echo "let generated = 1")) + > (diff? source.ml source.ml.generated)))) + > EOF + $ dune build @generate --auto-promote 2>&1 | grep 'fake ocamlformat is running' + fake ocamlformat is running: "--impl" "--inplace" "--name" "source.ml" "source.ml.generated" + [1] + $ cat source.ml + (* fake ocamlformat output *) + +Projects older than Dune 3.25 retain the unformatted correction: + + $ cd .. + $ mkdir old-project + $ cd old-project + $ make_dune_project 3.24 + $ echo 'let original = 0' > source.ml + $ cat > dune <<'EOF' + > (rule + > (alias generate) + > (action + > (progn + > (with-stdout-to source.ml.generated + > (echo "let generated = 1")) + > (diff? source.ml source.ml.generated)))) + > EOF + $ dune build @generate --auto-promote >/dev/null 2>&1 + [1] + $ cat source.ml + let generated = 1 + +Generated dune files use Dune's built-in formatter. The correction is consumed +by [diff?] rather than exposed as an intermediate build target: + + $ cd .. + $ mkdir dune-file + $ cd dune-file + $ make_dune_project 3.25 + $ echo '(rule (alias generated))' > generated + $ cat > dune <<'EOF' + > (rule + > (alias generate) + > (action + > (progn + > (copy generated dune.generated) + > (diff? dune dune.generated)))) + > EOF + $ dune build dune.generated + Error: Don't know how to build dune.generated + [1] + $ dune build @generate --auto-promote >/dev/null 2>&1 + [1] + $ cat dune + (rule + (alias generated)) diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh b/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh index dc24e3ca589..880cf2b2ab6 100644 --- a/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/helpers.sh @@ -22,7 +22,15 @@ make_fake_ocamlformat() { if Sys.file_exists ".ocamlformat-ignore" then print_endline "ignoring some files" ;; - let () = print_endline ("formatted with version "^version) + let () = + let output = "formatted with version " ^ version ^ "\n" in + if Array.exists (String.equal "--inplace") Sys.argv + then ( + let file = Sys.argv.(Array.length Sys.argv - 1) in + let channel = open_out file in + output_string channel output; + close_out channel) + else print_string output EOF fi cat > ocamlformat/dune <<- EOF diff --git a/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-generated-diff.t b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-generated-diff.t new file mode 100644 index 00000000000..ab03b5bad5e --- /dev/null +++ b/test/blackbox-tests/test-cases/pkg/ocamlformat/ocamlformat-generated-diff.t @@ -0,0 +1,33 @@ +Generated diff corrections use the locked OCamlFormat dev tool. + + $ mkrepo + $ make_fake_ocamlformat "0.26.2" + $ make_ocamlformat_opam_pkg "0.26.2" + $ make_project_with_dev_tool_lockdir + $ dune_cmd subst '3.13' '3.25' dune-project + $ cat >> dune <<'EOF' + > (rule + > (alias generate) + > (action + > (progn + > (with-stdout-to foo.ml.generated + > (echo "let generated = 1")) + > (diff? foo.ml foo.ml.generated)))) + > EOF + + $ dune tools install ocamlformat + Solution for _build/.dev-tools.locks/ocamlformat: + - ocamlformat.0.26.2 + + $ dune build @generate --auto-promote + File "foo.ml", line 1, characters 0-0: + --- foo.ml + +++ foo.ml.generated + @@ -1 +1 @@ + -let () = print_endline "Hello, world" + +formatted with version 0.26.2 + Promoting _build/default/foo.ml.generated to foo.ml. + [1] + + $ cat foo.ml + formatted with version 0.26.2 diff --git a/test/blackbox-tests/utils/ocamlformat.ml b/test/blackbox-tests/utils/ocamlformat.ml index 26e6a83a7cc..06d4b195ce0 100644 --- a/test/blackbox-tests/utils/ocamlformat.ml +++ b/test/blackbox-tests/utils/ocamlformat.ml @@ -4,13 +4,16 @@ *) let () = - let args = - Sys.argv - |> Array.to_list - |> List.tl - |> List.map (fun s -> Printf.sprintf "%S" s) - |> String.concat " " + let args = Sys.argv |> Array.to_list |> List.tl in + let quoted_args = + args |> List.map (fun s -> Printf.sprintf "%S" s) |> String.concat " " in - Printf.eprintf "fake ocamlformat is running: %s\n" args; - Printf.printf "(* fake ocamlformat output *)" + Printf.eprintf "fake ocamlformat is running: %s\n" quoted_args; + let output = "(* fake ocamlformat output *)" in + if List.mem "--inplace" args + then ( + let input = List.hd (List.rev args) in + let oc = open_out_bin input in + Fun.protect ~finally:(fun () -> close_out oc) (fun () -> output_string oc output)) + else Printf.printf "%s" output ;;