More capabilities

Author: michaelpj

lsp-types/src/Language/LSP/Types/Capabilities.hs

@@ -35,7 +35,7 @@ data LSPVersion = LSPVersion Int Int -- ^ Construct a major.minor version
 -- * 3.4 extended completion item and symbol item kinds
 -- * 3.0 dynamic registration
 capsForVersion :: LSPVersion -> ClientCapabilities
-capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Just window) Nothing
+capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Just window) (since 3 16 general) Nothing
   where
     w = WorkspaceClientCapabilities
           (Just True)
@@ -285,4 +285,13 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus
       | maj >= x && min >= y = Just a
       | otherwise            = Nothing
 
-    window = WindowClientCapabilities (since 3 15 True)
+    window =
+      WindowClientCapabilities
+        (since 3 15 True)
+        (since 3 16 $ ShowMessageRequestClientCapabilities Nothing)
+        (since 3 16 $ ShowDocumentClientCapabilities True)
+
+    general = GeneralClientCapabilities
+      (since 3 16 $ StaleRequestClientCapabilities True (List []))
+      (since 3 16 $ RegularExpressionsClientCapabilities "" Nothing)
+      (since 3 16 $ MarkdownClientCapabilities "" Nothing)

lsp-types/src/Language/LSP/Types/ClientCapabilities.hs

@@ -6,6 +6,8 @@ module Language.LSP.Types.ClientCapabilities where
 import           Data.Aeson.TH
 import qualified Data.Aeson as A
 import Data.Default
+import Data.Text (Text)
+
 import Language.LSP.Types.CallHierarchy
 import Language.LSP.Types.CodeAction
 import Language.LSP.Types.CodeLens
@@ -34,6 +36,8 @@ import Language.LSP.Types.Utils
 import Language.LSP.Types.WatchedFiles
 import Language.LSP.Types.WorkspaceEdit
 import Language.LSP.Types.WorkspaceSymbol
+import Language.LSP.Types.MarkupContent (MarkdownClientCapabilities)
+import Language.LSP.Types.Common (List)
 
 
 data WorkspaceClientCapabilities =
@@ -170,30 +174,122 @@ instance Default TextDocumentClientCapabilities where
 
 -- ---------------------------------------------------------------------
 
+-- | Capabilities specific to the `MessageActionItem` type.
+data MessageActionItemClientCapabilities =
+  MessageActionItemClientCapabilities
+    {
+      -- | Whether the client supports additional attributes which
+      -- are preserved and sent back to the server in the
+      -- request's response.
+      _additionalPropertiesSupport :: Maybe Bool
+    } deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''MessageActionItemClientCapabilities
+
+-- | Show message request client capabilities
+data ShowMessageRequestClientCapabilities =
+  ShowMessageRequestClientCapabilities
+    { -- | Capabilities specific to the `MessageActionItem` type.
+      _messageActionItem :: Maybe MessageActionItemClientCapabilities
+    } deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''ShowMessageRequestClientCapabilities
+
+-- | Client capabilities for the show document request.
+--
+-- @since 3.16.0
+data ShowDocumentClientCapabilities =
+  ShowDocumentClientCapabilities
+    { -- | The client has support for the show document request
+      _support :: Bool
+    } deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''ShowDocumentClientCapabilities
+
 -- | Window specific client capabilities.
 data WindowClientCapabilities =
   WindowClientCapabilities
     { -- | Whether client supports handling progress notifications.
+      --
+      -- @since 3.15.0
       _workDoneProgress :: Maybe Bool
+      -- | Capabilities specific to the showMessage request
+      --
+      -- @since 3.16.0
+    , _showMessage :: Maybe ShowMessageRequestClientCapabilities
+      -- | Capabilities specific to the showDocument request
+      --
+      -- @since 3.16.0
+    , _showDocument :: Maybe ShowDocumentClientCapabilities
     } deriving (Show, Read, Eq)
 
 deriveJSON lspOptions ''WindowClientCapabilities
 
 instance Default WindowClientCapabilities where
-  def = WindowClientCapabilities def
+  def = WindowClientCapabilities def def def
+
+-- ---------------------------------------------------------------------
+
+-- | Client capability that signals how the client
+-- handles stale requests (e.g. a request
+-- for which the client will not process the response
+-- anymore since the information is outdated).
+-- @since 3.17.0
+data StaleRequestClientCapabilities =
+  StaleRequestClientCapabilities
+    { _cancel :: Bool
+    , _retryOnContentModified :: List Text
+    } deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''StaleRequestClientCapabilities
+
+-- | Client capabilities specific to the used markdown parser.
+-- @since 3.16.0
+data RegularExpressionsClientCapabilities =
+  RegularExpressionsClientCapabilities
+    { _engine :: Text
+    , _version :: Maybe Text
+    } deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''RegularExpressionsClientCapabilities
+
+-- | General client capabilities.
+-- @since 3.16.0
+data GeneralClientCapabilities =
+  GeneralClientCapabilities
+    {
+      _staleRequestSupport :: Maybe StaleRequestClientCapabilities
+      -- | Client capabilities specific to regular expressions.
+      -- @since 3.16.0
+    , _regularExpressions :: Maybe RegularExpressionsClientCapabilities
+      -- | Client capabilities specific to the client's markdown parser.
+      -- @since 3.16.0
+    , _markdown :: Maybe MarkdownClientCapabilities
+    } deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''GeneralClientCapabilities
+
+instance Default GeneralClientCapabilities where
+  def = GeneralClientCapabilities def def def
+
+-- ---------------------------------------------------------------------
 
 data ClientCapabilities =
   ClientCapabilities
