Merge Target.resolve_targets_exn and Target.request

into a single Target.interpret_targets function. These two functions
where always used one after the other.

Signed-off-by: Jeremie Dimino <[email protected]>

bin/alias.ml

@@ -1,4 +1,5 @@
 open Stdune
+open Dune_engine
 
 type t =
   { name : Dune_engine.Alias.Name.t
@@ -59,3 +60,11 @@ let of_string (root : Workspace_root.t) ~recursive s ~contexts =
     let dir = Path.parent_exn path in
     let name = Dune_engine.Alias.Name.of_string (Path.basename path) in
     in_dir ~name ~recursive ~contexts dir
+
+let request { name; recursive; dir; contexts } =
+  let contexts = List.map ~f:Dune_rules.Context.name contexts in
+  (if recursive then
+    Build_system.Alias.dep_rec_multi_contexts
+  else
+    Build_system.Alias.dep_multi_contexts)
+    ~dir ~name ~contexts

bin/alias.mli

@@ -1,4 +1,5 @@
 open Stdune
+open Dune_engine
 
 type t = private
   { name : Dune_engine.Alias.Name.t
@@ -22,3 +23,5 @@ val of_string :
   -> t
 
 val pp : t -> _ Pp.t
+
+val request : t -> unit Action_builder.t

bin/build_cmd.ml

@@ -1,15 +1,12 @@
 open Stdune
 open Import
 
-let run_build_system ?report_error ~common
-    ~(targets : unit -> Target.t list Memo.Build.t) () =
+let run_build_system ?report_error ~common ~(request : unit Action_builder.t) ()
+    =
   let build_started = Unix.gettimeofday () in
   Fiber.finalize
     (fun () ->
-      Build_system.run ?report_error (fun () ->
-          let open Memo.Build.O in
-          let* targets = targets () in
-          Build_system.build (Target.request targets)))
+      Build_system.run ?report_error (fun () -> Build_system.build request))
     ~finally:(fun () ->
       (if Common.print_metrics common then
         let gc_stat = Gc.quick_stat () in
@@ -26,43 +23,42 @@ let run_build_system ?report_error ~common
              ]));
       Fiber.return ())
 
-let run_build_command_poll ~(common : Common.t) ~config ~targets ~setup =
+let run_build_command_poll ~(common : Common.t) ~config ~request ~setup =
   let open Fiber.O in
   let every ~report_error () =
     Cached_digest.invalidate_cached_timestamps ();
     let* setup = setup () in
-    let* targets =
+    let* request =
       match
         let open Option.O in
         let* rpc = Common.rpc common in
         Dune_rpc_impl.Server.pending_build_action rpc
       with
-      | None -> Fiber.return (fun () -> targets setup)
+      | None -> Fiber.return (request setup)
       | Some (Build (targets, ivar)) ->
         let+ () = Fiber.Ivar.fill ivar Accepted in
-        fun () ->
-          Target.resolve_targets_exn (Common.root common) config setup targets
+        Target.interpret_targets (Common.root common) config setup targets
     in
