{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE DuplicateRecordFields      #-}
module Language.Haskell.LSP.Types.Symbol where

import           Control.Applicative
import           Data.Aeson
import           Data.Aeson.TH
import           Data.Scientific
import           Data.Text                                      (Text)
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.TextDocument
import           Language.Haskell.LSP.Types.List
import           Language.Haskell.LSP.Types.Location
import           Language.Haskell.LSP.Types.Message
import           Language.Haskell.LSP.Types.Progress

-- ---------------------------------------------------------------------
{-
Document Symbols Request

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#document-symbols-request

The document symbol request is sent from the client to the server to list all
symbols found in a given text document.

    Changed: In 2.0 the request uses DocumentSymbolParams instead of a single
             uri.

Request

    method: 'textDocument/documentSymbol'
    params: DocumentSymbolParams defined as follows:

interface DocumentSymbolParams {
    /**
     * The text document.
     */
    textDocument: TextDocumentIdentifier;
}

Response

    result: SymbolInformation[] defined as follows:

/**
 * Represents information about programming constructs like variables, classes,
 * interfaces etc.
 */
interface SymbolInformation {
    /**
     * The name of this symbol.
     */
    name: string;

    /**
     * The kind of this symbol.
     */
    kind: number;

    /**
     * The location of this symbol.
     */
    location: Location;

    /**
     * The name of the symbol containing this symbol.
     */
    containerName?: string;
}

Where the kind is defined like this:

/**
 * A symbol kind.
 */
export enum SymbolKind {
    File = 1,
    Module = 2,
    Namespace = 3,
    Package = 4,
    Class = 5,
    Method = 6,
    Property = 7,
    Field = 8,
    Constructor = 9,
    Enum = 10,
    Interface = 11,
    Function = 12,
    Variable = 13,
    Constant = 14,
    Text = 15,
    Number = 16,
    Boolean = 17,
    Array = 18,
}

    error: code and message set in case an exception happens during the document
           symbol request.

Registration Options: TextDocumentRegistrationOptions
-}

data DocumentSymbolParams =
  DocumentSymbolParams
    { DocumentSymbolParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
    , DocumentSymbolParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken -- ^ An optional token that a server can use to report work done progress.
    } deriving (ReadPrec [DocumentSymbolParams]
ReadPrec DocumentSymbolParams
Int -> ReadS DocumentSymbolParams
ReadS [DocumentSymbolParams]
(Int -> ReadS DocumentSymbolParams)
-> ReadS [DocumentSymbolParams]
-> ReadPrec DocumentSymbolParams
-> ReadPrec [DocumentSymbolParams]
-> Read DocumentSymbolParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentSymbolParams]
$creadListPrec :: ReadPrec [DocumentSymbolParams]
readPrec :: ReadPrec DocumentSymbolParams
$creadPrec :: ReadPrec DocumentSymbolParams
readList :: ReadS [DocumentSymbolParams]
$creadList :: ReadS [DocumentSymbolParams]
readsPrec :: Int -> ReadS DocumentSymbolParams
$creadsPrec :: Int -> ReadS DocumentSymbolParams
Read,Int -> DocumentSymbolParams -> ShowS
[DocumentSymbolParams] -> ShowS
DocumentSymbolParams -> String
(Int -> DocumentSymbolParams -> ShowS)
-> (DocumentSymbolParams -> String)
-> ([DocumentSymbolParams] -> ShowS)
-> Show DocumentSymbolParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentSymbolParams] -> ShowS
$cshowList :: [DocumentSymbolParams] -> ShowS
show :: DocumentSymbolParams -> String
$cshow :: DocumentSymbolParams -> String
showsPrec :: Int -> DocumentSymbolParams -> ShowS
$cshowsPrec :: Int -> DocumentSymbolParams -> ShowS
Show,DocumentSymbolParams -> DocumentSymbolParams -> Bool
(DocumentSymbolParams -> DocumentSymbolParams -> Bool)
-> (DocumentSymbolParams -> DocumentSymbolParams -> Bool)
-> Eq DocumentSymbolParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentSymbolParams -> DocumentSymbolParams -> Bool
$c/= :: DocumentSymbolParams -> DocumentSymbolParams -> Bool
== :: DocumentSymbolParams -> DocumentSymbolParams -> Bool
$c== :: DocumentSymbolParams -> DocumentSymbolParams -> Bool
Eq)

