Merge pull request #12672 from ElectreAAS/push-kokylvswonux

Remove redundant function run_via_rpc

Author: Alizter

bin/build.ml

@@ -196,16 +196,16 @@ let build =
          perform the RPC call.
       *)
       let targets = Rpc.Rpc_common.prepare_targets targets in
-      Rpc.Rpc_common.run_via_rpc
-        ~common
-        ~config
-        (Rpc.Rpc_common.fire_request
-           ~name:"build"
-           ~wait:true
-           ~lock_held_by
-           builder
-           Dune_rpc_impl.Decl.build)
-        targets
+      Scheduler.go_without_rpc_server ~common ~config (fun () ->
+        let open Fiber.O in
+        Rpc.Rpc_common.fire_request
+          ~name:"build"
+          ~wait:true
+          ~lock_held_by
+          builder
+          Dune_rpc_impl.Decl.build
+          targets
+        >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:true)
     | Ok () ->
       let request setup =
         Target.interpret_targets (Common.root common) config setup targets

bin/exec.ml

@@ -226,16 +226,15 @@ let build_prog_via_rpc_if_necessary ~dir ~no_rebuild builder lock_held_by prog =
             (Dune_lang.String_with_vars.make_text Loc.none (Path.to_string path))
         in
         let targets = Rpc.Rpc_common.prepare_targets [ target ] in
-        Rpc.Rpc_common.wrap_build_outcome_exn
-          ~print_on_success:false
-          (Rpc.Rpc_common.fire_request
-             ~name:"build"
-             ~wait:true
-             ~lock_held_by
-             builder
-             Dune_rpc_impl.Decl.build)
+        let open Fiber.O in
+        Rpc.Rpc_common.fire_request
+          ~name:"build"
+          ~wait:true
+          ~lock_held_by
+          builder
+          Dune_rpc_impl.Decl.build
           targets
-          ())
+        >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:false)
     in
     Path.to_absolute_filename path
   | Absolute ->

bin/fmt.ml

@@ -45,25 +45,15 @@ let run_fmt_command ~common ~config ~preview builder =
   | Error lock_held_by ->
     (* The --preview flag is being ignored by the RPC server, warn the user. *)
     if preview then Rpc.Rpc_common.warn_ignore_arguments lock_held_by;
-    let response =
-      Scheduler.go_without_rpc_server ~common ~config (fun () ->
-        Rpc.Rpc_common.fire_request
-          ~name:"format"
-          ~wait:true
-          ~warn_forwarding:false
-          ~lock_held_by
-          builder
-          Dune_rpc.Procedures.Public.format
-          ())
-    in
-    (match response with
-     | Ok () -> ()
-     | Error error ->
-       User_error.raise
-         [ Pp.paragraphf
-             "Error: %s\n%!"
-             (Dyn.to_string (Dune_rpc.Response.Error.to_dyn error))
-         ])
+    Scheduler.go_without_rpc_server ~common ~config (fun () ->
+      Rpc.Rpc_common.fire_request
+        ~name:"format"
+        ~wait:true
+        ~warn_forwarding:false
+        ~lock_held_by
+        builder
+        Dune_rpc.Procedures.Public.format
+        ())
 ;;
 
 let command =

bin/promotion.ml

@@ -62,16 +62,16 @@ module Apply = struct
         let+ () = Fiber.return () in
         Diff_promotion.promote_files_registered_in_last_run files_to_promote)
     | Error lock_held_by ->
-      Rpc.Rpc_common.run_via_rpc
-        ~common
-        ~config
-        (Rpc.Rpc_common.fire_request
-           ~name:"promote_many"
-           ~wait:true
-           ~lock_held_by
-           builder
-           Dune_rpc_private.Procedures.Public.promote_many)
-        files_to_promote
+      Scheduler.go_without_rpc_server ~common ~config (fun () ->
+        let open Fiber.O in
+        Rpc.Rpc_common.fire_request
+          ~name:"promote_many"
+          ~wait:true
+          ~lock_held_by
+          builder
+          Dune_rpc_private.Procedures.Public.promote_many
+          files_to_promote
+        >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:true)
   ;;
 
   let command = Cmd.v info term

