refactor: move [System] to be a custom action

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: a4bd1fb1-8c20-4291-8ec1-c064654fa2a4 -->

bin/print_rules.ml

@@ -91,7 +91,6 @@ let rec encode : Action.For_shell.t -> Dune_lang.t =
   | Copy (x, y) -> List [ atom "copy"; path x; target y ]
   | Symlink (x, y) -> List [ atom "symlink"; path x; target y ]
   | Hardlink (x, y) -> List [ atom "hardlink"; path x; target y ]
-  | System x -> List [ atom "system"; string x ]
   | Bash x -> List [ atom "bash"; string x ]
   | Write_file (x, perm, y) ->
     List [ atom ("write-file" ^ File_perm.suffix perm); target x; string y ]

src/dune_engine/action.ml

@@ -49,7 +49,6 @@ struct
   let cat ps = Cat ps
   let copy a b = Copy (a, b)
   let symlink a b = Symlink (a, b)
-  let system s = System s
   let bash s = Bash s
   let write_file ?(perm = File_perm.Normal) p s = Write_file (p, perm, s)
   let rename a b = Rename (a, b)
@@ -189,7 +188,6 @@ let fold_one_step t ~init:acc ~f =
   | Copy _
   | Symlink _
   | Hardlink _
-  | System _
   | Bash _
   | Write_file _
   | Rename _
@@ -230,7 +228,6 @@ let rec is_dynamic = function
   | With_accepted_exit_codes (_, t) -> is_dynamic t
   | Progn l | Pipe (_, l) | Concurrent l -> List.exists l ~f:is_dynamic
   | Run _
-  | System _
   | Bash _
   | Echo _
   | Cat _
@@ -292,7 +289,6 @@ let is_useful_to memoize =
     | Mkdir _ -> false
     | Run _ -> true
     | Dynamic_run _ -> true
-    | System _ -> true
     | Bash _ -> true
     | Extension (module A) -> A.Spec.is_useful_to ~memoize
   in

src/dune_engine/action_exec.ml

@@ -236,12 +236,6 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t =
   | Hardlink (src, dst) ->
     let+ () = maybe_async (fun () -> Io.portable_hardlink ~src ~dst:(Path.build dst)) in
     Done
-  | System cmd ->
-    let path, arg =
-      Dune_util.Prog.system_shell_exn ~needed_to:"interpret (system ...) actions"
-    in
-    let+ () = exec_run ~display ~ectx ~eenv path [ arg; cmd ] in
-    Done
   | Bash cmd ->
     let+ () =
       exec_run

src/dune_engine/action_intf.ml

@@ -44,7 +44,6 @@ module type Ast = sig
     | Copy of path * target
     | Symlink of path * target
     | Hardlink of path * target
-    | System of string
     | Bash of string
     | Write_file of target * File_perm.t * string
     | Rename of target * target
@@ -78,7 +77,6 @@ module type Helpers = sig
   val cat : path list -> t
   val copy : path -> target -> t
   val symlink : path -> target -> t
-  val system : string -> t
   val bash : string -> t
   val write_file : ?perm:File_perm.t -> target -> string -> t
   val rename : target -> target -> t

src/dune_engine/action_mapper.ml

@@ -34,7 +34,6 @@ module Make (Src : Action_intf.Ast) (Dst : Action_intf.Ast) = struct
     | Copy (x, y) -> Copy (f_path ~dir x, f_target ~dir y)
     | Symlink (x, y) -> Symlink (f_path ~dir x, f_target ~dir y)
     | Hardlink (x, y) -> Hardlink (f_path ~dir x, f_target ~dir y)
-    | System x -> System (f_string ~dir x)
     | Bash x -> Bash (f_string ~dir x)
     | Write_file (x, perm, y) -> Write_file (f_target ~dir x, perm, f_string ~dir y)
     | Rename (x, y) -> Rename (f_target ~dir x, f_target ~dir y)

src/dune_engine/action_to_sh.ml

@@ -62,7 +62,6 @@ let simplify act =
     | Copy (x, y) -> Run ("cp", [ x; y ]) :: acc
     | Symlink (x, y) -> Run ("ln", [ "-s"; x; y ]) :: Run ("rm", [ "-f"; y ]) :: acc
     | Hardlink (x, y) -> Run ("ln", [ x; y ]) :: Run ("rm", [ "-f"; y ]) :: acc
