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

)

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

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

src/dune_rules/format_rules.ml

@@ -37,8 +37,7 @@ let action =
 
     let encode (version, src, dst) path target : Sexp.t =
       List
-        [ Atom "format-dune-file"
-        ; Dune_lang.Syntax.Version.encode version |> Dune_sexp.to_sexp
+        [ Dune_lang.Syntax.Version.encode version |> Dune_sexp.to_sexp
         ; path src
         ; target dst
         ]
@@ -50,18 +49,8 @@ let action =
     ;;
   end
   in
-  fun ~version (src : Path.t) (dst : Path.Build.t) ->
-    let module M :
-      Action.Ext.Instance with type path = Path.t and type target = Path.Build.t = struct
-      type path = Path.t
-      type target = Path.Build.t
-
-      module Spec = Spec
-
-      let v = version, src, dst
-    end
-    in
-    Action.Extension (module M)
+  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

src/dune_rules/install_rules.ml

@@ -1087,10 +1087,10 @@ struct
     type ('path, 'target) t = Path.t Install.Entry.t list * 'target
 
     let name = "gen-install-file"
-    let version = 1
+    let version = 2
     let bimap (entries, dst) _ g = entries, g dst
     let is_useful_to ~memoize = memoize
-    let encode (_entries, dst) _path target : Sexp.t = List [ Atom name; target dst ]
+    let encode (_entries, dst) _path target : Sexp.t = List [ target dst ]
 
     let make_entry entry path comps =
       Install.Entry.set_src entry path
@@ -1144,18 +1144,9 @@ struct
     ;;
   end
 
-  let gen_install_file entries ~dst =
-    let module M = struct
-      type path = Path.t
-      type target = Path.Build.t
+  module A = Action_ext.Make (Spec)
 
-      module Spec = Spec
-
-      let v = entries, dst
-    end
-    in
-    Dune_engine.Action.Extension (module M)
-  ;;
+  let gen_install_file entries ~dst = A.action (entries, dst)
 end :
 sig
   val gen_install_file : Path.t Install.Entry.t list -> dst:Path.Build.t -> Action.t

src/dune_rules/ocamldep.ml

@@ -34,8 +34,7 @@ module Merge_files_into = struct
       : Sexp.t
       =
       List
-        [ Atom name
-        ; List (List.map sources ~f:input)
+        [ List (List.map sources ~f:input)
         ; List (List.map ~f:(fun s -> Sexp.Atom s) extras)
         ; output target
         ]
@@ -55,18 +54,9 @@ module Merge_files_into = struct
     ;;
   end
 
-  let action sources extras target =
-    let module M = struct
-      type path = Path.t
-      type target = Path.Build.t
+  module Action = Action_ext.Make (Spec)
 
-      module Spec = Spec
-
-      let v = sources, extras, target
-    end
-    in
-    Dune_engine.Action.Extension (module M)
-  ;;
+  let action sources extras target = Action.action (sources, extras, target)
 end
 
 let parse_module_names ~dir ~(unit : Module.t) ~modules words =

src/dune_rules/pkg_build_progress.ml

@@ -56,10 +56,7 @@ module Spec = struct
   let version = 1
   let is_useful_to ~memoize:_ = true
   let bimap t _f _g = t
-
-  let encode t _ _ =
-    Sexp.List [ Sexp.Atom name; Sexp.Atom (Int.to_string version); Message.encode t ]
-  ;;
+  let encode t _ _ = Message.encode t
 
   let action t ~ectx:_ ~eenv:_ =
     let open Fiber.O in
@@ -68,15 +65,8 @@ module Spec = struct
   ;;
 end
 
-let progress_action package_name package_version status =
-  let module M = struct
-    type path = Path.t
-    type target = Path.Build.t
+module Action = Action_ext.Make (Spec)
 
-    module Spec = Spec
-
-    let v = { Message.package_name; package_version; status }
-  end
-  in
-  Action.Extension (module M)
+let progress_action package_name package_version status =
+  Action.action { Message.package_name; package_version; status }
 ;;