From 6978294e778d0c2def1f41c723b1cdf3a9f832f1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= Date: Sun, 1 Dec 2024 09:21:13 +0100 Subject: [PATCH] Avoid modifying engine, use existing action MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Signed-off-by: Nicolás Ojeda Bär --- bin/print_rules.ml | 1 - doc/changes/11166.md | 2 +- doc/reference/actions/format-dune-file.rst | 10 +++---- src/dune_engine/action.ml | 8 ++--- src/dune_engine/action_exec.ml | 14 --------- src/dune_engine/action_intf.ml | 1 - src/dune_engine/action_mapper.ml | 1 - src/dune_engine/action_to_sh.ml | 9 ------ src/dune_engine/dune | 1 - src/dune_lang/action.ml | 11 +++---- src/dune_lang/action.mli | 2 +- src/dune_rules/action_unexpanded.ml | 7 +++-- src/dune_rules/format_dune_file.ml | 28 ++++++++++++++++++ src/dune_rules/format_dune_file.mli | 3 ++ src/dune_rules/format_rules.ml | 29 +------------------ src/dune_rules/stanzas/rule_conf.ml | 2 +- .../formatting/format-dune-file.t/run.t | 28 ++++++++++++++---- 17 files changed, 75 insertions(+), 82 deletions(-) create mode 100644 src/dune_rules/format_dune_file.ml create mode 100644 src/dune_rules/format_dune_file.mli diff --git a/bin/print_rules.ml b/bin/print_rules.ml index 802ca32b3ef..beef4f5e882 100644 --- a/bin/print_rules.ml +++ b/bin/print_rules.ml @@ -100,7 +100,6 @@ let rec encode : Action.For_shell.t -> Dune_lang.t = | Pipe (outputs, l) -> List (atom (sprintf "pipe-%s" (Outputs.to_string outputs)) :: List.map l ~f:encode) | Extension ext -> List [ atom "ext"; Dune_sexp.Quoted_string (Sexp.to_string ext) ] - | Format_dune_file (_version, x) -> List [ atom "format-dune-file"; path x ] ;; let encode_path p = diff --git a/doc/changes/11166.md b/doc/changes/11166.md index 9cb9fd07543..9d30017fe6d 100644 --- a/doc/changes/11166.md +++ b/doc/changes/11166.md @@ -1 +1 @@ -- Add `(format-dune-file )` action. (#11166, @nojb) +- Add `(format-dune-file )` action. (#11166, @nojb) diff --git a/doc/reference/actions/format-dune-file.rst b/doc/reference/actions/format-dune-file.rst index 6d10292adca..9dc5a3e8eb8 100644 --- a/doc/reference/actions/format-dune-file.rst +++ b/doc/reference/actions/format-dune-file.rst @@ -3,12 +3,12 @@ cat .. highlight:: dune -.. describe:: (format-dune-file ) +.. describe:: (format-dune-file ) - Print the formatted contents of a file, assumed to contain S-expressions, to - stdout. Note that the precise formatting can depend on the version of the - Dune language used by containing project. + Output the formatted contents of the file ```` to ````. The source + file is assumed to contain S-expressions. Note that the precise formatting + can depend on the version of the Dune language used by containing project. Example:: - (format-dune-file file.sexp) + (format-dune-file file.sexp file.sexp.formatted) diff --git a/src/dune_engine/action.ml b/src/dune_engine/action.ml index 2c94430a8d5..dd06e73575f 100644 --- a/src/dune_engine/action.ml +++ b/src/dune_engine/action.ml @@ -193,8 +193,7 @@ let fold_one_step t ~init:acc ~f = | Rename _ | Remove_tree _ | Mkdir _ - | Extension _ - | Format_dune_file _ -> acc + | Extension _ -> acc ;; include Action_mapper.Make (Ast) (Ast) @@ -239,8 +238,7 @@ let rec is_dynamic = function | Rename _ | Remove_tree _ | Mkdir _ - | Extension _ - | Format_dune_file _ -> false + | Extension _ -> false ;; let maybe_sandbox_path sandbox p = @@ -281,7 +279,7 @@ let is_useful_to memoize = | Ignore (_, t) | With_accepted_exit_codes (_, t) -> loop t | Progn l | Pipe (_, l) | Concurrent l -> List.exists l ~f:loop | Echo _ -> false - | Cat _ | Format_dune_file _ -> memoize + | Cat _ -> memoize | Copy _ -> memoize | Symlink _ -> false | Hardlink _ -> false diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml index 035f1adbfcf..77a271e8775 100644 --- a/src/dune_engine/action_exec.ml +++ b/src/dune_engine/action_exec.ml @@ -265,20 +265,6 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t = | Extension (module A) -> let+ () = Produce.of_fiber @@ A.Spec.action A.v ~ectx ~eenv in Done - | Format_dune_file (version, path) -> - let+ () = - match Io.Untracked.with_lexbuf_from_file path ~f:Dune_lang.Format.parse with - | Sexps sexps -> - let str = - Format.asprintf "%a" Pp.to_fmt (Dune_lang.Format.pp_top_sexps ~version sexps) - in - exec_echo eenv.stdout_to str - | OCaml_syntax _ -> - maybe_async (fun () -> - Io.with_file_in path ~f:(fun ic -> - Io.copy_channels ic (Process.Io.out_channel eenv.stdout_to))) - in - Done and redirect_out t ~display ~ectx ~eenv ~perm outputs fn = redirect t ~display ~ectx ~eenv ~out:(outputs, fn, perm) () diff --git a/src/dune_engine/action_intf.ml b/src/dune_engine/action_intf.ml index 3c68ed1f923..8669f91c90f 100644 --- a/src/dune_engine/action_intf.ml +++ b/src/dune_engine/action_intf.ml @@ -51,7 +51,6 @@ module type Ast = sig | Mkdir of target | Pipe of Outputs.t * t list | Extension of ext - | Format_dune_file of Dune_lang.Syntax.Version.t * path end module type Helpers = sig diff --git a/src/dune_engine/action_mapper.ml b/src/dune_engine/action_mapper.ml index 257e30101d2..d6f680ff5b5 100644 --- a/src/dune_engine/action_mapper.ml +++ b/src/dune_engine/action_mapper.ml @@ -41,7 +41,6 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct | Mkdir x -> Mkdir (f_target ~dir x) | Pipe (outputs, l) -> Pipe (outputs, List.map l ~f:(fun t -> f t ~dir)) | Extension ext -> Extension (f_ext ~dir ext) - | Format_dune_file (version, x) -> Format_dune_file (version, f_path ~dir x) ;; let rec map t ~dir ~f_program ~f_string ~f_path ~f_target ~f_ext = diff --git a/src/dune_engine/action_to_sh.ml b/src/dune_engine/action_to_sh.ml index aabf103dad2..471a17f454c 100644 --- a/src/dune_engine/action_to_sh.ml +++ b/src/dune_engine/action_to_sh.ml @@ -70,15 +70,6 @@ let simplify act = | Mkdir x -> mkdir x :: acc | Pipe (outputs, l) -> Pipe (List.map ~f:block l, outputs) :: acc | Extension _ -> Sh "# extensions are not supported" :: acc - | Format_dune_file (version, x) -> - Run - ( "dune" - , [ "format-dune-file" - ; "--version" - ; Dune_lang.Syntax.Version.to_string version - ; x - ] ) - :: acc and block act = match List.rev (loop act []) with | [] -> [ Run ("true", []) ] diff --git a/src/dune_engine/dune b/src/dune_engine/dune index 6fe8f925dc9..a1cdfb66a1a 100644 --- a/src/dune_engine/dune +++ b/src/dune_engine/dune @@ -3,7 +3,6 @@ (library (name dune_engine) (libraries - dune_lang unix csexp stdune diff --git a/src/dune_lang/action.ml b/src/dune_lang/action.ml index fa6e7a7696f..8914ae8d996 100644 --- a/src/dune_lang/action.ml +++ b/src/dune_lang/action.ml @@ -176,7 +176,7 @@ type t = | Substitute of String_with_vars.t * String_with_vars.t | Withenv of String_with_vars.t Env_update.t list * t | When of Slang.blang * t - | Format_dune_file of String_with_vars.t + | Format_dune_file of String_with_vars.t * String_with_vars.t let is_dev_null t = String_with_vars.is_pform t (Var Dev_null) @@ -353,8 +353,9 @@ let cstrs_dune_file t = Cram script ) ; ( "format-dune-file" , Syntax.since Stanza.syntax (3, 18) - >>> let+ x = sw in - Format_dune_file x ) + >>> let+ src = sw + and+ dst = sw in + Format_dune_file (src, dst) ) ] ;; @@ -463,7 +464,7 @@ let rec encode = List [ atom "withenv"; List (List.map ~f:Env_update.encode ops); encode t ] | When (condition, action) -> List [ atom "when"; Slang.encode_blang condition; encode action ] - | Format_dune_file x -> List [ atom "format-dune-file"; sw x ] + | Format_dune_file (src, dst) -> List [ atom "format-dune-file"; sw src; sw dst ] ;; (* In [Action_exec] we rely on one-to-one mapping between the cwd-relative paths @@ -604,7 +605,7 @@ let rec map_string_with_vars t ~f = When ( blang_map_string_with_vars condition ~f:(slang_map_string_with_vars ~f) , map_string_with_vars t ~f ) - | Format_dune_file x -> Format_dune_file (f x) + | Format_dune_file (src, dst) -> Format_dune_file (f src, f dst) ;; let remove_locs = map_string_with_vars ~f:String_with_vars.remove_locs diff --git a/src/dune_lang/action.mli b/src/dune_lang/action.mli index 742233acf6e..8bcd6c1fc8b 100644 --- a/src/dune_lang/action.mli +++ b/src/dune_lang/action.mli @@ -119,7 +119,7 @@ type t = | Substitute of String_with_vars.t * String_with_vars.t | Withenv of String_with_vars.t Env_update.t list * t | When of Slang.blang * t - | Format_dune_file of String_with_vars.t + | Format_dune_file of String_with_vars.t * String_with_vars.t val encode : t Encoder.t val decode_dune_file : t Decoder.t diff --git a/src/dune_rules/action_unexpanded.ml b/src/dune_rules/action_unexpanded.ml index 3fe2c6eca06..e5cb07d5ccf 100644 --- a/src/dune_rules/action_unexpanded.ml +++ b/src/dune_rules/action_unexpanded.ml @@ -566,7 +566,7 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = | Cram script -> let+ script = E.dep script in Cram_exec.action script - | Format_dune_file x -> + | Format_dune_file (src, dst) -> A.with_expander (fun expander -> let open Memo.O in let+ version = @@ -574,8 +574,9 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t = Dune_load.find_project ~dir >>| Dune_project.dune_version in let open Action_expander.O in - let+ x = E.dep x in - O.Format_dune_file (version, x)) + let+ src = E.dep src + and+ dst = E.target dst in + Format_dune_file.action ~version src dst) | Withenv _ | Substitute _ | Patch _ | When _ -> (* these can only be provided by the package language which isn't expanded here *) assert false diff --git a/src/dune_rules/format_dune_file.ml b/src/dune_rules/format_dune_file.ml new file mode 100644 index 00000000000..0d3013ed7e4 --- /dev/null +++ b/src/dune_rules/format_dune_file.ml @@ -0,0 +1,28 @@ +open Import + +let action = + let module Spec = struct + type ('path, 'target) t = Dune_lang.Syntax.Version.t * 'path * 'target + + let name = "format-dune-file" + let version = 1 + let bimap (ver, src, dst) f g = ver, f src, g dst + let is_useful_to ~memoize = memoize + + let encode (version, src, dst) path target : Sexp.t = + List + [ Dune_lang.Syntax.Version.encode version |> Dune_sexp.to_sexp + ; path src + ; target dst + ] + ;; + + let action (version, src, dst) ~ectx:_ ~eenv:_ = + Dune_lang.Format.format_action ~version ~src ~dst; + Fiber.return () + ;; + end + in + let module A = Action_ext.Make (Spec) in + fun ~version (src : Path.t) (dst : Path.Build.t) -> A.action (version, src, dst) +;; diff --git a/src/dune_rules/format_dune_file.mli b/src/dune_rules/format_dune_file.mli new file mode 100644 index 00000000000..1e0af34a3c5 --- /dev/null +++ b/src/dune_rules/format_dune_file.mli @@ -0,0 +1,3 @@ +open Import + +val action : version:Dune_lang.Syntax.Version.t -> Path.t -> Path.Build.t -> Action.t diff --git a/src/dune_rules/format_rules.ml b/src/dune_rules/format_rules.ml index 048284887c9..1c3374c41b1 100644 --- a/src/dune_rules/format_rules.ml +++ b/src/dune_rules/format_rules.ml @@ -27,33 +27,6 @@ let depend_on_files ~named dir = let formatted_dir_basename = ".formatted" -let action = - let module Spec = struct - type ('path, 'target) t = Dune_lang.Syntax.Version.t * 'path * 'target - - let name = "format-dune-file" - let version = 1 - let bimap (ver, src, dst) f g = ver, f src, g dst - let is_useful_to ~memoize = memoize - - let encode (version, src, dst) path target : Sexp.t = - List - [ Dune_lang.Syntax.Version.encode version |> Dune_sexp.to_sexp - ; path src - ; target dst - ] - ;; - - let action (version, src, dst) ~ectx:_ ~eenv:_ = - Dune_lang.Format.format_action ~version ~src ~dst; - Fiber.return () - ;; - end - in - let module A = Action_ext.Make (Spec) in - fun ~version (src : Path.t) (dst : Path.Build.t) -> A.action (version, src, dst) -;; - module Alias = struct let fmt ~dir = Alias.make Alias0.fmt ~dir end @@ -217,7 +190,7 @@ let gen_rules_output let { Action_builder.With_targets.build; targets } = (let open Action_builder.O in let+ () = Action_builder.path input in - Action.Full.make (action ~version input output)) + Action.Full.make (Format_dune_file.action ~version input output)) |> Action_builder.with_file_targets ~file_targets:[ output ] in let rule = Rule.make ~mode:Standard ~targets build in diff --git a/src/dune_rules/stanzas/rule_conf.ml b/src/dune_rules/stanzas/rule_conf.ml index fcd4aa4e017..9cc9f8944af 100644 --- a/src/dune_rules/stanzas/rule_conf.ml +++ b/src/dune_rules/stanzas/rule_conf.ml @@ -62,7 +62,7 @@ let atom_table = ; "aliases", Field ; "alias", Field ; "enabled_if", Field - ; "format-dune-file", Since ((3, 18), Field) + ; "format-dune-file", Since ((3, 18), Action) ; "package", Since ((3, 8), Field) ] ;; diff --git a/test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t b/test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t index 973e60f44f4..bc7d33a03d2 100644 --- a/test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t +++ b/test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t @@ -197,10 +197,12 @@ Using the built-in action. $ cat >dune < (rule (with-stdout-to file (echo "( a c)"))) - > (rule (alias format) (action (format-dune-file file))) + > (rule (format-dune-file file file.formatted)) > EOF - $ dune build @format + $ dune build file.formatted + + $ cat _build/default/file.formatted (a c) Version check. @@ -209,10 +211,24 @@ Version check. > (lang dune 3.17) > EOF - $ dune build @format - File "dune", line 2, characters 29-52: - 2 | (rule (alias format) (action (format-dune-file file))) - ^^^^^^^^^^^^^^^^^^^^^^^ + $ dune build file.out + File "dune", line 2, characters 0-45: + 2 | (rule (format-dune-file file file.formatted)) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ + Error: 'format-dune-file' in short-form 'rule' is only available since + version 3.18 of the dune language. Please update your dune-project file to + have (lang dune 3.18). + [1] + + $ cat >dune < (rule (with-stdout-to file (echo "( a c)"))) + > (rule (action (format-dune-file file file.formatted))) + > EOF + + $ dune build file.out + File "dune", line 2, characters 14-52: + 2 | (rule (action (format-dune-file file file.formatted))) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: 'format-dune-file' is only available since version 3.18 of the dune language. Please update your dune-project file to have (lang dune 3.18). [1]