From 98c14ba822d3ceb27ef3dbb6fb9e91ede3949169 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Wed, 14 Aug 2024 21:59:02 +0800 Subject: [PATCH] refactor: remove action extension intermediate environment/context Signed-off-by: Rudi Grinberg --- src/dune_engine/action.ml | 18 ++++++++++ src/dune_engine/action.mli | 18 ++++++++++ src/dune_engine/action_exec.ml | 60 ++++++++------------------------ src/dune_engine/action_intf.ml | 33 +++++++++--------- src/dune_patch/dune_patch.ml | 2 +- src/dune_rules/cram/cram_exec.ml | 2 +- src/dune_rules/pkg_rules.ml | 6 ++-- src/promote/diff_action.ml | 2 +- 8 files changed, 73 insertions(+), 68 deletions(-) diff --git a/src/dune_engine/action.ml b/src/dune_engine/action.ml index ebd91b47a01..f584e3e75eb 100644 --- a/src/dune_engine/action.ml +++ b/src/dune_engine/action.ml @@ -6,6 +6,24 @@ module type T = sig type t end +type context = Action_intf.context = + { targets : Targets.Validated.t option + ; context : Build_context.t option + ; metadata : Process.metadata + ; rule_loc : Loc.t + ; build_deps : Dep.Set.t -> Dep.Facts.t Fiber.t + } + +type env = Action_intf.env = + { working_dir : Path.t + ; env : Env.t + ; stdout_to : Process.Io.output Process.Io.t + ; stderr_to : Process.Io.output Process.Io.t + ; stdin_from : Process.Io.input Process.Io.t + ; prepared_dependencies : Dune_action_plugin.Private.Protocol.Dependency.Set.t + ; exit_codes : int Predicate.t + } + module Make (Program : T) (Path : T) diff --git a/src/dune_engine/action.mli b/src/dune_engine/action.mli index 9ea86626936..44230ef8f17 100644 --- a/src/dune_engine/action.mli +++ b/src/dune_engine/action.mli @@ -47,6 +47,24 @@ end module Ext : module type of Action_intf.Ext +type context = Action_intf.context = + { targets : Targets.Validated.t option + ; context : Build_context.t option + ; metadata : Process.metadata + ; rule_loc : Loc.t + ; build_deps : Dep.Set.t -> Dep.Facts.t Fiber.t + } + +type env = Action_intf.env = + { working_dir : Path.t + ; env : Env.t + ; stdout_to : Process.Io.output Process.Io.t + ; stderr_to : Process.Io.output Process.Io.t + ; stdin_from : Process.Io.input Process.Io.t + ; prepared_dependencies : Dune_action_plugin.Private.Protocol.Dependency.Set.t + ; exit_codes : int Predicate.t + } + (** result of the lookup of a program, the path to it or information about the failure and possibly a hint how to fix it *) module Prog : sig diff --git a/src/dune_engine/action_exec.ml b/src/dune_engine/action_exec.ml index 7fdc6a95e6f..931c1ff3696 100644 --- a/src/dune_engine/action_exec.ml +++ b/src/dune_engine/action_exec.ml @@ -138,27 +138,11 @@ module Exec_result = struct ;; end -type exec_context = - { targets : Targets.Validated.t option - ; context : Build_context.t option - ; metadata : Process.metadata - ; rule_loc : Loc.t - ; build_deps : Dep.Set.t -> Dep.Facts.t Fiber.t - } - -type exec_environment = - { working_dir : Path.t - ; env : Env.t - ; stdout_to : Process.Io.output Process.Io.t - ; stderr_to : Process.Io.output Process.Io.t - ; stdin_from : Process.Io.input Process.Io.t - ; prepared_dependencies : DAP.Dependency.Set.t - ; exit_codes : int Predicate.t - } - open Produce.O -let exec_run ~display ~ectx ~eenv prog args : _ Produce.t = +let exec_run ~display ~(ectx : Action_intf.context) ~(eenv : Action_intf.env) prog args + : _ Produce.t + = let* (res : (Proc.Times.t, int) result) = Produce.of_fiber @@ Process.run_with_times @@ -178,7 +162,14 @@ let exec_run ~display ~ectx ~eenv prog args : _ Produce.t = | Ok times -> Produce.incr_duration times.elapsed_time ;; -let exec_run_dynamic_client ~display ~ectx ~eenv prog args = +let exec_run_dynamic_client + ~display + ~(ectx : Action_intf.context) + ~(eenv : Action_intf.env) + prog + args + = + let* () = Produce.of_fiber @@ Rpc.ensure_ready () in let run_arguments_fn = Temp.create File ~prefix:"dune" ~suffix:"run" in let response_fn = Temp.create File ~prefix:"dune" ~suffix:"response" in let run_arguments = @@ -289,26 +280,6 @@ let bash_exn = [ Pp.textf "I need bash to %s but I couldn't find it :(" needed_to ] ;; -(* When passing these to an extension, they shouldn't need to know about any - kind of dynamic build dependency functions or prepped dependencies, etc, - which should be handled here instead. *) -let restrict_ctx { targets; context; metadata; rule_loc; build_deps } = - { Action.Ext.targets; context; purpose = metadata.purpose; rule_loc; build_deps } -;; - -let restrict_env - { working_dir - ; env - ; stdout_to - ; stderr_to - ; stdin_from - ; exit_codes - ; prepared_dependencies = _ - } - = - { Action.Ext.working_dir; env; stdout_to; stderr_to; stdin_from; exit_codes } -;; - let zero = Predicate_lang.element 0 let maybe_async f = Produce.of_fiber (maybe_async f) @@ -402,10 +373,7 @@ let rec exec t ~display ~ectx ~eenv : done_or_more_deps Produce.t = Done | Pipe (outputs, l) -> exec_pipe ~display ~ectx ~eenv outputs l | Extension (module A) -> - let+ () = - Produce.of_fiber - @@ A.Spec.action A.v ~ectx:(restrict_ctx ectx) ~eenv:(restrict_env eenv) - in + let+ () = Produce.of_fiber @@ A.Spec.action A.v ~ectx ~eenv in Done and redirect_out t ~display ~ectx ~eenv ~perm outputs fn = @@ -539,7 +507,7 @@ let exec = let ectx = let metadata = Process.create_metadata ~purpose:(Build_job targets) () in - { targets; metadata; context; rule_loc; build_deps } + { Action_intf.targets; metadata; context; rule_loc; build_deps } and eenv = let env = match @@ -553,7 +521,7 @@ let exec (* TODO generify *) [ Some { source = Path.to_absolute_filename root; target } ] in - { working_dir = Path.root + { Action_intf.working_dir = Path.root ; env ; stdout_to = Process.Io.make_stdout diff --git a/src/dune_engine/action_intf.ml b/src/dune_engine/action_intf.ml index 77e5ad1ec2f..830f4c0c8d2 100644 --- a/src/dune_engine/action_intf.ml +++ b/src/dune_engine/action_intf.ml @@ -86,24 +86,25 @@ module type Helpers = sig val mkdir : target -> t end -module Ext = struct - type context = - { targets : Targets.Validated.t option - ; context : Build_context.t option - ; purpose : Process.purpose - ; rule_loc : Loc.t - ; build_deps : Dep.Set.t -> Dep.Facts.t Fiber.t - } +type context = + { targets : Targets.Validated.t option + ; context : Build_context.t option + ; metadata : Process.metadata + ; rule_loc : Loc.t + ; build_deps : Dep.Set.t -> Dep.Facts.t Fiber.t + } - type env = - { working_dir : Path.t - ; env : Env.t - ; stdout_to : Process.Io.output Process.Io.t - ; stderr_to : Process.Io.output Process.Io.t - ; stdin_from : Process.Io.input Process.Io.t - ; exit_codes : int Predicate.t - } +type env = + { working_dir : Path.t + ; env : Env.t + ; stdout_to : Process.Io.output Process.Io.t + ; stderr_to : Process.Io.output Process.Io.t + ; stdin_from : Process.Io.input Process.Io.t + ; prepared_dependencies : Dune_action_plugin.Private.Protocol.Dependency.Set.t + ; exit_codes : int Predicate.t + } +module Ext = struct module type Spec = sig type ('path, 'target) t diff --git a/src/dune_patch/dune_patch.ml b/src/dune_patch/dune_patch.ml index 9e41c577ea2..b95693a6056 100644 --- a/src/dune_patch/dune_patch.ml +++ b/src/dune_patch/dune_patch.ml @@ -109,7 +109,7 @@ module Spec = struct let is_useful_to ~memoize = memoize let encode patch input _ : Sexp.t = List [ Atom name; input patch ] - let action patch ~ectx:_ ~(eenv : Action.Ext.env) = + let action patch ~ectx:_ ~(eenv : Action.env) = exec !Dune_engine.Clflags.display ~patch ~dir:eenv.working_dir ~stderr:eenv.stderr_to ;; end diff --git a/src/dune_rules/cram/cram_exec.ml b/src/dune_rules/cram/cram_exec.ml index c7f0ee7eb01..b7545e78662 100644 --- a/src/dune_rules/cram/cram_exec.ml +++ b/src/dune_rules/cram/cram_exec.ml @@ -459,7 +459,7 @@ module Spec = struct let bimap path f _ = f path let is_useful_to ~memoize:_ = true let encode script path _ : Sexp.t = List [ Atom name; path script ] - let action script ~ectx:_ ~(eenv : Action.Ext.env) = run ~env:eenv.env ~script + let action script ~ectx:_ ~(eenv : Action.env) = run ~env:eenv.env ~script end let action script = diff --git a/src/dune_rules/pkg_rules.ml b/src/dune_rules/pkg_rules.ml index de30bd6e6ad..886b1734824 100644 --- a/src/dune_rules/pkg_rules.ml +++ b/src/dune_rules/pkg_rules.ml @@ -649,8 +649,8 @@ module Run_with_path = struct let action { prog; args; ocamlfind_destdir; pkg } - ~(ectx : Action.Ext.context) - ~(eenv : Action.Ext.env) + ~(ectx : Action.context) + ~(eenv : Action.env) = let open Fiber.O in let display = !Clflags.display in @@ -664,7 +664,7 @@ module Run_with_path = struct | Path p -> Path.to_absolute_filename p) |> String.concat ~sep:"") in - let metadata = Process.create_metadata ~purpose:ectx.purpose () in + let metadata = Process.create_metadata ~purpose:ectx.metadata.purpose () in let env = Env.add eenv.env diff --git a/src/promote/diff_action.ml b/src/promote/diff_action.ml index 08325ccf627..a62f838bda8 100644 --- a/src/promote/diff_action.ml +++ b/src/promote/diff_action.ml @@ -97,7 +97,7 @@ module Spec = struct List [ Atom name; Atom (Bool.to_string optional); mode; input file1; output file2 ] ;; - let action diff ~(ectx : Dune_engine.Action.Ext.context) ~eenv:_ = + let action diff ~(ectx : Dune_engine.Action.context) ~eenv:_ = exec ~rule_loc:ectx.rule_loc diff ;; end