deriveJSON lspOptions ''DocumentSymbolParams

-- -------------------------------------

data SymbolKind
    = SkFile
    | SkModule
    | SkNamespace
    | SkPackage
    | SkClass
    | SkMethod
    | SkProperty
    | SkField
    | SkConstructor
    | SkEnum
    | SkInterface
    | SkFunction
    | SkVariable
    | SkConstant
    | SkString
    | SkNumber
    | SkBoolean
    | SkArray
    | SkObject
    | SkKey
    | SkNull
    | SkEnumMember
    | SkStruct
    | SkEvent
    | SkOperator
    | SkTypeParameter
    | SkUnknown Scientific
    deriving (ReadPrec [SymbolKind]
ReadPrec SymbolKind
Int -> ReadS SymbolKind
ReadS [SymbolKind]
(Int -> ReadS SymbolKind)
-> ReadS [SymbolKind]
-> ReadPrec SymbolKind
-> ReadPrec [SymbolKind]
-> Read SymbolKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SymbolKind]
$creadListPrec :: ReadPrec [SymbolKind]
readPrec :: ReadPrec SymbolKind
$creadPrec :: ReadPrec SymbolKind
readList :: ReadS [SymbolKind]
$creadList :: ReadS [SymbolKind]
readsPrec :: Int -> ReadS SymbolKind
$creadsPrec :: Int -> ReadS SymbolKind
Read,Int -> SymbolKind -> ShowS
[SymbolKind] -> ShowS
SymbolKind -> String
(Int -> SymbolKind -> ShowS)
-> (SymbolKind -> String)
-> ([SymbolKind] -> ShowS)
-> Show SymbolKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymbolKind] -> ShowS
$cshowList :: [SymbolKind] -> ShowS
show :: SymbolKind -> String
$cshow :: SymbolKind -> String
showsPrec :: Int -> SymbolKind -> ShowS
$cshowsPrec :: Int -> SymbolKind -> ShowS
Show,SymbolKind -> SymbolKind -> Bool
(SymbolKind -> SymbolKind -> Bool)
-> (SymbolKind -> SymbolKind -> Bool) -> Eq SymbolKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolKind -> SymbolKind -> Bool
$c/= :: SymbolKind -> SymbolKind -> Bool
== :: SymbolKind -> SymbolKind -> Bool
$c== :: SymbolKind -> SymbolKind -> Bool
Eq)

instance ToJSON SymbolKind where
  toJSON :: SymbolKind -> Value
toJSON SymbolKind
SkFile          = Scientific -> Value
Number Scientific
1
  toJSON SymbolKind
SkModule        = Scientific -> Value
Number Scientific
2
  toJSON SymbolKind
SkNamespace     = Scientific -> Value
Number Scientific
3
  toJSON SymbolKind
SkPackage       = Scientific -> Value
Number Scientific
4
  toJSON SymbolKind
SkClass         = Scientific -> Value
Number Scientific
5
  toJSON SymbolKind
SkMethod        = Scientific -> Value
Number Scientific
6
  toJSON SymbolKind
SkProperty      = Scientific -> Value
Number Scientific
7
  toJSON SymbolKind
SkField         = Scientific -> Value
Number Scientific
8
  toJSON SymbolKind
SkConstructor   = Scientific -> Value
Number Scientific
9
  toJSON SymbolKind
SkEnum          = Scientific -> Value
Number Scientific
10
  toJSON SymbolKind
SkInterface     = Scientific -> Value
Number Scientific
11
  toJSON SymbolKind
SkFunction      = Scientific -> Value
Number Scientific
12
  toJSON SymbolKind
SkVariable      = Scientific -> Value
Number Scientific
13
  toJSON SymbolKind
SkConstant      = Scientific -> Value
Number Scientific
14
  toJSON SymbolKind
