1{-# LANGUAGE TemplateHaskell            #-}
2{-# LANGUAGE DuplicateRecordFields      #-}
3module Language.LSP.Types.DocumentSymbol where
4
5import           Data.Aeson
6import           Data.Aeson.TH
7import           Data.Scientific
8import           Data.Text                                      (Text)
9
10import           Language.LSP.Types.TextDocument
11import           Language.LSP.Types.Common
12import           Language.LSP.Types.Location
13import           Language.LSP.Types.Progress
14import           Language.LSP.Types.Utils
15
16-- ---------------------------------------------------------------------
17
18makeExtendingDatatype "DocumentSymbolOptions"
19  [''WorkDoneProgressOptions]
20  [ ("_label", [t| Maybe Bool |])]
21deriveJSON lspOptions ''DocumentSymbolOptions
22
23makeExtendingDatatype "DocumentSymbolRegistrationOptions"
24  [ ''TextDocumentRegistrationOptions
25  , ''DocumentSymbolOptions
26  ] []
27deriveJSON lspOptions ''DocumentSymbolRegistrationOptions
28
29-- ---------------------------------------------------------------------
30
31makeExtendingDatatype "DocumentSymbolParams"
32  [ ''WorkDoneProgressParams
33  , ''PartialResultParams
34  ]
35  [ ("_textDocument", [t| TextDocumentIdentifier |])]
36deriveJSON lspOptions ''DocumentSymbolParams
37
38-- -------------------------------------
39
40data SymbolKind
41    = SkFile
42    | SkModule
43    | SkNamespace
44    | SkPackage
45    | SkClass
46    | SkMethod
47    | SkProperty
48    | SkField
49    | SkConstructor
50    | SkEnum
51    | SkInterface
52    | SkFunction
53    | SkVariable
54    | SkConstant
55    | SkString
56    | SkNumber
57    | SkBoolean
58    | SkArray
59    | SkObject
60    | SkKey
61    | SkNull
62    | SkEnumMember
63    | SkStruct
64    | SkEvent
65    | SkOperator
66    | SkTypeParameter
67    | SkUnknown Scientific
68    deriving (Read,Show,Eq)
69
70instance ToJSON SymbolKind where
71  toJSON SkFile          = Number 1
72  toJSON SkModule        = Number 2
73  toJSON SkNamespace     = Number 3
74  toJSON SkPackage       = Number 4
75  toJSON SkClass         = Number 5
76  toJSON SkMethod        = Number 6
77  toJSON SkProperty      = Number 7
78  toJSON SkField         = Number 8
79  toJSON SkConstructor   = Number 9
80  toJSON SkEnum          = Number 10
81  toJSON SkInterface     = Number 11
82  toJSON SkFunction      = Number 12
83  toJSON SkVariable      = Number 13
84  toJSON SkConstant      = Number 14
85  toJSON SkString        = Number 15
86  toJSON SkNumber        = Number 16
87  toJSON SkBoolean       = Number 17
88  toJSON SkArray         = Number 18
89  toJSON SkObject        = Number 19
90  toJSON SkKey           = Number 20
91  toJSON SkNull          = Number 21
92  toJSON SkEnumMember    = Number 22
93  toJSON SkStruct        = Number 23
94  toJSON SkEvent         = Number 24
95  toJSON SkOperator      = Number 25
96  toJSON SkTypeParameter = Number 26
97  toJSON (SkUnknown x)   = Number x
98
99instance FromJSON SymbolKind where
100  parseJSON (Number  1) = pure SkFile
101  parseJSON (Number  2) = pure SkModule
102  parseJSON (Number  3) = pure SkNamespace
103  parseJSON (Number  4) = pure SkPackage
104  parseJSON (Number  5) = pure SkClass
105  parseJSON (Number  6) = pure SkMethod
106  parseJSON (Number  7) = pure SkProperty
107  parseJSON (Number  8) = pure SkField
108  parseJSON (Number  9) = pure SkConstructor
109  parseJSON (Number 10) = pure SkEnum
110  parseJSON (Number 11) = pure SkInterface
111  parseJSON (Number 12) = pure SkFunction
112  parseJSON (Number 13) = pure SkVariable
113  parseJSON (Number 14) = pure SkConstant
114  parseJSON (Number 15) = pure SkString
115  parseJSON (Number 16) = pure SkNumber
116  parseJSON (Number 17) = pure SkBoolean
117  parseJSON (Number 18) = pure SkArray
118  parseJSON (Number 19) = pure SkObject
119  parseJSON (Number 20) = pure SkKey
120  parseJSON (Number 21) = pure SkNull
121  parseJSON (Number 22) = pure SkEnumMember
122  parseJSON (Number 23) = pure SkStruct
123  parseJSON (Number 24) = pure SkEvent
124  parseJSON (Number 25) = pure SkOperator
125  parseJSON (Number 26) = pure SkTypeParameter
126  parseJSON (Number x)  = pure (SkUnknown x)
127  parseJSON _           = fail "SymbolKind"
128
129{-|
130Symbol tags are extra annotations that tweak the rendering of a symbol.
131
132@since 3.16.0
133-}
134data SymbolTag =
135  StDeprecated -- ^ Render a symbol as obsolete, usually using a strike-out.
136  | StUnknown Scientific
137  deriving (Read, Show, Eq)
138
139instance ToJSON SymbolTag where
140  toJSON StDeprecated          = Number 1
141  toJSON (StUnknown x)   = Number x
142
143instance FromJSON SymbolTag where
144  parseJSON (Number  1) = pure StDeprecated
145  parseJSON (Number x)  = pure (StUnknown x)
146  parseJSON _           = fail "SymbolTag"
147
148-- -------------------------------------
149
150data DocumentSymbolKindClientCapabilities =
151  DocumentSymbolKindClientCapabilities
152    { -- | The symbol kind values the client supports. When this
153      --  property exists the client also guarantees that it will
154      --  handle values outside its set gracefully and falls back
155      --  to a default value when unknown.
156      --
157      --  If this property is not present the client only supports
158      --  the symbol kinds from `File` to `Array` as defined in
159      --  the initial version of the protocol.
160      _valueSet :: Maybe (List SymbolKind)
161    }
162  deriving (Show, Read, Eq)
163
164deriveJSON lspOptions ''DocumentSymbolKindClientCapabilities
165
166data DocumentSymbolTagClientCapabilities =
167  DocumentSymbolTagClientCapabilities
168    { -- | The tags supported by the client.
169      _valueSet :: Maybe (List SymbolTag)
170    }
171  deriving (Show, Read, Eq)
172
173deriveJSON lspOptions ''DocumentSymbolTagClientCapabilities
174
175data DocumentSymbolClientCapabilities =
176  DocumentSymbolClientCapabilities
177    { -- | Whether document symbol supports dynamic registration.
178      _dynamicRegistration :: Maybe Bool
179      -- | Specific capabilities for the `SymbolKind`.
180    , _symbolKind :: Maybe DocumentSymbolKindClientCapabilities
181    , _hierarchicalDocumentSymbolSupport :: Maybe Bool
182      -- | The client supports tags on `SymbolInformation`.
183      -- Clients supporting tags have to handle unknown tags gracefully.
184      --
185      -- @since 3.16.0
186    , _tagSupport :: Maybe DocumentSymbolTagClientCapabilities
187      -- | The client supports an additional label presented in the UI when
188      -- registering a document symbol provider.
189      --
190      -- @since 3.16.0
191    , _labelSupport :: Maybe Bool
192    } deriving (Show, Read, Eq)
193
194deriveJSON lspOptions ''DocumentSymbolClientCapabilities
195
196-- ---------------------------------------------------------------------
197
198-- | Represents programming constructs like variables, classes, interfaces etc.
199-- that appear in a document. Document symbols can be hierarchical and they
200-- have two ranges: one that encloses its definition and one that points to its
201-- most interesting range, e.g. the range of an identifier.
202data DocumentSymbol =
203  DocumentSymbol
204    { _name           :: Text -- ^ The name of this symbol.
205    -- | More detail for this symbol, e.g the signature of a function. If not
206    -- provided the name is used.
207    , _detail         :: Maybe Text
208    , _kind           :: SymbolKind -- ^ The kind of this symbol.
209    , _tags           :: Maybe (List SymbolTag) -- ^ Tags for this document symbol.
210    , _deprecated     :: Maybe Bool -- ^ Indicates if this symbol is deprecated. Deprecated, use tags instead.
211    -- | The range enclosing this symbol not including leading/trailing
212    -- whitespace but everything else like comments. This information is
213    -- typically used to determine if the the clients cursor is inside the symbol
214    -- to reveal in the symbol in the UI.
215    , _range          :: Range
216    -- | The range that should be selected and revealed when this symbol is being
217    -- picked, e.g the name of a function. Must be contained by the the '_range'.
218    , _selectionRange :: Range
219    -- | Children of this symbol, e.g. properties of a class.
220    , _children       :: Maybe (List DocumentSymbol)
221    } deriving (Read,Show,Eq)
222
223deriveJSON lspOptions ''DocumentSymbol
224
225-- ---------------------------------------------------------------------
226
227-- | Represents information about programming constructs like variables, classes,
228-- interfaces etc.
229data SymbolInformation =
230  SymbolInformation
231    { _name          :: Text -- ^ The name of this symbol.
232    , _kind          :: SymbolKind -- ^ The kind of this symbol.
233    , _tags          :: Maybe (List SymbolTag) -- ^ Tags for this symbol.
234    , _deprecated    :: Maybe Bool -- ^ Indicates if this symbol is deprecated. Deprecated, use tags instead.
235    -- | The location of this symbol. The location's range is used by a tool
236    -- to reveal the location in the editor. If the symbol is selected in the
237    -- tool the range's start information is used to position the cursor. So
238    -- the range usually spans more then the actual symbol's name and does
239    -- normally include things like visibility modifiers.
240    --
241    -- The range doesn't have to denote a node range in the sense of a abstract
242    -- syntax tree. It can therefore not be used to re-construct a hierarchy of
243    -- the symbols.
244    , _location      :: Location
245    -- | The name of the symbol containing this symbol. This information is for
246    -- user interface purposes (e.g. to render a qualifier in the user interface
247    -- if necessary). It can't be used to re-infer a hierarchy for the document
248    -- symbols.
249    , _containerName :: Maybe Text
250    } deriving (Read,Show,Eq)
251{-# DEPRECATED _deprecated "Use tags instead" #-}
252
253deriveJSON lspOptions ''SymbolInformation
254