From 41e29cab36962bea71092f9b389f3107a982ff31 Mon Sep 17 00:00:00 2001 From: David Sancho Moreno Date: Wed, 5 Nov 2025 17:34:34 +0100 Subject: [PATCH 1/2] Register and allow to install --- src/command_api.ml | 1 + src/extension_commands.ml | 21 +++++++++++++ src/extension_instance.ml | 61 ++++++++++++++++++++++++++++++++++++ src/extension_instance.mli | 3 ++ src/vscode_ocaml_platform.ml | 1 + 5 files changed, 87 insertions(+) diff --git a/src/command_api.ml b/src/command_api.ml index b8f880ef5..682fba2df 100644 --- a/src/command_api.ml +++ b/src/command_api.ml @@ -68,6 +68,7 @@ module Internal = struct let select_sandbox = unit_handle "select-sandbox" let install_ocaml_lsp_server = unit_handle "install-ocaml-lsp-server" let upgrade_ocaml_lsp_server = unit_handle "update-ocaml-lsp-server" + let install_ocamlmerlin_mlx = unit_handle "install-ocamlmerlin-mlx" let restart_language_server = unit_handle "server.restart" let select_sandbox_and_open_terminal = unit_handle "open-terminal-select" let open_terminal = unit_handle "open-terminal" diff --git a/src/extension_commands.ml b/src/extension_commands.ml index c1d7357fe..18d6fbe10 100644 --- a/src/extension_commands.ml +++ b/src/extension_commands.ml @@ -90,6 +90,27 @@ let _upgrade_ocaml_lsp_server = command Command_api.Internal.upgrade_ocaml_lsp_server callback ;; +let _install_ocamlmerlin_mlx = + let callback (instance : Extension_instance.t) () = + let open Promise.Syntax in + let (_ : unit Promise.t) = + let sandbox = Extension_instance.sandbox instance in + let* ocamlmerlin_mlx_present = + Extension_instance.check_ocamlmerlin_mlx_available sandbox + in + match ocamlmerlin_mlx_present with + | Ok () -> + show_message `Info "ocamlmerlin-mlx is already installed." |> Promise.return + | Error _ -> + let* () = Extension_instance.install_ocamlmerlin_mlx sandbox in + show_message `Info "Installation of ocamlmerlin-mlx completed successfully."; + Extension_instance.start_language_server instance + in + () + in + command Command_api.Internal.install_ocamlmerlin_mlx callback +;; + let _install_dune_lsp_server = let callback (instance : Extension_instance.t) () = let open Promise.Syntax in diff --git a/src/extension_instance.ml b/src/extension_instance.ml index 75104b268..aa5d70526 100644 --- a/src/extension_instance.ml +++ b/src/extension_instance.ml @@ -158,6 +158,18 @@ let check_ocaml_lsp_available (sandbox : Sandbox.t) = current sandbox.") ;; +let check_ocamlmerlin_mlx_available (sandbox : Sandbox.t) = + let ocamlmerlin_mlx_version sandbox = + Sandbox.get_command sandbox "ocamlmerlin-mlx" [ "--version" ] `Tool + in + let cwd = Sandbox.workspace_root () in + Cmd.output ?cwd (ocamlmerlin_mlx_version sandbox) + |> Promise.Result.fold + ~ok:(fun (_ : string) -> ()) + ~error:(fun (_ : string) -> + "\"ocamlmerlin-mlx\" is not installed in the current sandbox.") +;; + module Language_server_init : sig val start_language_server : t -> unit Promise.t end = struct @@ -319,6 +331,14 @@ let upgrade_ocaml_lsp_server sandbox = () ;; +let install_ocamlmerlin_mlx sandbox = + let open Promise.Syntax in + let* () = Sandbox.install_packages sandbox [ "ocamlmerlin-mlx" ] in + let* () = Command_api.(execute Internal.refresh_switches) () in + let+ () = Command_api.(execute Internal.refresh_sandbox) () in + () +;; + module Sandbox_info : sig val make : Sandbox.t -> StatusBarItem.t val update : StatusBarItem.t -> new_sandbox:Sandbox.t -> unit @@ -483,6 +503,47 @@ let open_terminal sandbox = let ast_editor_state t = t.ast_editor_state +let suggest_or_install_ocamlmerlin_mlx t = + let open Promise.Syntax in + let install_mlx_text = "Install ocamlmerlin-mlx" in + let select_different_sandbox = "Select a different Sandbox" in + let* selection = + Window.showInformationMessage + ~message: + "MLX support requires \"ocamlmerlin-mlx\". Without it, the language server may crash \ + when opening .mlx files." + ~choices:[ install_mlx_text, `Install_mlx; select_different_sandbox, `Select_sandbox ] + () + in + match selection with + | Some `Install_mlx -> + let+ () = Command_api.(execute Internal.install_ocamlmerlin_mlx) () in + () + | Some `Select_sandbox -> + let+ () = Command_api.(execute Internal.select_sandbox) () in + () + | _ -> Promise.return () +;; + +let check_mlx_file_opened t (document : TextDocument.t) = + let file_name = TextDocument.fileName document in + if String.is_suffix file_name ~suffix:".mlx" + then ( + let (_ : unit Promise.t) = + let open Promise.Syntax in + let* ocamlmerlin_mlx_present = check_ocamlmerlin_mlx_available t.sandbox in + match ocamlmerlin_mlx_present with + | Ok () -> Promise.return () + | Error _ -> suggest_or_install_ocamlmerlin_mlx t + in + ()) +;; + +let register_mlx_check t = + let listener document = check_mlx_file_opened t document in + Workspace.onDidOpenTextDocument ~listener () +;; + let disposable t = Disposable.make ~dispose:(fun () -> StatusBarItem.dispose t.sandbox_info; diff --git a/src/extension_instance.mli b/src/extension_instance.mli index 63caa3e93..397c9e89c 100644 --- a/src/extension_instance.mli +++ b/src/extension_instance.mli @@ -8,6 +8,7 @@ val set_sandbox : t -> Sandbox.t -> unit val language_client : t -> LanguageClient.t option val ocaml_lsp : t -> Ocaml_lsp.t option val check_ocaml_lsp_available : Sandbox.t -> (unit, string) result Promise.t +val check_ocamlmerlin_mlx_available : Sandbox.t -> (unit, string) result Promise.t val start_documentation_server : t @@ -20,6 +21,7 @@ val ocaml_version_exn : t -> Ocaml_version.t val start_language_server : t -> unit Promise.t val install_ocaml_lsp_server : Sandbox.t -> unit Promise.t val upgrade_ocaml_lsp_server : Sandbox.t -> unit Promise.t +val install_ocamlmerlin_mlx : Sandbox.t -> unit Promise.t val suggest_to_run_dune_pkg_lock : unit -> unit val set_configuration @@ -34,6 +36,7 @@ val set_configuration val open_terminal : Sandbox.t -> unit val disposable : t -> Disposable.t +val register_mlx_check : t -> Disposable.t val repl : t -> Terminal_sandbox.t option val set_repl : t -> Terminal.t -> unit val close_repl : t -> unit diff --git a/src/vscode_ocaml_platform.ml b/src/vscode_ocaml_platform.ml index dd0eb84e9..421280e97 100644 --- a/src/vscode_ocaml_platform.ml +++ b/src/vscode_ocaml_platform.ml @@ -41,6 +41,7 @@ let activate (extension : ExtensionContext.t) = extension ~disposable:(Extension_instance.disposable instance); ExtensionContext.subscribe extension ~disposable:(notify_configuration_changes instance); + ExtensionContext.subscribe extension ~disposable:(Extension_instance.register_mlx_check instance); Dune_formatter.register extension instance; Dune_task_provider.register extension instance; Treeview_switches.register extension instance; From 83b22fe49d0d133f1035f87288d12a12e411f50a Mon Sep 17 00:00:00 2001 From: David Sancho Moreno Date: Wed, 5 Nov 2025 17:57:51 +0100 Subject: [PATCH 2/2] Check for ocamlmerlin only once --- src/extension_instance.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/extension_instance.ml b/src/extension_instance.ml index aa5d70526..88ba6edde 100644 --- a/src/extension_instance.ml +++ b/src/extension_instance.ml @@ -16,6 +16,7 @@ type t = ; mutable standard_hover : bool option ; mutable dune_diagnostics : bool option ; mutable syntax_documentation : bool option + ; mutable prompted_for_ocamlmerlin_mlx : bool } let sandbox t = t.sandbox @@ -384,6 +385,7 @@ let make () = ; standard_hover = None ; dune_diagnostics = None ; syntax_documentation = None + ; prompted_for_ocamlmerlin_mlx = false } ;; @@ -527,8 +529,9 @@ let suggest_or_install_ocamlmerlin_mlx t = let check_mlx_file_opened t (document : TextDocument.t) = let file_name = TextDocument.fileName document in - if String.is_suffix file_name ~suffix:".mlx" + if String.is_suffix file_name ~suffix:".mlx" && not t.prompted_for_ocamlmerlin_mlx then ( + t.prompted_for_ocamlmerlin_mlx <- true; let (_ : unit Promise.t) = let open Promise.Syntax in let* ocamlmerlin_mlx_present = check_ocamlmerlin_mlx_available t.sandbox in