-    | System x -> Sh x :: acc
     | Bash x -> Run ("bash", [ "-e"; "-u"; "-o"; "pipefail"; "-c"; x ]) :: acc
     | Write_file (x, perm, y) ->
       interpret_perm perm x (Redirect_out (echo y, Stdout, File x) :: acc)

src/dune_engine/build_system.ml

@@ -245,7 +245,7 @@ end = struct
 
   (* The current version of the rule digest scheme. We should increment it when
      making any changes to the scheme, to avoid collisions. *)
-  let rule_digest_version = 21
+  let rule_digest_version = 22
 
   let compute_rule_digest
     (rule : Rule.t)
@@ -722,7 +722,7 @@ end = struct
 
   (* The current version of the action digest scheme. We should increment it when
      making any changes to the scheme, to avoid collisions. *)
-  let action_digest_version = 1
+  let action_digest_version = 2
 
   let execute_action_generic
     ~observing_facts

src/dune_rules/action_unexpanded.ml

@@ -522,7 +522,7 @@ let rec expand (t : Dune_lang.Action.t) : Action.t Action_expander.t =
         Copy_line_directive.action context ~src:x ~dst:y))
   | System x ->
     let+ x = E.string x in
-    O.System x
+    System.action x
   | Bash x ->
     let+ x = E.string x in
     O.Bash x

src/dune_rules/pkg_rules.ml

@@ -958,10 +958,9 @@ module Action_expander = struct
       let+ args = Memo.parallel_map t ~f:(expand ~expander) in
       Action.Progn args
     | System arg ->
-      let+ arg =
-        Expander.expand_pform_gen ~mode:Single expander arg >>| Value.to_string ~dir
-      in
-      Action.System arg
+      Expander.expand_pform_gen ~mode:Single expander arg
+      >>| Value.to_string ~dir
+      >>| System.action
     | Patch p ->
       let+ patch =
         Expander.expand_pform_gen ~mode:Single expander p >>| Value.to_path ~dir

src/dune_rules/system.ml

@@ -0,0 +1,45 @@
+open Import
+open Fiber.O
+
+module Spec = struct
+  type (_, _) t = string
+
+  let name = "system"
+  let version = 1
+  let bimap t _ _ = t
+  let is_useful_to ~memoize = memoize
+  let encode cmd _ _ : Sexp.t = List [ Atom name; Atom cmd ]
+
+  let action cmd ~(ectx : Action.context) ~(eenv : Action.env) =
+    let prog, arg =
+      Dune_util.Prog.system_shell_exn ~needed_to:"interpret (system ...) actions"
+    in
+    let display = !Clflags.display in
+    Process.run
+      (Accept eenv.exit_codes)
+      prog
+      [ arg; cmd ]
+      ~display
+      ~metadata:ectx.metadata
+      ~stdout_to:eenv.stdout_to
+      ~stderr_to:eenv.stderr_to
+      ~stdin_from:eenv.stdin_from
+      ~dir:eenv.working_dir
+      ~env:eenv.env
+    >>| function
+    | Error _ -> ()
+    | Ok s -> s
+  ;;
+end
+
+let action cmd =
+  Action.Extension
+    (module struct
+      type path = Path.t
+      type target = Path.Build.t
+
+      module Spec = Spec
+
+      let v = cmd
+    end)
+;;

src/dune_rules/system.mli

@@ -0,0 +1 @@
+val action : string -> Dune_engine.Action.t

test/blackbox-tests/test-cases/dune-cache/mode-copy.t

@@ -40,9 +40,9 @@ never built [target1] before.
   $ dune build --config-file=config target1 --debug-cache=shared,workspace-local \
   >   2>&1 | grep '_build/default/source\|_build/default/target'
   Workspace-local cache miss: _build/default/source: never seen this target before
-  Shared cache miss [13c77218604dc994750d09a29ee8afbc] (_build/default/source): not found in cache
+  Shared cache miss [14310d25a9f1419e568e561a619c1aba] (_build/default/source): not found in cache
   Workspace-local cache miss: _build/default/target1: never seen this target before
