diff --git a/hls-plugin-api.cabal b/hls-plugin-api.cabal --- a/hls-plugin-api.cabal +++ b/hls-plugin-api.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: hls-plugin-api -version: 1.1.0.2 +version: 1.2.0.0 synopsis: Haskell Language Server API for plugin communication description: Please see the README on GitHub at @@ -44,17 +44,33 @@ , Diff ^>=0.4.0 , dlist , ghc - , ghc-api-compat , hashable + , hls-graph ^>=1.4 , hslogger , lens - , lsp ^>=1.2 + , lsp ^>=1.2.0.1 , opentelemetry + , optparse-applicative , process , regex-tdfa >=1.3.1.0 - , hls-graph ^>=1.4 , text , unordered-containers + + if impl(ghc < 8.10.5) + build-depends: + ghc-api-compat ==8.6 + elif impl(ghc == 8.10.5) + build-depends: + ghc-api-compat ==8.10.5 + elif impl(ghc == 8.10.6) + build-depends: + ghc-api-compat ==8.10.6 + elif impl(ghc == 8.10.7) + build-depends: + ghc-api-compat ==8.10.7 + elif impl(ghc == 9.0.1) + build-depends: + ghc-api-compat ==9.0.1 if os(windows) build-depends: Win32 diff --git a/src/Ide/Plugin/Config.hs b/src/Ide/Plugin/Config.hs --- a/src/Ide/Plugin/Config.hs +++ b/src/Ide/Plugin/Config.hs @@ -121,54 +121,58 @@ -- This provides a regular naming scheme for all plugin config. data PluginConfig = PluginConfig - { plcGlobalOn :: !Bool - , plcCodeActionsOn :: !Bool - , plcCodeLensOn :: !Bool - , plcDiagnosticsOn :: !Bool - , plcHoverOn :: !Bool - , plcSymbolsOn :: !Bool - , plcCompletionOn :: !Bool - , plcRenameOn :: !Bool - , plcConfig :: !A.Object + { plcGlobalOn :: !Bool + , plcCallHierarchyOn :: !Bool + , plcCodeActionsOn :: !Bool + , plcCodeLensOn :: !Bool + , plcDiagnosticsOn :: !Bool + , plcHoverOn :: !Bool + , plcSymbolsOn :: !Bool + , plcCompletionOn :: !Bool + , plcRenameOn :: !Bool + , plcConfig :: !A.Object } deriving (Show,Eq) instance Default PluginConfig where def = PluginConfig - { plcGlobalOn = True - , plcCodeActionsOn = True - , plcCodeLensOn = True - , plcDiagnosticsOn = True - , plcHoverOn = True - , plcSymbolsOn = True - , plcCompletionOn = True - , plcRenameOn = True - , plcConfig = mempty + { plcGlobalOn = True + , plcCallHierarchyOn = True + , plcCodeActionsOn = True + , plcCodeLensOn = True + , plcDiagnosticsOn = True + , plcHoverOn = True + , plcSymbolsOn = True + , plcCompletionOn = True + , plcRenameOn = True + , plcConfig = mempty } instance A.ToJSON PluginConfig where - toJSON (PluginConfig g ca cl d h s c rn cfg) = r + toJSON (PluginConfig g ch ca cl d h s c rn cfg) = r where - r = object [ "globalOn" .= g - , "codeActionsOn" .= ca - , "codeLensOn" .= cl - , "diagnosticsOn" .= d - , "hoverOn" .= h - , "symbolsOn" .= s - , "completionOn" .= c - , "renameOn" .= rn - , "config" .= cfg + r = object [ "globalOn" .= g + , "callHierarchyOn" .= ch + , "codeActionsOn" .= ca + , "codeLensOn" .= cl + , "diagnosticsOn" .= d + , "hoverOn" .= h + , "symbolsOn" .= s + , "completionOn" .= c + , "renameOn" .= rn + , "config" .= cfg ] instance A.FromJSON PluginConfig where parseJSON = A.withObject "PluginConfig" $ \o -> PluginConfig - <$> o .:? "globalOn" .!= plcGlobalOn def - <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def - <*> o .:? "codeLensOn" .!= plcCodeLensOn def - <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ - <*> o .:? "hoverOn" .!= plcHoverOn def - <*> o .:? "symbolsOn" .!= plcSymbolsOn def - <*> o .:? "completionOn" .!= plcCompletionOn def - <*> o .:? "renameOn" .!= plcRenameOn def - <*> o .:? "config" .!= plcConfig def + <$> o .:? "globalOn" .!= plcGlobalOn def + <*> o .:? "callHierarchyOn" .!= plcCallHierarchyOn def + <*> o .:? "codeActionsOn" .!= plcCodeActionsOn def + <*> o .:? "codeLensOn" .!= plcCodeLensOn def + <*> o .:? "diagnosticsOn" .!= plcDiagnosticsOn def -- AZ + <*> o .:? "hoverOn" .!= plcHoverOn def + <*> o .:? "symbolsOn" .!= plcSymbolsOn def + <*> o .:? "completionOn" .!= plcCompletionOn def + <*> o .:? "renameOn" .!= plcRenameOn def + <*> o .:? "config" .!= plcConfig def -- --------------------------------------------------------------------- diff --git a/src/Ide/PluginUtils.hs b/src/Ide/PluginUtils.hs --- a/src/Ide/PluginUtils.hs +++ b/src/Ide/PluginUtils.hs @@ -30,17 +30,19 @@ import Data.Algorithm.Diff import Data.Algorithm.DiffOutput +import Data.Containers.ListUtils (nubOrdOn) import qualified Data.HashMap.Strict as H import qualified Data.Text as T -import Ide.Types -import Language.LSP.Types -import qualified Language.LSP.Types as J -import Language.LSP.Types.Capabilities - -import Data.Containers.ListUtils (nubOrdOn) import Ide.Plugin.Config import Ide.Plugin.Properties +import Ide.Types import Language.LSP.Server +import Language.LSP.Types hiding + (SemanticTokenAbsolute (length, line), + SemanticTokenRelative (length), + SemanticTokensEdit (_start)) +import qualified Language.LSP.Types as J +import Language.LSP.Types.Capabilities -- --------------------------------------------------------------------- diff --git a/src/Ide/Types.hs b/src/Ide/Types.hs --- a/src/Ide/Types.hs +++ b/src/Ide/Types.hs @@ -1,18 +1,20 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DefaultSignatures #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} module Ide.Types where @@ -44,11 +46,24 @@ import Ide.Plugin.Config import Ide.Plugin.Properties import Language.LSP.Server (LspM, getVirtualFile) -import Language.LSP.Types -import Language.LSP.Types.Capabilities -import Language.LSP.Types.Lens as J hiding (id) +import Language.LSP.Types hiding (SemanticTokenAbsolute(length, line), SemanticTokenRelative(length), SemanticTokensEdit(_start)) +import Language.LSP.Types.Capabilities (ClientCapabilities (ClientCapabilities), + TextDocumentClientCapabilities (_codeAction, _documentSymbol)) +import Language.LSP.Types.Lens as J (HasChildren (children), + HasCommand (command), + HasContents (contents), + HasDeprecated (deprecated), + HasEdit (edit), + HasKind (kind), + HasName (name), + HasOptions (..), + HasRange (range), + HasTextDocument (..), + HasTitle (title), + HasUri (..)) import Language.LSP.VFS import OpenTelemetry.Eventlog +import Options.Applicative (ParserInfo) import System.IO.Unsafe import Text.Regex.TDFA.Text () @@ -56,6 +71,7 @@ newtype IdePlugins ideState = IdePlugins { ipMap :: [(PluginId, PluginDescriptor ideState)]} + deriving newtype (Monoid, Semigroup) -- | Hooks for modifying the 'DynFlags' at different times of the compilation -- process. Plugins can install a 'DynFlagsModifications' via @@ -80,7 +96,11 @@ instance Monoid DynFlagsModifications where mempty = DynFlagsModifications id id +-- --------------------------------------------------------------------- +newtype IdeCommand state = IdeCommand (state -> IO ()) +instance Show (IdeCommand st) where show _ = "" + -- --------------------------------------------------------------------- data PluginDescriptor ideState = @@ -91,6 +111,7 @@ , pluginConfigDescriptor :: ConfigDescriptor , pluginNotificationHandlers :: PluginNotificationHandlers ideState , pluginModifyDynflags :: DynFlagsModifications + , pluginCli :: Maybe (ParserInfo (IdeCommand ideState)) } -- | An existential wrapper of 'Properties' @@ -246,6 +267,15 @@ pluginEnabled _ pid conf = (PluginId $ formattingProvider conf) == pid combineResponses _ _ _ _ (x :| _) = x +instance PluginMethod TextDocumentPrepareCallHierarchy where + pluginEnabled _ = pluginEnabledConfig plcCallHierarchyOn + +instance PluginMethod CallHierarchyIncomingCalls where + pluginEnabled _ = pluginEnabledConfig plcCallHierarchyOn + +instance PluginMethod CallHierarchyOutgoingCalls where + pluginEnabled _ = pluginEnabledConfig plcCallHierarchyOn + -- --------------------------------------------------------------------- -- | Methods which have a PluginMethod instance @@ -324,6 +354,7 @@ defaultConfigDescriptor mempty mempty + Nothing newtype CommandId = CommandId T.Text deriving (Show, Read, Eq, Ord) @@ -442,10 +473,14 @@ instance HasTracing (Maybe InitializedParams) instance HasTracing WorkspaceSymbolParams where traceWithSpan sp (WorkspaceSymbolParams _ _ query) = setTag sp "query" (encodeUtf8 query) +instance HasTracing CallHierarchyIncomingCallsParams +instance HasTracing CallHierarchyOutgoingCallsParams -- --------------------------------------------------------------------- {-# NOINLINE pROCESS_ID #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} pROCESS_ID :: T.Text pROCESS_ID = unsafePerformIO getPid