bin/rpc/rpc_build.ml

@@ -12,10 +12,8 @@ let term =
     Rpc_common.fire_request ~name:"build" ~wait builder Dune_rpc_impl.Decl.build targets
   in
   match response with
-  | Error (error : Dune_rpc.Response.Error.t) ->
-    Printf.eprintf "Error: %s\n%!" (Dyn.to_string (Dune_rpc.Response.Error.to_dyn error))
-  | Ok Success -> print_endline "Success"
-  | Ok (Failure _) -> print_endline "Failure"
+  | Success -> print_endline "Success"
+  | Failure _ -> print_endline "Failure"
 ;;
 
 let info =

bin/rpc/rpc_common.ml

@@ -21,17 +21,22 @@ let raise_rpc_error (e : Rpc_error.t) =
   User_error.raise
     [ Pp.paragraph "Server returned error: "
     ; Pp.paragraphf "%s (error kind: %s)" e.message (interpret_kind e.kind)
+      (* CR-soon ElectreAAS: Should we be printing the payload? *)
     ]
 ;;
 
-let request_exn client request n =
+let request_exn client request arg =
   let open Fiber.O in
   let* decl =
     Client.Versioned.prepare_request client (Dune_rpc.Decl.Request.witness request)
   in
   match decl with
+  | Ok decl ->
+    Client.request client decl arg
+    >>| (function
+     | Ok response -> response
+     | Error e -> raise_rpc_error e)
   | Error e -> raise (Dune_rpc.Version_error.E e)
-  | Ok decl -> Client.request client decl n
 ;;
 
 let client_term builder f =
@@ -111,15 +116,12 @@ let fire_request
     ~f:(fun client -> request_exn client request arg)
 ;;
 
-let wrap_build_outcome_exn ~print_on_success f args () =
-  let open Fiber.O in
-  let+ response = f args in
-  match response with
-  | Error (error : Rpc_error.t) -> raise_rpc_error error
-  | Ok Dune_rpc.Build_outcome_with_diagnostics.Success ->
+let wrap_build_outcome_exn ~print_on_success build_outcome =
+  match build_outcome with
+  | Dune_rpc.Build_outcome_with_diagnostics.Success ->
     if print_on_success
     then Console.print [ Pp.text "Success" |> Pp.tag User_message.Style.Success ]
-  | Ok (Failure errors) ->
+  | Failure errors ->
     let error_msg =
       match List.length errors with
       | 0 ->
@@ -133,10 +135,3 @@ let wrap_build_outcome_exn ~print_on_success f args () =
       Console.print_user_message main);
     User_error.raise [ error_msg |> Pp.tag User_message.Style.Error ]
 ;;
-
-let run_via_rpc ~common ~config f args =
-  Scheduler.go_without_rpc_server
-    ~common
-    ~config
-    (wrap_build_outcome_exn ~print_on_success:true f args)
-;;

bin/rpc/rpc_common.mli

@@ -13,7 +13,7 @@ val request_exn
   :  Dune_rpc_client.Client.t
   -> ('a, 'b) Dune_rpc.Decl.request
   -> 'a