-  Shared cache miss [20702b179e0171aac33d40d83f666fc2] (_build/default/target1): not found in cache
+  Shared cache miss [859bfe7523c5c00a35ba163f44225971] (_build/default/target1): not found in cache
 
   $ dune_cmd stat hardlinks _build/default/source
   1

test/blackbox-tests/test-cases/dune-cache/mode-hardlink.t

@@ -35,9 +35,9 @@ never built [target1] before.
   $ dune build --config-file=config target1 --debug-cache=shared,workspace-local \
   >   2>&1 | grep '_build/default/source\|_build/default/target'
   Workspace-local cache miss: _build/default/source: never seen this target before
-  Shared cache miss [3ad1761950da90e34e52b4c065db1504] (_build/default/source): not found in cache
+  Shared cache miss [761de13745c580498ceed897e6f7dfa0] (_build/default/source): not found in cache
   Workspace-local cache miss: _build/default/target1: never seen this target before
-  Shared cache miss [b5096eeda3d7be4e9a631c563907399e] (_build/default/target1): not found in cache
+  Shared cache miss [bca67363790f3659e7dbb055563002ce] (_build/default/target1): not found in cache
 
   $ dune_cmd stat hardlinks _build/default/source
   3

test/blackbox-tests/test-cases/dune-cache/repro-check.t

@@ -67,7 +67,7 @@ Set 'cache-check-probability' to 1.0, which should trigger the check
   > EOF
   $ rm -rf _build
   $ dune build --config-file config reproducible non-reproducible
-  Warning: cache store error [e4096cb8e17c59cb28c421878c60fbfa]: ((in_cache
+  Warning: cache store error [a6a24f394ece470e01ae5a1642dfeaff]: ((in_cache
   ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed
   ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing
   (echo 'build non-reproducible';cp dep non-reproducible)
@@ -119,7 +119,7 @@ Test that the environment variable and the command line flag work too
 
   $ rm -rf _build
   $ DUNE_CACHE_CHECK_PROBABILITY=1.0 dune build --cache=enabled reproducible non-reproducible
-  Warning: cache store error [e4096cb8e17c59cb28c421878c60fbfa]: ((in_cache
+  Warning: cache store error [a6a24f394ece470e01ae5a1642dfeaff]: ((in_cache
   ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed
   ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing
   (echo 'build non-reproducible';cp dep non-reproducible)
@@ -131,7 +131,7 @@ Test that the environment variable and the command line flag work too
 
   $ rm -rf _build
   $ dune build --cache=enabled --cache-check-probability=1.0 reproducible non-reproducible
-  Warning: cache store error [e4096cb8e17c59cb28c421878c60fbfa]: ((in_cache
+  Warning: cache store error [a6a24f394ece470e01ae5a1642dfeaff]: ((in_cache
   ((non-reproducible 1c8fc4744d4cef1bd2b8f5e915b36be9))) (computed
   ((non-reproducible 6cfaa7a90747882bcf4ffe7252c1cf89)))) after executing
   (echo 'build non-reproducible';cp dep non-reproducible)

test/blackbox-tests/test-cases/dune-cache/trim.t

@@ -78,8 +78,8 @@ entries uniformly.
 
   $ (cd "$PWD/.xdg-cache/dune/db/meta/v5"; grep -rws . -e 'metadata' | sort ) > out
   $ cat out
-  ./c2/c2ad4d4223dc4899614b496fe575ab08:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781)))
-  ./d9/d9253f5d1695e3bee65f4e6e63b4dc5e:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c)))
+  ./1e/1efc41b0afe3809e04a72bc8adc62354:((8:metadata)(5:files(8:target_a32:5637dd9730e430c7477f52d46de3909c)))
+  ./32/328a92f21e553977cbd543f462bcac6c:((8:metadata)(5:files(8:target_b32:8a53bfae3829b48866079fa7f2d97781)))
 
   $ digest="$(awk -F: '/target_b/ { digest=$1 } END { print digest }' < out)"
 

test/expect-tests/dune_engine/action_to_sh_tests.ml

@@ -177,12 +177,6 @@ let%expect_test "copy" =
     cp foo bar |}]
 ;;
 
-let%expect_test "system" =
-  System "foo bar baz" |> print;
-  [%expect {|
-    foo bar baz |}]
-;;
-
 let%expect_test "bash" =
   Bash "echo Hello world" |> print;
   [%expect {|