-    let+ () = run_build_system ~report_error ~common ~targets () in
+    let+ () = run_build_system ~report_error ~common ~request () in
     `Continue
   in
   Scheduler.poll ~common ~config ~every ~finally:Hooks.End_of_build.run
 
-let run_build_command_once ~(common : Common.t) ~config ~targets ~setup =
+let run_build_command_once ~(common : Common.t) ~config ~request ~setup =
   let open Fiber.O in
   let once () =
     let* setup = setup () in
-    run_build_system ~common ~targets:(fun () -> targets setup) ()
+    run_build_system ~common ~request:(request setup) ()
   in
   Scheduler.go ~common ~config once
 
-let run_build_command ~(common : Common.t) ~config ~targets =
+let run_build_command ~(common : Common.t) ~config ~request =
   let setup () = Import.Main.setup () in
   (if Common.watch common then
     run_build_command_poll
   else
     run_build_command_once)
-    ~setup ~common ~config ~targets
+    ~setup ~common ~config ~request
 
 let runtest =
   let doc = "Run tests." in
@@ -85,15 +81,15 @@ let runtest =
     let+ common = Common.term
     and+ dirs = Arg.(value & pos_all string [ "." ] name_) in
     let config = Common.init common in
-    let targets (setup : Import.Main.build_system) =
-      Memo.Build.return
-      @@ List.map dirs ~f:(fun dir ->
+    let request (setup : Import.Main.build_system) =
+      Action_builder.all_unit
+        (List.map dirs ~f:(fun dir ->
              let dir = Path.(relative root) (Common.prefix_target common dir) in
-             Target.Alias
-               (Alias.in_dir ~name:Dune_engine.Alias.Name.runtest
-                  ~recursive:true ~contexts:setup.contexts dir))
+             Alias.in_dir ~name:Dune_engine.Alias.Name.runtest ~recursive:true
+               ~contexts:setup.contexts dir
+             |> Alias.request))
     in
-    run_build_command ~common ~config ~targets
+    run_build_command ~common ~config ~request
   in
   (term, Term.info "runtest" ~doc ~man)
 
@@ -126,9 +122,9 @@ let build =
       | _ :: _ -> targets
     in
     let config = Common.init common in
-    let targets setup =
-      Target.resolve_targets_exn (Common.root common) config setup targets
+    let request setup =
+      Target.interpret_targets (Common.root common) config setup targets
     in
-    run_build_command ~common ~config ~targets
+    run_build_command ~common ~config ~request
   in
   (term, Term.info "build" ~doc ~man)

bin/build_cmd.mli

@@ -1,7 +1,9 @@
+open Dune_engine
+
 val run_build_command :
      common:Common.t
   -> config:Dune_config.t
-  -> targets:(Dune_rules.Main.build_system -> Target.t list Memo.Build.t)
+  -> request:(Dune_rules.Main.build_system -> unit Action_builder.t)
   -> unit
 
 val runtest : unit Cmdliner.Term.t * Cmdliner.Term.info

bin/print_rules.ml

@@ -121,9 +121,9 @@ let term =
                       Path.build p :: acc)
               >>| Action_builder.paths
             | _ ->
-              Target.resolve_targets_exn (Common.root common) config setup
-                targets
-              >>| Target.request
+              Memo.Build.return
+                (Target.interpret_targets (Common.root common) config setup
+                   targets)
           in
           let+ rules =
             Build_system.For_command_line.evaluate_rules ~request ~recursive

bin/target.ml

@@ -16,13 +16,7 @@ let request targets =
       >>>
       match target with
       | File path -> Action_builder.path path
-      | Alias { Alias.name; recursive; dir; contexts } ->
-        let contexts = List.map ~f:Dune_rules.Context.name contexts in
-        (if recursive then
-          Build_system.Alias.dep_rec_multi_contexts
-        else
-          Build_system.Alias.dep_multi_contexts)
-          ~dir ~name ~contexts)
+      | Alias a -> Alias.request a)
 
 let target_hint (_setup : Dune_rules.Main.build_system) path =
   assert (Path.is_managed path);
@@ -170,3 +164,9 @@ let resolve_targets_exn root config setup user_targets =
             ]
             ~hints
         | Ok targets -> targets)
+
+let interpret_targets root config setup user_targets =
+  let open Action_builder.O in
+  let* () = Action_builder.return () in
+  Action_builder.memo_build (resolve_targets_exn root config setup user_targets)
+  >>= request

bin/target.mli

@@ -1,14 +1,8 @@
-open Stdune
+open! Stdune
 
-type t =
-  | File of Path.t
-  | Alias of Alias.t
-
-val request : t list -> unit Dune_engine.Action_builder.t
-
-val resolve_targets_exn :
+val interpret_targets :
      Workspace_root.t
   -> Dune_config.t
   -> Dune_rules.Main.build_system
   -> Arg.Dep.t list
-  -> t list Memo.Build.t
+  -> unit Dune_engine.Action_builder.t

bin/top.ml

@@ -56,10 +56,7 @@ let term =
             Dune_rules.Lib.L.toplevel_include_paths requires
           in
           let* files = link_deps requires in
-          let* () =
-            Build_system.build
-              (Target.request (List.map files ~f:(fun f -> Target.File f)))
-          in
+          let* () = Build_system.build (Action_builder.paths files) in
           let files_to_load =
             List.filter files ~f:(fun p ->
                 let ext = Path.extension p in