Automatically install or update ocaml-lsp-server

CHANGELOG.md

@@ -2,6 +2,8 @@
 
 # Unreleased
 
+- Add one-click install option for ocaml-lsp-server (#1725)
+
 ## 1.28.0
 
 - Add `.re` file extension support. (#1685)

package.json

@@ -114,6 +114,15 @@
           "dark": "assets/plus-dark.svg"
         }
       },
+      {
+        "command": "ocaml.install-ocaml-lsp-server",
+        "category": "OCaml",
+        "title": "Install OCaml-LSP Server",
+        "icon": {
+          "light": "assets/plus-light.svg",
+          "dark": "assets/plus-dark.svg"
+        }
+      },
       {
         "command": "ocaml.upgrade-sandbox",
         "category": "OCaml",

src/extension_commands.ml

@@ -56,6 +56,46 @@ let _select_sandbox =
   command Extension_consts.Commands.select_sandbox handler
 ;;
 
+let _install_ocaml_lsp_server =
+  let handler (instance : Extension_instance.t) ~args:_ =
+    let open Promise.Syntax in
+    let (_ : unit Promise.t) =
+      let sandbox = Extension_instance.sandbox instance in
+      let* ocamllsp_present = Extension_instance.check_ocaml_lsp_available sandbox in
+      match ocamllsp_present with
+      | Ok () ->
+        show_message `Info "OCaml-LSP server is already installed." |> Promise.return
+      | Error _ ->
+        let* () = Extension_instance.install_ocaml_lsp_server sandbox in
+        show_message `Info "Installation of OCaml-LSP server completed successfully.";
+        Extension_instance.start_language_server instance
+    in
+    ()
+  in
+  command Extension_consts.Commands.install_ocaml_lsp_server handler
+;;
+
+let _upgrade_ocaml_lsp_server =
+  let handler (instance : Extension_instance.t) ~args:_ =
+    let open Promise.Syntax in
+    let (_ : unit Promise.t) =
+      let sandbox = Extension_instance.sandbox instance in
+      match
+        Ocaml_lsp.is_version_up_to_date
+          (Extension_instance.ocaml_lsp instance |> Option.value_exn)
+          (Extension_instance.ocaml_version_exn instance)
+      with
+      | Ok () -> Promise.return ()
+      | Error (`Msg _error) ->
+        let* _ = Extension_instance.upgrade_ocaml_lsp_server sandbox in
+        let+ _ = Extension_instance.start_language_server instance in
+        show_message `Info "OCaml-LSP server upgraded successfully"
+    in
+    ()
+  in
+  command Extension_consts.Commands.upgrade_ocaml_lsp_server handler
+;;
+
 let _restart_language_server =
   let handler (instance : Extension_instance.t) ~args:_ =
     let (_ : unit Promise.t) = Extension_instance.start_language_server instance in
@@ -1101,9 +1141,13 @@ module Search_by_type = struct
          | None -> show_message `Warn "ocamllsp is not running"
          | Some (_client, ocaml_lsp)
            when ocaml_lsp_doesnt_support_search_by_type ocaml_lsp ->
-           show_message
-             `Warn
-             "The installed version of `ocamllsp` does not support type search"
+           let _ =
+             Ocaml_lsp.suggest_to_upgrade_ocaml_lsp_server
+               ~message:
+                 "The installed version of `ocamllsp` does not support type search."
+               ()
+           in
+           ()
          | Some (client, _) -> show_query_input text_editor client)
     in
     command Extension_consts.Commands.search_by_type handler
@@ -1272,9 +1316,14 @@ module Navigate_holes = struct
          | None -> show_message `Warn "ocamllsp is not running"
          | Some (_client, ocaml_lsp) when ocaml_lsp_doesnt_support_typed_holes ocaml_lsp
            ->
-           show_message
-             `Warn
-             "The installed version of `ocamllsp` does not support typed hole navigation"
+           let _ =
+             Ocaml_lsp.suggest_to_upgrade_ocaml_lsp_server
+               ~message:
+                 "The installed version of `ocamllsp` does not support typed hole \
+                  navigation."
+               ()
+           in
+           ()
          | Some (client, _) ->
            let _ = handle_hole_navigation text_editor client instance in
            ())

