Add (format-dune-file) action (#11166)

Signed-off-by: Nicolás Ojeda Bär <n.oje.bar@gmail.com>

Author: nojb

doc/changes/11166.md

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

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

@@ -0,0 +1,14 @@
+cat
+---
+
+.. highlight:: dune
+
+.. describe:: (format-dune-file <src> <dst>)
+
+   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 file.sexp.formatted)

doc/reference/actions/index.rst

@@ -53,6 +53,7 @@ The following constructions are available:
        copy#
        write-file
        pipe-outputs
+       format-dune-file
 
   .. grid-item::
 

src/dune_lang/action.ml

@@ -176,6 +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 * String_with_vars.t
 
 let is_dev_null t = String_with_vars.is_pform t (Var Dev_null)
 
@@ -350,6 +351,11 @@ let cstrs_dune_file t =
     , Syntax.since Stanza.syntax (2, 7)
       >>> let+ script = sw in
           Cram script )
+  ; ( "format-dune-file"
+    , Syntax.since Stanza.syntax (3, 18)
+      >>> let+ src = sw
+          and+ dst = sw in
+          Format_dune_file (src, dst) )
   ]
 ;;
 
@@ -458,6 +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 (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
@@ -495,7 +502,8 @@ let ensure_at_most_one_dynamic_run ~loc action =
     | Diff _
     | Substitute _
     | Patch _
-    | Cram _ -> false
+    | Cram _
+    | Format_dune_file _ -> false
     | Pipe (_, ts) | Progn ts | Concurrent ts ->
       List.fold_left ts ~init:false ~f:(fun acc t ->
         let have_dyn = loop t in
@@ -597,6 +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 (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,6 +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 * String_with_vars.t
 
 val encode : t Encoder.t
 val decode_dune_file : t Decoder.t

src/dune_rules/action_unexpanded.ml

@@ -566,6 +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 (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+ 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,6 +62,7 @@ let atom_table =
     ; "aliases", Field
     ; "alias", Field
     ; "enabled_if", Field
+    ; "format-dune-file", Since ((3, 18), Action)
     ; "package", Since ((3, 8), Field)
     ]
 ;;