Avoid modifying engine, use existing action

Signed-off-by: Nicolás Ojeda Bär <[email protected]>

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 =

doc/changes/11166.md

@@ -1 +1 @@
-- Add `(format-dune-file <file>)` action.  (#11166, @nojb)
+- Add `(format-dune-file <src> <dst>)` action.  (#11166, @nojb)

doc/reference/actions/format-dune-file.rst

@@ -3,12 +3,12 @@ cat
 
 .. highlight:: dune
 
-.. describe:: (format-dune-file <file>)
+.. describe:: (format-dune-file <src> <dst>)
 
-   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 ``<src>`` to ``<dst>``. 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)

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

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) ()

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

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 =

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", []) ]

src/dune_engine/dune

@@ -3,7 +3,6 @@
 (library
  (name dune_engine)
  (libraries
-  dune_lang
   unix
   csexp
   stdune

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

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

src/dune_rules/action_unexpanded.ml

@@ -566,16 +566,17 @@ 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 =
         let dir = Expander.dir expander in
         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

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)
+;;

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

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

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)
     ]
 ;;

test/blackbox-tests/test-cases/formatting/format-dune-file.t/run.t

@@ -197,10 +197,12 @@ Using the built-in action.
 
   $ cat >dune <<EOF
   > (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 <<EOF
+  > (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]