src/extension_consts.ml

@@ -2,6 +2,8 @@ let ocaml_prefixed key = "ocaml." ^ key
 
 module Commands = struct
   let select_sandbox = ocaml_prefixed "select-sandbox"
+  let install_ocaml_lsp_server = ocaml_prefixed "install-ocaml-lsp-server"
+  let upgrade_ocaml_lsp_server = ocaml_prefixed "update-ocaml-lsp-server"
   let restart_language_server = ocaml_prefixed "server.restart"
   let select_sandbox_and_open_terminal = ocaml_prefixed "open-terminal-select"
   let open_terminal = ocaml_prefixed "open-terminal"

src/extension_instance.ml

@@ -108,6 +108,23 @@ let stop_server t =
     else Promise.return ()
 ;;
 
+let check_ocaml_lsp_available sandbox =
+  let ocaml_lsp_version sandbox =
+    Sandbox.get_command sandbox "ocamllsp" [ "--version" ]
+  in
+  let cwd =
+    match Workspace.workspaceFolders () with
+    | [ cwd ] -> Some (cwd |> WorkspaceFolder.uri |> Uri.fsPath |> Path.of_string)
+    | _ -> None
+  in
+  Cmd.output ?cwd (ocaml_lsp_version sandbox)
+  |> Promise.Result.fold
+       ~ok:(fun (_ : string) -> ())
+       ~error:(fun (_ : string) ->
+         "Sandbox initialization failed: `ocaml-lsp-server` is not installed in the \
+          current sandbox.")
+;;
+
 module Language_server_init : sig
   val start_language_server : t -> unit Promise.t
 end = struct
@@ -150,21 +167,35 @@ end = struct
       LanguageClient.Executable.create ~command ~args ~options ()
   ;;
 
-  let check_ocaml_lsp_available sandbox =
-    let ocaml_lsp_version sandbox =
-      Sandbox.get_command sandbox "ocamllsp" [ "--version" ]
-    in
-    let cwd =
-      match Workspace.workspaceFolders () with
-      | [ cwd ] -> Some (cwd |> WorkspaceFolder.uri |> Uri.fsPath |> Path.of_string)
-      | _ -> None
+  let suggest_to_install_ocaml_lsp_server () =
+    let open Promise.Syntax in
+    let install_lsp_text = "Install OCaml-LSP server" in
+    let select_different_sandbox = "Select a different Sandbox" in
+    let* selection =
+      Window.showInformationMessage
+        ~message:
+          "Failed to start the language server. `ocaml-lsp-server` is not installed in \
+           the current sandbox."
+        ~choices:
+          [ install_lsp_text, `Install_lsp; select_different_sandbox, `Select_sandbox ]
+        ()
     in
-    Cmd.output ?cwd (ocaml_lsp_version sandbox)
-    |> Promise.Result.fold
-         ~ok:(fun (_ : string) -> ())
-         ~error:(fun (_ : string) ->
-           "Sandbox initialization failed: `ocaml-lsp-server` is not installed in the \
-            current sandbox.")
+    match selection with
+    | Some `Install_lsp ->
+      let+ (_ : Ojs.t option) =
+        Vscode.Commands.executeCommand
+          ~command:Extension_consts.Commands.install_ocaml_lsp_server
+          ~args:[]
+      in
+      ()
+    | Some `Select_sandbox ->
+      let+ (_ : Ojs.t option) =
+        Vscode.Commands.executeCommand
+          ~command:Extension_consts.Commands.select_sandbox
+          ~args:[]
+      in
+      ()
+    | _ -> Promise.return ()
   ;;
 
   let client_capabilities =
