Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
20 changes: 10 additions & 10 deletions bin/build.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
17 changes: 8 additions & 9 deletions bin/exec.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down
28 changes: 9 additions & 19 deletions bin/fmt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
20 changes: 10 additions & 10 deletions bin/promotion.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 2 additions & 4 deletions bin/rpc/rpc_build.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
27 changes: 11 additions & 16 deletions bin/rpc/rpc_common.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down Expand Up @@ -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 ->
Expand All @@ -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)
;;
20 changes: 3 additions & 17 deletions bin/rpc/rpc_common.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
18 changes: 9 additions & 9 deletions bin/rpc/rpc_ping.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
22 changes: 10 additions & 12 deletions bin/runtest.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
17 changes: 8 additions & 9 deletions bin/tools/tools_common.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 =
Expand Down
Loading