Add tag support for DocumentSymbol, SymbolInformation, and document symbol provider label (#301)

* Add tag support for DocumentSymbol, SymbolInformation, and document symbol provider label

* WorkspaceSymbol tag support

Author: michaelpj

example/Reactor.hs

@@ -246,7 +246,7 @@ handle = mconcat
       liftIO $ debugM "reactor.handle" "Processing a textDocument/documentSymbol request"
       let J.DocumentSymbolParams _ _ doc = req ^. J.params
           loc = J.Location (doc ^. J.uri) (J.Range (J.Position 0 0) (J.Position 0 0))
-          sym = J.SymbolInformation "lsp-hello" J.SkFunction Nothing loc Nothing
+          sym = J.SymbolInformation "lsp-hello" J.SkFunction Nothing Nothing loc Nothing
           rsp = J.InR (J.List [sym])
       responder (Right rsp)
 

lsp-test/test/DummyServer.hs

@@ -68,6 +68,7 @@ handlers =
                       Nothing
                       SkObject
                       Nothing
+                      Nothing
                       (mkRange 0 0 3 6)
                       (mkRange 0 0 3 6)
                       Nothing

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

@@ -59,10 +59,14 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus
     symbolCapabilities = WorkspaceSymbolClientCapabilities
       dynamicReg
       (since 3 4 symbolKindCapabilities)
+      (since 3 16 symbolTagCapabilities)
 
     symbolKindCapabilities =
       WorkspaceSymbolKindClientCapabilities (Just sKs)
 
+    symbolTagCapabilities =
+      WorkspaceSymbolTagClientCapabilities (Just (List [StDeprecated]))
+
     sKs
       | maj >= 3 && min >= 4 = List (oldSKs ++ newSKs)
       | otherwise            = List oldSKs
@@ -224,11 +228,16 @@ capsForVersion (LSPVersion maj min) = ClientCapabilities (Just w) (Just td) (Jus
         dynamicReg
         (since 3 4 documentSymbolKind)
         (since 3 10 True)
+        (since 3 16 documentSymbolTag)
+        (since 3 16 True)
 
     documentSymbolKind =
       DocumentSymbolKindClientCapabilities
         (Just sKs) -- same as workspace symbol kinds
 
+    documentSymbolTag =
+      DocumentSymbolTagClientCapabilities (Just (List [StDeprecated]))
+
     foldingRangeCapability =
       FoldingRangeClientCapabilities
         dynamicReg

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

@@ -15,7 +15,9 @@ import           Language.LSP.Types.Utils
 
 -- ---------------------------------------------------------------------
 
-makeExtendingDatatype "DocumentSymbolOptions" [''WorkDoneProgressOptions] []
+makeExtendingDatatype "DocumentSymbolOptions"
+  [''WorkDoneProgressOptions]
+  [ ("_label", [t| Maybe Bool |])]
 deriveJSON lspOptions ''DocumentSymbolOptions
 
 makeExtendingDatatype "DocumentSymbolRegistrationOptions"
@@ -123,6 +125,25 @@ instance FromJSON SymbolKind where
   parseJSON (Number 26) = pure SkTypeParameter
   parseJSON (Number x)  = pure (SkUnknown x)
   parseJSON _           = mempty
+
+{-|
+Symbol tags are extra annotations that tweak the rendering of a symbol.
+
+@since 3.16.0
+-}
+data SymbolTag =
+  StDeprecated -- ^ Render a symbol as obsolete, usually using a strike-out.
+  | StUnknown Scientific
+  deriving (Read, Show, Eq)
+
+instance ToJSON SymbolTag where
+  toJSON StDeprecated          = Number 1
+  toJSON (StUnknown x)   = Number x
+
+instance FromJSON SymbolTag where
+  parseJSON (Number  1) = pure StDeprecated
+  parseJSON (Number x)  = pure (StUnknown x)
+  parseJSON _           = mempty
 
 -- -------------------------------------
 
@@ -142,18 +163,36 @@ data DocumentSymbolKindClientCapabilities =
 
 deriveJSON lspOptions ''DocumentSymbolKindClientCapabilities
 
+data DocumentSymbolTagClientCapabilities =
+  DocumentSymbolTagClientCapabilities
+    { -- | The tags supported by the client.
+      _valueSet :: Maybe (List SymbolTag)
+    }
+  deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''DocumentSymbolTagClientCapabilities
+
 data DocumentSymbolClientCapabilities =
   DocumentSymbolClientCapabilities
     { -- | Whether document symbol supports dynamic registration.
       _dynamicRegistration :: Maybe Bool
       -- | Specific capabilities for the `SymbolKind`.
     , _symbolKind :: Maybe DocumentSymbolKindClientCapabilities
     , _hierarchicalDocumentSymbolSupport :: Maybe Bool
+      -- | The client supports tags on `SymbolInformation`.
+      -- Clients supporting tags have to handle unknown tags gracefully.
+      --
+      -- @since 3.16.0
+    , _tagSupport :: Maybe DocumentSymbolTagClientCapabilities
+      -- | The client supports an additional label presented in the UI when
+      -- registering a document symbol provider.
+      --
+      -- @since 3.16.0
+    , _labelSupport :: Maybe Bool
     } deriving (Show, Read, Eq)
 
 deriveJSON lspOptions ''DocumentSymbolClientCapabilities
 
-
 -- ---------------------------------------------------------------------
 
 -- | Represents programming constructs like variables, classes, interfaces etc.
@@ -167,7 +206,8 @@ data DocumentSymbol =
     -- provided the name is used.
     , _detail         :: Maybe Text
     , _kind           :: SymbolKind -- ^ The kind of this symbol.
-    , _deprecated     :: Maybe Bool -- ^ Indicates if this symbol is deprecated.
+    , _tags           :: Maybe (List SymbolTag) -- ^ Tags for this document symbol.
+    , _deprecated     :: Maybe Bool -- ^ Indicates if this symbol is deprecated. Deprecated, use tags instead.
     -- | The range enclosing this symbol not including leading/trailing
     -- whitespace but everything else like comments. This information is
     -- typically used to determine if the the clients cursor is inside the symbol
@@ -190,7 +230,8 @@ data SymbolInformation =
   SymbolInformation
     { _name          :: Text -- ^ The name of this symbol.
     , _kind          :: SymbolKind -- ^ The kind of this symbol.
-    , _deprecated    :: Maybe Bool -- ^ Indicates if this symbol is deprecated.
+    , _tags          :: Maybe (List SymbolTag) -- ^ Tags for this symbol.
+    , _deprecated    :: Maybe Bool -- ^ Indicates if this symbol is deprecated. Deprecated, use tags instead.
     -- | The location of this symbol. The location's range is used by a tool
     -- to reveal the location in the editor. If the symbol is selected in the
     -- tool the range's start information is used to position the cursor. So
@@ -207,5 +248,6 @@ data SymbolInformation =
     -- symbols.
     , _containerName :: Maybe Text
     } deriving (Read,Show,Eq)
+{-# DEPRECATED _deprecated "Use tags instead" #-}
 
 deriveJSON lspOptions ''SymbolInformation

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

@@ -26,6 +26,15 @@ data WorkspaceSymbolKindClientCapabilities =
 
 deriveJSON lspOptions ''WorkspaceSymbolKindClientCapabilities
 
+data WorkspaceSymbolTagClientCapabilities =
+  WorkspaceSymbolTagClientCapabilities
+    { -- | The tags supported by the client.
+      _valueSet :: Maybe (List SymbolTag)
+    }
+  deriving (Show, Read, Eq)
+
+deriveJSON lspOptions ''WorkspaceSymbolTagClientCapabilities
+
 instance Default WorkspaceSymbolKindClientCapabilities where
   def = WorkspaceSymbolKindClientCapabilities (Just $ List allKinds)
     where allKinds = [ SkFile
@@ -53,6 +62,11 @@ data WorkspaceSymbolClientCapabilities =
     { _dynamicRegistration :: Maybe Bool -- ^Symbol request supports dynamic
                                          -- registration.
     , _symbolKind :: Maybe WorkspaceSymbolKindClientCapabilities -- ^ Specific capabilities for the `SymbolKind`.
+      -- | The client supports tags on `SymbolInformation`.
+      -- Clients supporting tags have to handle unknown tags gracefully.
+      --
+      -- @since 3.16.0
+    , _tagSupport :: Maybe WorkspaceSymbolTagClientCapabilities 
     } deriving (Show, Read, Eq)
 
 deriveJSON lspOptions ''WorkspaceSymbolClientCapabilities

test/CapabilitiesSpec.hs

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