SkString        = Scientific -> Value
Number Scientific
15
  toJSON SymbolKind
SkNumber        = Scientific -> Value
Number Scientific
16
  toJSON SymbolKind
SkBoolean       = Scientific -> Value
Number Scientific
17
  toJSON SymbolKind
SkArray         = Scientific -> Value
Number Scientific
18
  toJSON SymbolKind
SkObject        = Scientific -> Value
Number Scientific
19
  toJSON SymbolKind
SkKey           = Scientific -> Value
Number Scientific
20
  toJSON SymbolKind
SkNull          = Scientific -> Value
Number Scientific
21
  toJSON SymbolKind
SkEnumMember    = Scientific -> Value
Number Scientific
22
  toJSON SymbolKind
SkStruct        = Scientific -> Value
Number Scientific
23
  toJSON SymbolKind
SkEvent         = Scientific -> Value
Number Scientific
24
  toJSON SymbolKind
SkOperator      = Scientific -> Value
Number Scientific
25
  toJSON SymbolKind
SkTypeParameter = Scientific -> Value
Number Scientific
26
  toJSON (SkUnknown Scientific
x)   = Scientific -> Value
Number Scientific
x

instance FromJSON SymbolKind where
  parseJSON :: Value -> Parser SymbolKind
parseJSON (Number  Scientific
1) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkFile
  parseJSON (Number  Scientific
2) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkModule
  parseJSON (Number  Scientific
3) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkNamespace
  parseJSON (Number  Scientific
4) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkPackage
  parseJSON (Number  Scientific
5) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkClass
  parseJSON (Number  Scientific
6) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkMethod
  parseJSON (Number  Scientific
7) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkProperty
  parseJSON (Number  Scientific
8) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkField
  parseJSON (Number  Scientific
9) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkConstructor
  parseJSON (Number Scientific
10) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkEnum
  parseJSON (Number Scientific
11) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkInterface
  parseJSON (Number Scientific
12) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkFunction
  parseJSON (Number Scientific
13) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkVariable
  parseJSON (Number Scientific
14) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkConstant
  parseJSON (Number Scientific
15) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkString
  parseJSON (Number Scientific
16) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkNumber
  parseJSON (Number Scientific
17) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkBoolean
  parseJSON (Number Scientific
18) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkArray
  parseJSON (Number Scientific
19) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkObject
  parseJSON (Number Scientific
20) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkKey
  parseJSON (Number Scientific
21) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkNull
  parseJSON (Number Scientific
22) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkEnumMember
  parseJSON (Number Scientific
23) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkStruct
  parseJSON (Number Scientific
24) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkEvent
  parseJSON (Number Scientific
25) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkOperator
  parseJSON (Number Scientific
26) = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure SymbolKind
SkTypeParameter
  parseJSON (Number Scientific
x)  = SymbolKind -> Parser SymbolKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> SymbolKind
SkUnknown Scientific
x)
  parseJSON Value
_           = Parser SymbolKind
forall a. Monoid a => a
mempty

-- ---------------------------------------------------------------------

