refactor: add [Action_ext] to simplify custom action definitions (#10840)

Signed-off-by: Rudi Grinberg <[email protected]>

Author: rgrinberg

boot/libs.ml

@@ -50,6 +50,7 @@ let local_libraries =
   ; ("src/fswatch_win", Some "Fswatch_win", false, None)
   ; ("src/dune_file_watcher", Some "Dune_file_watcher", false, None)
   ; ("src/dune_engine", Some "Dune_engine", false, None)
+  ; ("src/action_ext", Some "Action_ext", false, None)
   ; ("src/promote", Some "Promote", false, None)
   ; ("src/ocaml-config", Some "Ocaml_config", false, None)
   ; ("src/ocaml", Some "Ocaml", false, None)

src/action_ext/action_ext.ml

@@ -0,0 +1,26 @@
+open Stdune
+module Action = Dune_engine.Action
+
+module Make (S : Action.Ext.Spec) = struct
+  module Spec = struct
+    include S
+
+    let encode t f g =
+      let open Sexp in
+      List [ Atom name; Atom (Int.to_string version); S.encode t f g ]
+    ;;
+  end
+
+  let action p =
+    let module M = struct
+      type path = Path.t
+      type target = Path.Build.t
+
+      module Spec = Spec
+
+      let v = p
+    end
+    in
+    Action.Extension (module M)
+  ;;
+end

src/action_ext/action_ext.mli

@@ -0,0 +1,5 @@
+open Stdune
+
+module Make (S : Dune_engine.Action.Ext.Spec) : sig
+  val action : (Path.t, Path.Build.t) S.t -> Dune_engine.Action.t
+end

src/action_ext/dune

@@ -0,0 +1,3 @@
+(library
+ (name action_ext)
+ (libraries dune_engine fiber stdune))

src/dune_patch/dune

@@ -1,5 +1,5 @@
 (library
  (name dune_patch)
- (libraries stdune fiber dune_engine dune_lang dune_re)
+ (libraries stdune fiber dune_engine dune_lang action_ext dune_re)
  (instrumentation
   (backend bisect_ppx)))

src/dune_patch/dune_patch.ml

@@ -104,29 +104,20 @@ module Spec = struct
   type ('path, 'target) t = 'path
 
   let name = "patch"
-  let version = 1
+  let version = 2
   let bimap patch f _ = f patch
   let is_useful_to ~memoize = memoize
-  let encode patch input _ : Sexp.t = List [ Atom name; input patch ]
+  let encode patch input _ : Sexp.t = input patch
 
   let action patch ~ectx:_ ~(eenv : Action.env) =
     exec !Dune_engine.Clflags.display ~patch ~dir:eenv.working_dir ~stderr:eenv.stderr_to
   ;;
 end
 
 (* CR-someday alizter: This should be an action builder. *)
-let action ~patch =
-  let module M = struct
-    type path = Path.t
-    type target = Path.Build.t
+module Action = Action_ext.Make (Spec)
 
-    module Spec = Spec
-
-    let v = patch
-  end
-  in
-  Action.Extension (module M)
-;;
+let action ~patch = Action.action patch
 
 module For_tests = struct
   let exec = exec

src/dune_rules/copy_line_directive.ml

@@ -70,17 +70,12 @@ module Spec = struct
   type ('path, 'target) t = 'path * 'target * merlin
 
   let name = "copy-line-directive"
-  let version = 1
+  let version = 2
   let bimap (src, dst, merlin) f g = f src, g dst, merlin
   let is_useful_to ~memoize = memoize
 
   let encode (src, dst, merlin) path target : Sexp.t =
-    List
-      [ Atom "copy-line-directive"
-      ; path src
-      ; target dst
-      ; Atom (Bool.to_string (bool_of_merlin merlin))
-      ]
+    List [ path src; target dst; Atom (Bool.to_string (bool_of_merlin merlin)) ]
   ;;
 
   let action (src, dst, merlin) ~ectx:_ ~eenv:_ =
@@ -97,17 +92,10 @@ module Spec = struct
   ;;
 end
 
-let action (context : Context.t) ~src ~dst =
-  let module M = struct
-    type path = Path.t
-    type target = Path.Build.t
-
-    module Spec = Spec
+module A = Action_ext.Make (Spec)
 
-    let v = src, dst, if Context.merlin context then Spec.Yes else No
-  end
-  in
-  Action.Extension (module M)
+let action (context : Context.t) ~src ~dst =
+  A.action (src, dst, if Context.merlin context then Spec.Yes else No)
 ;;
 
 let builder context ~src ~dst =

src/dune_rules/cram/cram_exec.ml

@@ -455,22 +455,13 @@ module Spec = struct
   type ('path, _) t = 'path
 
   let name = "cram"
-  let version = 1
+  let version = 2
   let bimap path f _ = f path
   let is_useful_to ~memoize:_ = true
-  let encode script path _ : Sexp.t = List [ Atom name; path script ]
+  let encode script path _ : Sexp.t = List [ path script ]
   let action script ~ectx:_ ~(eenv : Action.env) = run ~env:eenv.env ~script
 end
 
-let action script =
-  let module M = struct
-    type path = Path.t
-    type target = Path.Build.t
+module Action = Action_ext.Make (Spec)
 
-    module Spec = Spec
-
-    let v = script
-  end
-  in
-  Action.Extension (module M)
-;;
+let action = Action.action

src/dune_rules/dune

@@ -29,6 +29,7 @@
   dune_targets
   opam_core
   promote
+  action_ext
   build_path_prefix_map
   dune_engine
   dune_vcs

src/dune_rules/fetch_rules.ml

@@ -73,15 +73,14 @@ module Spec = struct
     }
 
   let name = "source-fetch"
-  let version = 1
+  let version = 2
   let bimap t _ g = { t with target = g t.target }
   let is_useful_to ~memoize = memoize
 
   let encode { target; url = _, url; checksum; kind } _ encode_target : Sexp.t =
     List
-      ([ Sexp.Atom name
-       ; encode_target target
-       ; Atom (OpamUrl.to_string url)
+      ([ encode_target target
+       ; Sexp.Atom (OpamUrl.to_string url)
        ; Atom
            (match kind with
             | `File -> "file"
@@ -128,18 +127,9 @@ module Spec = struct
   ;;
 end
 
-let action ~url ~checksum ~target ~kind =
-  let module M = struct
-    type path = Path.t
-    type target = Path.Build.t
+module A = Action_ext.Make (Spec)
 
-    module Spec = Spec
-
-    let v = { Spec.target; checksum; url; kind }
-  end
-  in
-  Action.Extension (module M)
-;;
+let action ~url ~checksum ~target ~kind = A.action { Spec.target; checksum; url; kind }
 
 let extract_checksums_and_urls (lockdir : Dune_pkg.Lock_dir.t) =
   Package.Name.Map.fold
@@ -275,12 +265,12 @@ module Copy = struct
       }
 
     let name = "copy-dir"
-    let version = 1
+    let version = 2
     let bimap t f g = { src_dir = f t.src_dir; dst_dir = g t.dst_dir }
     let is_useful_to ~memoize = memoize
 
     let encode { src_dir; dst_dir } path target : Sexp.t =
-      List [ Atom name; path src_dir; target dst_dir ]
+      List [ path src_dir; target dst_dir ]
     ;;
 
     let action { src_dir; dst_dir } ~ectx:_ ~eenv:_ =
@@ -300,18 +290,9 @@ module Copy = struct
     ;;
   end
 
-  let action ~src_dir ~dst_dir =
-    let module M = struct
-      type path = Path.t
-      type target = Path.Build.t
+  module A = Action_ext.Make (Spec)
 
-      module Spec = Spec
-
-      let v = { Spec.dst_dir; src_dir }
-    end
-    in
-    Action.Extension (module M)
-  ;;
+  let action ~src_dir ~dst_dir = A.action { Spec.dst_dir; src_dir }
 end
 
 let fetch ~target kind (source : Source.t) =