-    { _workspace    :: Maybe WorkspaceClientCapabilities
+    { -- | Workspace specific client capabilities
+      _workspace    :: Maybe WorkspaceClientCapabilities
+      -- | Text document specific client capabilities
     , _textDocument :: Maybe TextDocumentClientCapabilities
-    -- | Capabilities specific to `window/progress` requests. Experimental.
-    --
-    -- @since 0.10.0.0
+      -- | Window specific client capabilities.
     , _window :: Maybe WindowClientCapabilities
+      -- | General client capabilities.
+      -- @since 3.16.0
+    , _general :: Maybe GeneralClientCapabilities
+      -- | Experimental client capabilities.
     , _experimental :: Maybe A.Object
     } deriving (Show, Read, Eq)
 
 deriveJSON lspOptions ''ClientCapabilities
 
 instance Default ClientCapabilities where
-  def = ClientCapabilities def def def def
+  def = ClientCapabilities def def def def def

lsp-types/src/Language/LSP/Types/Lens.hs

@@ -57,6 +57,12 @@ import           Control.Lens.TH
 -- TODO: This is out of date and very unmantainable, use TH to call all these!!
 
 -- client capabilities
+makeFieldsNoPrefix ''MessageActionItemClientCapabilities
+makeFieldsNoPrefix ''ShowMessageRequestClientCapabilities
+makeFieldsNoPrefix ''ShowDocumentClientCapabilities
+makeFieldsNoPrefix ''StaleRequestClientCapabilities
+makeFieldsNoPrefix ''RegularExpressionsClientCapabilities
+makeFieldsNoPrefix ''GeneralClientCapabilities
 makeFieldsNoPrefix ''WorkspaceClientCapabilities
 makeFieldsNoPrefix ''WindowClientCapabilities
 makeFieldsNoPrefix ''ClientCapabilities
@@ -115,6 +121,7 @@ makeFieldsNoPrefix ''LocationLink
 
 -- Markup
 makeFieldsNoPrefix ''MarkupContent
+makeFieldsNoPrefix ''MarkdownClientCapabilities
 
 -- Completion
 makeFieldsNoPrefix ''CompletionDoc

lsp-types/src/Language/LSP/Types/MarkupContent.hs

@@ -91,3 +91,12 @@ instance Monoid MarkupContent where
 
 -- ---------------------------------------------------------------------
 
+-- | Client capabilities specific to the used markdown parser.
+-- @since 3.16.0
+data MarkdownClientCapabilities =
+  MarkdownClientCapabilities
+    { _parser :: Text
+    , _version :: Maybe Text
+    } deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''MarkdownClientCapabilities

lsp/src/Language/LSP/Server/Core.hs

@@ -473,7 +473,7 @@ getWorkspaceFolders :: MonadLsp config m => m (Maybe [WorkspaceFolder])
 getWorkspaceFolders = do
   clientCaps <- getClientCapabilities
   let clientSupportsWfs = fromMaybe False $ do
-        let (J.ClientCapabilities mw _ _ _) = clientCaps
+        let (J.ClientCapabilities mw _ _ _ _) = clientCaps
         (J.WorkspaceClientCapabilities _ _ _ _ _ _ mwf _ _) <- mw
         mwf
   if clientSupportsWfs
@@ -654,8 +654,8 @@ withProgressBase indefinite title cancellable f = do
               WorkDoneProgressReportParams Nothing msg percentage
 
 clientSupportsProgress :: J.ClientCapabilities -> Bool
-clientSupportsProgress (J.ClientCapabilities _ _ wc _) = fromMaybe False $ do
-  (J.WindowClientCapabilities mProgress) <- wc
+clientSupportsProgress (J.ClientCapabilities _ _ wc _ _) = fromMaybe False $ do
+  (J.WindowClientCapabilities mProgress _ _) <- wc
   mProgress
 
 {-# INLINE clientSupportsProgress #-}

lsp/test/CapabilitiesSpec.hs

@@ -7,10 +7,10 @@ import Test.Hspec
 spec :: Spec
 spec = describe "capabilities" $ do
   it "gives 3.10 capabilities" $
-    let ClientCapabilities _ (Just tdcs) _ _ = capsForVersion (LSPVersion 3 10)
+    let ClientCapabilities _ (Just tdcs) _ _ _ = capsForVersion (LSPVersion 3 10)
         Just (DocumentSymbolClientCapabilities _ _ mHierarchical _ _ ) = _documentSymbol tdcs
       in mHierarchical `shouldBe` Just True
   it "gives pre 3.10 capabilities" $
-      let ClientCapabilities _ (Just tdcs) _ _ = capsForVersion (LSPVersion 3 9)
+      let ClientCapabilities _ (Just tdcs) _ _ _ = capsForVersion (LSPVersion 3 9)
           Just (DocumentSymbolClientCapabilities _ _ mHierarchical _ _) = _documentSymbol tdcs
         in mHierarchical `shouldBe` Nothing