-- | Represents programming constructs like variables, classes, interfaces etc.
-- that appear in a document. Document symbols can be hierarchical and they
-- have two ranges: one that encloses its definition and one that points to its
-- most interesting range, e.g. the range of an identifier.
data DocumentSymbol =
  DocumentSymbol
    { DocumentSymbol -> Text
_name           :: Text -- ^ The name of this symbol.
    -- | More detail for this symbol, e.g the signature of a function. If not
    -- provided the name is used.
    , DocumentSymbol -> Maybe Text
_detail         :: Maybe Text
    , DocumentSymbol -> SymbolKind
_kind           :: SymbolKind -- ^ The kind of this symbol.
    , DocumentSymbol -> Maybe Bool
_deprecated     :: Maybe Bool -- ^ Indicates if this symbol is deprecated.
    -- | 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
    -- to reveal in the symbol in the UI.
    , DocumentSymbol -> Range
_range          :: Range
    -- | The range that should be selected and revealed when this symbol is being
    -- picked, e.g the name of a function. Must be contained by the the '_range'.
    , DocumentSymbol -> Range
_selectionRange :: Range
    -- | Children of this symbol, e.g. properties of a class.
    , DocumentSymbol -> Maybe (List DocumentSymbol)
_children       :: Maybe (List DocumentSymbol)
    } deriving (ReadPrec [DocumentSymbol]
ReadPrec DocumentSymbol
Int -> ReadS DocumentSymbol
ReadS [DocumentSymbol]
(Int -> ReadS DocumentSymbol)
-> ReadS [DocumentSymbol]
-> ReadPrec DocumentSymbol
-> ReadPrec [DocumentSymbol]
-> Read DocumentSymbol
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentSymbol]
$creadListPrec :: ReadPrec [DocumentSymbol]
readPrec :: ReadPrec DocumentSymbol
$creadPrec :: ReadPrec DocumentSymbol
readList :: ReadS [DocumentSymbol]
$creadList :: ReadS [DocumentSymbol]
readsPrec :: Int -> ReadS DocumentSymbol
$creadsPrec :: Int -> ReadS DocumentSymbol
Read,Int -> DocumentSymbol -> ShowS
[DocumentSymbol] -> ShowS
DocumentSymbol -> String
(Int -> DocumentSymbol -> ShowS)
-> (DocumentSymbol -> String)
-> ([DocumentSymbol] -> ShowS)
-> Show DocumentSymbol
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentSymbol] -> ShowS
$cshowList :: [DocumentSymbol] -> ShowS
show :: DocumentSymbol -> String
$cshow :: DocumentSymbol -> String
showsPrec :: Int -> DocumentSymbol -> ShowS
$cshowsPrec :: Int -> DocumentSymbol -> ShowS
Show,DocumentSymbol -> DocumentSymbol -> Bool
(DocumentSymbol -> DocumentSymbol -> Bool)
-> (DocumentSymbol -> DocumentSymbol -> Bool) -> Eq DocumentSymbol
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentSymbol -> DocumentSymbol -> Bool
$c/= :: DocumentSymbol -> DocumentSymbol -> Bool
== :: DocumentSymbol -> DocumentSymbol -> Bool
$c== :: DocumentSymbol -> DocumentSymbol -> Bool
Eq)

deriveJSON lspOptions ''DocumentSymbol

-- ---------------------------------------------------------------------

-- | Represents information about programming constructs like variables, classes,
-- interfaces etc.
data SymbolInformation =
  SymbolInformation
    { SymbolInformation -> Text
_name          :: Text -- ^ The name of this symbol.
    , SymbolInformation -> SymbolKind
_kind          :: SymbolKind -- ^ The kind of this symbol.
    , SymbolInformation -> Maybe Bool
_deprecated    :: Maybe Bool -- ^ Indicates if this symbol is deprecated.
    -- | 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
    -- the range usually spans more then the actual symbol's name and does
    -- normally include things like visibility modifiers.
    --
    -- The range doesn't have to denote a node range in the sense of a abstract
    -- syntax tree. It can therefore not be used to re-construct a hierarchy of
    -- the symbols.
    , SymbolInformation -> Location
_location      :: Location
    -- | The name of the symbol containing this symbol. This information is for
    -- user interface purposes (e.g. to render a qualifier in the user interface
    -- if necessary). It can't be used to re-infer a hierarchy for the document
    -- symbols.
    , SymbolInformation -> Maybe Text
_containerName :: Maybe Text
    } deriving (ReadPrec [SymbolInformation]
ReadPrec SymbolInformation
Int -> ReadS SymbolInformation
ReadS [SymbolInformation]
(Int -> ReadS SymbolInformation)
-> ReadS [SymbolInformation]
-> ReadPrec SymbolInformation
-> ReadPrec [SymbolInformation]
-> Read SymbolInformation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SymbolInformation]
$creadListPrec :: ReadPrec [SymbolInformation]
readPrec :: ReadPrec SymbolInformation
$creadPrec :: ReadPrec SymbolInformation
readList :: ReadS [SymbolInformation]
$creadList :: ReadS [SymbolInformation]
readsPrec :: Int -> ReadS SymbolInformation
$creadsPrec :: Int -> ReadS SymbolInformation
Read,Int -> SymbolInformation -> ShowS
[SymbolInformation] -> ShowS
SymbolInformation -> String
(Int -> SymbolInformation -> ShowS)
-> (SymbolInformation -> String)
-> ([SymbolInformation] -> ShowS)
-> Show SymbolInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SymbolInformation] -> ShowS
$cshowList :: [SymbolInformation] -> ShowS
show :: SymbolInformation -> String
$cshow :: SymbolInformation -> String
showsPrec :: Int -> SymbolInformation -> ShowS
$cshowsPrec :: Int -> SymbolInformation -> ShowS
Show,SymbolInformation -> SymbolInformation -> Bool
(SymbolInformation -> SymbolInformation -> Bool)
-> (SymbolInformation -> SymbolInformation -> Bool)
-> Eq SymbolInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SymbolInformation -> SymbolInformation -> Bool
$c/= :: SymbolInformation -> SymbolInformation -> Bool
== :: SymbolInformation -> SymbolInformation -> Bool
$c== :: SymbolInformation -> SymbolInformation -> Bool
Eq)