@@ -180,44 +211,46 @@ end = struct
   let start_language_server t =
     let open Promise.Syntax in
     let* () = stop_server t in
-    let+ res =
-      let open Promise.Result.Syntax in
-      let* () = check_ocaml_lsp_available t.sandbox in
-      let client =
-        let serverOptions = server_options t.sandbox in
-        let clientOptions = client_options () in
-        LanguageClient.make
-          ~id:"ocaml"
-          ~name:"OCaml Platform VS Code extension"
-          ~serverOptions
-          ~clientOptions
-          ()
+    let* ocamllsp_present = check_ocaml_lsp_available t.sandbox in
+    match ocamllsp_present with
+    | Ok () ->
+      let+ res =
+        let client =
+          let serverOptions = server_options t.sandbox in
+          let clientOptions = client_options () in
+          LanguageClient.make
+            ~id:"ocaml"
+            ~name:"OCaml Platform VS Code extension"
+            ~serverOptions
+            ~clientOptions
+            ()
+        in
+        LanguageClient.registerFeature client ~feature:client_capabilities;
+        let open Promise.Syntax in
+        let+ () = LanguageClient.start client in
+        let initialize_result = LanguageClient.initializeResult client in
+        let ocaml_lsp = Ocaml_lsp.of_initialize_result initialize_result in
+        t.lsp_client <- Some (client, ocaml_lsp);
+        (match Ocaml_lsp.is_version_up_to_date ocaml_lsp (ocaml_version_exn t) with
+         | Ok () -> ()
+         | Error (`Msg _) -> ());
+        send_configuration
+          client
+          ~codelens:t.codelens
+          ~extended_hover:t.extended_hover
+          ~standard_hover:t.standard_hover
+          ~dune_diagnostics:t.dune_diagnostics
+          ~syntax_documentation:t.syntax_documentation;
+        Ok ()
       in
-      LanguageClient.registerFeature client ~feature:client_capabilities;
-      let open Promise.Syntax in
-      let+ () = LanguageClient.start client in
-      let initialize_result = LanguageClient.initializeResult client in
-      let ocaml_lsp = Ocaml_lsp.of_initialize_result initialize_result in
-      t.lsp_client <- Some (client, ocaml_lsp);
-      (match Ocaml_lsp.is_version_up_to_date ocaml_lsp (ocaml_version_exn t) with
+      (match res with
        | Ok () -> ()
-       | Error (`Msg m) -> show_message `Warn "%s" m);
-      send_configuration
-        client
-        ~codelens:t.codelens
-        ~extended_hover:t.extended_hover
-        ~standard_hover:t.standard_hover
-        ~dune_diagnostics:t.dune_diagnostics
-        ~syntax_documentation:t.syntax_documentation;
-      Ok ()
-    in
-    match res with
-    | Ok () -> ()
-    | Error s ->
-      show_message
-        `Error
-        "An error occurred starting the language server `ocamllsp`. %s"
-        s
+       | Error s ->
+         show_message
+           `Error
+           "An error occurred starting the language server `ocamllsp`. %s"
+           s)
+    | Error _ -> suggest_to_install_ocaml_lsp_server ()
   ;;
 end
 
@@ -239,6 +272,38 @@ let documentation_server_info () =
   status_bar
 ;;
 
+let install_ocaml_lsp_server sandbox =
+  let open Promise.Syntax in
+  let* () = Sandbox.install_packages sandbox [ "ocaml-lsp-server" ] in
+  let* (_ : Ojs.t option) =
+    Vscode.Commands.executeCommand
+      ~command:Extension_consts.Commands.refresh_switches
+      ~args:[]
+  in
+  let+ (_ : Ojs.t option) =
+    Vscode.Commands.executeCommand
+      ~command:Extension_consts.Commands.refresh_sandbox
+      ~args:[]
+  in
+  ()
+;;
+
+let upgrade_ocaml_lsp_server sandbox =
+  let open Promise.Syntax in
+  let* () = Sandbox.upgrade_packages sandbox ~packages:[ "ocaml-lsp-server" ] in
+  let* (_ : Ojs.t option) =
+    Vscode.Commands.executeCommand
+      ~command:Extension_consts.Commands.refresh_switches
+      ~args:[]
+  in
+  let+ (_ : Ojs.t option) =
+    Vscode.Commands.executeCommand
+      ~command:Extension_consts.Commands.refresh_sandbox
+      ~args:[]
+  in
+  ()
+;;
+
 module Sandbox_info : sig
   val make : Sandbox.t -> StatusBarItem.t
   val update : StatusBarItem.t -> new_sandbox:Sandbox.t -> unit

src/extension_instance.mli

@@ -7,6 +7,7 @@ val sandbox : t -> Sandbox.t
 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 start_documentation_server
   :  t
@@ -17,6 +18,8 @@ val stop_documentation_server : t -> unit
 val lsp_client : t -> (LanguageClient.t * Ocaml_lsp.t) option
 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 set_configuration
   :  t

src/ocaml_lsp.ml

@@ -199,6 +199,31 @@ let available_versions version =
   List.Assoc.find lsp_versions ~equal:Poly.equal prefix
 ;;
 
+let suggest_to_upgrade_ocaml_lsp_server
+      ?(message = "OCaml-LSP server is not up to date.")
+      ()
+  =
+  let open Promise.Syntax in
+  let upgrade_lsp_text = "Yes" in
+  let no_upgrade = "No" in
+  let* selection =
+    Window.showInformationMessage
+      ~message:(message ^ " Do you want to upgrade it?")
+      ~choices:[ upgrade_lsp_text, `Update_lsp; no_upgrade, `No_upgrade ]
+      ()
+  in
+  match selection with
+  | Some `Update_lsp ->
+    let+ (_ : Ojs.t option) =
+      Vscode.Commands.executeCommand
+        ~command:Extension_consts.Commands.upgrade_ocaml_lsp_server
+        ~args:[]
+    in
+    ()
+  | Some `No_upgrade -> Promise.return ()
+  | _ -> Promise.return ()
+;;
+
 let is_version_up_to_date t ocaml_v =
   let ocamllsp_version = get_version_from_serverInfo t in
   let res =

src/ocaml_lsp.mli

@@ -11,6 +11,7 @@ val can_handle_type_selection : t -> bool
 val can_handle_construct : t -> bool
 val can_handle_merlin_jump : t -> bool
 val can_handle_search_by_type : t -> bool
+val suggest_to_upgrade_ocaml_lsp_server : ?message:string -> unit -> unit Promise.t
 
 module OcamllspSettingEnable : sig
   include Ojs.T

src/opam.ml

@@ -310,7 +310,11 @@ let install t switch ~packages =
 ;;
 
 let update t switch = spawn t [ "update"; switch_arg switch ]
-let upgrade t switch = spawn t [ "upgrade"; switch_arg switch; "-y" ]
+
+let upgrade ?(packages = []) t switch =
+  spawn t ("upgrade" :: switch_arg switch :: "-y" :: packages)
+;;
+
 let remove t switch packages = spawn t ("remove" :: switch_arg switch :: "-y" :: packages)
 
 let switch_compiler t switch =

src/opam.mli

@@ -47,7 +47,7 @@ val install : t -> Switch.t -> packages:string list -> Cmd.t
 val update : t -> Switch.t -> Cmd.t
 
 (** Upgrade packages in a switch *)
-val upgrade : t -> Switch.t -> Cmd.t
+val upgrade : ?packages:string list -> t -> Switch.t -> Cmd.t
 
 (* Remove a list of packages from a switch *)
 val remove : t -> Switch.t -> string list -> Cmd.t