From 8d0e29c4b3f9a40e18ffbec237165ff464dd4d54 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Tue, 9 Apr 2024 15:49:35 +0000 Subject: [PATCH 1/6] start dune contexts --- Makefile | 2 +- README.md | 1 + package.json | 5 +++++ src/custom_requests.ml | 6 ++++++ src/custom_requests.mli | 2 ++ src/extension_commands.ml | 17 +++++++++++++++++ src/extension_consts.ml | 3 +++ src/extension_instance.ml | 16 +++++++++++++--- src/extension_instance.mli | 1 + src/ocaml_lsp.ml | 24 ++++++++++++++++++++++-- src/ocaml_lsp.mli | 11 +++++++++++ src/settings.ml | 7 +++++++ src/settings.mli | 2 ++ src/vscode_ocaml_platform.ml | 6 +++++- 14 files changed, 96 insertions(+), 7 deletions(-) diff --git a/Makefile b/Makefile index 8cc4e2e70..1798c2626 100644 --- a/Makefile +++ b/Makefile @@ -11,7 +11,7 @@ yarn-deps: .PHONY: deps deps: ## Install development dependencies $(MAKE) yarn-deps - opam install --deps-only --with-test --with-doc --with-dev-setup --yes . + opam install --deps-only --with-test --with-doc --yes . .PHONY: create_switch create_switch: diff --git a/README.md b/README.md index e152fc833..f11428cdb 100644 --- a/README.md +++ b/README.md @@ -262,6 +262,7 @@ prefix `OCaml:`: | `ocaml.switch-impl-intf` | Switch implementation/interface | `Alt+O` | | `ocaml.open-repl` | Open REPL | | | `ocaml.evaluate-selection` | Evaluate Selection | `Shift+Enter` | +| `ocaml.select-dune-context` | Select a Dune context for this workspace | | ## Debugging OCaml programs (experimental) diff --git a/package.json b/package.json index d0d6c0f1c..f23953c20 100644 --- a/package.json +++ b/package.json @@ -241,6 +241,11 @@ "command": "ocaml.goto-closure-code-location", "category": "OCaml", "title": "Goto Closure Code Location" + }, + { + "command": "ocaml.select-dune-context", + "category": "OCaml", + "title": "Select a Dune context for this Workspace" } ], "configuration": { diff --git a/src/custom_requests.ml b/src/custom_requests.ml index 90d551077..9c3ef18db 100644 --- a/src/custom_requests.ml +++ b/src/custom_requests.ml @@ -33,3 +33,9 @@ let typedHoles = Jsonoo.Encode.(object_ [ ("uri", string @@ Uri.toString uri ()) ])) ; decode_response = Jsonoo.Decode.list Range.t_of_json } + +let getDuneContexts = + { meth = ocamllsp_prefixed "duneContexts" + ; encode_params = (fun () -> Jsonoo.Encode.list Fn.id []) + ; decode_response = Jsonoo.Decode.(list string) + } diff --git a/src/custom_requests.mli b/src/custom_requests.mli index 8823263eb..018f04dbd 100644 --- a/src/custom_requests.mli +++ b/src/custom_requests.mli @@ -20,3 +20,5 @@ val switchImplIntf : (string, string array) custom_request val inferIntf : (string, string) custom_request val typedHoles : (Uri.t, Range.t list) custom_request + +val getDuneContexts : (unit, string list) custom_request diff --git a/src/extension_commands.ml b/src/extension_commands.ml index 20b991fb9..92def28a0 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -158,6 +158,23 @@ let ( _open_ocamllsp_output_pane Extension_consts.Commands.open_ocaml_commands_output (handler Output.command_output_channel) ) +let _set_dune_contexts = + let handler (instance : Extension_instance.t) ~args:_ = + let open Promise.Syntax in + let (_ : unit Promise.t) = + let* sandbox = Sandbox.select_sandbox () in + match sandbox with + | None (* sandbox selection cancelled *) -> Promise.return () + | Some new_sandbox -> + Extension_instance.set_sandbox instance new_sandbox; + let* () = Sandbox.save_to_settings new_sandbox in + let* () = Extension_instance.update_ocaml_info instance in + Extension_instance.start_language_server instance + in + () + in + command Extension_consts.Commands.select_dune_context handler + module Holes_commands : sig val _jump_to_prev_hole : t diff --git a/src/extension_consts.ml b/src/extension_consts.ml index 21e35e831..315268758 100644 --- a/src/extension_consts.ml +++ b/src/extension_consts.ml @@ -66,6 +66,9 @@ module Commands = struct let goto_closure_code_location = ocaml_prefixed "goto-closure-code-location" let ask_debug_program = ocaml_prefixed "ask-debug-program" + + let select_dune_context = ocaml_prefixed "select-dune-context" + end module Command_errors = struct diff --git a/src/extension_instance.ml b/src/extension_instance.ml index cffa4da4a..223906bb2 100644 --- a/src/extension_instance.ml +++ b/src/extension_instance.ml @@ -15,6 +15,7 @@ type t = ; mutable extended_hover : bool option ; mutable dune_diagnostics : bool option ; mutable syntax_documentation : bool option + ; mutable dune_context : string option } let sandbox t = t.sandbox @@ -28,7 +29,7 @@ let lsp_client t = t.lsp_client let ocaml_version_exn t = Option.value_exn t.ocaml_version let send_configuration ~codelens ~extended_hover ~dune_diagnostics - ~syntax_documentation client = + ~syntax_documentation ~dune_context client = let codelens = Option.map codelens ~f:(fun enable -> Ocaml_lsp.OcamllspSettingEnable.create ~enable) @@ -45,12 +46,17 @@ let send_configuration ~codelens ~extended_hover ~dune_diagnostics Option.map syntax_documentation ~f:(fun enable -> Ocaml_lsp.OcamllspSettingEnable.create ~enable) in + let duneContext = + Option.map dune_context ~f:(fun value -> + Ocaml_lsp.OcamllspSettingString.create ~value) + in let settings = Ocaml_lsp.OcamllspSettings.create ~codelens ~extendedHover ~duneDiagnostics ~syntaxDocumentation + ~duneContext in let payload = let settings = @@ -66,11 +72,12 @@ let send_configuration ~codelens ~extended_hover ~dune_diagnostics payload let set_configuration t ~codelens ~extended_hover ~dune_diagnostics - ~syntax_documentation = + ~syntax_documentation ~dune_context = t.codelens <- codelens; t.extended_hover <- extended_hover; t.dune_diagnostics <- dune_diagnostics; t.syntax_documentation <- syntax_documentation; + t.dune_context <- dune_context; match t.lsp_client with | None -> () | Some (client, (_ : Ocaml_lsp.t)) -> @@ -79,6 +86,7 @@ let set_configuration t ~codelens ~extended_hover ~dune_diagnostics ~extended_hover ~dune_diagnostics ~syntax_documentation + ~dune_context client let stop_server t = @@ -196,7 +204,8 @@ end = struct ~codelens:t.codelens ~extended_hover:t.extended_hover ~dune_diagnostics:t.dune_diagnostics - ~syntax_documentation:t.syntax_documentation; + ~syntax_documentation:t.syntax_documentation + ~dune_context:t.dune_context; Ok () in match res with @@ -270,6 +279,7 @@ let make () = ; extended_hover = None ; dune_diagnostics = None ; syntax_documentation = None + ; dune_context = None } let set_documentation_context ~running = diff --git a/src/extension_instance.mli b/src/extension_instance.mli index ea315d694..a666ba14c 100644 --- a/src/extension_instance.mli +++ b/src/extension_instance.mli @@ -29,6 +29,7 @@ val set_configuration : -> extended_hover:bool option -> dune_diagnostics:bool option -> syntax_documentation:bool option + -> dune_context:string option -> unit val open_terminal : Sandbox.t -> unit diff --git a/src/ocaml_lsp.ml b/src/ocaml_lsp.ml index 2953757b7..0f8366392 100644 --- a/src/ocaml_lsp.ml +++ b/src/ocaml_lsp.ml @@ -11,6 +11,16 @@ module OcamllspSettingEnable = struct val create : enable:bool -> t [@@js.builder]] end +module OcamllspSettingString = struct + include Interface.Make () + + include + [%js: + val value : t -> string or_undefined [@@js.get] + + val create : value:string -> t [@@js.builder]] +end + module OcamllspSettings = struct include Interface.Make () @@ -25,17 +35,27 @@ module OcamllspSettings = struct val syntaxDocumentation : t -> OcamllspSettingEnable.t or_undefined [@@js.get] + val duneContext : t -> OcamllspSettingString.t or_undefined [@@js.get] + val create : ?codelens:OcamllspSettingEnable.t -> ?extendedHover:OcamllspSettingEnable.t -> ?duneDiagnostics:OcamllspSettingEnable.t -> ?syntaxDocumentation:OcamllspSettingEnable.t + -> ?duneContext:OcamllspSettingString.t -> unit -> t [@@js.builder]] - let create ~codelens ~extendedHover ~duneDiagnostics ~syntaxDocumentation = - create ?codelens ?extendedHover ?duneDiagnostics ?syntaxDocumentation () + let create ~codelens ~extendedHover ~duneDiagnostics ~syntaxDocumentation + ~duneContext = + create + ?codelens + ?extendedHover + ?duneDiagnostics + ?syntaxDocumentation + ?duneContext + () end module Experimental_capabilities = struct diff --git a/src/ocaml_lsp.mli b/src/ocaml_lsp.mli index dffcadcc3..4fa8b5356 100644 --- a/src/ocaml_lsp.mli +++ b/src/ocaml_lsp.mli @@ -21,6 +21,14 @@ module OcamllspSettingEnable : sig val create : enable:bool -> t end +module OcamllspSettingString : sig + include Ojs.T + + val value : t -> string option + + val create : value:string -> t +end + module OcamllspSettings : sig include Ojs.T @@ -32,10 +40,13 @@ module OcamllspSettings : sig val syntaxDocumentation : t -> OcamllspSettingEnable.t option + val duneContext : t -> OcamllspSettingString.t option + val create : codelens:OcamllspSettingEnable.t option -> extendedHover:OcamllspSettingEnable.t option -> duneDiagnostics:OcamllspSettingEnable.t option -> syntaxDocumentation:OcamllspSettingEnable.t option + -> duneContext:OcamllspSettingString.t option -> t end diff --git a/src/settings.ml b/src/settings.ml index 887970f9a..877bacb7b 100644 --- a/src/settings.ml +++ b/src/settings.ml @@ -141,3 +141,10 @@ let server_syntaxDocumentation_setting = ~key:"ocaml.server.syntaxDocumentation" ~of_json:Jsonoo.Decode.bool ~to_json:Jsonoo.Encode.bool + +let server_duneContext_setting = + create_setting + ~scope:ConfigurationTarget.Workspace + ~key:"ocaml.server.duneContext" + ~of_json:Jsonoo.Decode.string + ~to_json:Jsonoo.Encode.string diff --git a/src/settings.mli b/src/settings.mli index 08df2692a..13efe67d4 100644 --- a/src/settings.mli +++ b/src/settings.mli @@ -45,3 +45,5 @@ val server_extendedHover_setting : bool setting val server_duneDiagnostics_setting : bool setting val server_syntaxDocumentation_setting : bool setting + +val server_duneContext_setting : string setting diff --git a/src/vscode_ocaml_platform.ml b/src/vscode_ocaml_platform.ml index e3da72221..1a44c21e7 100644 --- a/src/vscode_ocaml_platform.ml +++ b/src/vscode_ocaml_platform.ml @@ -29,12 +29,16 @@ let notify_configuration_changes instance = let syntax_documentation = Settings.(get server_syntaxDocumentation_setting) in + let dune_context = + Settings.(get server_duneContext_setting) + in Extension_instance.set_configuration instance ~codelens ~extended_hover ~dune_diagnostics - ~syntax_documentation) + ~syntax_documentation + ~dune_context) () let activate (extension : ExtensionContext.t) = From c56d8923bf33efb177670cec0b2b830d2bd445a1 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Mon, 15 Apr 2024 14:51:47 +0000 Subject: [PATCH 2/6] setting dune ctxt --- package.json | 5 ++++ src/custom_requests.ml | 2 +- src/extension_commands.ml | 62 ++++++++++++++++++++++++++++++++------- src/ocaml_lsp.ml | 6 ++++ src/ocaml_lsp.mli | 2 ++ 5 files changed, 65 insertions(+), 12 deletions(-) diff --git a/package.json b/package.json index f23953c20..c84e9cec4 100644 --- a/package.json +++ b/package.json @@ -285,6 +285,11 @@ "default": true, "markdownDescription": "Enable/Disable dune diagnostics" }, + "ocaml.server.duneContext": { + "type": "string", + "default": "default", + "markdownDescription": "Set the current Dune context for Merlin" + }, "ocaml.server.syntaxDocumentation": { "type": "boolean", "default": false, diff --git a/src/custom_requests.ml b/src/custom_requests.ml index 9c3ef18db..3baa9aa5f 100644 --- a/src/custom_requests.ml +++ b/src/custom_requests.ml @@ -36,6 +36,6 @@ let typedHoles = let getDuneContexts = { meth = ocamllsp_prefixed "duneContexts" - ; encode_params = (fun () -> Jsonoo.Encode.list Fn.id []) + ; encode_params = (fun () -> Jsonoo.Encode.null) ; decode_response = Jsonoo.Decode.(list string) } diff --git a/src/extension_commands.ml b/src/extension_commands.ml index 92def28a0..a0ee003f8 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -158,20 +158,60 @@ let ( _open_ocamllsp_output_pane Extension_consts.Commands.open_ocaml_commands_output (handler Output.command_output_channel) ) -let _set_dune_contexts = +let _set_dune_context = let handler (instance : Extension_instance.t) ~args:_ = let open Promise.Syntax in - let (_ : unit Promise.t) = - let* sandbox = Sandbox.select_sandbox () in - match sandbox with - | None (* sandbox selection cancelled *) -> Promise.return () - | Some new_sandbox -> - Extension_instance.set_sandbox instance new_sandbox; - let* () = Sandbox.save_to_settings new_sandbox in - let* () = Extension_instance.update_ocaml_info instance in - Extension_instance.start_language_server instance + let select_context (choices : string list) = + let current_context = + (* TODO (jchavarri): read from config *) "default" + in + let choices = + let to_quick_pick current_context context = + let create = QuickPickItem.create in + let description = + if String.equal current_context context then + Some "Currently selected Dune context" + else None + in + create ~label:context ?description () + in + List.map + ~f:(fun (context : string) -> + let quick_pick = to_quick_pick current_context context in + (quick_pick, context)) + choices + in + let options = + let placeHolder = + "Which Dune context would you like to use in the editor?" + in + QuickPickOptions.create ~canPickMany:false ~placeHolder () + in + Window.showQuickPickItems ~choices ~options () in - () + let select_dune_context client = + let* candidates = + Custom_requests.send_request client Custom_requests.getDuneContexts () + in + let* context = select_context candidates in + match context with + | None (* context selection cancelled *) -> Promise.return () + | Some new_context -> + Settings.set Settings.server_duneContext_setting new_context + in + match Extension_instance.lsp_client instance with + | None -> show_message `Warn "ocamllsp is not running." + | Some (client, ocaml_lsp) -> + if Ocaml_lsp.can_handle_dune_contexts ocaml_lsp then + let (_ : unit Promise.t) = select_dune_context client in + () + else + (* if ocamllsp doesn't have the capability, recommend updating + ocamllsp*) + show_message + `Warn + "The installed version of ocamllsp does not support setting the Dune \ + context. Consider updating ocamllsp." in command Extension_consts.Commands.select_dune_context handler diff --git a/src/ocaml_lsp.ml b/src/ocaml_lsp.ml index 0f8366392..791a6cc4c 100644 --- a/src/ocaml_lsp.ml +++ b/src/ocaml_lsp.ml @@ -64,6 +64,7 @@ module Experimental_capabilities = struct ; handleSwitchImplIntf : bool ; handleInferIntf : bool ; handleTypedHoles : bool + ; handleDuneContexts : bool } let default = @@ -71,6 +72,7 @@ module Experimental_capabilities = struct ; handleSwitchImplIntf = false ; handleInferIntf = false ; handleTypedHoles = false + ; handleDuneContexts = false } (** Creates [t] given a JSON of form [{ 'handleSwitchImplIntf' : true, .... }] *) @@ -85,10 +87,12 @@ module Experimental_capabilities = struct let handleSwitchImplIntf = has_capability "handleSwitchImplIntf" in let handleInferIntf = has_capability "handleInferIntf" in let handleTypedHoles = has_capability "handleTypedHoles" in + let handleDuneContexts = has_capability "handleDuneContexts" in { interfaceSpecificLangId ; handleSwitchImplIntf ; handleInferIntf ; handleTypedHoles + ; handleDuneContexts } with Jsonoo.Decode_error err -> show_message @@ -250,3 +254,5 @@ let can_handle_switch_impl_intf t = let can_handle_infer_intf t = t.experimental_capabilities.handleSwitchImplIntf let can_handle_typed_holes t = t.experimental_capabilities.handleTypedHoles + +let can_handle_dune_contexts t = t.experimental_capabilities.handleDuneContexts diff --git a/src/ocaml_lsp.mli b/src/ocaml_lsp.mli index 4fa8b5356..097ac959d 100644 --- a/src/ocaml_lsp.mli +++ b/src/ocaml_lsp.mli @@ -13,6 +13,8 @@ val can_handle_infer_intf : t -> bool val can_handle_typed_holes : t -> bool +val can_handle_dune_contexts : t -> bool + module OcamllspSettingEnable : sig include Ojs.T From c4f368e0494bd8f2eb83cda7e5b316f84ce6e0de Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Tue, 16 Apr 2024 16:55:57 +0000 Subject: [PATCH 3/6] pass --context flag to ocamllsp --- src/extension_commands.ml | 9 +++++++-- src/extension_instance.ml | 9 ++++++++- src/vscode_ocaml_platform.ml | 4 +--- 3 files changed, 16 insertions(+), 6 deletions(-) diff --git a/src/extension_commands.ml b/src/extension_commands.ml index a0ee003f8..2eb977818 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -163,7 +163,9 @@ let _set_dune_context = let open Promise.Syntax in let select_context (choices : string list) = let current_context = - (* TODO (jchavarri): read from config *) "default" + Option.value + ~default:"default" + (Settings.get Settings.server_duneContext_setting) in let choices = let to_quick_pick current_context context = @@ -197,7 +199,10 @@ let _set_dune_context = match context with | None (* context selection cancelled *) -> Promise.return () | Some new_context -> - Settings.set Settings.server_duneContext_setting new_context + let* () = + Settings.set Settings.server_duneContext_setting new_context + in + Extension_instance.start_language_server instance in match Extension_instance.lsp_client instance with | None -> show_message `Warn "ocamllsp is not running." diff --git a/src/extension_instance.ml b/src/extension_instance.ml index 223906bb2..753bef903 100644 --- a/src/extension_instance.ml +++ b/src/extension_instance.ml @@ -119,7 +119,14 @@ end = struct () let server_options sandbox = - let args = Settings.(get server_args_setting) |> Option.value ~default:[] in + let args = + let default_args = + match Settings.get Settings.server_duneContext_setting with + | None -> [] + | Some context -> [ "--context"; context ] + in + Settings.(get server_args_setting) |> Option.value ~default:default_args + in let command = Sandbox.get_command sandbox "ocamllsp" args in Cmd.log command; let env = diff --git a/src/vscode_ocaml_platform.ml b/src/vscode_ocaml_platform.ml index 1a44c21e7..3a064574f 100644 --- a/src/vscode_ocaml_platform.ml +++ b/src/vscode_ocaml_platform.ml @@ -29,9 +29,7 @@ let notify_configuration_changes instance = let syntax_documentation = Settings.(get server_syntaxDocumentation_setting) in - let dune_context = - Settings.(get server_duneContext_setting) - in + let dune_context = Settings.(get server_duneContext_setting) in Extension_instance.set_configuration instance ~codelens From e257784a7843bf17053e78db99787bb875072ad1 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Thu, 18 Apr 2024 07:52:41 +0000 Subject: [PATCH 4/6] cleanup --- Makefile | 2 +- package.json | 10 +++++----- src/extension_commands.ml | 6 ++---- src/extension_consts.ml | 1 - src/extension_instance.ml | 31 ++++++++++++------------------- src/extension_instance.mli | 1 - src/ocaml_lsp.ml | 24 ++---------------------- src/ocaml_lsp.mli | 11 ----------- src/settings.ml | 4 ++-- src/settings.mli | 2 +- src/vscode_ocaml_platform.ml | 4 +--- 11 files changed, 26 insertions(+), 70 deletions(-) diff --git a/Makefile b/Makefile index 1798c2626..8cc4e2e70 100644 --- a/Makefile +++ b/Makefile @@ -11,7 +11,7 @@ yarn-deps: .PHONY: deps deps: ## Install development dependencies $(MAKE) yarn-deps - opam install --deps-only --with-test --with-doc --yes . + opam install --deps-only --with-test --with-doc --with-dev-setup --yes . .PHONY: create_switch create_switch: diff --git a/package.json b/package.json index c84e9cec4..68d1dc06e 100644 --- a/package.json +++ b/package.json @@ -285,11 +285,6 @@ "default": true, "markdownDescription": "Enable/Disable dune diagnostics" }, - "ocaml.server.duneContext": { - "type": "string", - "default": "default", - "markdownDescription": "Set the current Dune context for Merlin" - }, "ocaml.server.syntaxDocumentation": { "type": "boolean", "default": false, @@ -300,6 +295,11 @@ "default": true, "description": "Controls whether dune tasks should be automatically detected." }, + "ocaml.dune.context": { + "type": "string", + "default": "default", + "markdownDescription": "Set the current Dune context for Merlin" + }, "ocaml.trace.server": { "description": "Controls the logging output of the language server. Valid settings are `off`, `messages`, or `verbose`.", "type": "string", diff --git a/src/extension_commands.ml b/src/extension_commands.ml index 2eb977818..efdb78acd 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -165,7 +165,7 @@ let _set_dune_context = let current_context = Option.value ~default:"default" - (Settings.get Settings.server_duneContext_setting) + (Settings.get Settings.dune_context_setting) in let choices = let to_quick_pick current_context context = @@ -199,9 +199,7 @@ let _set_dune_context = match context with | None (* context selection cancelled *) -> Promise.return () | Some new_context -> - let* () = - Settings.set Settings.server_duneContext_setting new_context - in + let* () = Settings.set Settings.dune_context_setting new_context in Extension_instance.start_language_server instance in match Extension_instance.lsp_client instance with diff --git a/src/extension_consts.ml b/src/extension_consts.ml index 315268758..8498900f6 100644 --- a/src/extension_consts.ml +++ b/src/extension_consts.ml @@ -68,7 +68,6 @@ module Commands = struct let ask_debug_program = ocaml_prefixed "ask-debug-program" let select_dune_context = ocaml_prefixed "select-dune-context" - end module Command_errors = struct diff --git a/src/extension_instance.ml b/src/extension_instance.ml index 753bef903..7c8b84df9 100644 --- a/src/extension_instance.ml +++ b/src/extension_instance.ml @@ -15,7 +15,6 @@ type t = ; mutable extended_hover : bool option ; mutable dune_diagnostics : bool option ; mutable syntax_documentation : bool option - ; mutable dune_context : string option } let sandbox t = t.sandbox @@ -29,7 +28,7 @@ let lsp_client t = t.lsp_client let ocaml_version_exn t = Option.value_exn t.ocaml_version let send_configuration ~codelens ~extended_hover ~dune_diagnostics - ~syntax_documentation ~dune_context client = + ~syntax_documentation client = let codelens = Option.map codelens ~f:(fun enable -> Ocaml_lsp.OcamllspSettingEnable.create ~enable) @@ -46,17 +45,12 @@ let send_configuration ~codelens ~extended_hover ~dune_diagnostics Option.map syntax_documentation ~f:(fun enable -> Ocaml_lsp.OcamllspSettingEnable.create ~enable) in - let duneContext = - Option.map dune_context ~f:(fun value -> - Ocaml_lsp.OcamllspSettingString.create ~value) - in let settings = Ocaml_lsp.OcamllspSettings.create ~codelens ~extendedHover ~duneDiagnostics ~syntaxDocumentation - ~duneContext in let payload = let settings = @@ -72,12 +66,11 @@ let send_configuration ~codelens ~extended_hover ~dune_diagnostics payload let set_configuration t ~codelens ~extended_hover ~dune_diagnostics - ~syntax_documentation ~dune_context = + ~syntax_documentation = t.codelens <- codelens; t.extended_hover <- extended_hover; t.dune_diagnostics <- dune_diagnostics; t.syntax_documentation <- syntax_documentation; - t.dune_context <- dune_context; match t.lsp_client with | None -> () | Some (client, (_ : Ocaml_lsp.t)) -> @@ -86,7 +79,6 @@ let set_configuration t ~codelens ~extended_hover ~dune_diagnostics ~extended_hover ~dune_diagnostics ~syntax_documentation - ~dune_context client let stop_server t = @@ -119,14 +111,17 @@ end = struct () let server_options sandbox = + let args = Settings.(get server_args_setting) |> Option.value ~default:[] in let args = - let default_args = - match Settings.get Settings.server_duneContext_setting with - | None -> [] - | Some context -> [ "--context"; context ] - in - Settings.(get server_args_setting) |> Option.value ~default:default_args + (* `handleDuneContexts` capability is already checked when getting the + contexts for the `ocaml.select-dune-context` command, so the only way + to get here with a version of ocamllsp that doesn't support contexts is + if the user adds the `dune.context` setting manually *) + match Settings.get Settings.dune_context_setting with + | None -> args + | Some context -> "--context" :: context :: args in + let command = Sandbox.get_command sandbox "ocamllsp" args in Cmd.log command; let env = @@ -211,8 +206,7 @@ end = struct ~codelens:t.codelens ~extended_hover:t.extended_hover ~dune_diagnostics:t.dune_diagnostics - ~syntax_documentation:t.syntax_documentation - ~dune_context:t.dune_context; + ~syntax_documentation:t.syntax_documentation; Ok () in match res with @@ -286,7 +280,6 @@ let make () = ; extended_hover = None ; dune_diagnostics = None ; syntax_documentation = None - ; dune_context = None } let set_documentation_context ~running = diff --git a/src/extension_instance.mli b/src/extension_instance.mli index a666ba14c..ea315d694 100644 --- a/src/extension_instance.mli +++ b/src/extension_instance.mli @@ -29,7 +29,6 @@ val set_configuration : -> extended_hover:bool option -> dune_diagnostics:bool option -> syntax_documentation:bool option - -> dune_context:string option -> unit val open_terminal : Sandbox.t -> unit diff --git a/src/ocaml_lsp.ml b/src/ocaml_lsp.ml index 791a6cc4c..f2049c3e8 100644 --- a/src/ocaml_lsp.ml +++ b/src/ocaml_lsp.ml @@ -11,16 +11,6 @@ module OcamllspSettingEnable = struct val create : enable:bool -> t [@@js.builder]] end -module OcamllspSettingString = struct - include Interface.Make () - - include - [%js: - val value : t -> string or_undefined [@@js.get] - - val create : value:string -> t [@@js.builder]] -end - module OcamllspSettings = struct include Interface.Make () @@ -35,27 +25,17 @@ module OcamllspSettings = struct val syntaxDocumentation : t -> OcamllspSettingEnable.t or_undefined [@@js.get] - val duneContext : t -> OcamllspSettingString.t or_undefined [@@js.get] - val create : ?codelens:OcamllspSettingEnable.t -> ?extendedHover:OcamllspSettingEnable.t -> ?duneDiagnostics:OcamllspSettingEnable.t -> ?syntaxDocumentation:OcamllspSettingEnable.t - -> ?duneContext:OcamllspSettingString.t -> unit -> t [@@js.builder]] - let create ~codelens ~extendedHover ~duneDiagnostics ~syntaxDocumentation - ~duneContext = - create - ?codelens - ?extendedHover - ?duneDiagnostics - ?syntaxDocumentation - ?duneContext - () + let create ~codelens ~extendedHover ~duneDiagnostics ~syntaxDocumentation = + create ?codelens ?extendedHover ?duneDiagnostics ?syntaxDocumentation () end module Experimental_capabilities = struct diff --git a/src/ocaml_lsp.mli b/src/ocaml_lsp.mli index 097ac959d..7f8263114 100644 --- a/src/ocaml_lsp.mli +++ b/src/ocaml_lsp.mli @@ -23,14 +23,6 @@ module OcamllspSettingEnable : sig val create : enable:bool -> t end -module OcamllspSettingString : sig - include Ojs.T - - val value : t -> string option - - val create : value:string -> t -end - module OcamllspSettings : sig include Ojs.T @@ -42,13 +34,10 @@ module OcamllspSettings : sig val syntaxDocumentation : t -> OcamllspSettingEnable.t option - val duneContext : t -> OcamllspSettingString.t option - val create : codelens:OcamllspSettingEnable.t option -> extendedHover:OcamllspSettingEnable.t option -> duneDiagnostics:OcamllspSettingEnable.t option -> syntaxDocumentation:OcamllspSettingEnable.t option - -> duneContext:OcamllspSettingString.t option -> t end diff --git a/src/settings.ml b/src/settings.ml index 877bacb7b..db61f7965 100644 --- a/src/settings.ml +++ b/src/settings.ml @@ -142,9 +142,9 @@ let server_syntaxDocumentation_setting = ~of_json:Jsonoo.Decode.bool ~to_json:Jsonoo.Encode.bool -let server_duneContext_setting = +let dune_context_setting = create_setting ~scope:ConfigurationTarget.Workspace - ~key:"ocaml.server.duneContext" + ~key:"ocaml.dune.context" ~of_json:Jsonoo.Decode.string ~to_json:Jsonoo.Encode.string diff --git a/src/settings.mli b/src/settings.mli index 13efe67d4..47cd7a1ab 100644 --- a/src/settings.mli +++ b/src/settings.mli @@ -46,4 +46,4 @@ val server_duneDiagnostics_setting : bool setting val server_syntaxDocumentation_setting : bool setting -val server_duneContext_setting : string setting +val dune_context_setting : string setting diff --git a/src/vscode_ocaml_platform.ml b/src/vscode_ocaml_platform.ml index 3a064574f..e3da72221 100644 --- a/src/vscode_ocaml_platform.ml +++ b/src/vscode_ocaml_platform.ml @@ -29,14 +29,12 @@ let notify_configuration_changes instance = let syntax_documentation = Settings.(get server_syntaxDocumentation_setting) in - let dune_context = Settings.(get server_duneContext_setting) in Extension_instance.set_configuration instance ~codelens ~extended_hover ~dune_diagnostics - ~syntax_documentation - ~dune_context) + ~syntax_documentation) () let activate (extension : ExtensionContext.t) = From 04597347e1a4b7fb728c39574039493cf76710f3 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Thu, 18 Apr 2024 08:04:10 +0000 Subject: [PATCH 5/6] +changelog --- CHANGELOG.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 92e482b34..18b49ec82 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ # Unreleased +- Allow selection of Dune context (#1449) + ## 1.18.0 - Fallback to `ocaml.org` package documentation page if there is no doc field in From 9d348689874890487734bb20b02d1daeb282d7c2 Mon Sep 17 00:00:00 2001 From: Javier Chavarri Date: Fri, 3 May 2024 10:53:12 +0000 Subject: [PATCH 6/6] remove duneContexts and call describe contexts from the vscode extension --- src/custom_requests.ml | 6 ---- src/custom_requests.mli | 2 -- src/extension_commands.ml | 60 ++++++++++++++++++++++++--------------- src/extension_instance.ml | 4 --- src/ocaml_lsp.ml | 6 ---- src/ocaml_lsp.mli | 2 -- 6 files changed, 37 insertions(+), 43 deletions(-) diff --git a/src/custom_requests.ml b/src/custom_requests.ml index 3baa9aa5f..90d551077 100644 --- a/src/custom_requests.ml +++ b/src/custom_requests.ml @@ -33,9 +33,3 @@ let typedHoles = Jsonoo.Encode.(object_ [ ("uri", string @@ Uri.toString uri ()) ])) ; decode_response = Jsonoo.Decode.list Range.t_of_json } - -let getDuneContexts = - { meth = ocamllsp_prefixed "duneContexts" - ; encode_params = (fun () -> Jsonoo.Encode.null) - ; decode_response = Jsonoo.Decode.(list string) - } diff --git a/src/custom_requests.mli b/src/custom_requests.mli index 018f04dbd..8823263eb 100644 --- a/src/custom_requests.mli +++ b/src/custom_requests.mli @@ -20,5 +20,3 @@ val switchImplIntf : (string, string array) custom_request val inferIntf : (string, string) custom_request val typedHoles : (Uri.t, Range.t list) custom_request - -val getDuneContexts : (unit, string list) custom_request diff --git a/src/extension_commands.ml b/src/extension_commands.ml index efdb78acd..0239a0532 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -191,30 +191,44 @@ let _set_dune_context = in Window.showQuickPickItems ~choices ~options () in - let select_dune_context client = - let* candidates = - Custom_requests.send_request client Custom_requests.getDuneContexts () - in - let* context = select_context candidates in - match context with - | None (* context selection cancelled *) -> Promise.return () - | Some new_context -> - let* () = Settings.set Settings.dune_context_setting new_context in - Extension_instance.start_language_server instance + let select_dune_context () = + match Workspace.rootPath () with + | None -> + (* Assumes that Dune root matches the workspace root *) + Promise.return + (show_message + `Warn + "Project root wasn't found. Can't select Dune context without \ + project root.") + | Some root -> ( + let* result = + let sandbox = Extension_instance.sandbox instance in + let cmd = + Sandbox.get_command sandbox "dune" [ "describe"; "contexts" ] + in + let env = + Interop.Dict.of_alist [ ("DUNE_CONFIG__GLOBAL_LOCK", "disabled") ] + in + Cmd.output ~env ~cwd:(Path.of_string root) cmd + in + match result with + | Error msg -> + Promise.return + (show_message + `Warn + "Error when calling `dune describe contexts': %s" + msg) + | Ok output -> ( + let candidates = String.split output ~on:'\n' in + let* context = select_context candidates in + match context with + | None (* context selection cancelled *) -> Promise.return () + | Some new_context -> + let* () = Settings.set Settings.dune_context_setting new_context in + Extension_instance.start_language_server instance)) in - match Extension_instance.lsp_client instance with - | None -> show_message `Warn "ocamllsp is not running." - | Some (client, ocaml_lsp) -> - if Ocaml_lsp.can_handle_dune_contexts ocaml_lsp then - let (_ : unit Promise.t) = select_dune_context client in - () - else - (* if ocamllsp doesn't have the capability, recommend updating - ocamllsp*) - show_message - `Warn - "The installed version of ocamllsp does not support setting the Dune \ - context. Consider updating ocamllsp." + let (_ : unit Promise.t) = select_dune_context () in + () in command Extension_consts.Commands.select_dune_context handler diff --git a/src/extension_instance.ml b/src/extension_instance.ml index 7c8b84df9..eedd6f18c 100644 --- a/src/extension_instance.ml +++ b/src/extension_instance.ml @@ -113,10 +113,6 @@ end = struct let server_options sandbox = let args = Settings.(get server_args_setting) |> Option.value ~default:[] in let args = - (* `handleDuneContexts` capability is already checked when getting the - contexts for the `ocaml.select-dune-context` command, so the only way - to get here with a version of ocamllsp that doesn't support contexts is - if the user adds the `dune.context` setting manually *) match Settings.get Settings.dune_context_setting with | None -> args | Some context -> "--context" :: context :: args diff --git a/src/ocaml_lsp.ml b/src/ocaml_lsp.ml index f2049c3e8..2953757b7 100644 --- a/src/ocaml_lsp.ml +++ b/src/ocaml_lsp.ml @@ -44,7 +44,6 @@ module Experimental_capabilities = struct ; handleSwitchImplIntf : bool ; handleInferIntf : bool ; handleTypedHoles : bool - ; handleDuneContexts : bool } let default = @@ -52,7 +51,6 @@ module Experimental_capabilities = struct ; handleSwitchImplIntf = false ; handleInferIntf = false ; handleTypedHoles = false - ; handleDuneContexts = false } (** Creates [t] given a JSON of form [{ 'handleSwitchImplIntf' : true, .... }] *) @@ -67,12 +65,10 @@ module Experimental_capabilities = struct let handleSwitchImplIntf = has_capability "handleSwitchImplIntf" in let handleInferIntf = has_capability "handleInferIntf" in let handleTypedHoles = has_capability "handleTypedHoles" in - let handleDuneContexts = has_capability "handleDuneContexts" in { interfaceSpecificLangId ; handleSwitchImplIntf ; handleInferIntf ; handleTypedHoles - ; handleDuneContexts } with Jsonoo.Decode_error err -> show_message @@ -234,5 +230,3 @@ let can_handle_switch_impl_intf t = let can_handle_infer_intf t = t.experimental_capabilities.handleSwitchImplIntf let can_handle_typed_holes t = t.experimental_capabilities.handleTypedHoles - -let can_handle_dune_contexts t = t.experimental_capabilities.handleDuneContexts diff --git a/src/ocaml_lsp.mli b/src/ocaml_lsp.mli index 7f8263114..dffcadcc3 100644 --- a/src/ocaml_lsp.mli +++ b/src/ocaml_lsp.mli @@ -13,8 +13,6 @@ val can_handle_infer_intf : t -> bool val can_handle_typed_holes : t -> bool -val can_handle_dune_contexts : t -> bool - module OcamllspSettingEnable : sig include Ojs.T