-  -> ('b, Dune_rpc.Response.Error.t) result Fiber.t
+  -> 'b Fiber.t
 
 (** Cmdliner term for a generic RPC client. *)
 val client_term : Common.Builder.t -> (unit -> 'a Fiber.t) -> 'a
@@ -38,26 +38,12 @@ val fire_request
   -> Common.Builder.t
   -> ('a, 'b) Dune_rpc.Decl.request
   -> 'a
-  -> ('b, Dune_rpc.Response.Error.t) result Fiber.t
+  -> 'b Fiber.t
 
 val wrap_build_outcome_exn
   :  print_on_success:bool
-  -> ('a
-      -> (Dune_rpc.Build_outcome_with_diagnostics.t, Dune_rpc.Response.Error.t) result
-           Fiber.t)
-  -> 'a
+  -> Dune_rpc.Build_outcome_with_diagnostics.t
   -> unit
-  -> unit Fiber.t
 
 (** Warn the user that since a RPC server is running, some arguments are ignored. *)
 val warn_ignore_arguments : Dune_util.Global_lock.Lock_held_by.t -> unit
-
-(**  Schedule a fiber to run via RPC, wrapping any errors. *)
-val run_via_rpc
-  :  common:Common.t
-  -> config:Dune_config_file.Dune_config.t
-  -> ('a
-      -> (Dune_rpc.Build_outcome_with_diagnostics.t, Dune_rpc.Response.Error.t) result
-           Fiber.t)
-  -> 'a
-  -> unit

bin/rpc/rpc_ping.ml

@@ -15,15 +15,15 @@ let term =
   Rpc_common.client_term builder
   @@ fun () ->
   let open Fiber.O in
-  Rpc_common.fire_request
-    ~name:"ping_cmd"
-    ~wait
-    builder
-    Dune_rpc_private.Procedures.Public.ping
-    ()
-  >>| function
-  | Ok () -> Console.print [ Pp.text "Server appears to be responding normally" ]
-  | Error e -> Rpc_common.raise_rpc_error e
+  let+ () =
+    Rpc_common.fire_request
+      ~name:"ping_cmd"
+      ~wait
+      builder
+      Dune_rpc_private.Procedures.Public.ping
+      ()
+  in
+  Console.print [ Pp.text "Server appears to be responding normally" ]
 ;;
 
 let cmd = Cmd.v info term

bin/runtest.ml

@@ -48,18 +48,16 @@ let runtest_term =
            ~dir_or_cram_test_paths
            ~to_cwd:(Common.root common).to_cwd)
   | Error lock_held_by ->
-    Scheduler.go_without_rpc_server
-      ~common
-      ~config
-      (Rpc.Rpc_common.wrap_build_outcome_exn
-         ~print_on_success:true
-         (Rpc.Rpc_common.fire_request
-            ~name:"runtest"
-            ~wait:false
-            ~lock_held_by
-            builder
-            Dune_rpc.Procedures.Public.runtest)
-         dir_or_cram_test_paths)
+    Scheduler.go_without_rpc_server ~common ~config (fun () ->
+      let open Fiber.O in
+      Rpc.Rpc_common.fire_request
+        ~name:"runtest"
+        ~wait:false
+        ~lock_held_by
+        builder
+        Dune_rpc.Procedures.Public.runtest
+        dir_or_cram_test_paths
+      >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:true)
 ;;
 
 let commands =

bin/tools/tools_common.ml

@@ -36,16 +36,15 @@ let build_dev_tool_directly common dev_tool =
 let build_dev_tool_via_rpc builder lock_held_by dev_tool =
   let target = dev_tool_build_target dev_tool in
   let targets = Rpc.Rpc_common.prepare_targets [ target ] in
-  Rpc.Rpc_common.wrap_build_outcome_exn
-    ~print_on_success:false
-    (Rpc.Rpc_common.fire_request
-       ~name:"build"
-       ~wait:true
-       ~lock_held_by
-       builder
-       Dune_rpc_impl.Decl.build)
+  let open Fiber.O in
+  Rpc.Rpc_common.fire_request
+    ~name:"build"
+    ~wait:true
+    ~lock_held_by
+    builder
+    Dune_rpc_impl.Decl.build
     targets
-    ()
+  >>| Rpc.Rpc_common.wrap_build_outcome_exn ~print_on_success:false
 ;;
 
 let lock_and_build_dev_tool ~common ~config builder dev_tool =