From 43300d3dd0f3b50a7e575175156bfcb34af5f9fe Mon Sep 17 00:00:00 2001 From: Valentin Gatien-Baron Date: Mon, 27 Oct 2025 18:43:30 +0100 Subject: [PATCH] avoid command line parsing in a the middle of a library --- bin/ocamlformat-rpc/main.ml | 2 +- bin/ocamlformat/main.ml | 2 +- lib-rpc-server/ocamlformat_rpc.ml | 21 +++--- lib/bin_conf/Bin_conf.ml | 112 ++++++++++++++---------------- lib/bin_conf/Bin_conf.mli | 6 +- 5 files changed, 69 insertions(+), 74 deletions(-) diff --git a/bin/ocamlformat-rpc/main.ml b/bin/ocamlformat-rpc/main.ml index f6fc689b6f..2064436e78 100644 --- a/bin/ocamlformat-rpc/main.ml +++ b/bin/ocamlformat-rpc/main.ml @@ -73,6 +73,6 @@ let info = Cmd.info "ocamlformat-rpc" ~version:Ocamlformat_lib.Version.current ~doc ~man -let rpc_main_t = Term.(const Ocamlformat_rpc.run $ const ()) +let rpc_main_t = Term.(const (Ocamlformat_rpc.run ~global_conf:None) $ const ()) let () = Stdlib.exit @@ Cmd.eval_result (Cmd.v info rpc_main_t) diff --git a/bin/ocamlformat/main.ml b/bin/ocamlformat/main.ml index 3574eda7a9..6d05de7ab0 100644 --- a/bin/ocamlformat/main.ml +++ b/bin/ocamlformat/main.ml @@ -87,7 +87,7 @@ let run_action action = | Print_config conf -> Conf.print_config conf ; Ok () ;; -match Bin_conf.action () with +match Cmdliner.Cmd.eval_value Bin_conf.term with | Ok (`Ok action) -> ( match run_action action with | Ok () -> Stdlib.exit 0 diff --git a/lib-rpc-server/ocamlformat_rpc.ml b/lib-rpc-server/ocamlformat_rpc.ml index c9799d888a..f4d87c2ef6 100644 --- a/lib-rpc-server/ocamlformat_rpc.ml +++ b/lib-rpc-server/ocamlformat_rpc.ml @@ -62,10 +62,10 @@ let run_config conf c = in update conf c -let run_path path = +let run_path ~global_conf path = match Bin_conf.build_config ~enable_outside_detected_project:false ~root:None - ~file:path ~is_stdin:false + ~file:path ~is_stdin:false ?global_conf () with | Ok _ as ok -> ok | Error e -> Error (`Path_error e) @@ -93,9 +93,9 @@ let run_format conf x = ; format Expression ; format Use_file ] -let run_format_with_args {Rpc.path; config} conf x = +let run_format_with_args ~global_conf {Rpc.path; config} conf x = let open Result in - Option.value_map path ~default:(Ok conf) ~f:run_path + Option.value_map path ~default:(Ok conf) ~f:(run_path ~global_conf) >>= fun conf -> Option.value_map config ~default:(Ok conf) ~f:(fun c -> run_config conf c) >>= fun conf -> run_format conf x @@ -124,7 +124,8 @@ let handle_error e output = | `Config_error e -> handle_config_error e output | `Path_error e -> handle_path_error e output -let rec rpc_main = function +let rpc_main ~global_conf v = + let rec rpc_main = function | Waiting_for_version -> ( match Protocol.Init.read_input stdin with | `Halt -> Ok () @@ -146,7 +147,7 @@ let rec rpc_main = function | `Unknown | `Error _ -> rpc_main state | `Format x -> let conf = - match run_format_with_args Rpc.empty_args conf x with + match run_format_with_args ~global_conf Rpc.empty_args conf x with | Ok (`Format formatted) -> Protocol.V1.output stdout (`Format formatted) ; conf @@ -169,7 +170,7 @@ let rec rpc_main = function | `Unknown | `Error _ -> rpc_main state | `Format (x, format_args) -> let conf = - match run_format_with_args format_args conf x with + match run_format_with_args ~global_conf format_args conf x with | Ok (`Format formatted) -> Protocol.V2.output stdout (`Format (formatted, format_args)) ; conf @@ -178,8 +179,10 @@ let rec rpc_main = function conf in rpc_main (Version_defined (v, conf)) ) ) + in + rpc_main v -let run () = +let run ~global_conf () = Stdio.In_channel.set_binary_mode stdin true ; Stdio.Out_channel.set_binary_mode stdout true ; - rpc_main Waiting_for_version + rpc_main ~global_conf Waiting_for_version diff --git a/lib/bin_conf/Bin_conf.ml b/lib/bin_conf/Bin_conf.ml index 5c357c4a5a..3279837809 100644 --- a/lib/bin_conf/Bin_conf.ml +++ b/lib/bin_conf/Bin_conf.ml @@ -48,8 +48,6 @@ let default = ; ocp_indent_config= false ; config= [] } -let global_conf = ref default - let info = let doc = "A tool to format OCaml code." in let man = @@ -355,11 +353,6 @@ let global_term = in term -let set_global_term = - declare_option - ~set:(fun conf_modif -> global_conf := conf_modif default) - global_term - (** Do not escape from [build_config] *) exception Conf_error of string @@ -392,7 +385,7 @@ let update_from_ocp_indent c loc (oic : IndentConfig.t) = ; match_indent_nested= elt @@ convert_threechoices oic.i_strict_with } } -let read_config_file ?version_check ?disable_conf_attrs conf = function +let read_config_file ?version_check ?disable_conf_attrs ~ignore_invalid_options conf = function | File_system.Ocp_indent file -> ( let filename = Fpath.to_string file in try @@ -415,7 +408,7 @@ let read_config_file ?version_check ?disable_conf_attrs conf = function (ocp_indent_conf, conf, errors) with | Invalid_argument e - when !global_conf.ignore_invalid_options -> + when ignore_invalid_options -> warn ~loc "%s" e ; (ocp_indent_conf, conf, errors) | Invalid_argument e -> @@ -444,7 +437,7 @@ let read_config_file ?version_check ?disable_conf_attrs conf = function line with | Ok conf -> (conf, errors) - | Error _ when !global_conf.ignore_invalid_options -> + | Error _ when ignore_invalid_options -> warn ~loc "ignoring invalid options %S" line ; (conf, errors) | Error e -> (conf, e :: errors) ) @@ -505,7 +498,12 @@ let is_in_listing_file ~listings ~filename = warn ~loc "%s. Ignoring file." err ; None ) -let update_using_env conf = +type global_conf = + { apply_cli : t -> t + ; current : t + } + +let update_using_env ~global_conf conf = let f (config, errors) (name, value) = match Decl.update Conf.options ~config ~from:`Env ~name ~value ~inline:false @@ -514,48 +512,34 @@ let update_using_env conf = | Error e -> (config, e :: errors) in let conf, errors = - List.fold_left !global_conf.config ~init:(conf, []) ~f + List.fold_left global_conf.current.config ~init:(conf, []) ~f in match List.rev errors with | [] -> conf | l -> failwith_user_errors ~from:"OCAMLFORMAT environment variable" l -let global_lib_term = - Term.( - const (fun conf_modif lib_conf -> - let new_global = conf_modif {!global_conf with lib_conf} in - global_conf := new_global ; - new_global.lib_conf ) - $ global_term ) - -let global_lib_term_eval = - lazy - (let discard = Format.make_formatter (fun _ _ _ -> ()) ignore in - Cmd.eval_value ~err:discard ~help:discard (Cmd.v info global_lib_term) - ) - -let update_using_cmdline config = - match Lazy.force global_lib_term_eval with - | Ok (`Ok conf_modif) -> conf_modif config - | Error _ | Ok (`Version | `Help) -> config - -let build_config ~enable_outside_detected_project ~root ~file ~is_stdin = +let update_using_cmdline ~global_conf config = + let t = global_conf.apply_cli { default with lib_conf = config } in + t.lib_conf, { global_conf with current = t } + +let build_config ~enable_outside_detected_project ~root ~file ~is_stdin ~global_conf = let vfile = Fpath.v file in let file_abs = Fpath.(vfile |> to_absolute |> normalize) in let fs = File_system.make ~enable_outside_detected_project - ~disable_conf_files:!global_conf.disable_conf_files - ~ocp_indent_config:!global_conf.ocp_indent_config ~root ~file:file_abs + ~disable_conf_files:global_conf.current.disable_conf_files + ~ocp_indent_config:global_conf.current.ocp_indent_config ~root ~file:file_abs in (* [version-check] can be modified by cmdline (evaluated last) but could lead to errors when parsing the .ocamlformat files (evaluated first). Similarly, [disable-conf-attrs] could lead to incorrect config. *) - let forward_conf = + let forward_conf, global_conf = let read_config_file = read_config_file ~version_check:false ~disable_conf_attrs:false in - List.fold fs.configuration_files ~init:Conf.default ~f:read_config_file - |> update_using_env |> update_using_cmdline + List.fold fs.configuration_files ~init:Conf.default + ~f:(read_config_file ~ignore_invalid_options:global_conf.current.ignore_invalid_options) + |> update_using_env ~global_conf |> update_using_cmdline ~global_conf in let conf = let opr_opts = @@ -565,10 +549,12 @@ let build_config ~enable_outside_detected_project ~root ~file ~is_stdin = in {Conf.default with opr_opts} in - let conf = - List.fold fs.configuration_files ~init:conf ~f:read_config_file - |> update_using_env |> update_using_cmdline + let conf, global_conf = + List.fold fs.configuration_files ~init:conf + ~f:(read_config_file ~ignore_invalid_options:global_conf.current.ignore_invalid_options) + |> update_using_env ~global_conf |> update_using_cmdline ~global_conf in + let _ = global_conf in if (not is_stdin) && (not (File_system.has_ocamlformat_file fs)) @@ -603,11 +589,11 @@ let build_config ~enable_outside_detected_project ~root ~file ~is_stdin = {f with disable= {f.disable with v= not f.disable.v}} ) | None -> conf -let build_config ~enable_outside_detected_project ~root ~file ~is_stdin = +let build_config ~enable_outside_detected_project ~root ~file ~is_stdin ?(global_conf = { current = default; apply_cli = Fn.id }) () = try let conf, warn_now = collect_warnings (fun () -> - build_config ~enable_outside_detected_project ~root ~file ~is_stdin ) + build_config ~enable_outside_detected_project ~root ~file ~is_stdin ~global_conf ) in if not conf.opr_opts.quiet.v then warn_now () ; Ok conf @@ -625,19 +611,19 @@ let ( let* ) = Result.( >>= ) let ( let+ ) = Result.( >>| ) -let make_action ~enable_outside_detected_project ~root action inputs = +let make_action ~enable_outside_detected_project ~root action inputs ~global_conf = let make_file ?name kind file = let name = Option.value ~default:file name in let+ conf = build_config ~enable_outside_detected_project ~root ~file:name - ~is_stdin:false + ~is_stdin:false ~global_conf () in {kind; name; file= File file; conf} in let make_stdin ?(name = "") kind = let+ conf = build_config ~enable_outside_detected_project ~root ~file:name - ~is_stdin:false + ~is_stdin:false ~global_conf () in {kind; name; file= Stdin; conf} in @@ -669,7 +655,8 @@ let make_action ~enable_outside_detected_project ~root action inputs = (File_system.root_ocamlformat_file ~root |> Fpath.to_string, true) in let+ conf = - build_config ~enable_outside_detected_project ~root ~file ~is_stdin + build_config ~enable_outside_detected_project ~root ~file ~is_stdin ~global_conf + () in Print_config conf | (`No_action | `Output _ | `Inplace | `Check), `No_input -> @@ -692,8 +679,8 @@ let make_action ~enable_outside_detected_project ~root action inputs = let+ inputs = make_inputs inputs in Check inputs -let validate_inputs () = - match (!global_conf.inputs, !global_conf.kind, !global_conf.name) with +let validate_inputs ~global_conf = + match (global_conf.inputs, global_conf.kind, global_conf.name) with | [], _, _ -> Ok `No_input | [Stdin], None, None -> Error @@ -728,14 +715,14 @@ let validate_inputs () = |> Result.all |> Result.map ~f:(fun files -> `Several_files files) -let validate_action () = +let validate_action ~global_conf () = match List.filter_map ~f:(fun s -> s) - [ Option.map ~f:(fun o -> (`Output o, "--output")) !global_conf.output - ; Option.some_if !global_conf.inplace (`Inplace, "--inplace") - ; Option.some_if !global_conf.check (`Check, "--check") - ; Option.some_if !global_conf.print_config + [ Option.map ~f:(fun o -> (`Output o, "--output")) global_conf.output + ; Option.some_if global_conf.inplace (`Inplace, "--inplace") + ; Option.some_if global_conf.check (`Check, "--check") + ; Option.some_if global_conf.print_config (`Print_config, "--print-config") ] with | [] -> Ok `No_action @@ -743,21 +730,24 @@ let validate_action () = | (_, a1) :: (_, a2) :: _ -> Error (Printf.sprintf "Cannot specify %s with %s" a1 a2) -let validate () = +let validate ~global_conf = let root = - Option.map !global_conf.root + Option.map global_conf.current.root ~f:Fpath.(fun x -> v x |> to_absolute |> normalize) in let enable_outside_detected_project = - !global_conf.enable_outside_detected_project && Option.is_none root + global_conf.current.enable_outside_detected_project && Option.is_none root in match - let* action = validate_action () in - let* inputs = validate_inputs () in - make_action ~enable_outside_detected_project ~root action inputs + let* action = validate_action ~global_conf:global_conf.current () in + let* inputs = validate_inputs ~global_conf:global_conf.current in + make_action ~enable_outside_detected_project ~root action inputs ~global_conf with | Error e -> `Error (false, e) | Ok action -> `Ok action -let action () = - Cmd.eval_value (Cmd.v info Term.(ret (const validate $ set_global_term))) +let term = + Cmd.v info + Term.(ret (Syntax.( + let+ apply_cli = global_term in + validate ~global_conf:{ apply_cli; current = apply_cli default }))) diff --git a/lib/bin_conf/Bin_conf.mli b/lib/bin_conf/Bin_conf.mli index f255d6ca53..c22294ca6e 100644 --- a/lib/bin_conf/Bin_conf.mli +++ b/lib/bin_conf/Bin_conf.mli @@ -9,11 +9,14 @@ (* *) (**************************************************************************) +type global_conf val build_config : enable_outside_detected_project:bool -> root:Fpath.t option -> file:string -> is_stdin:bool + -> ?global_conf:global_conf + -> unit -> (Ocamlformat_lib.Conf.t, string) Result.t type file = Stdin | File of string @@ -35,5 +38,4 @@ type action = | Print_config of Ocamlformat_lib.Conf.t (** Print the configuration and exit. *) -val action : - unit -> (action Cmdliner.Cmd.eval_ok, Cmdliner.Cmd.eval_error) Result.t +val term : action Cmdliner.Cmd.t