deriveJSON lspOptions ''SymbolInformation

-- -------------------------------------

data DSResult = DSDocumentSymbols (List DocumentSymbol)
              | DSSymbolInformation (List SymbolInformation)
  deriving (ReadPrec [DSResult]
ReadPrec DSResult
Int -> ReadS DSResult
ReadS [DSResult]
(Int -> ReadS DSResult)
-> ReadS [DSResult]
-> ReadPrec DSResult
-> ReadPrec [DSResult]
-> Read DSResult
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DSResult]
$creadListPrec :: ReadPrec [DSResult]
readPrec :: ReadPrec DSResult
$creadPrec :: ReadPrec DSResult
readList :: ReadS [DSResult]
$creadList :: ReadS [DSResult]
readsPrec :: Int -> ReadS DSResult
$creadsPrec :: Int -> ReadS DSResult
Read,Int -> DSResult -> ShowS
[DSResult] -> ShowS
DSResult -> String
(Int -> DSResult -> ShowS)
-> (DSResult -> String) -> ([DSResult] -> ShowS) -> Show DSResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DSResult] -> ShowS
$cshowList :: [DSResult] -> ShowS
show :: DSResult -> String
$cshow :: DSResult -> String
showsPrec :: Int -> DSResult -> ShowS
$cshowsPrec :: Int -> DSResult -> ShowS
Show,DSResult -> DSResult -> Bool
(DSResult -> DSResult -> Bool)
-> (DSResult -> DSResult -> Bool) -> Eq DSResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DSResult -> DSResult -> Bool
$c/= :: DSResult -> DSResult -> Bool
== :: DSResult -> DSResult -> Bool
$c== :: DSResult -> DSResult -> Bool
Eq)

instance FromJSON DSResult where
  parseJSON :: Value -> Parser DSResult
parseJSON Value
x = List DocumentSymbol -> DSResult
DSDocumentSymbols (List DocumentSymbol -> DSResult)
-> Parser (List DocumentSymbol) -> Parser DSResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (List DocumentSymbol)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x Parser DSResult -> Parser DSResult -> Parser DSResult
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> List SymbolInformation -> DSResult
DSSymbolInformation (List SymbolInformation -> DSResult)
-> Parser (List SymbolInformation) -> Parser DSResult
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (List SymbolInformation)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

instance ToJSON DSResult where
  toJSON :: DSResult -> Value
toJSON (DSDocumentSymbols List DocumentSymbol
x) = List DocumentSymbol -> Value
forall a. ToJSON a => a -> Value
toJSON List DocumentSymbol
x
  toJSON (DSSymbolInformation List SymbolInformation
x) = List SymbolInformation -> Value
forall a. ToJSON a => a -> Value
toJSON List SymbolInformation
x


type DocumentSymbolRequest = RequestMessage ClientMethod DocumentSymbolParams DSResult
type DocumentSymbolsResponse = ResponseMessage DSResult