Ability to manually configure LSP for Haskell

Allow users who have HLS installed using `ghcup` to manually provide the path for the Haskell language server

assets/settings/default.json

@@ -451,6 +451,10 @@
   "deno": {
     "enable": false
   },
+  // Settings specific to the Haskell integration
+  "haskell": {
+    "lsp": "none"
+  },
   // Different settings for specific languages.
   "languages": {
     "Plain Text": {

crates/zed/src/languages.rs

@@ -7,7 +7,7 @@ use settings::Settings;
 use std::{borrow::Cow, str, sync::Arc};
 use util::{asset_str, paths::PLUGINS_DIR};
 
-use self::{deno::DenoSettings, elixir::ElixirSettings};
+use self::{deno::DenoSettings, elixir::ElixirSettings, haskell::HaskellSettings};
 
 mod c;
 mod css;
@@ -55,6 +55,7 @@ pub fn init(
 ) {
     ElixirSettings::register(cx);
     DenoSettings::register(cx);
+    HaskellSettings::register(cx);
 
     let language = |name, grammar, adapters| {
         languages.register(name, load_config(name), grammar, adapters, load_queries)
@@ -202,11 +203,21 @@ pub fn init(
             );
         }
     }
-    language(
+
-        "haskell",
+    match &HaskellSettings::get(None, cx).lsp {
-        tree_sitter_haskell::language(),
+        haskell::HaskellLspSetting::None => {
-        vec![Arc::new(haskell::HaskellLspAdapter)],
+            language("haskell", tree_sitter_haskell::language(), vec![])
-    );
+        }
+        haskell::HaskellLspSetting::Local { path, arguments } => language(
+            "haskell",
+            tree_sitter_haskell::language(),
+            vec![Arc::new(haskell::LocalLspAdapter {
+                path: path.clone(),
+                arguments: arguments.clone(),
+            })],
+        ),
+    }
+
     language(
         "html",
         tree_sitter_html::language(),

crates/zed/src/languages/haskell.rs

@@ -1,140 +1,102 @@
-use std::env::consts::ARCH;
+use anyhow::Result;
-use std::ffi::OsString;
-use std::{any::Any, path::PathBuf};
-
-use anyhow::{anyhow, Context, Result};
-use async_compression::futures::bufread::XzDecoder;
-use async_tar::Archive;
 use async_trait::async_trait;
-use futures::{io::BufReader, StreamExt};
-use smol::fs;
-
 use language::{LanguageServerName, LspAdapter, LspAdapterDelegate};
 use lsp::LanguageServerBinary;
-use util::async_maybe;
+use schemars::JsonSchema;
-use util::github::latest_github_release;
+use serde_derive::{Deserialize, Serialize};
-use util::{github::GitHubLspBinaryVersion, ResultExt};
+use settings::Settings;
+use std::ops::Deref;
+use std::{any::Any, path::PathBuf};
 
-fn server_binary_arguments() -> Vec<OsString> {
+#[derive(Clone, Serialize, Deserialize, JsonSchema)]
-    vec!["--lsp".into()]
+pub struct HaskellSettings {
+    pub lsp: HaskellLspSetting,
 }
 
-pub struct HaskellLspAdapter;
+#[derive(Clone, Serialize, Deserialize, JsonSchema)]
+#[serde(rename_all = "snake_case")]
+pub enum HaskellLspSetting {
+    None,
+    Local {
+        path: String,
+        arguments: Vec<String>,
+    },
+}
+
+#[derive(Clone, Serialize, Default, Deserialize, JsonSchema)]
+pub struct HaskellSettingsContent {
+    lsp: Option<HaskellLspSetting>,
+}
+
+impl Settings for HaskellSettings {
+    const KEY: Option<&'static str> = Some("haskell");
+
+    type FileContent = HaskellSettingsContent;
+
+    fn load(
+        default_value: &Self::FileContent,
+        user_values: &[&Self::FileContent],
+        _: &mut gpui::AppContext,
+    ) -> Result<Self>
+    where
+        Self: Sized,
+    {
+        Self::load_via_json_merge(default_value, user_values)
+    }
+}
+
+pub struct LocalLspAdapter {
+    pub path: String,
+    pub arguments: Vec<String>,
+}
 
 #[async_trait]
-impl LspAdapter for HaskellLspAdapter {
+impl LspAdapter for LocalLspAdapter {
     fn name(&self) -> LanguageServerName {
-        LanguageServerName("haskell-language-server".into())
+        LanguageServerName("local-hls".into())
     }
 
     fn short_name(&self) -> &'static str {
-        "hls"
+        "local-hls"
     }
 
     async fn fetch_latest_server_version(
         &self,
-        delegate: &dyn LspAdapterDelegate,
+        _: &dyn LspAdapterDelegate,
     ) -> Result<Box<dyn 'static + Send + Any>> {
-        // TODO: Release version should be matched against GHC version
+        Ok(Box::new(()) as Box<_>)
-        let release = latest_github_release(
-            "haskell/haskell-language-server",
-            false,
-            delegate.http_client(),
-        )
-        .await?;
-        let asset_name = format!(
-            "haskell-language-server-{}-{}-apple-darwin.tar.xz",
-            release.name, ARCH
-        );
-        let asset = release
-            .assets
-            .iter()
-            .find(|asset| asset.name == asset_name)
-            .ok_or_else(|| anyhow!("no asset found matching {:?}", asset_name))?;
-        let version = GitHubLspBinaryVersion {
-            name: release.name,
-            url: asset.browser_download_url.clone(),
-        };
-        Ok(Box::new(version) as Box<_>)
     }
 
     async fn fetch_server_binary(
         &self,
-        version: Box<dyn 'static + Send + Any>,
+        _: Box<dyn 'static + Send + Any>,
-        container_dir: PathBuf,
+        _: PathBuf,
-        delegate: &dyn LspAdapterDelegate,
+        _: &dyn LspAdapterDelegate,
     ) -> Result<LanguageServerBinary> {
-        let version = version.downcast::<GitHubLspBinaryVersion>().unwrap();
+        let path = shellexpand::full(&self.path)?;
-        let destination_path =
-            container_dir.join(format!("haskell-language-server-{}", version.name));
-        if fs::metadata(&destination_path).await.is_err() {
-            let mut response = delegate
-                .http_client()
-                .get(&version.url, Default::default(), true)
-                .await
-                .context("error downloading release")?;
-            let decompressed_bytes = XzDecoder::new(BufReader::new(response.body_mut()));
-            let archive = Archive::new(decompressed_bytes);
-            archive.unpack(&container_dir).await?;
-        }
-        let binary_path = destination_path.join("bin/haskell-language-server-wrapper");
-        fs::set_permissions(
-            &binary_path,
-            <fs::Permissions as fs::unix::PermissionsExt>::from_mode(0o755),
-        )
-        .await?;
         Ok(LanguageServerBinary {
-            path: binary_path,
+            path: PathBuf::from(path.deref()),
-            arguments: server_binary_arguments(),
+            arguments: self.arguments.iter().map(|arg| arg.into()).collect(),
         })
     }
 
     async fn cached_server_binary(
         &self,
-        container_dir: PathBuf,
+        _: PathBuf,
         _: &dyn LspAdapterDelegate,
     ) -> Option<LanguageServerBinary> {
-        get_cached_server_binary(container_dir).await
+        let path = shellexpand::full(&self.path).ok()?;
+        Some(LanguageServerBinary {
+            path: PathBuf::from(path.deref()),
+            arguments: self.arguments.iter().map(|arg| arg.into()).collect(),
+        })
     }
 
-    async fn installation_test_binary(
+    async fn installation_test_binary(&self, _: PathBuf) -> Option<LanguageServerBinary> {
-        &self,
+        let path = shellexpand::full(&self.path).ok()?;
-        container_dir: PathBuf,
+        Some(LanguageServerBinary {
-    ) -> Option<LanguageServerBinary> {
+            path: PathBuf::from(path.deref()),
-        get_cached_server_binary(container_dir)
+            arguments: self.arguments.iter().map(|arg| arg.into()).collect(),
-            .await
+        })
-            .map(|mut binary| {
-                binary.arguments = vec!["--help".into()];
-                binary
-            })
     }
 }
-
-async fn get_cached_server_binary(container_dir: PathBuf) -> Option<LanguageServerBinary> {
-    async_maybe!({
-        let mut last_binary_path = None;
-        let mut entries = fs::read_dir(&container_dir).await?;
-        while let Some(entry) = entries.next().await {
-            let entry = entry?;
-            if entry.file_type().await?.is_file()
-                && entry
-                    .file_name()
-                    .to_str()
-                    .map_or(false, |name| name == "haskell-language-server-wrapper")
-            {
-                last_binary_path = Some(entry.path());
-            }
-        }
-
-        if let Some(path) = last_binary_path {
-            Ok(LanguageServerBinary {
-                path,
-                arguments: server_binary_arguments(),
-            })
-        } else {
-            Err(anyhow!("no cached binary"))
-        }
-    })
-    .await
-    .log_err()
-}