diff --git a/CHANGELOG.md b/CHANGELOG.md index f8774641b..c6ba035bb 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,8 @@ # Unreleased +- Allow selection of Dune context (#1449) + ## 1.18.1 - Fix `sideEffects` field in `astexplorer/package.json` (#1427) 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 18e9a927f..fd6c57385 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": { @@ -290,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 20b991fb9..0239a0532 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -158,6 +158,80 @@ let ( _open_ocamllsp_output_pane Extension_consts.Commands.open_ocaml_commands_output (handler Output.command_output_channel) ) +let _set_dune_context = + let handler (instance : Extension_instance.t) ~args:_ = + let open Promise.Syntax in + let select_context (choices : string list) = + let current_context = + Option.value + ~default:"default" + (Settings.get Settings.dune_context_setting) + 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 () = + 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 + let (_ : unit Promise.t) = select_dune_context () 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..8498900f6 100644 --- a/src/extension_consts.ml +++ b/src/extension_consts.ml @@ -66,6 +66,8 @@ 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..eedd6f18c 100644 --- a/src/extension_instance.ml +++ b/src/extension_instance.ml @@ -112,6 +112,12 @@ end = struct let server_options sandbox = let args = Settings.(get server_args_setting) |> Option.value ~default:[] in + let args = + 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 = diff --git a/src/settings.ml b/src/settings.ml index 887970f9a..db61f7965 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 dune_context_setting = + create_setting + ~scope:ConfigurationTarget.Workspace + ~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 08df2692a..47cd7a1ab 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 dune_context_setting : string setting