{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE FunctionalDependencies     #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeSynonymInstances       #-}
{-# LANGUAGE ScopedTypeVariables        #-}

module Language.Haskell.LSP.Types.DataTypesJSON where

import           Control.Applicative
import qualified Data.Aeson                                 as A
import           Data.Aeson.TH
import           Data.Aeson.Types
import           Data.Bits                                  (testBit)
import           Data.Scientific                            (floatingOrInteger)
import           Data.Text                                  (Text)
import qualified Data.Text                                  as T
import           Language.Haskell.LSP.Types.ClientCapabilities
import           Language.Haskell.LSP.Types.CodeAction
import           Language.Haskell.LSP.Types.Command
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.Diagnostic
import           Language.Haskell.LSP.Types.DocumentFilter
import           Language.Haskell.LSP.Types.List
import           Language.Haskell.LSP.Types.Location
import           Language.Haskell.LSP.Types.Message
import           Language.Haskell.LSP.Types.Progress
import           Language.Haskell.LSP.Types.Symbol
import           Language.Haskell.LSP.Types.TextDocument
import           Language.Haskell.LSP.Types.Uri
import           Language.Haskell.LSP.Types.WorkspaceEdit
import           Language.Haskell.LSP.Types.WorkspaceFolders

-- =====================================================================
-- ACTUAL PROTOCOL -----------------------------------------------------
-- =====================================================================

-- ---------------------------------------------------------------------
-- Initialize Request
-- ---------------------------------------------------------------------
{-
Initialize Request

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

The initialize request is sent as the first request from the client to the server.

Request

    method: 'initialize'
    params: InitializeParams defined as follows:

interface InitializeParams {
        /**
         * The process Id of the parent process that started
         * the server. Is null if the process has not been started by another process.
         * If the parent process is not alive then the server should exit (see exit notification) its process.
         */
        processId: number | null;

        /**
         * The rootPath of the workspace. Is null
         * if no folder is open.
         *
         * @deprecated in favour of rootUri.
         */
        rootPath?: string | null;

        /**
         * The rootUri of the workspace. Is null if no
         * folder is open. If both `rootPath` and `rootUri` are set
         * `rootUri` wins.
         */
        rootUri: DocumentUri | null;

        /**
         * User provided initialization options.
         */
        initializationOptions?: any;

        /**
         * The capabilities provided by the client (editor or tool)
         */
        capabilities: ClientCapabilities;

        /**
         * The initial trace setting. If omitted trace is disabled ('off').
         */
        trace?: 'off' | 'messages' | 'verbose';
}
-}

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

instance A.ToJSON Trace where
  toJSON :: Trace -> Value
toJSON Trace
TraceOff      = Text -> Value
A.String (String -> Text
T.pack String
"off")
  toJSON Trace
TraceMessages = Text -> Value
A.String (String -> Text
T.pack String
"messages")
  toJSON Trace
TraceVerbose  = Text -> Value
A.String (String -> Text
T.pack String
"verbose")

instance A.FromJSON Trace where
  parseJSON :: Value -> Parser Trace
parseJSON (A.String Text
s) = case Text -> String
T.unpack Text
s of
    String
"off"      -> Trace -> Parser Trace
forall (m :: * -> *) a. Monad m => a -> m a
return Trace
TraceOff
    String
"messages" -> Trace -> Parser Trace
forall (m :: * -> *) a. Monad m => a -> m a
return Trace
TraceMessages
    String
"verbose"  -> Trace -> Parser Trace
forall (m :: * -> *) a. Monad m => a -> m a
return Trace
TraceVerbose
    String
_          -> Parser Trace
forall a. Monoid a => a
mempty
  parseJSON Value
_                               = Parser Trace
forall a. Monoid a => a
mempty

data InitializeParams =
  InitializeParams {
    InitializeParams -> Maybe Int
_processId             :: Maybe Int
  , InitializeParams -> Maybe Text
_rootPath              :: Maybe Text -- ^ Deprecated in favour of _rootUri
  , InitializeParams -> Maybe Uri
_rootUri               :: Maybe Uri
  , InitializeParams -> Maybe Value
_initializationOptions :: Maybe A.Value
  , InitializeParams -> ClientCapabilities
_capabilities          :: ClientCapabilities
  , InitializeParams -> Maybe Trace
_trace                 :: Maybe Trace
  -- |  The workspace folders configured in the client when the server starts.
  -- This property is only available if the client supports workspace folders.
  -- It can be `null` if the client supports workspace folders but none are
  -- configured.
  -- Since LSP 3.6
  --
  -- @since 0.7.0.0
  , InitializeParams -> Maybe (List WorkspaceFolder)
_workspaceFolders      :: Maybe (List WorkspaceFolder)
  } deriving (Int -> InitializeParams -> ShowS
[InitializeParams] -> ShowS
InitializeParams -> String
(Int -> InitializeParams -> ShowS)
-> (InitializeParams -> String)
-> ([InitializeParams] -> ShowS)
-> Show InitializeParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializeParams] -> ShowS
$cshowList :: [InitializeParams] -> ShowS
show :: InitializeParams -> String
$cshow :: InitializeParams -> String
showsPrec :: Int -> InitializeParams -> ShowS
$cshowsPrec :: Int -> InitializeParams -> ShowS
Show, ReadPrec [InitializeParams]
ReadPrec InitializeParams
Int -> ReadS InitializeParams
ReadS [InitializeParams]
(Int -> ReadS InitializeParams)
-> ReadS [InitializeParams]
-> ReadPrec InitializeParams
-> ReadPrec [InitializeParams]
-> Read InitializeParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializeParams]
$creadListPrec :: ReadPrec [InitializeParams]
readPrec :: ReadPrec InitializeParams
$creadPrec :: ReadPrec InitializeParams
readList :: ReadS [InitializeParams]
$creadList :: ReadS [InitializeParams]
readsPrec :: Int -> ReadS InitializeParams
$creadsPrec :: Int -> ReadS InitializeParams
Read, InitializeParams -> InitializeParams -> Bool
(InitializeParams -> InitializeParams -> Bool)
-> (InitializeParams -> InitializeParams -> Bool)
-> Eq InitializeParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializeParams -> InitializeParams -> Bool
$c/= :: InitializeParams -> InitializeParams -> Bool
== :: InitializeParams -> InitializeParams -> Bool
$c== :: InitializeParams -> InitializeParams -> Bool
Eq)

{-# DEPRECATED _rootPath "Use _rootUri" #-}

deriveJSON lspOptions ''InitializeParams

-- ---------------------------------------------------------------------
-- Initialize Response
-- ---------------------------------------------------------------------
{-

    error.data:

interface InitializeError {
    /**
     * Indicates whether the client should retry to send the
     * initilize request after showing the message provided
     * in the ResponseError.
     */
    retry: boolean;
-
-}
data InitializeError =
  InitializeError
    { InitializeError -> Bool
_retry :: Bool
    } deriving (ReadPrec [InitializeError]
ReadPrec InitializeError
Int -> ReadS InitializeError
ReadS [InitializeError]
(Int -> ReadS InitializeError)
-> ReadS [InitializeError]
-> ReadPrec InitializeError
-> ReadPrec [InitializeError]
-> Read InitializeError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializeError]
$creadListPrec :: ReadPrec [InitializeError]
readPrec :: ReadPrec InitializeError
$creadPrec :: ReadPrec InitializeError
readList :: ReadS [InitializeError]
$creadList :: ReadS [InitializeError]
readsPrec :: Int -> ReadS InitializeError
$creadsPrec :: Int -> ReadS InitializeError
Read, Int -> InitializeError -> ShowS
[InitializeError] -> ShowS
InitializeError -> String
(Int -> InitializeError -> ShowS)
-> (InitializeError -> String)
-> ([InitializeError] -> ShowS)
-> Show InitializeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializeError] -> ShowS
$cshowList :: [InitializeError] -> ShowS
show :: InitializeError -> String
$cshow :: InitializeError -> String
showsPrec :: Int -> InitializeError -> ShowS
$cshowsPrec :: Int -> InitializeError -> ShowS
Show, InitializeError -> InitializeError -> Bool
(InitializeError -> InitializeError -> Bool)
-> (InitializeError -> InitializeError -> Bool)
-> Eq InitializeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializeError -> InitializeError -> Bool
$c/= :: InitializeError -> InitializeError -> Bool
== :: InitializeError -> InitializeError -> Bool
$c== :: InitializeError -> InitializeError -> Bool
Eq)

deriveJSON lspOptions ''InitializeError

-- ---------------------------------------------------------------------
{-
The server can signal the following capabilities:

/**
 * Defines how the host (editor) should sync document changes to the language server.
 */
enum TextDocumentSyncKind {
    /**
     * Documents should not be synced at all.
     */
    None = 0,
    /**
     * Documents are synced by always sending the full content of the document.
     */
    Full = 1,
    /**
     * Documents are synced by sending the full content on open. After that only incremental
     * updates to the document are sent.
     */
    Incremental = 2
}
-}

-- ^ Note: Omitting this parameter from the capabilities is effectively a fourth
-- state, where DidSave events are generated without sending document contents.
data TextDocumentSyncKind = TdSyncNone
                          | TdSyncFull
                          | TdSyncIncremental
       deriving (ReadPrec [TextDocumentSyncKind]
ReadPrec TextDocumentSyncKind
Int -> ReadS TextDocumentSyncKind
ReadS [TextDocumentSyncKind]
(Int -> ReadS TextDocumentSyncKind)
-> ReadS [TextDocumentSyncKind]
-> ReadPrec TextDocumentSyncKind
-> ReadPrec [TextDocumentSyncKind]
-> Read TextDocumentSyncKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextDocumentSyncKind]
$creadListPrec :: ReadPrec [TextDocumentSyncKind]
readPrec :: ReadPrec TextDocumentSyncKind
$creadPrec :: ReadPrec TextDocumentSyncKind
readList :: ReadS [TextDocumentSyncKind]
$creadList :: ReadS [TextDocumentSyncKind]
readsPrec :: Int -> ReadS TextDocumentSyncKind
$creadsPrec :: Int -> ReadS TextDocumentSyncKind
Read,TextDocumentSyncKind -> TextDocumentSyncKind -> Bool
(TextDocumentSyncKind -> TextDocumentSyncKind -> Bool)
-> (TextDocumentSyncKind -> TextDocumentSyncKind -> Bool)
-> Eq TextDocumentSyncKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDocumentSyncKind -> TextDocumentSyncKind -> Bool
$c/= :: TextDocumentSyncKind -> TextDocumentSyncKind -> Bool
== :: TextDocumentSyncKind -> TextDocumentSyncKind -> Bool
$c== :: TextDocumentSyncKind -> TextDocumentSyncKind -> Bool
Eq,Int -> TextDocumentSyncKind -> ShowS
[TextDocumentSyncKind] -> ShowS
TextDocumentSyncKind -> String
(Int -> TextDocumentSyncKind -> ShowS)
-> (TextDocumentSyncKind -> String)
-> ([TextDocumentSyncKind] -> ShowS)
-> Show TextDocumentSyncKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDocumentSyncKind] -> ShowS
$cshowList :: [TextDocumentSyncKind] -> ShowS
show :: TextDocumentSyncKind -> String
$cshow :: TextDocumentSyncKind -> String
showsPrec :: Int -> TextDocumentSyncKind -> ShowS
$cshowsPrec :: Int -> TextDocumentSyncKind -> ShowS
Show)

instance A.ToJSON TextDocumentSyncKind where
  toJSON :: TextDocumentSyncKind -> Value
toJSON TextDocumentSyncKind
TdSyncNone        = Scientific -> Value
A.Number Scientific
0
  toJSON TextDocumentSyncKind
TdSyncFull        = Scientific -> Value
A.Number Scientific
1
  toJSON TextDocumentSyncKind
TdSyncIncremental = Scientific -> Value
A.Number Scientific
2

instance A.FromJSON TextDocumentSyncKind where
  parseJSON :: Value -> Parser TextDocumentSyncKind
parseJSON (A.Number Scientific
0) = TextDocumentSyncKind -> Parser TextDocumentSyncKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextDocumentSyncKind
TdSyncNone
  parseJSON (A.Number Scientific
1) = TextDocumentSyncKind -> Parser TextDocumentSyncKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextDocumentSyncKind
TdSyncFull
  parseJSON (A.Number Scientific
2) = TextDocumentSyncKind -> Parser TextDocumentSyncKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextDocumentSyncKind
TdSyncIncremental
  parseJSON Value
_            = Parser TextDocumentSyncKind
forall a. Monoid a => a
mempty

-- ---------------------------------------------------------------------
{-
/**
 * Completion options.
 */
interface CompletionOptions {
    /**
     * The server provides support to resolve additional information for a completion item.
     */
    resolveProvider?: boolean;

    /**
     * The characters that trigger completion automatically.
     */
    triggerCharacters?: string[];

    /**
     * The list of all possible characters that commit a completion. This field can be used
     * if clients don't support individual commmit characters per completion item. See
     * `ClientCapabilities.textDocument.completion.completionItem.commitCharactersSupport`.
     *
     * If a server provides both `allCommitCharacters` and commit characters on an individual
     * completion item the once on the completion item win.
     *
     * @since 3.2.0
     */
    allCommitCharacters?: string[];
}
-}

data CompletionOptions =
  CompletionOptions
    { CompletionOptions -> Maybe Bool
_resolveProvider     :: Maybe Bool
    -- | The characters that trigger completion automatically.
    , CompletionOptions -> Maybe [String]
_triggerCharacters   :: Maybe [String]
    -- | The list of all possible characters that commit a completion. This field can be used
    -- if clients don't support individual commmit characters per completion item. See
    -- `_commitCharactersSupport`.
    -- Since LSP 3.2.0
    -- @since 0.18.0.0
    , CompletionOptions -> Maybe [String]
_allCommitCharacters :: Maybe [String]
    } deriving (ReadPrec [CompletionOptions]
ReadPrec CompletionOptions
Int -> ReadS CompletionOptions
ReadS [CompletionOptions]
(Int -> ReadS CompletionOptions)
-> ReadS [CompletionOptions]
-> ReadPrec CompletionOptions
-> ReadPrec [CompletionOptions]
-> Read CompletionOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionOptions]
$creadListPrec :: ReadPrec [CompletionOptions]
readPrec :: ReadPrec CompletionOptions
$creadPrec :: ReadPrec CompletionOptions
readList :: ReadS [CompletionOptions]
$creadList :: ReadS [CompletionOptions]
readsPrec :: Int -> ReadS CompletionOptions
$creadsPrec :: Int -> ReadS CompletionOptions
Read,Int -> CompletionOptions -> ShowS
[CompletionOptions] -> ShowS
CompletionOptions -> String
(Int -> CompletionOptions -> ShowS)
-> (CompletionOptions -> String)
-> ([CompletionOptions] -> ShowS)
-> Show CompletionOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionOptions] -> ShowS
$cshowList :: [CompletionOptions] -> ShowS
show :: CompletionOptions -> String
$cshow :: CompletionOptions -> String
showsPrec :: Int -> CompletionOptions -> ShowS
$cshowsPrec :: Int -> CompletionOptions -> ShowS
Show,CompletionOptions -> CompletionOptions -> Bool
(CompletionOptions -> CompletionOptions -> Bool)
-> (CompletionOptions -> CompletionOptions -> Bool)
-> Eq CompletionOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionOptions -> CompletionOptions -> Bool
$c/= :: CompletionOptions -> CompletionOptions -> Bool
== :: CompletionOptions -> CompletionOptions -> Bool
$c== :: CompletionOptions -> CompletionOptions -> Bool
Eq)

deriveJSON lspOptions {omitNothingFields = True } ''CompletionOptions

-- ---------------------------------------------------------------------
{-
/**
 * Signature help options.
 */
interface SignatureHelpOptions {
    /**
     * The characters that trigger signature help automatically.
     */
    triggerCharacters?: string[];
    /**
     * List of characters that re-trigger signature help.
     *
     * These trigger characters are only active when signature help is already showing. All trigger characters
     * are also counted as re-trigger characters.
     *
     * @since 3.15.0
     */
-}

data SignatureHelpOptions =
  SignatureHelpOptions
    { -- | The characters that trigger signature help automatically.
      SignatureHelpOptions -> Maybe [String]
_triggerCharacters   :: Maybe [String]

    -- | List of characters that re-trigger signature help.
    -- These trigger characters are only active when signature help is already showing. All trigger characters
    -- are also counted as re-trigger characters.
    --
    -- Since LSP 3.15.0
    -- @since 0.18.0.0
    , SignatureHelpOptions -> Maybe [String]
_retriggerCharacters :: Maybe [String]
    } deriving (ReadPrec [SignatureHelpOptions]
ReadPrec SignatureHelpOptions
Int -> ReadS SignatureHelpOptions
ReadS [SignatureHelpOptions]
(Int -> ReadS SignatureHelpOptions)
-> ReadS [SignatureHelpOptions]
-> ReadPrec SignatureHelpOptions
-> ReadPrec [SignatureHelpOptions]
-> Read SignatureHelpOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignatureHelpOptions]
$creadListPrec :: ReadPrec [SignatureHelpOptions]
readPrec :: ReadPrec SignatureHelpOptions
$creadPrec :: ReadPrec SignatureHelpOptions
readList :: ReadS [SignatureHelpOptions]
$creadList :: ReadS [SignatureHelpOptions]
readsPrec :: Int -> ReadS SignatureHelpOptions
$creadsPrec :: Int -> ReadS SignatureHelpOptions
Read,Int -> SignatureHelpOptions -> ShowS
[SignatureHelpOptions] -> ShowS
SignatureHelpOptions -> String
(Int -> SignatureHelpOptions -> ShowS)
-> (SignatureHelpOptions -> String)
-> ([SignatureHelpOptions] -> ShowS)
-> Show SignatureHelpOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureHelpOptions] -> ShowS
$cshowList :: [SignatureHelpOptions] -> ShowS
show :: SignatureHelpOptions -> String
$cshow :: SignatureHelpOptions -> String
showsPrec :: Int -> SignatureHelpOptions -> ShowS
$cshowsPrec :: Int -> SignatureHelpOptions -> ShowS
Show,SignatureHelpOptions -> SignatureHelpOptions -> Bool
(SignatureHelpOptions -> SignatureHelpOptions -> Bool)
-> (SignatureHelpOptions -> SignatureHelpOptions -> Bool)
-> Eq SignatureHelpOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureHelpOptions -> SignatureHelpOptions -> Bool
$c/= :: SignatureHelpOptions -> SignatureHelpOptions -> Bool
== :: SignatureHelpOptions -> SignatureHelpOptions -> Bool
$c== :: SignatureHelpOptions -> SignatureHelpOptions -> Bool
Eq)

deriveJSON lspOptions ''SignatureHelpOptions

-- ---------------------------------------------------------------------
{-
/**
 * Code Lens options.
 */
interface CodeLensOptions {
    /**
     * Code lens has a resolve provider as well.
     */
    resolveProvider?: boolean;
}
-}

data CodeLensOptions =
  CodeLensOptions
    { CodeLensOptions -> Maybe Bool
_resolveProvider :: Maybe Bool
    } deriving (ReadPrec [CodeLensOptions]
ReadPrec CodeLensOptions
Int -> ReadS CodeLensOptions
ReadS [CodeLensOptions]
(Int -> ReadS CodeLensOptions)
-> ReadS [CodeLensOptions]
-> ReadPrec CodeLensOptions
-> ReadPrec [CodeLensOptions]
-> Read CodeLensOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodeLensOptions]
$creadListPrec :: ReadPrec [CodeLensOptions]
readPrec :: ReadPrec CodeLensOptions
$creadPrec :: ReadPrec CodeLensOptions
readList :: ReadS [CodeLensOptions]
$creadList :: ReadS [CodeLensOptions]
readsPrec :: Int -> ReadS CodeLensOptions
$creadsPrec :: Int -> ReadS CodeLensOptions
Read,Int -> CodeLensOptions -> ShowS
[CodeLensOptions] -> ShowS
CodeLensOptions -> String
(Int -> CodeLensOptions -> ShowS)
-> (CodeLensOptions -> String)
-> ([CodeLensOptions] -> ShowS)
-> Show CodeLensOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeLensOptions] -> ShowS
$cshowList :: [CodeLensOptions] -> ShowS
show :: CodeLensOptions -> String
$cshow :: CodeLensOptions -> String
showsPrec :: Int -> CodeLensOptions -> ShowS
$cshowsPrec :: Int -> CodeLensOptions -> ShowS
Show,CodeLensOptions -> CodeLensOptions -> Bool
(CodeLensOptions -> CodeLensOptions -> Bool)
-> (CodeLensOptions -> CodeLensOptions -> Bool)
-> Eq CodeLensOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeLensOptions -> CodeLensOptions -> Bool
$c/= :: CodeLensOptions -> CodeLensOptions -> Bool
== :: CodeLensOptions -> CodeLensOptions -> Bool
$c== :: CodeLensOptions -> CodeLensOptions -> Bool
Eq)

deriveJSON lspOptions ''CodeLensOptions

-- ---------------------------------------------------------------------
{-
/**
 * Code Action options.
 */
export interface CodeActionOptions {
    /**
     * CodeActionKinds that this server may return.
     *
     * The list of kinds may be generic, such as `CodeActionKind.Refactor`, or the server
     * may list out every specific kind they provide.
     */
    codeActionKinds?: CodeActionKind[];
}
-}

data CodeActionOptions =
  CodeActionOptionsStatic Bool
  | CodeActionOptions
    { CodeActionOptions -> Maybe [CodeActionKind]
_codeActionKinds :: Maybe [CodeActionKind]
    } deriving (ReadPrec [CodeActionOptions]
ReadPrec CodeActionOptions
Int -> ReadS CodeActionOptions
ReadS [CodeActionOptions]
(Int -> ReadS CodeActionOptions)
-> ReadS [CodeActionOptions]
-> ReadPrec CodeActionOptions
-> ReadPrec [CodeActionOptions]
-> Read CodeActionOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodeActionOptions]
$creadListPrec :: ReadPrec [CodeActionOptions]
readPrec :: ReadPrec CodeActionOptions
$creadPrec :: ReadPrec CodeActionOptions
readList :: ReadS [CodeActionOptions]
$creadList :: ReadS [CodeActionOptions]
readsPrec :: Int -> ReadS CodeActionOptions
$creadsPrec :: Int -> ReadS CodeActionOptions
Read,Int -> CodeActionOptions -> ShowS
[CodeActionOptions] -> ShowS
CodeActionOptions -> String
(Int -> CodeActionOptions -> ShowS)
-> (CodeActionOptions -> String)
-> ([CodeActionOptions] -> ShowS)
-> Show CodeActionOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeActionOptions] -> ShowS
$cshowList :: [CodeActionOptions] -> ShowS
show :: CodeActionOptions -> String
$cshow :: CodeActionOptions -> String
showsPrec :: Int -> CodeActionOptions -> ShowS
$cshowsPrec :: Int -> CodeActionOptions -> ShowS
Show,CodeActionOptions -> CodeActionOptions -> Bool
(CodeActionOptions -> CodeActionOptions -> Bool)
-> (CodeActionOptions -> CodeActionOptions -> Bool)
-> Eq CodeActionOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeActionOptions -> CodeActionOptions -> Bool
$c/= :: CodeActionOptions -> CodeActionOptions -> Bool
== :: CodeActionOptions -> CodeActionOptions -> Bool
$c== :: CodeActionOptions -> CodeActionOptions -> Bool
Eq)

deriveJSON (lspOptions { sumEncoding = A.UntaggedValue }) ''CodeActionOptions

-- ---------------------------------------------------------------------
{-
/**
 * Format document on type options
 */
interface DocumentOnTypeFormattingOptions {
    /**
     * A character on which formatting should be triggered, like `}`.
     */
    firstTriggerCharacter: string;
    /**
     * More trigger characters.
     */
    moreTriggerCharacter?: string[]
}
-}
data DocumentOnTypeFormattingOptions =
  DocumentOnTypeFormattingOptions
    { DocumentOnTypeFormattingOptions -> Text
_firstTriggerCharacter :: Text
    , DocumentOnTypeFormattingOptions -> Maybe [Text]
_moreTriggerCharacter  :: Maybe [Text]
    } deriving (ReadPrec [DocumentOnTypeFormattingOptions]
ReadPrec DocumentOnTypeFormattingOptions
Int -> ReadS DocumentOnTypeFormattingOptions
ReadS [DocumentOnTypeFormattingOptions]
(Int -> ReadS DocumentOnTypeFormattingOptions)
-> ReadS [DocumentOnTypeFormattingOptions]
-> ReadPrec DocumentOnTypeFormattingOptions
-> ReadPrec [DocumentOnTypeFormattingOptions]
-> Read DocumentOnTypeFormattingOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentOnTypeFormattingOptions]
$creadListPrec :: ReadPrec [DocumentOnTypeFormattingOptions]
readPrec :: ReadPrec DocumentOnTypeFormattingOptions
$creadPrec :: ReadPrec DocumentOnTypeFormattingOptions
readList :: ReadS [DocumentOnTypeFormattingOptions]
$creadList :: ReadS [DocumentOnTypeFormattingOptions]
readsPrec :: Int -> ReadS DocumentOnTypeFormattingOptions
$creadsPrec :: Int -> ReadS DocumentOnTypeFormattingOptions
Read,Int -> DocumentOnTypeFormattingOptions -> ShowS
[DocumentOnTypeFormattingOptions] -> ShowS
DocumentOnTypeFormattingOptions -> String
(Int -> DocumentOnTypeFormattingOptions -> ShowS)
-> (DocumentOnTypeFormattingOptions -> String)
-> ([DocumentOnTypeFormattingOptions] -> ShowS)
-> Show DocumentOnTypeFormattingOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentOnTypeFormattingOptions] -> ShowS
$cshowList :: [DocumentOnTypeFormattingOptions] -> ShowS
show :: DocumentOnTypeFormattingOptions -> String
$cshow :: DocumentOnTypeFormattingOptions -> String
showsPrec :: Int -> DocumentOnTypeFormattingOptions -> ShowS
$cshowsPrec :: Int -> DocumentOnTypeFormattingOptions -> ShowS
Show,DocumentOnTypeFormattingOptions
-> DocumentOnTypeFormattingOptions -> Bool
(DocumentOnTypeFormattingOptions
 -> DocumentOnTypeFormattingOptions -> Bool)
-> (DocumentOnTypeFormattingOptions
    -> DocumentOnTypeFormattingOptions -> Bool)
-> Eq DocumentOnTypeFormattingOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentOnTypeFormattingOptions
-> DocumentOnTypeFormattingOptions -> Bool
$c/= :: DocumentOnTypeFormattingOptions
-> DocumentOnTypeFormattingOptions -> Bool
== :: DocumentOnTypeFormattingOptions
-> DocumentOnTypeFormattingOptions -> Bool
$c== :: DocumentOnTypeFormattingOptions
-> DocumentOnTypeFormattingOptions -> Bool
Eq)

deriveJSON lspOptions ''DocumentOnTypeFormattingOptions

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

/**
 * Document link options
 */
export interface DocumentLinkOptions {
        /**
         * Document links have a resolve provider as well.
         */
        resolveProvider?: boolean;
}
-}

data DocumentLinkOptions =
  DocumentLinkOptions
    { -- | Document links have a resolve provider as well.
      DocumentLinkOptions -> Maybe Bool
_resolveProvider :: Maybe Bool
    } deriving (Int -> DocumentLinkOptions -> ShowS
[DocumentLinkOptions] -> ShowS
DocumentLinkOptions -> String
(Int -> DocumentLinkOptions -> ShowS)
-> (DocumentLinkOptions -> String)
-> ([DocumentLinkOptions] -> ShowS)
-> Show DocumentLinkOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentLinkOptions] -> ShowS
$cshowList :: [DocumentLinkOptions] -> ShowS
show :: DocumentLinkOptions -> String
$cshow :: DocumentLinkOptions -> String
showsPrec :: Int -> DocumentLinkOptions -> ShowS
$cshowsPrec :: Int -> DocumentLinkOptions -> ShowS
Show, ReadPrec [DocumentLinkOptions]
ReadPrec DocumentLinkOptions
Int -> ReadS DocumentLinkOptions
ReadS [DocumentLinkOptions]
(Int -> ReadS DocumentLinkOptions)
-> ReadS [DocumentLinkOptions]
-> ReadPrec DocumentLinkOptions
-> ReadPrec [DocumentLinkOptions]
-> Read DocumentLinkOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentLinkOptions]
$creadListPrec :: ReadPrec [DocumentLinkOptions]
readPrec :: ReadPrec DocumentLinkOptions
$creadPrec :: ReadPrec DocumentLinkOptions
readList :: ReadS [DocumentLinkOptions]
$creadList :: ReadS [DocumentLinkOptions]
readsPrec :: Int -> ReadS DocumentLinkOptions
$creadsPrec :: Int -> ReadS DocumentLinkOptions
Read, DocumentLinkOptions -> DocumentLinkOptions -> Bool
(DocumentLinkOptions -> DocumentLinkOptions -> Bool)
-> (DocumentLinkOptions -> DocumentLinkOptions -> Bool)
-> Eq DocumentLinkOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentLinkOptions -> DocumentLinkOptions -> Bool
$c/= :: DocumentLinkOptions -> DocumentLinkOptions -> Bool
== :: DocumentLinkOptions -> DocumentLinkOptions -> Bool
$c== :: DocumentLinkOptions -> DocumentLinkOptions -> Bool
Eq)

deriveJSON lspOptions ''DocumentLinkOptions

-- ---------------------------------------------------------------------
{-
New in 3.12
----------

/**
 * Rename options
 */
export interface RenameOptions {
        /**
         * Renames should be checked and tested before being executed.
         */
        prepareProvider?: boolean;
}
-}

data RenameOptions =
  RenameOptionsStatic Bool
  | RenameOptions
    { -- | Renames should be checked and tested before being executed.
      RenameOptions -> Maybe Bool
_prepareProvider :: Maybe Bool
    } deriving (Int -> RenameOptions -> ShowS
[RenameOptions] -> ShowS
RenameOptions -> String
(Int -> RenameOptions -> ShowS)
-> (RenameOptions -> String)
-> ([RenameOptions] -> ShowS)
-> Show RenameOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RenameOptions] -> ShowS
$cshowList :: [RenameOptions] -> ShowS
show :: RenameOptions -> String
$cshow :: RenameOptions -> String
showsPrec :: Int -> RenameOptions -> ShowS
$cshowsPrec :: Int -> RenameOptions -> ShowS
Show, ReadPrec [RenameOptions]
ReadPrec RenameOptions
Int -> ReadS RenameOptions
ReadS [RenameOptions]
(Int -> ReadS RenameOptions)
-> ReadS [RenameOptions]
-> ReadPrec RenameOptions
-> ReadPrec [RenameOptions]
-> Read RenameOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RenameOptions]
$creadListPrec :: ReadPrec [RenameOptions]
readPrec :: ReadPrec RenameOptions
$creadPrec :: ReadPrec RenameOptions
readList :: ReadS [RenameOptions]
$creadList :: ReadS [RenameOptions]
readsPrec :: Int -> ReadS RenameOptions
$creadsPrec :: Int -> ReadS RenameOptions
Read, RenameOptions -> RenameOptions -> Bool
(RenameOptions -> RenameOptions -> Bool)
-> (RenameOptions -> RenameOptions -> Bool) -> Eq RenameOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RenameOptions -> RenameOptions -> Bool
$c/= :: RenameOptions -> RenameOptions -> Bool
== :: RenameOptions -> RenameOptions -> Bool
$c== :: RenameOptions -> RenameOptions -> Bool
Eq)

deriveJSON lspOptions { sumEncoding = A.UntaggedValue } ''RenameOptions

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

{-
New in 3.0
-----------

/**
 * Execute command options.
 */
export interface ExecuteCommandOptions {
        /**
         * The commands to be executed on the server
         */
        commands: string[]
}
-}

data ExecuteCommandOptions =
  ExecuteCommandOptions
    { -- | The commands to be executed on the server
      ExecuteCommandOptions -> List Text
_commands :: List Text
    } deriving (Int -> ExecuteCommandOptions -> ShowS
[ExecuteCommandOptions] -> ShowS
ExecuteCommandOptions -> String
(Int -> ExecuteCommandOptions -> ShowS)
-> (ExecuteCommandOptions -> String)
-> ([ExecuteCommandOptions] -> ShowS)
-> Show ExecuteCommandOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteCommandOptions] -> ShowS
$cshowList :: [ExecuteCommandOptions] -> ShowS
show :: ExecuteCommandOptions -> String
$cshow :: ExecuteCommandOptions -> String
showsPrec :: Int -> ExecuteCommandOptions -> ShowS
$cshowsPrec :: Int -> ExecuteCommandOptions -> ShowS
Show, ReadPrec [ExecuteCommandOptions]
ReadPrec ExecuteCommandOptions
Int -> ReadS ExecuteCommandOptions
ReadS [ExecuteCommandOptions]
(Int -> ReadS ExecuteCommandOptions)
-> ReadS [ExecuteCommandOptions]
-> ReadPrec ExecuteCommandOptions
-> ReadPrec [ExecuteCommandOptions]
-> Read ExecuteCommandOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecuteCommandOptions]
$creadListPrec :: ReadPrec [ExecuteCommandOptions]
readPrec :: ReadPrec ExecuteCommandOptions
$creadPrec :: ReadPrec ExecuteCommandOptions
readList :: ReadS [ExecuteCommandOptions]
$creadList :: ReadS [ExecuteCommandOptions]
readsPrec :: Int -> ReadS ExecuteCommandOptions
$creadsPrec :: Int -> ReadS ExecuteCommandOptions
Read, ExecuteCommandOptions -> ExecuteCommandOptions -> Bool
(ExecuteCommandOptions -> ExecuteCommandOptions -> Bool)
-> (ExecuteCommandOptions -> ExecuteCommandOptions -> Bool)
-> Eq ExecuteCommandOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteCommandOptions -> ExecuteCommandOptions -> Bool
$c/= :: ExecuteCommandOptions -> ExecuteCommandOptions -> Bool
== :: ExecuteCommandOptions -> ExecuteCommandOptions -> Bool
$c== :: ExecuteCommandOptions -> ExecuteCommandOptions -> Bool
Eq)

deriveJSON lspOptions ''ExecuteCommandOptions

-- ---------------------------------------------------------------------
{-
New in 3.0
----------
/**
 * Save options.
 */
export interface SaveOptions {
        /**
         * The client is supposed to include the content on save.
         */
        includeText?: boolean;
}
-}
data SaveOptions =
  SaveOptions
    { -- |The client is supposed to include the content on save.
      SaveOptions -> Maybe Bool
_includeText :: Maybe Bool
    } deriving (Int -> SaveOptions -> ShowS
[SaveOptions] -> ShowS
SaveOptions -> String
(Int -> SaveOptions -> ShowS)
-> (SaveOptions -> String)
-> ([SaveOptions] -> ShowS)
-> Show SaveOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SaveOptions] -> ShowS
$cshowList :: [SaveOptions] -> ShowS
show :: SaveOptions -> String
$cshow :: SaveOptions -> String
showsPrec :: Int -> SaveOptions -> ShowS
$cshowsPrec :: Int -> SaveOptions -> ShowS
Show, ReadPrec [SaveOptions]
ReadPrec SaveOptions
Int -> ReadS SaveOptions
ReadS [SaveOptions]
(Int -> ReadS SaveOptions)
-> ReadS [SaveOptions]
-> ReadPrec SaveOptions
-> ReadPrec [SaveOptions]
-> Read SaveOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SaveOptions]
$creadListPrec :: ReadPrec [SaveOptions]
readPrec :: ReadPrec SaveOptions
$creadPrec :: ReadPrec SaveOptions
readList :: ReadS [SaveOptions]
$creadList :: ReadS [SaveOptions]
readsPrec :: Int -> ReadS SaveOptions
$creadsPrec :: Int -> ReadS SaveOptions
Read, SaveOptions -> SaveOptions -> Bool
(SaveOptions -> SaveOptions -> Bool)
-> (SaveOptions -> SaveOptions -> Bool) -> Eq SaveOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SaveOptions -> SaveOptions -> Bool
$c/= :: SaveOptions -> SaveOptions -> Bool
== :: SaveOptions -> SaveOptions -> Bool
$c== :: SaveOptions -> SaveOptions -> Bool
Eq)

deriveJSON lspOptions ''SaveOptions

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

export interface TextDocumentSyncOptions {
        /**
         * Open and close notifications are sent to the server.
         */
        openClose?: boolean;
        /**
         * Change notificatins are sent to the server. See TextDocumentSyncKind.None, TextDocumentSyncKind.Full
         * and TextDocumentSyncKindIncremental.
         */
        change?: number;
        /**
         * Will save notifications are sent to the server.
         */
        willSave?: boolean;
        /**
         * Will save wait until requests are sent to the server.
         */
        willSaveWaitUntil?: boolean;
        /**
         * Save notifications are sent to the server.
         */
        save?: SaveOptions;
}
-}

data TextDocumentSyncOptions =
  TextDocumentSyncOptions
    { -- | Open and close notifications are sent to the server.
      TextDocumentSyncOptions -> Maybe Bool
_openClose         :: Maybe Bool

      -- | Change notificatins are sent to the server. See
      -- TextDocumentSyncKind.None, TextDocumentSyncKind.Full and
      -- TextDocumentSyncKindIncremental.
    , TextDocumentSyncOptions -> Maybe TextDocumentSyncKind
_change            :: Maybe TextDocumentSyncKind

      -- | Will save notifications are sent to the server.
    , TextDocumentSyncOptions -> Maybe Bool
_willSave          :: Maybe Bool

      -- | Will save wait until requests are sent to the server.
    , TextDocumentSyncOptions -> Maybe Bool
_willSaveWaitUntil :: Maybe Bool

      -- | Save notifications are sent to the server.
    , TextDocumentSyncOptions -> Maybe SaveOptions
_save              :: Maybe SaveOptions
    } deriving (Int -> TextDocumentSyncOptions -> ShowS
[TextDocumentSyncOptions] -> ShowS
TextDocumentSyncOptions -> String
(Int -> TextDocumentSyncOptions -> ShowS)
-> (TextDocumentSyncOptions -> String)
-> ([TextDocumentSyncOptions] -> ShowS)
-> Show TextDocumentSyncOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDocumentSyncOptions] -> ShowS
$cshowList :: [TextDocumentSyncOptions] -> ShowS
show :: TextDocumentSyncOptions -> String
$cshow :: TextDocumentSyncOptions -> String
showsPrec :: Int -> TextDocumentSyncOptions -> ShowS
$cshowsPrec :: Int -> TextDocumentSyncOptions -> ShowS
Show, ReadPrec [TextDocumentSyncOptions]
ReadPrec TextDocumentSyncOptions
Int -> ReadS TextDocumentSyncOptions
ReadS [TextDocumentSyncOptions]
(Int -> ReadS TextDocumentSyncOptions)
-> ReadS [TextDocumentSyncOptions]
-> ReadPrec TextDocumentSyncOptions
-> ReadPrec [TextDocumentSyncOptions]
-> Read TextDocumentSyncOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextDocumentSyncOptions]
$creadListPrec :: ReadPrec [TextDocumentSyncOptions]
readPrec :: ReadPrec TextDocumentSyncOptions
$creadPrec :: ReadPrec TextDocumentSyncOptions
readList :: ReadS [TextDocumentSyncOptions]
$creadList :: ReadS [TextDocumentSyncOptions]
readsPrec :: Int -> ReadS TextDocumentSyncOptions
$creadsPrec :: Int -> ReadS TextDocumentSyncOptions
Read, TextDocumentSyncOptions -> TextDocumentSyncOptions -> Bool
(TextDocumentSyncOptions -> TextDocumentSyncOptions -> Bool)
-> (TextDocumentSyncOptions -> TextDocumentSyncOptions -> Bool)
-> Eq TextDocumentSyncOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDocumentSyncOptions -> TextDocumentSyncOptions -> Bool
$c/= :: TextDocumentSyncOptions -> TextDocumentSyncOptions -> Bool
== :: TextDocumentSyncOptions -> TextDocumentSyncOptions -> Bool
$c== :: TextDocumentSyncOptions -> TextDocumentSyncOptions -> Bool
Eq)

deriveJSON lspOptions ''TextDocumentSyncOptions

-- ---------------------------------------------------------------------
{-

Extended in 3.0
---------------

interface ServerCapabilities {
        /**
         * Defines how text documents are synced. Is either a detailed structure defining each notification or
         * for backwards compatibility the TextDocumentSyncKind number. If omitted it defaults to `TextDocumentSyncKind.None`.
         */
        textDocumentSync?: TextDocumentSyncOptions | number;
        /**
         * The server provides hover support.
         */
        hoverProvider?: boolean;
        /**
         * The server provides completion support.
         */
        completionProvider?: CompletionOptions;
        /**
         * The server provides signature help support.
         */
        signatureHelpProvider?: SignatureHelpOptions;
        /**
         * The server provides goto definition support.
         */
        definitionProvider?: boolean;
        /**
         * The server provides Goto Type Definition support.
         *
         * Since 3.6.0
         */
        typeDefinitionProvider?: boolean | (TextDocumentRegistrationOptions & StaticRegistrationOptions);
        /**
         * The server provides Goto Implementation support.
         *
         * Since 3.6.0
         */
        implementationProvider?: boolean | (TextDocumentRegistrationOptions & StaticRegistrationOptions);
        /**
         * The server provides find references support.
         */
        referencesProvider?: boolean;
        /**
         * The server provides document highlight support.
         */
        documentHighlightProvider?: boolean;
        /**
         * The server provides document symbol support.
         */
        documentSymbolProvider?: boolean;
        /**
         * The server provides workspace symbol support.
         */
        workspaceSymbolProvider?: boolean;
        /**
         * The server provides code actions. The `CodeActionOptions` return type is only
         * valid if the client signals code action literal support via the property
         * `textDocument.codeAction.codeActionLiteralSupport`.
         */
        codeActionProvider?: boolean | CodeActionOptions;
        /**
         * The server provides code lens.
         */
        codeLensProvider?: CodeLensOptions;
        /**
         * The server provides document formatting.
         */
        documentFormattingProvider?: boolean;
        /**
         * The server provides document range formatting.
         */
        documentRangeFormattingProvider?: boolean;
        /**
         * The server provides document formatting on typing.
         */
        documentOnTypeFormattingProvider?: DocumentOnTypeFormattingOptions;
        /**
         * The server provides rename support.
         */
        renameProvider?: boolean;
        /**
         * The server provides document link support.
         */
        documentLinkProvider?: DocumentLinkOptions;
        /**
         * The server provides color provider support.
         *
         * Since 3.6.0
         */
        colorProvider?: boolean | ColorProviderOptions | (ColorProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions);
        /**
         * The server provides folding provider support.
         *
         * Since 3.10.0
         */
        foldingRangeProvider?: boolean | FoldingRangeProviderOptions | (FoldingRangeProviderOptions & TextDocumentRegistrationOptions & StaticRegistrationOptions);
        /**
         * The server provides execute command support.
         */
        executeCommandProvider?: ExecuteCommandOptions;
        /**
         * Workspace specific server capabilities
         */
        workspace?: {
                /**
                 * The server supports workspace folder.
                 *
                 * Since 3.6.0
                 */
                workspaceFolders?: {
                        /**
                        * The server has support for workspace folders
                        */
                        supported?: boolean;
                        /**
                        * Whether the server wants to receive workspace folder
                        * change notifications.
                        *
                        * If a strings is provided the string is treated as a ID
                        * under which the notification is registered on the client
                        * side. The ID can be used to unregister for these events
                        * using the `client/unregisterCapability` request.
                        */
                        changeNotifications?: string | boolean;
                }
        }
        /**
         * Experimental server capabilities.
         */
        experimental?: any;
}
-}

-- | Wrapper for TextDocumentSyncKind fallback.
data TDS = TDSOptions TextDocumentSyncOptions
         | TDSKind TextDocumentSyncKind
    deriving (Int -> TDS -> ShowS
[TDS] -> ShowS
TDS -> String
(Int -> TDS -> ShowS)
-> (TDS -> String) -> ([TDS] -> ShowS) -> Show TDS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TDS] -> ShowS
$cshowList :: [TDS] -> ShowS
show :: TDS -> String
$cshow :: TDS -> String
showsPrec :: Int -> TDS -> ShowS
$cshowsPrec :: Int -> TDS -> ShowS
Show, ReadPrec [TDS]
ReadPrec TDS
Int -> ReadS TDS
ReadS [TDS]
(Int -> ReadS TDS)
-> ReadS [TDS] -> ReadPrec TDS -> ReadPrec [TDS] -> Read TDS
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TDS]
$creadListPrec :: ReadPrec [TDS]
readPrec :: ReadPrec TDS
$creadPrec :: ReadPrec TDS
readList :: ReadS [TDS]
$creadList :: ReadS [TDS]
readsPrec :: Int -> ReadS TDS
$creadsPrec :: Int -> ReadS TDS
Read, TDS -> TDS -> Bool
(TDS -> TDS -> Bool) -> (TDS -> TDS -> Bool) -> Eq TDS
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TDS -> TDS -> Bool
$c/= :: TDS -> TDS -> Bool
== :: TDS -> TDS -> Bool
$c== :: TDS -> TDS -> Bool
Eq)

instance FromJSON TDS where
    parseJSON :: Value -> Parser TDS
parseJSON Value
x = TextDocumentSyncOptions -> TDS
TDSOptions (TextDocumentSyncOptions -> TDS)
-> Parser TextDocumentSyncOptions -> Parser TDS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TextDocumentSyncOptions
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x Parser TDS -> Parser TDS -> Parser TDS
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> TextDocumentSyncKind -> TDS
TDSKind (TextDocumentSyncKind -> TDS)
-> Parser TextDocumentSyncKind -> Parser TDS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser TextDocumentSyncKind
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

instance ToJSON TDS where
    toJSON :: TDS -> Value
toJSON (TDSOptions TextDocumentSyncOptions
x) = TextDocumentSyncOptions -> Value
forall a. ToJSON a => a -> Value
toJSON TextDocumentSyncOptions
x
    toJSON (TDSKind TextDocumentSyncKind
x) = TextDocumentSyncKind -> Value
forall a. ToJSON a => a -> Value
toJSON TextDocumentSyncKind
x

data GotoOptions = GotoOptionsStatic Bool
                 | GotoOptionsDynamic
                    { -- | A document selector to identify the scope of the registration. If set to null
                      -- the document selector provided on the client side will be used.
                      GotoOptions -> Maybe DocumentSelector
_documentSelector :: Maybe DocumentSelector
                      -- | The id used to register the request. The id can be used to deregister
                      -- the request again. See also Registration#id.
                    , GotoOptions -> Maybe Text
_id :: Maybe Text
                    }
  deriving (Int -> GotoOptions -> ShowS
[GotoOptions] -> ShowS
GotoOptions -> String
(Int -> GotoOptions -> ShowS)
-> (GotoOptions -> String)
-> ([GotoOptions] -> ShowS)
-> Show GotoOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GotoOptions] -> ShowS
$cshowList :: [GotoOptions] -> ShowS
show :: GotoOptions -> String
$cshow :: GotoOptions -> String
showsPrec :: Int -> GotoOptions -> ShowS
$cshowsPrec :: Int -> GotoOptions -> ShowS
Show, ReadPrec [GotoOptions]
ReadPrec GotoOptions
Int -> ReadS GotoOptions
ReadS [GotoOptions]
(Int -> ReadS GotoOptions)
-> ReadS [GotoOptions]
-> ReadPrec GotoOptions
-> ReadPrec [GotoOptions]
-> Read GotoOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GotoOptions]
$creadListPrec :: ReadPrec [GotoOptions]
readPrec :: ReadPrec GotoOptions
$creadPrec :: ReadPrec GotoOptions
readList :: ReadS [GotoOptions]
$creadList :: ReadS [GotoOptions]
readsPrec :: Int -> ReadS GotoOptions
$creadsPrec :: Int -> ReadS GotoOptions
Read, GotoOptions -> GotoOptions -> Bool
(GotoOptions -> GotoOptions -> Bool)
-> (GotoOptions -> GotoOptions -> Bool) -> Eq GotoOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GotoOptions -> GotoOptions -> Bool
$c/= :: GotoOptions -> GotoOptions -> Bool
== :: GotoOptions -> GotoOptions -> Bool
$c== :: GotoOptions -> GotoOptions -> Bool
Eq)

deriveJSON lspOptions { sumEncoding = A.UntaggedValue } ''GotoOptions
-- TODO: Figure out how to make Lens', not Traversal', for sum types
--makeFieldsNoPrefix ''GotoOptions

data ColorOptions = ColorOptionsStatic Bool
                  | ColorOptionsDynamic
                  | ColorOptionsDynamicDocument
                    { -- | A document selector to identify the scope of the registration. If set to null
                      -- the document selector provided on the client side will be used.
                      ColorOptions -> Maybe DocumentSelector
_documentSelector :: Maybe DocumentSelector
                      -- | The id used to register the request. The id can be used to deregister
                      -- the request again. See also Registration#id.
                    , ColorOptions -> Maybe Text
_id :: Maybe Text
                    }
  deriving (Int -> ColorOptions -> ShowS
[ColorOptions] -> ShowS
ColorOptions -> String
(Int -> ColorOptions -> ShowS)
-> (ColorOptions -> String)
-> ([ColorOptions] -> ShowS)
-> Show ColorOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColorOptions] -> ShowS
$cshowList :: [ColorOptions] -> ShowS
show :: ColorOptions -> String
$cshow :: ColorOptions -> String
showsPrec :: Int -> ColorOptions -> ShowS
$cshowsPrec :: Int -> ColorOptions -> ShowS
Show, ReadPrec [ColorOptions]
ReadPrec ColorOptions
Int -> ReadS ColorOptions
ReadS [ColorOptions]
(Int -> ReadS ColorOptions)
-> ReadS [ColorOptions]
-> ReadPrec ColorOptions
-> ReadPrec [ColorOptions]
-> Read ColorOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ColorOptions]
$creadListPrec :: ReadPrec [ColorOptions]
readPrec :: ReadPrec ColorOptions
$creadPrec :: ReadPrec ColorOptions
readList :: ReadS [ColorOptions]
$creadList :: ReadS [ColorOptions]
readsPrec :: Int -> ReadS ColorOptions
$creadsPrec :: Int -> ReadS ColorOptions
Read, ColorOptions -> ColorOptions -> Bool
(ColorOptions -> ColorOptions -> Bool)
-> (ColorOptions -> ColorOptions -> Bool) -> Eq ColorOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColorOptions -> ColorOptions -> Bool
$c/= :: ColorOptions -> ColorOptions -> Bool
== :: ColorOptions -> ColorOptions -> Bool
$c== :: ColorOptions -> ColorOptions -> Bool
Eq)

deriveJSON lspOptions { sumEncoding = A.UntaggedValue } ''ColorOptions
-- makeFieldsNoPrefix ''ColorOptions

data FoldingRangeOptions = FoldingRangeOptionsStatic Bool
                         | FoldingRangeOptionsDynamic
                         | FoldingRangeOptionsDynamicDocument
                           { -- | A document selector to identify the scope of the registration. If set to null
                             -- the document selector provided on the client side will be used.
                             FoldingRangeOptions -> Maybe DocumentSelector
_documentSelector :: Maybe DocumentSelector
                             -- | The id used to register the request. The id can be used to deregister
                             -- the request again. See also Registration#id.
                           , FoldingRangeOptions -> Maybe Text
_id :: Maybe Text
                           }
  deriving (Int -> FoldingRangeOptions -> ShowS
[FoldingRangeOptions] -> ShowS
FoldingRangeOptions -> String
(Int -> FoldingRangeOptions -> ShowS)
-> (FoldingRangeOptions -> String)
-> ([FoldingRangeOptions] -> ShowS)
-> Show FoldingRangeOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FoldingRangeOptions] -> ShowS
$cshowList :: [FoldingRangeOptions] -> ShowS
show :: FoldingRangeOptions -> String
$cshow :: FoldingRangeOptions -> String
showsPrec :: Int -> FoldingRangeOptions -> ShowS
$cshowsPrec :: Int -> FoldingRangeOptions -> ShowS
Show, ReadPrec [FoldingRangeOptions]
ReadPrec FoldingRangeOptions
Int -> ReadS FoldingRangeOptions
ReadS [FoldingRangeOptions]
(Int -> ReadS FoldingRangeOptions)
-> ReadS [FoldingRangeOptions]
-> ReadPrec FoldingRangeOptions
-> ReadPrec [FoldingRangeOptions]
-> Read FoldingRangeOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FoldingRangeOptions]
$creadListPrec :: ReadPrec [FoldingRangeOptions]
readPrec :: ReadPrec FoldingRangeOptions
$creadPrec :: ReadPrec FoldingRangeOptions
readList :: ReadS [FoldingRangeOptions]
$creadList :: ReadS [FoldingRangeOptions]
readsPrec :: Int -> ReadS FoldingRangeOptions
$creadsPrec :: Int -> ReadS FoldingRangeOptions
Read, FoldingRangeOptions -> FoldingRangeOptions -> Bool
(FoldingRangeOptions -> FoldingRangeOptions -> Bool)
-> (FoldingRangeOptions -> FoldingRangeOptions -> Bool)
-> Eq FoldingRangeOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FoldingRangeOptions -> FoldingRangeOptions -> Bool
$c/= :: FoldingRangeOptions -> FoldingRangeOptions -> Bool
== :: FoldingRangeOptions -> FoldingRangeOptions -> Bool
$c== :: FoldingRangeOptions -> FoldingRangeOptions -> Bool
Eq)

deriveJSON lspOptions { sumEncoding = A.UntaggedValue } ''FoldingRangeOptions
-- makeFieldsNoPrefix ''FoldingRangeOptions

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

deriveJSON lspOptions{ sumEncoding = A.UntaggedValue } ''WorkspaceFolderChangeNotifications

data WorkspaceFolderOptions =
  WorkspaceFolderOptions
    { -- | The server has support for workspace folders
      WorkspaceFolderOptions -> Maybe Bool
_supported :: Maybe Bool
      -- | Whether the server wants to receive workspace folder
      -- change notifications.
      -- If a strings is provided the string is treated as a ID
      -- under which the notification is registered on the client
      -- side. The ID can be used to unregister for these events
      -- using the `client/unregisterCapability` request.
    , WorkspaceFolderOptions -> Maybe WorkspaceFolderChangeNotifications
_changeNotifications :: Maybe WorkspaceFolderChangeNotifications
    }
  deriving (Int -> WorkspaceFolderOptions -> ShowS
[WorkspaceFolderOptions] -> ShowS
WorkspaceFolderOptions -> String
(Int -> WorkspaceFolderOptions -> ShowS)
-> (WorkspaceFolderOptions -> String)
-> ([WorkspaceFolderOptions] -> ShowS)
-> Show WorkspaceFolderOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceFolderOptions] -> ShowS
$cshowList :: [WorkspaceFolderOptions] -> ShowS
show :: WorkspaceFolderOptions -> String
$cshow :: WorkspaceFolderOptions -> String
showsPrec :: Int -> WorkspaceFolderOptions -> ShowS
$cshowsPrec :: Int -> WorkspaceFolderOptions -> ShowS
Show, ReadPrec [WorkspaceFolderOptions]
ReadPrec WorkspaceFolderOptions
Int -> ReadS WorkspaceFolderOptions
ReadS [WorkspaceFolderOptions]
(Int -> ReadS WorkspaceFolderOptions)
-> ReadS [WorkspaceFolderOptions]
-> ReadPrec WorkspaceFolderOptions
-> ReadPrec [WorkspaceFolderOptions]
-> Read WorkspaceFolderOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceFolderOptions]
$creadListPrec :: ReadPrec [WorkspaceFolderOptions]
readPrec :: ReadPrec WorkspaceFolderOptions
$creadPrec :: ReadPrec WorkspaceFolderOptions
readList :: ReadS [WorkspaceFolderOptions]
$creadList :: ReadS [WorkspaceFolderOptions]
readsPrec :: Int -> ReadS WorkspaceFolderOptions
$creadsPrec :: Int -> ReadS WorkspaceFolderOptions
Read, WorkspaceFolderOptions -> WorkspaceFolderOptions -> Bool
(WorkspaceFolderOptions -> WorkspaceFolderOptions -> Bool)
-> (WorkspaceFolderOptions -> WorkspaceFolderOptions -> Bool)
-> Eq WorkspaceFolderOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceFolderOptions -> WorkspaceFolderOptions -> Bool
$c/= :: WorkspaceFolderOptions -> WorkspaceFolderOptions -> Bool
== :: WorkspaceFolderOptions -> WorkspaceFolderOptions -> Bool
$c== :: WorkspaceFolderOptions -> WorkspaceFolderOptions -> Bool
Eq)

deriveJSON lspOptions ''WorkspaceFolderOptions

data WorkspaceOptions =
  WorkspaceOptions
    { -- | The server supports workspace folder. Since LSP 3.6
      --
      -- @since 0.7.0.0
      WorkspaceOptions -> Maybe WorkspaceFolderOptions
_workspaceFolders :: Maybe WorkspaceFolderOptions
    }
  deriving (Int -> WorkspaceOptions -> ShowS
[WorkspaceOptions] -> ShowS
WorkspaceOptions -> String
(Int -> WorkspaceOptions -> ShowS)
-> (WorkspaceOptions -> String)
-> ([WorkspaceOptions] -> ShowS)
-> Show WorkspaceOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceOptions] -> ShowS
$cshowList :: [WorkspaceOptions] -> ShowS
show :: WorkspaceOptions -> String
$cshow :: WorkspaceOptions -> String
showsPrec :: Int -> WorkspaceOptions -> ShowS
$cshowsPrec :: Int -> WorkspaceOptions -> ShowS
Show, ReadPrec [WorkspaceOptions]
ReadPrec WorkspaceOptions
Int -> ReadS WorkspaceOptions
ReadS [WorkspaceOptions]
(Int -> ReadS WorkspaceOptions)
-> ReadS [WorkspaceOptions]
-> ReadPrec WorkspaceOptions
-> ReadPrec [WorkspaceOptions]
-> Read WorkspaceOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceOptions]
$creadListPrec :: ReadPrec [WorkspaceOptions]
readPrec :: ReadPrec WorkspaceOptions
$creadPrec :: ReadPrec WorkspaceOptions
readList :: ReadS [WorkspaceOptions]
$creadList :: ReadS [WorkspaceOptions]
readsPrec :: Int -> ReadS WorkspaceOptions
$creadsPrec :: Int -> ReadS WorkspaceOptions
Read, WorkspaceOptions -> WorkspaceOptions -> Bool
(WorkspaceOptions -> WorkspaceOptions -> Bool)
-> (WorkspaceOptions -> WorkspaceOptions -> Bool)
-> Eq WorkspaceOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceOptions -> WorkspaceOptions -> Bool
$c/= :: WorkspaceOptions -> WorkspaceOptions -> Bool
== :: WorkspaceOptions -> WorkspaceOptions -> Bool
$c== :: WorkspaceOptions -> WorkspaceOptions -> Bool
Eq)

deriveJSON lspOptions ''WorkspaceOptions

data InitializeResponseCapabilitiesInner =
  InitializeResponseCapabilitiesInner
    { -- | Defines how text documents are synced. Is either a detailed structure
      -- defining each notification or for backwards compatibility the
      -- 'TextDocumentSyncKind' number.
      -- If omitted it defaults to 'TdSyncNone'.
      InitializeResponseCapabilitiesInner -> Maybe TDS
_textDocumentSync                 :: Maybe TDS
      -- | The server provides hover support.
    , InitializeResponseCapabilitiesInner -> Maybe Bool
_hoverProvider                    :: Maybe Bool
      -- | The server provides completion support.
    , InitializeResponseCapabilitiesInner -> Maybe CompletionOptions
_completionProvider               :: Maybe CompletionOptions
      -- | The server provides signature help support.
    , InitializeResponseCapabilitiesInner -> Maybe SignatureHelpOptions
_signatureHelpProvider            :: Maybe SignatureHelpOptions
      -- | The server provides goto definition support.
    , InitializeResponseCapabilitiesInner -> Maybe Bool
_definitionProvider               :: Maybe Bool
      -- | The server provides Goto Type Definition support. Since LSP 3.6
      --
      -- @since 0.7.0.0
    , InitializeResponseCapabilitiesInner -> Maybe GotoOptions
_typeDefinitionProvider           :: Maybe GotoOptions
      -- | The server provides Goto Implementation support.
      -- Since LSP 3.6
      --
      -- @since 0.7.0.0
    , InitializeResponseCapabilitiesInner -> Maybe GotoOptions
_implementationProvider           :: Maybe GotoOptions
      -- | The server provides find references support.
    , InitializeResponseCapabilitiesInner -> Maybe Bool
_referencesProvider               :: Maybe Bool
      -- | The server provides document highlight support.
    , InitializeResponseCapabilitiesInner -> Maybe Bool
_documentHighlightProvider        :: Maybe Bool
      -- | The server provides document symbol support.
    , InitializeResponseCapabilitiesInner -> Maybe Bool
_documentSymbolProvider           :: Maybe Bool
      -- | The server provides workspace symbol support.
    , InitializeResponseCapabilitiesInner -> Maybe Bool
_workspaceSymbolProvider          :: Maybe Bool
      -- | The server provides code actions.
    , InitializeResponseCapabilitiesInner -> Maybe CodeActionOptions
_codeActionProvider               :: Maybe CodeActionOptions
      -- | The server provides code lens.
    , InitializeResponseCapabilitiesInner -> Maybe CodeLensOptions
_codeLensProvider                 :: Maybe CodeLensOptions
      -- | The server provides document formatting.
    , InitializeResponseCapabilitiesInner -> Maybe Bool
_documentFormattingProvider       :: Maybe Bool
      -- | The server provides document range formatting.
    , InitializeResponseCapabilitiesInner -> Maybe Bool
_documentRangeFormattingProvider  :: Maybe Bool
      -- | The server provides document formatting on typing.
    , InitializeResponseCapabilitiesInner
-> Maybe DocumentOnTypeFormattingOptions
_documentOnTypeFormattingProvider :: Maybe DocumentOnTypeFormattingOptions
      -- | The server provides rename support.
    , InitializeResponseCapabilitiesInner -> Maybe RenameOptions
_renameProvider                   :: Maybe RenameOptions
      -- | The server provides document link support.
    , InitializeResponseCapabilitiesInner -> Maybe DocumentLinkOptions
_documentLinkProvider             :: Maybe DocumentLinkOptions
      -- | The server provides color provider support. Since LSP 3.6
      --
      -- @since 0.7.0.0
    , InitializeResponseCapabilitiesInner -> Maybe ColorOptions
_colorProvider                    :: Maybe ColorOptions
      -- | The server provides folding provider support. Since LSP 3.10
      --
      -- @since 0.7.0.0
    , InitializeResponseCapabilitiesInner -> Maybe FoldingRangeOptions
_foldingRangeProvider             :: Maybe FoldingRangeOptions
      -- | The server provides execute command support.
    , InitializeResponseCapabilitiesInner -> Maybe ExecuteCommandOptions
_executeCommandProvider           :: Maybe ExecuteCommandOptions
      -- | Workspace specific server capabilities
    , InitializeResponseCapabilitiesInner -> Maybe WorkspaceOptions
_workspace                        :: Maybe WorkspaceOptions
      -- | Experimental server capabilities.
    , InitializeResponseCapabilitiesInner -> Maybe Value
_experimental                     :: Maybe A.Value
    } deriving (Int -> InitializeResponseCapabilitiesInner -> ShowS
[InitializeResponseCapabilitiesInner] -> ShowS
InitializeResponseCapabilitiesInner -> String
(Int -> InitializeResponseCapabilitiesInner -> ShowS)
-> (InitializeResponseCapabilitiesInner -> String)
-> ([InitializeResponseCapabilitiesInner] -> ShowS)
-> Show InitializeResponseCapabilitiesInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializeResponseCapabilitiesInner] -> ShowS
$cshowList :: [InitializeResponseCapabilitiesInner] -> ShowS
show :: InitializeResponseCapabilitiesInner -> String
$cshow :: InitializeResponseCapabilitiesInner -> String
showsPrec :: Int -> InitializeResponseCapabilitiesInner -> ShowS
$cshowsPrec :: Int -> InitializeResponseCapabilitiesInner -> ShowS
Show, ReadPrec [InitializeResponseCapabilitiesInner]
ReadPrec InitializeResponseCapabilitiesInner
Int -> ReadS InitializeResponseCapabilitiesInner
ReadS [InitializeResponseCapabilitiesInner]
(Int -> ReadS InitializeResponseCapabilitiesInner)
-> ReadS [InitializeResponseCapabilitiesInner]
-> ReadPrec InitializeResponseCapabilitiesInner
-> ReadPrec [InitializeResponseCapabilitiesInner]
-> Read InitializeResponseCapabilitiesInner
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializeResponseCapabilitiesInner]
$creadListPrec :: ReadPrec [InitializeResponseCapabilitiesInner]
readPrec :: ReadPrec InitializeResponseCapabilitiesInner
$creadPrec :: ReadPrec InitializeResponseCapabilitiesInner
readList :: ReadS [InitializeResponseCapabilitiesInner]
$creadList :: ReadS [InitializeResponseCapabilitiesInner]
readsPrec :: Int -> ReadS InitializeResponseCapabilitiesInner
$creadsPrec :: Int -> ReadS InitializeResponseCapabilitiesInner
Read, InitializeResponseCapabilitiesInner
-> InitializeResponseCapabilitiesInner -> Bool
(InitializeResponseCapabilitiesInner
 -> InitializeResponseCapabilitiesInner -> Bool)
-> (InitializeResponseCapabilitiesInner
    -> InitializeResponseCapabilitiesInner -> Bool)
-> Eq InitializeResponseCapabilitiesInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializeResponseCapabilitiesInner
-> InitializeResponseCapabilitiesInner -> Bool
$c/= :: InitializeResponseCapabilitiesInner
-> InitializeResponseCapabilitiesInner -> Bool
== :: InitializeResponseCapabilitiesInner
-> InitializeResponseCapabilitiesInner -> Bool
$c== :: InitializeResponseCapabilitiesInner
-> InitializeResponseCapabilitiesInner -> Bool
Eq)

deriveJSON lspOptions ''InitializeResponseCapabilitiesInner

-- ---------------------------------------------------------------------
-- |
--   Information about the capabilities of a language server
--
data InitializeResponseCapabilities =
  InitializeResponseCapabilities {
    InitializeResponseCapabilities
-> InitializeResponseCapabilitiesInner
_capabilities :: InitializeResponseCapabilitiesInner
  } deriving (Int -> InitializeResponseCapabilities -> ShowS
[InitializeResponseCapabilities] -> ShowS
InitializeResponseCapabilities -> String
(Int -> InitializeResponseCapabilities -> ShowS)
-> (InitializeResponseCapabilities -> String)
-> ([InitializeResponseCapabilities] -> ShowS)
-> Show InitializeResponseCapabilities
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitializeResponseCapabilities] -> ShowS
$cshowList :: [InitializeResponseCapabilities] -> ShowS
show :: InitializeResponseCapabilities -> String
$cshow :: InitializeResponseCapabilities -> String
showsPrec :: Int -> InitializeResponseCapabilities -> ShowS
$cshowsPrec :: Int -> InitializeResponseCapabilities -> ShowS
Show, ReadPrec [InitializeResponseCapabilities]
ReadPrec InitializeResponseCapabilities
Int -> ReadS InitializeResponseCapabilities
ReadS [InitializeResponseCapabilities]
(Int -> ReadS InitializeResponseCapabilities)
-> ReadS [InitializeResponseCapabilities]
-> ReadPrec InitializeResponseCapabilities
-> ReadPrec [InitializeResponseCapabilities]
-> Read InitializeResponseCapabilities
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InitializeResponseCapabilities]
$creadListPrec :: ReadPrec [InitializeResponseCapabilities]
readPrec :: ReadPrec InitializeResponseCapabilities
$creadPrec :: ReadPrec InitializeResponseCapabilities
readList :: ReadS [InitializeResponseCapabilities]
$creadList :: ReadS [InitializeResponseCapabilities]
readsPrec :: Int -> ReadS InitializeResponseCapabilities
$creadsPrec :: Int -> ReadS InitializeResponseCapabilities
Read, InitializeResponseCapabilities
-> InitializeResponseCapabilities -> Bool
(InitializeResponseCapabilities
 -> InitializeResponseCapabilities -> Bool)
-> (InitializeResponseCapabilities
    -> InitializeResponseCapabilities -> Bool)
-> Eq InitializeResponseCapabilities
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitializeResponseCapabilities
-> InitializeResponseCapabilities -> Bool
$c/= :: InitializeResponseCapabilities
-> InitializeResponseCapabilities -> Bool
== :: InitializeResponseCapabilities
-> InitializeResponseCapabilities -> Bool
$c== :: InitializeResponseCapabilities
-> InitializeResponseCapabilities -> Bool
Eq)

deriveJSON lspOptions ''InitializeResponseCapabilities

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

type InitializeResponse = ResponseMessage InitializeResponseCapabilities

type InitializeRequest = RequestMessage ClientMethod InitializeParams InitializeResponseCapabilities

{-
    error.code:

/**
 * Known error codes for an `InitializeError`;
 */
export namespace InitializeError {
        /**
         * If the protocol version provided by the client can't be handled by the server.
         * @deprecated This initialize error got replaced by client capabilities. There is
         * no version handshake in version 3.0x
         */
        export const unknownProtocolVersion: number = 1;
}

    error.data:

interface InitializeError {
        /**
         * Indicates whether the client execute the following retry logic:
         * (1) show the message provided by the ResponseError to the user
         * (2) user selects retry or cancel
         * (3) if user selected retry the initialize method is sent again.
         */
        retry: boolean;
}
-}

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

{-
New in 3.0
----------
Initialized Notification

The initialized notification is sent from the client to the server after the
client is fully initialized and is able to listen to arbritary requests and
notifications sent from the server.

Notification:

    method: 'initialized'
    params: void

-}

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

instance A.FromJSON InitializedParams where
  parseJSON :: Value -> Parser InitializedParams
parseJSON (A.Object Object
_) = InitializedParams -> Parser InitializedParams
forall (f :: * -> *) a. Applicative f => a -> f a
pure InitializedParams
InitializedParams
  parseJSON Value
_            = Parser InitializedParams
forall a. Monoid a => a
mempty

instance A.ToJSON InitializedParams where
  toJSON :: InitializedParams -> Value
toJSON InitializedParams
InitializedParams = Object -> Value
A.Object Object
forall a. Monoid a => a
mempty

type InitializedNotification = NotificationMessage ClientMethod (Maybe InitializedParams)

-- ---------------------------------------------------------------------
{-
Shutdown Request

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

The shutdown request is sent from the client to the server. It asks the server
to shut down, but to not exit (otherwise the response might not be delivered
correctly to the client). There is a separate exit notification that asks the
server to exit.

Request

    method: 'shutdown'
    params: undefined

Response

    result: undefined
    error: code and message set in case an exception happens during shutdown request.


-}

type ShutdownRequest  = RequestMessage ClientMethod (Maybe A.Value) (Maybe ())
type ShutdownResponse = ResponseMessage (Maybe ())

-- ---------------------------------------------------------------------
{-
Exit Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#exit-notification

A notification to ask the server to exit its process.

Notification

    method: 'exit'

-}

-- |
--   Notification from the server to actually exit now, after shutdown acked
--
data ExitParams =
  ExitParams
    {
    } deriving (Int -> ExitParams -> ShowS
[ExitParams] -> ShowS
ExitParams -> String
(Int -> ExitParams -> ShowS)
-> (ExitParams -> String)
-> ([ExitParams] -> ShowS)
-> Show ExitParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExitParams] -> ShowS
$cshowList :: [ExitParams] -> ShowS
show :: ExitParams -> String
$cshow :: ExitParams -> String
showsPrec :: Int -> ExitParams -> ShowS
$cshowsPrec :: Int -> ExitParams -> ShowS
Show, ReadPrec [ExitParams]
ReadPrec ExitParams
Int -> ReadS ExitParams
ReadS [ExitParams]
(Int -> ReadS ExitParams)
-> ReadS [ExitParams]
-> ReadPrec ExitParams
-> ReadPrec [ExitParams]
-> Read ExitParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExitParams]
$creadListPrec :: ReadPrec [ExitParams]
readPrec :: ReadPrec ExitParams
$creadPrec :: ReadPrec ExitParams
readList :: ReadS [ExitParams]
$creadList :: ReadS [ExitParams]
readsPrec :: Int -> ReadS ExitParams
$creadsPrec :: Int -> ReadS ExitParams
Read, ExitParams -> ExitParams -> Bool
(ExitParams -> ExitParams -> Bool)
-> (ExitParams -> ExitParams -> Bool) -> Eq ExitParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExitParams -> ExitParams -> Bool
$c/= :: ExitParams -> ExitParams -> Bool
== :: ExitParams -> ExitParams -> Bool
$c== :: ExitParams -> ExitParams -> Bool
Eq)

deriveJSON defaultOptions ''ExitParams

type ExitNotification = NotificationMessage ClientMethod (Maybe ExitParams)

-- ---------------------------------------------------------------------
{-
Telemetry Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#telemetry-notification

    New: The telemetry notification is sent from the server to the client to ask
    the client to log a telemetry event.

Notification:

    method: 'telemetry/event'
    params: 'any'
-}


type TelemetryNotification = NotificationMessage ServerMethod A.Value

type CustomClientNotification = NotificationMessage ClientMethod A.Value
type CustomServerNotification = NotificationMessage ServerMethod A.Value

type CustomClientRequest = RequestMessage ClientMethod A.Value A.Value
type CustomServerRequest = RequestMessage ServerMethod A.Value A.Value

type CustomResponse = ResponseMessage A.Value

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

Register Capability

The client/registerCapability request is sent from the server to the client to
register for a new capability on the client side. Not all clients need to
support dynamic capability registration. A client opts in via the
ClientCapabilities.dynamicRegistration property.

Request:

    method: 'client/registerCapability'
    params: RegistrationParams

Where RegistrationParams are defined as follows:

/**
 * General paramters to to regsiter for a capability.
 */
export interface Registration {
        /**
         * The id used to register the request. The id can be used to deregister
         * the request again.
         */
        id: string;

        /**
         * The method / capability to register for.
         */
        method: string;

        /**
         * Options necessary for the registration.
         */
        registerOptions?: any;
}

export interface RegistrationParams {
        registrations: Registration[];
}
-}

data Registration =
  Registration
    { -- |The id used to register the request. The id can be used to deregister
      -- the request again.
      Registration -> Text
_id              :: Text

       -- | The method / capability to register for.
    , Registration -> ClientMethod
_method          :: ClientMethod

      -- | Options necessary for the registration.
    , Registration -> Maybe Value
_registerOptions :: Maybe A.Value
    } deriving (Int -> Registration -> ShowS
[Registration] -> ShowS
Registration -> String
(Int -> Registration -> ShowS)
-> (Registration -> String)
-> ([Registration] -> ShowS)
-> Show Registration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Registration] -> ShowS
$cshowList :: [Registration] -> ShowS
show :: Registration -> String
$cshow :: Registration -> String
showsPrec :: Int -> Registration -> ShowS
$cshowsPrec :: Int -> Registration -> ShowS
Show, ReadPrec [Registration]
ReadPrec Registration
Int -> ReadS Registration
ReadS [Registration]
(Int -> ReadS Registration)
-> ReadS [Registration]
-> ReadPrec Registration
-> ReadPrec [Registration]
-> Read Registration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Registration]
$creadListPrec :: ReadPrec [Registration]
readPrec :: ReadPrec Registration
$creadPrec :: ReadPrec Registration
readList :: ReadS [Registration]
$creadList :: ReadS [Registration]
readsPrec :: Int -> ReadS Registration
$creadsPrec :: Int -> ReadS Registration
Read, Registration -> Registration -> Bool
(Registration -> Registration -> Bool)
-> (Registration -> Registration -> Bool) -> Eq Registration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Registration -> Registration -> Bool
$c/= :: Registration -> Registration -> Bool
== :: Registration -> Registration -> Bool
$c== :: Registration -> Registration -> Bool
Eq)

deriveJSON lspOptions ''Registration

data RegistrationParams =
  RegistrationParams
    { RegistrationParams -> List Registration
_registrations :: List Registration
    } deriving (Int -> RegistrationParams -> ShowS
[RegistrationParams] -> ShowS
RegistrationParams -> String
(Int -> RegistrationParams -> ShowS)
-> (RegistrationParams -> String)
-> ([RegistrationParams] -> ShowS)
-> Show RegistrationParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RegistrationParams] -> ShowS
$cshowList :: [RegistrationParams] -> ShowS
show :: RegistrationParams -> String
$cshow :: RegistrationParams -> String
showsPrec :: Int -> RegistrationParams -> ShowS
$cshowsPrec :: Int -> RegistrationParams -> ShowS
Show, ReadPrec [RegistrationParams]
ReadPrec RegistrationParams
Int -> ReadS RegistrationParams
ReadS [RegistrationParams]
(Int -> ReadS RegistrationParams)
-> ReadS [RegistrationParams]
-> ReadPrec RegistrationParams
-> ReadPrec [RegistrationParams]
-> Read RegistrationParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RegistrationParams]
$creadListPrec :: ReadPrec [RegistrationParams]
readPrec :: ReadPrec RegistrationParams
$creadPrec :: ReadPrec RegistrationParams
readList :: ReadS [RegistrationParams]
$creadList :: ReadS [RegistrationParams]
readsPrec :: Int -> ReadS RegistrationParams
$creadsPrec :: Int -> ReadS RegistrationParams
Read, RegistrationParams -> RegistrationParams -> Bool
(RegistrationParams -> RegistrationParams -> Bool)
-> (RegistrationParams -> RegistrationParams -> Bool)
-> Eq RegistrationParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RegistrationParams -> RegistrationParams -> Bool
$c/= :: RegistrationParams -> RegistrationParams -> Bool
== :: RegistrationParams -> RegistrationParams -> Bool
$c== :: RegistrationParams -> RegistrationParams -> Bool
Eq)

deriveJSON lspOptions ''RegistrationParams

-- |Note: originates at the server
type RegisterCapabilityRequest = RequestMessage ServerMethod RegistrationParams ()

type RegisterCapabilityResponse = ResponseMessage ()

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

{-
Since most of the registration options require to specify a document selector
there is a base interface that can be used.

export interface TextDocumentRegistrationOptions {
        /**
         * A document selector to identify the scope of the registration. If set to null
         * the document selector provided on the client side will be used.
         */
        documentSelector: DocumentSelector | null;
}
-}

data TextDocumentRegistrationOptions =
  TextDocumentRegistrationOptions
    { TextDocumentRegistrationOptions -> Maybe DocumentSelector
_documentSelector :: Maybe DocumentSelector
    } deriving (Int -> TextDocumentRegistrationOptions -> ShowS
[TextDocumentRegistrationOptions] -> ShowS
TextDocumentRegistrationOptions -> String
(Int -> TextDocumentRegistrationOptions -> ShowS)
-> (TextDocumentRegistrationOptions -> String)
-> ([TextDocumentRegistrationOptions] -> ShowS)
-> Show TextDocumentRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDocumentRegistrationOptions] -> ShowS
$cshowList :: [TextDocumentRegistrationOptions] -> ShowS
show :: TextDocumentRegistrationOptions -> String
$cshow :: TextDocumentRegistrationOptions -> String
showsPrec :: Int -> TextDocumentRegistrationOptions -> ShowS
$cshowsPrec :: Int -> TextDocumentRegistrationOptions -> ShowS
Show, ReadPrec [TextDocumentRegistrationOptions]
ReadPrec TextDocumentRegistrationOptions
Int -> ReadS TextDocumentRegistrationOptions
ReadS [TextDocumentRegistrationOptions]
(Int -> ReadS TextDocumentRegistrationOptions)
-> ReadS [TextDocumentRegistrationOptions]
-> ReadPrec TextDocumentRegistrationOptions
-> ReadPrec [TextDocumentRegistrationOptions]
-> Read TextDocumentRegistrationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextDocumentRegistrationOptions]
$creadListPrec :: ReadPrec [TextDocumentRegistrationOptions]
readPrec :: ReadPrec TextDocumentRegistrationOptions
$creadPrec :: ReadPrec TextDocumentRegistrationOptions
readList :: ReadS [TextDocumentRegistrationOptions]
$creadList :: ReadS [TextDocumentRegistrationOptions]
readsPrec :: Int -> ReadS TextDocumentRegistrationOptions
$creadsPrec :: Int -> ReadS TextDocumentRegistrationOptions
Read, TextDocumentRegistrationOptions
-> TextDocumentRegistrationOptions -> Bool
(TextDocumentRegistrationOptions
 -> TextDocumentRegistrationOptions -> Bool)
-> (TextDocumentRegistrationOptions
    -> TextDocumentRegistrationOptions -> Bool)
-> Eq TextDocumentRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDocumentRegistrationOptions
-> TextDocumentRegistrationOptions -> Bool
$c/= :: TextDocumentRegistrationOptions
-> TextDocumentRegistrationOptions -> Bool
== :: TextDocumentRegistrationOptions
-> TextDocumentRegistrationOptions -> Bool
$c== :: TextDocumentRegistrationOptions
-> TextDocumentRegistrationOptions -> Bool
Eq)

deriveJSON lspOptions ''TextDocumentRegistrationOptions

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

Unregister Capability

The client/unregisterCapability request is sent from the server to the client to
unregister a previously register capability.

Request:

    method: 'client/unregisterCapability'
    params: UnregistrationParams

Where UnregistrationParams are defined as follows:

/**
 * General parameters to unregister a capability.
 */
export interface Unregistration {
        /**
         * The id used to unregister the request or notification. Usually an id
         * provided during the register request.
         */
        id: string;

        /**
         * The method / capability to unregister for.
         */
        method: string;
}

export interface UnregistrationParams {
        unregisterations: Unregistration[];
}
-}

data Unregistration =
  Unregistration
    { -- | The id used to unregister the request or notification. Usually an id
      -- provided during the register request.
      Unregistration -> Text
_id     :: Text

       -- |The method / capability to unregister for.
    , Unregistration -> Text
_method :: Text
    } deriving (Int -> Unregistration -> ShowS
[Unregistration] -> ShowS
Unregistration -> String
(Int -> Unregistration -> ShowS)
-> (Unregistration -> String)
-> ([Unregistration] -> ShowS)
-> Show Unregistration
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Unregistration] -> ShowS
$cshowList :: [Unregistration] -> ShowS
show :: Unregistration -> String
$cshow :: Unregistration -> String
showsPrec :: Int -> Unregistration -> ShowS
$cshowsPrec :: Int -> Unregistration -> ShowS
Show, ReadPrec [Unregistration]
ReadPrec Unregistration
Int -> ReadS Unregistration
ReadS [Unregistration]
(Int -> ReadS Unregistration)
-> ReadS [Unregistration]
-> ReadPrec Unregistration
-> ReadPrec [Unregistration]
-> Read Unregistration
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Unregistration]
$creadListPrec :: ReadPrec [Unregistration]
readPrec :: ReadPrec Unregistration
$creadPrec :: ReadPrec Unregistration
readList :: ReadS [Unregistration]
$creadList :: ReadS [Unregistration]
readsPrec :: Int -> ReadS Unregistration
$creadsPrec :: Int -> ReadS Unregistration
Read, Unregistration -> Unregistration -> Bool
(Unregistration -> Unregistration -> Bool)
-> (Unregistration -> Unregistration -> Bool) -> Eq Unregistration
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Unregistration -> Unregistration -> Bool
$c/= :: Unregistration -> Unregistration -> Bool
== :: Unregistration -> Unregistration -> Bool
$c== :: Unregistration -> Unregistration -> Bool
Eq)

deriveJSON lspOptions ''Unregistration

data UnregistrationParams =
  UnregistrationParams
    { UnregistrationParams -> List Unregistration
_unregistrations :: List Unregistration
    } deriving (Int -> UnregistrationParams -> ShowS
[UnregistrationParams] -> ShowS
UnregistrationParams -> String
(Int -> UnregistrationParams -> ShowS)
-> (UnregistrationParams -> String)
-> ([UnregistrationParams] -> ShowS)
-> Show UnregistrationParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UnregistrationParams] -> ShowS
$cshowList :: [UnregistrationParams] -> ShowS
show :: UnregistrationParams -> String
$cshow :: UnregistrationParams -> String
showsPrec :: Int -> UnregistrationParams -> ShowS
$cshowsPrec :: Int -> UnregistrationParams -> ShowS
Show, ReadPrec [UnregistrationParams]
ReadPrec UnregistrationParams
Int -> ReadS UnregistrationParams
ReadS [UnregistrationParams]
(Int -> ReadS UnregistrationParams)
-> ReadS [UnregistrationParams]
-> ReadPrec UnregistrationParams
-> ReadPrec [UnregistrationParams]
-> Read UnregistrationParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UnregistrationParams]
$creadListPrec :: ReadPrec [UnregistrationParams]
readPrec :: ReadPrec UnregistrationParams
$creadPrec :: ReadPrec UnregistrationParams
readList :: ReadS [UnregistrationParams]
$creadList :: ReadS [UnregistrationParams]
readsPrec :: Int -> ReadS UnregistrationParams
$creadsPrec :: Int -> ReadS UnregistrationParams
Read, UnregistrationParams -> UnregistrationParams -> Bool
(UnregistrationParams -> UnregistrationParams -> Bool)
-> (UnregistrationParams -> UnregistrationParams -> Bool)
-> Eq UnregistrationParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UnregistrationParams -> UnregistrationParams -> Bool
$c/= :: UnregistrationParams -> UnregistrationParams -> Bool
== :: UnregistrationParams -> UnregistrationParams -> Bool
$c== :: UnregistrationParams -> UnregistrationParams -> Bool
Eq)

deriveJSON lspOptions ''UnregistrationParams

type UnregisterCapabilityRequest = RequestMessage ServerMethod UnregistrationParams ()

type UnregisterCapabilityResponse = ResponseMessage ()

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

-- /**
--  * Describe options to be used when registering for file system change events.
--  */
-- export interface DidChangeWatchedFilesRegistrationOptions {
-- 	/**
-- 	 * The watchers to register.
-- 	 */
-- 	watchers: FileSystemWatcher[];
-- }
--
-- export interface FileSystemWatcher {
-- 	/**
-- 	 * The  glob pattern to watch.
-- 	 *
-- 	 * Glob patterns can have the following syntax:
-- 	 * - `*` to match one or more characters in a path segment
-- 	 * - `?` to match on one character in a path segment
-- 	 * - `**` to match any number of path segments, including none
-- 	 * - `{}` to group conditions (e.g. `**​/*.{ts,js}` matches all TypeScript and JavaScript files)
-- 	 * - `[]` to declare a range of characters to match in a path segment (e.g., `example.[0-9]` to match on `example.0`, `example.1`, …)
-- 	 * - `[!...]` to negate a range of characters to match in a path segment (e.g., `example.[!0-9]` to match on `example.a`, `example.b`, but not `example.0`)
-- 	 */
-- 	globPattern: string;
--
-- 	/**
-- 	 * The kind of events of interest. If omitted it defaults
-- 	 * to WatchKind.Create | WatchKind.Change | WatchKind.Delete
-- 	 * which is 7.
-- 	 */
-- 	kind?: number;
-- }
--
-- export namespace WatchKind {
-- 	/**
-- 	 * Interested in create events.
-- 	 */
-- 	export const Create = 1;
--
-- 	/**
-- 	 * Interested in change events
-- 	 */
-- 	export const Change = 2;
--
-- 	/**
-- 	 * Interested in delete events
-- 	 */
-- 	export const Delete = 4;
-- }

data DidChangeWatchedFilesRegistrationOptions =
  DidChangeWatchedFilesRegistrationOptions {
    DidChangeWatchedFilesRegistrationOptions -> List FileSystemWatcher
_watchers :: List FileSystemWatcher
  } deriving (Int -> DidChangeWatchedFilesRegistrationOptions -> ShowS
[DidChangeWatchedFilesRegistrationOptions] -> ShowS
DidChangeWatchedFilesRegistrationOptions -> String
(Int -> DidChangeWatchedFilesRegistrationOptions -> ShowS)
-> (DidChangeWatchedFilesRegistrationOptions -> String)
-> ([DidChangeWatchedFilesRegistrationOptions] -> ShowS)
-> Show DidChangeWatchedFilesRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidChangeWatchedFilesRegistrationOptions] -> ShowS
$cshowList :: [DidChangeWatchedFilesRegistrationOptions] -> ShowS
show :: DidChangeWatchedFilesRegistrationOptions -> String
$cshow :: DidChangeWatchedFilesRegistrationOptions -> String
showsPrec :: Int -> DidChangeWatchedFilesRegistrationOptions -> ShowS
$cshowsPrec :: Int -> DidChangeWatchedFilesRegistrationOptions -> ShowS
Show, ReadPrec [DidChangeWatchedFilesRegistrationOptions]
ReadPrec DidChangeWatchedFilesRegistrationOptions
Int -> ReadS DidChangeWatchedFilesRegistrationOptions
ReadS [DidChangeWatchedFilesRegistrationOptions]
(Int -> ReadS DidChangeWatchedFilesRegistrationOptions)
-> ReadS [DidChangeWatchedFilesRegistrationOptions]
-> ReadPrec DidChangeWatchedFilesRegistrationOptions
-> ReadPrec [DidChangeWatchedFilesRegistrationOptions]
-> Read DidChangeWatchedFilesRegistrationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidChangeWatchedFilesRegistrationOptions]
$creadListPrec :: ReadPrec [DidChangeWatchedFilesRegistrationOptions]
readPrec :: ReadPrec DidChangeWatchedFilesRegistrationOptions
$creadPrec :: ReadPrec DidChangeWatchedFilesRegistrationOptions
readList :: ReadS [DidChangeWatchedFilesRegistrationOptions]
$creadList :: ReadS [DidChangeWatchedFilesRegistrationOptions]
readsPrec :: Int -> ReadS DidChangeWatchedFilesRegistrationOptions
$creadsPrec :: Int -> ReadS DidChangeWatchedFilesRegistrationOptions
Read, DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
(DidChangeWatchedFilesRegistrationOptions
 -> DidChangeWatchedFilesRegistrationOptions -> Bool)
-> (DidChangeWatchedFilesRegistrationOptions
    -> DidChangeWatchedFilesRegistrationOptions -> Bool)
-> Eq DidChangeWatchedFilesRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
$c/= :: DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
== :: DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
$c== :: DidChangeWatchedFilesRegistrationOptions
-> DidChangeWatchedFilesRegistrationOptions -> Bool
Eq)

data FileSystemWatcher =
  FileSystemWatcher {
    FileSystemWatcher -> String
_globPattern :: String,
    FileSystemWatcher -> Maybe WatchKind
_kind :: Maybe WatchKind
  } deriving (Int -> FileSystemWatcher -> ShowS
[FileSystemWatcher] -> ShowS
FileSystemWatcher -> String
(Int -> FileSystemWatcher -> ShowS)
-> (FileSystemWatcher -> String)
-> ([FileSystemWatcher] -> ShowS)
-> Show FileSystemWatcher
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileSystemWatcher] -> ShowS
$cshowList :: [FileSystemWatcher] -> ShowS
show :: FileSystemWatcher -> String
$cshow :: FileSystemWatcher -> String
showsPrec :: Int -> FileSystemWatcher -> ShowS
$cshowsPrec :: Int -> FileSystemWatcher -> ShowS
Show, ReadPrec [FileSystemWatcher]
ReadPrec FileSystemWatcher
Int -> ReadS FileSystemWatcher
ReadS [FileSystemWatcher]
(Int -> ReadS FileSystemWatcher)
-> ReadS [FileSystemWatcher]
-> ReadPrec FileSystemWatcher
-> ReadPrec [FileSystemWatcher]
-> Read FileSystemWatcher
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileSystemWatcher]
$creadListPrec :: ReadPrec [FileSystemWatcher]
readPrec :: ReadPrec FileSystemWatcher
$creadPrec :: ReadPrec FileSystemWatcher
readList :: ReadS [FileSystemWatcher]
$creadList :: ReadS [FileSystemWatcher]
readsPrec :: Int -> ReadS FileSystemWatcher
$creadsPrec :: Int -> ReadS FileSystemWatcher
Read, FileSystemWatcher -> FileSystemWatcher -> Bool
(FileSystemWatcher -> FileSystemWatcher -> Bool)
-> (FileSystemWatcher -> FileSystemWatcher -> Bool)
-> Eq FileSystemWatcher
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileSystemWatcher -> FileSystemWatcher -> Bool
$c/= :: FileSystemWatcher -> FileSystemWatcher -> Bool
== :: FileSystemWatcher -> FileSystemWatcher -> Bool
$c== :: FileSystemWatcher -> FileSystemWatcher -> Bool
Eq)

data WatchKind =
  WatchKind {
    -- | Watch for create events
    WatchKind -> Bool
_watchCreate :: Bool,
    -- | Watch for change events
    WatchKind -> Bool
_watchChange :: Bool,
    -- | Watch for delete events
    WatchKind -> Bool
_watchDelete :: Bool
  } deriving (Int -> WatchKind -> ShowS
[WatchKind] -> ShowS
WatchKind -> String
(Int -> WatchKind -> ShowS)
-> (WatchKind -> String)
-> ([WatchKind] -> ShowS)
-> Show WatchKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WatchKind] -> ShowS
$cshowList :: [WatchKind] -> ShowS
show :: WatchKind -> String
$cshow :: WatchKind -> String
showsPrec :: Int -> WatchKind -> ShowS
$cshowsPrec :: Int -> WatchKind -> ShowS
Show, ReadPrec [WatchKind]
ReadPrec WatchKind
Int -> ReadS WatchKind
ReadS [WatchKind]
(Int -> ReadS WatchKind)
-> ReadS [WatchKind]
-> ReadPrec WatchKind
-> ReadPrec [WatchKind]
-> Read WatchKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WatchKind]
$creadListPrec :: ReadPrec [WatchKind]
readPrec :: ReadPrec WatchKind
$creadPrec :: ReadPrec WatchKind
readList :: ReadS [WatchKind]
$creadList :: ReadS [WatchKind]
readsPrec :: Int -> ReadS WatchKind
$creadsPrec :: Int -> ReadS WatchKind
Read, WatchKind -> WatchKind -> Bool
(WatchKind -> WatchKind -> Bool)
-> (WatchKind -> WatchKind -> Bool) -> Eq WatchKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WatchKind -> WatchKind -> Bool
$c/= :: WatchKind -> WatchKind -> Bool
== :: WatchKind -> WatchKind -> Bool
$c== :: WatchKind -> WatchKind -> Bool
Eq)

instance A.ToJSON WatchKind where
  toJSON :: WatchKind -> Value
toJSON WatchKind
wk = Scientific -> Value
A.Number (Scientific
createNum Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Scientific
changeNum Scientific -> Scientific -> Scientific
forall a. Num a => a -> a -> a
+ Scientific
deleteNum)
    where
      createNum :: Scientific
createNum = if WatchKind -> Bool
_watchCreate WatchKind
wk then Scientific
0x1 else Scientific
0x0
      changeNum :: Scientific
changeNum = if WatchKind -> Bool
_watchChange WatchKind
wk then Scientific
0x2 else Scientific
0x0
      deleteNum :: Scientific
deleteNum = if WatchKind -> Bool
_watchDelete WatchKind
wk then Scientific
0x4 else Scientific
0x0

instance A.FromJSON WatchKind where
  parseJSON :: Value -> Parser WatchKind
parseJSON (A.Number Scientific
n)
    | Right Int
i <- Scientific -> Either Double Int
forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger Scientific
n :: Either Double Int
    , Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 =
        WatchKind -> Parser WatchKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WatchKind -> Parser WatchKind) -> WatchKind -> Parser WatchKind
forall a b. (a -> b) -> a -> b
$ Bool -> Bool -> Bool -> WatchKind
WatchKind (Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
i Int
0x0) (Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
i Int
0x1) (Int -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
testBit Int
i Int
0x2)
    | Bool
otherwise = Parser WatchKind
forall a. Monoid a => a
mempty
  parseJSON Value
_            = Parser WatchKind
forall a. Monoid a => a
mempty

deriveJSON lspOptions ''FileSystemWatcher
deriveJSON lspOptions ''DidChangeWatchedFilesRegistrationOptions

-- ---------------------------------------------------------------------
{-
DidChangeConfiguration Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didchangeconfiguration-notification

A notification sent from the client to the server to signal the change of
configuration settings.

Notification:

    method: 'workspace/didChangeConfiguration',
    params: DidChangeConfigurationParams defined as follows:

interface DidChangeConfigurationParams {
    /**
     * The actual changed settings
     */
    settings: any;
}
-}

data DidChangeConfigurationParams =
  DidChangeConfigurationParams {
    DidChangeConfigurationParams -> Value
_settings :: A.Value
  } deriving (Int -> DidChangeConfigurationParams -> ShowS
[DidChangeConfigurationParams] -> ShowS
DidChangeConfigurationParams -> String
(Int -> DidChangeConfigurationParams -> ShowS)
-> (DidChangeConfigurationParams -> String)
-> ([DidChangeConfigurationParams] -> ShowS)
-> Show DidChangeConfigurationParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidChangeConfigurationParams] -> ShowS
$cshowList :: [DidChangeConfigurationParams] -> ShowS
show :: DidChangeConfigurationParams -> String
$cshow :: DidChangeConfigurationParams -> String
showsPrec :: Int -> DidChangeConfigurationParams -> ShowS
$cshowsPrec :: Int -> DidChangeConfigurationParams -> ShowS
Show, ReadPrec [DidChangeConfigurationParams]
ReadPrec DidChangeConfigurationParams
Int -> ReadS DidChangeConfigurationParams
ReadS [DidChangeConfigurationParams]
(Int -> ReadS DidChangeConfigurationParams)
-> ReadS [DidChangeConfigurationParams]
-> ReadPrec DidChangeConfigurationParams
-> ReadPrec [DidChangeConfigurationParams]
-> Read DidChangeConfigurationParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidChangeConfigurationParams]
$creadListPrec :: ReadPrec [DidChangeConfigurationParams]
readPrec :: ReadPrec DidChangeConfigurationParams
$creadPrec :: ReadPrec DidChangeConfigurationParams
readList :: ReadS [DidChangeConfigurationParams]
$creadList :: ReadS [DidChangeConfigurationParams]
readsPrec :: Int -> ReadS DidChangeConfigurationParams
$creadsPrec :: Int -> ReadS DidChangeConfigurationParams
Read, DidChangeConfigurationParams
-> DidChangeConfigurationParams -> Bool
(DidChangeConfigurationParams
 -> DidChangeConfigurationParams -> Bool)
-> (DidChangeConfigurationParams
    -> DidChangeConfigurationParams -> Bool)
-> Eq DidChangeConfigurationParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidChangeConfigurationParams
-> DidChangeConfigurationParams -> Bool
$c/= :: DidChangeConfigurationParams
-> DidChangeConfigurationParams -> Bool
== :: DidChangeConfigurationParams
-> DidChangeConfigurationParams -> Bool
$c== :: DidChangeConfigurationParams
-> DidChangeConfigurationParams -> Bool
Eq)

deriveJSON lspOptions ''DidChangeConfigurationParams

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

type DidChangeConfigurationNotification = NotificationMessage ClientMethod DidChangeConfigurationParams

{-
Configuration Request (:arrow_right_hook:)
Since version 3.6.0

The workspace/configuration request is sent from the server to the client to
fetch configuration settings from the client. The request can fetch n
configuration settings in one roundtrip. The order of the returned configuration
settings correspond to the order of the passed ConfigurationItems (e.g. the
first item in the response is the result for the first configuration item in the
params).

A ConfigurationItem consist of the configuration section to ask for and an
additional scope URI. The configuration section ask for is defined by the server
and doesn’t necessarily need to correspond to the configuration store used be
the client. So a server might ask for a configuration cpp.formatterOptions but
the client stores the configuration in a XML store layout differently. It is up
to the client to do the necessary conversion. If a scope URI is provided the
client should return the setting scoped to the provided resource. If the client
for example uses EditorConfig to manage its settings the configuration should be
returned for the passed resource URI. If the client can’t provide a
configuration setting for a given scope then null need to be present in the
returned array.

Request:

method: ‘workspace/configuration’
params: ConfigurationParams defined as follows
export interface ConfigurationParams {
        items: ConfigurationItem[];
}

export interface ConfigurationItem {
        /**
         * The scope to get the configuration section for.
         */
        scopeUri?: string;

        /**
         * The configuration section asked for.
         */
        section?: string;
}
Response:

result: any[]
error: code and message set in case an exception happens during the
‘workspace/configuration’ request
-}

data ConfigurationItem =
  ConfigurationItem
    { ConfigurationItem -> Maybe Text
_scopeUri :: Maybe Text -- ^ The scope to get the configuration section for.
    , ConfigurationItem -> Maybe Text
_section  :: Maybe Text -- ^ The configuration section asked for.
    } deriving (Int -> ConfigurationItem -> ShowS
[ConfigurationItem] -> ShowS
ConfigurationItem -> String
(Int -> ConfigurationItem -> ShowS)
-> (ConfigurationItem -> String)
-> ([ConfigurationItem] -> ShowS)
-> Show ConfigurationItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationItem] -> ShowS
$cshowList :: [ConfigurationItem] -> ShowS
show :: ConfigurationItem -> String
$cshow :: ConfigurationItem -> String
showsPrec :: Int -> ConfigurationItem -> ShowS
$cshowsPrec :: Int -> ConfigurationItem -> ShowS
Show, ReadPrec [ConfigurationItem]
ReadPrec ConfigurationItem
Int -> ReadS ConfigurationItem
ReadS [ConfigurationItem]
(Int -> ReadS ConfigurationItem)
-> ReadS [ConfigurationItem]
-> ReadPrec ConfigurationItem
-> ReadPrec [ConfigurationItem]
-> Read ConfigurationItem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfigurationItem]
$creadListPrec :: ReadPrec [ConfigurationItem]
readPrec :: ReadPrec ConfigurationItem
$creadPrec :: ReadPrec ConfigurationItem
readList :: ReadS [ConfigurationItem]
$creadList :: ReadS [ConfigurationItem]
readsPrec :: Int -> ReadS ConfigurationItem
$creadsPrec :: Int -> ReadS ConfigurationItem
Read, ConfigurationItem -> ConfigurationItem -> Bool
(ConfigurationItem -> ConfigurationItem -> Bool)
-> (ConfigurationItem -> ConfigurationItem -> Bool)
-> Eq ConfigurationItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationItem -> ConfigurationItem -> Bool
$c/= :: ConfigurationItem -> ConfigurationItem -> Bool
== :: ConfigurationItem -> ConfigurationItem -> Bool
$c== :: ConfigurationItem -> ConfigurationItem -> Bool
Eq)

deriveJSON lspOptions ''ConfigurationItem

data ConfigurationParams =
  ConfigurationParams
    { ConfigurationParams -> List ConfigurationItem
_items :: List ConfigurationItem
    } deriving (Int -> ConfigurationParams -> ShowS
[ConfigurationParams] -> ShowS
ConfigurationParams -> String
(Int -> ConfigurationParams -> ShowS)
-> (ConfigurationParams -> String)
-> ([ConfigurationParams] -> ShowS)
-> Show ConfigurationParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConfigurationParams] -> ShowS
$cshowList :: [ConfigurationParams] -> ShowS
show :: ConfigurationParams -> String
$cshow :: ConfigurationParams -> String
showsPrec :: Int -> ConfigurationParams -> ShowS
$cshowsPrec :: Int -> ConfigurationParams -> ShowS
Show, ReadPrec [ConfigurationParams]
ReadPrec ConfigurationParams
Int -> ReadS ConfigurationParams
ReadS [ConfigurationParams]
(Int -> ReadS ConfigurationParams)
-> ReadS [ConfigurationParams]
-> ReadPrec ConfigurationParams
-> ReadPrec [ConfigurationParams]
-> Read ConfigurationParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConfigurationParams]
$creadListPrec :: ReadPrec [ConfigurationParams]
readPrec :: ReadPrec ConfigurationParams
$creadPrec :: ReadPrec ConfigurationParams
readList :: ReadS [ConfigurationParams]
$creadList :: ReadS [ConfigurationParams]
readsPrec :: Int -> ReadS ConfigurationParams
$creadsPrec :: Int -> ReadS ConfigurationParams
Read, ConfigurationParams -> ConfigurationParams -> Bool
(ConfigurationParams -> ConfigurationParams -> Bool)
-> (ConfigurationParams -> ConfigurationParams -> Bool)
-> Eq ConfigurationParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConfigurationParams -> ConfigurationParams -> Bool
$c/= :: ConfigurationParams -> ConfigurationParams -> Bool
== :: ConfigurationParams -> ConfigurationParams -> Bool
$c== :: ConfigurationParams -> ConfigurationParams -> Bool
Eq)

deriveJSON lspOptions ''ConfigurationParams

type ConfigurationRequest = RequestMessage ServerMethod ConfigurationParams (List A.Value)
type ConfigurationResponse = ResponseMessage (List A.Value)

-- ---------------------------------------------------------------------
{-
DidOpenTextDocument Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didopentextdocument-notification

The document open notification is sent from the client to the server to signal
newly opened text documents. The document's truth is now managed by the client
and the server must not try to read the document's truth using the document's
uri.

Notification:

    method: 'textDocument/didOpen'
    params: DidOpenTextDocumentParams defined as follows:

interface DidOpenTextDocumentParams {
    /**
     * The document that was opened.
     */
    textDocument: TextDocumentItem;
}

Registration Options: TextDocumentRegistrationOptions
-}

data DidOpenTextDocumentParams =
  DidOpenTextDocumentParams {
    DidOpenTextDocumentParams -> TextDocumentItem
_textDocument :: TextDocumentItem
  } deriving (Int -> DidOpenTextDocumentParams -> ShowS
[DidOpenTextDocumentParams] -> ShowS
DidOpenTextDocumentParams -> String
(Int -> DidOpenTextDocumentParams -> ShowS)
-> (DidOpenTextDocumentParams -> String)
-> ([DidOpenTextDocumentParams] -> ShowS)
-> Show DidOpenTextDocumentParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidOpenTextDocumentParams] -> ShowS
$cshowList :: [DidOpenTextDocumentParams] -> ShowS
show :: DidOpenTextDocumentParams -> String
$cshow :: DidOpenTextDocumentParams -> String
showsPrec :: Int -> DidOpenTextDocumentParams -> ShowS
$cshowsPrec :: Int -> DidOpenTextDocumentParams -> ShowS
Show, ReadPrec [DidOpenTextDocumentParams]
ReadPrec DidOpenTextDocumentParams
Int -> ReadS DidOpenTextDocumentParams
ReadS [DidOpenTextDocumentParams]
(Int -> ReadS DidOpenTextDocumentParams)
-> ReadS [DidOpenTextDocumentParams]
-> ReadPrec DidOpenTextDocumentParams
-> ReadPrec [DidOpenTextDocumentParams]
-> Read DidOpenTextDocumentParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidOpenTextDocumentParams]
$creadListPrec :: ReadPrec [DidOpenTextDocumentParams]
readPrec :: ReadPrec DidOpenTextDocumentParams
$creadPrec :: ReadPrec DidOpenTextDocumentParams
readList :: ReadS [DidOpenTextDocumentParams]
$creadList :: ReadS [DidOpenTextDocumentParams]
readsPrec :: Int -> ReadS DidOpenTextDocumentParams
$creadsPrec :: Int -> ReadS DidOpenTextDocumentParams
Read, DidOpenTextDocumentParams -> DidOpenTextDocumentParams -> Bool
(DidOpenTextDocumentParams -> DidOpenTextDocumentParams -> Bool)
-> (DidOpenTextDocumentParams -> DidOpenTextDocumentParams -> Bool)
-> Eq DidOpenTextDocumentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidOpenTextDocumentParams -> DidOpenTextDocumentParams -> Bool
$c/= :: DidOpenTextDocumentParams -> DidOpenTextDocumentParams -> Bool
== :: DidOpenTextDocumentParams -> DidOpenTextDocumentParams -> Bool
$c== :: DidOpenTextDocumentParams -> DidOpenTextDocumentParams -> Bool
Eq)

deriveJSON lspOptions ''DidOpenTextDocumentParams

type DidOpenTextDocumentNotification = NotificationMessage ClientMethod DidOpenTextDocumentParams

-- ---------------------------------------------------------------------
{-
DidChangeTextDocument Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didchangetextdocument-notification

    Changed: The document change notification is sent from the client to the
    server to signal changes to a text document. In 2.0 the shape of the params
    has changed to include proper version numbers and language ids.

Notification:

    method: 'textDocument/didChange'
    params: DidChangeTextDocumentParams defined as follows:

interface DidChangeTextDocumentParams {
    /**
     * The document that did change. The version number points
     * to the version after all provided content changes have
     * been applied.
     */
    textDocument: VersionedTextDocumentIdentifier;

    /**
     * The actual content changes.
     */
    contentChanges: TextDocumentContentChangeEvent[];
}

/**
 * An event describing a change to a text document. If range and rangeLength are omitted
 * the new text is considered to be the full content of the document.
 */
interface TextDocumentContentChangeEvent {
    /**
     * The range of the document that changed.
     */
    range?: Range;

    /**
     * The length of the range that got replaced.
     */
    rangeLength?: number;

    /**
     * The new text of the document.
     */
    text: string;
}
-}
data TextDocumentContentChangeEvent =
  TextDocumentContentChangeEvent
    { TextDocumentContentChangeEvent -> Maybe Range
_range       :: Maybe Range
    , TextDocumentContentChangeEvent -> Maybe Int
_rangeLength :: Maybe Int
    , TextDocumentContentChangeEvent -> Text
_text        :: Text
    } deriving (ReadPrec [TextDocumentContentChangeEvent]
ReadPrec TextDocumentContentChangeEvent
Int -> ReadS TextDocumentContentChangeEvent
ReadS [TextDocumentContentChangeEvent]
(Int -> ReadS TextDocumentContentChangeEvent)
-> ReadS [TextDocumentContentChangeEvent]
-> ReadPrec TextDocumentContentChangeEvent
-> ReadPrec [TextDocumentContentChangeEvent]
-> Read TextDocumentContentChangeEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextDocumentContentChangeEvent]
$creadListPrec :: ReadPrec [TextDocumentContentChangeEvent]
readPrec :: ReadPrec TextDocumentContentChangeEvent
$creadPrec :: ReadPrec TextDocumentContentChangeEvent
readList :: ReadS [TextDocumentContentChangeEvent]
$creadList :: ReadS [TextDocumentContentChangeEvent]
readsPrec :: Int -> ReadS TextDocumentContentChangeEvent
$creadsPrec :: Int -> ReadS TextDocumentContentChangeEvent
Read,Int -> TextDocumentContentChangeEvent -> ShowS
[TextDocumentContentChangeEvent] -> ShowS
TextDocumentContentChangeEvent -> String
(Int -> TextDocumentContentChangeEvent -> ShowS)
-> (TextDocumentContentChangeEvent -> String)
-> ([TextDocumentContentChangeEvent] -> ShowS)
-> Show TextDocumentContentChangeEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDocumentContentChangeEvent] -> ShowS
$cshowList :: [TextDocumentContentChangeEvent] -> ShowS
show :: TextDocumentContentChangeEvent -> String
$cshow :: TextDocumentContentChangeEvent -> String
showsPrec :: Int -> TextDocumentContentChangeEvent -> ShowS
$cshowsPrec :: Int -> TextDocumentContentChangeEvent -> ShowS
Show,TextDocumentContentChangeEvent
-> TextDocumentContentChangeEvent -> Bool
(TextDocumentContentChangeEvent
 -> TextDocumentContentChangeEvent -> Bool)
-> (TextDocumentContentChangeEvent
    -> TextDocumentContentChangeEvent -> Bool)
-> Eq TextDocumentContentChangeEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDocumentContentChangeEvent
-> TextDocumentContentChangeEvent -> Bool
$c/= :: TextDocumentContentChangeEvent
-> TextDocumentContentChangeEvent -> Bool
== :: TextDocumentContentChangeEvent
-> TextDocumentContentChangeEvent -> Bool
$c== :: TextDocumentContentChangeEvent
-> TextDocumentContentChangeEvent -> Bool
Eq)

deriveJSON lspOptions { omitNothingFields = True } ''TextDocumentContentChangeEvent

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

data DidChangeTextDocumentParams =
  DidChangeTextDocumentParams
    { DidChangeTextDocumentParams -> VersionedTextDocumentIdentifier
_textDocument   :: VersionedTextDocumentIdentifier
    , DidChangeTextDocumentParams -> List TextDocumentContentChangeEvent
_contentChanges :: List TextDocumentContentChangeEvent
    } deriving (Int -> DidChangeTextDocumentParams -> ShowS
[DidChangeTextDocumentParams] -> ShowS
DidChangeTextDocumentParams -> String
(Int -> DidChangeTextDocumentParams -> ShowS)
-> (DidChangeTextDocumentParams -> String)
-> ([DidChangeTextDocumentParams] -> ShowS)
-> Show DidChangeTextDocumentParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidChangeTextDocumentParams] -> ShowS
$cshowList :: [DidChangeTextDocumentParams] -> ShowS
show :: DidChangeTextDocumentParams -> String
$cshow :: DidChangeTextDocumentParams -> String
showsPrec :: Int -> DidChangeTextDocumentParams -> ShowS
$cshowsPrec :: Int -> DidChangeTextDocumentParams -> ShowS
Show,ReadPrec [DidChangeTextDocumentParams]
ReadPrec DidChangeTextDocumentParams
Int -> ReadS DidChangeTextDocumentParams
ReadS [DidChangeTextDocumentParams]
(Int -> ReadS DidChangeTextDocumentParams)
-> ReadS [DidChangeTextDocumentParams]
-> ReadPrec DidChangeTextDocumentParams
-> ReadPrec [DidChangeTextDocumentParams]
-> Read DidChangeTextDocumentParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidChangeTextDocumentParams]
$creadListPrec :: ReadPrec [DidChangeTextDocumentParams]
readPrec :: ReadPrec DidChangeTextDocumentParams
$creadPrec :: ReadPrec DidChangeTextDocumentParams
readList :: ReadS [DidChangeTextDocumentParams]
$creadList :: ReadS [DidChangeTextDocumentParams]
readsPrec :: Int -> ReadS DidChangeTextDocumentParams
$creadsPrec :: Int -> ReadS DidChangeTextDocumentParams
Read,DidChangeTextDocumentParams -> DidChangeTextDocumentParams -> Bool
(DidChangeTextDocumentParams
 -> DidChangeTextDocumentParams -> Bool)
-> (DidChangeTextDocumentParams
    -> DidChangeTextDocumentParams -> Bool)
-> Eq DidChangeTextDocumentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidChangeTextDocumentParams -> DidChangeTextDocumentParams -> Bool
$c/= :: DidChangeTextDocumentParams -> DidChangeTextDocumentParams -> Bool
== :: DidChangeTextDocumentParams -> DidChangeTextDocumentParams -> Bool
$c== :: DidChangeTextDocumentParams -> DidChangeTextDocumentParams -> Bool
Eq)

deriveJSON lspOptions ''DidChangeTextDocumentParams

type DidChangeTextDocumentNotification = NotificationMessage ClientMethod DidChangeTextDocumentParams
{-
New in 3.0
----------

Registration Options: TextDocumentChangeRegistrationOptions defined as follows:

/**
 * Descibe options to be used when registered for text document change events.
 */
export interface TextDocumentChangeRegistrationOptions extends TextDocumentRegistrationOptions {
        /**
         * How documents are synced to the server. See TextDocumentSyncKind.Full
         * and TextDocumentSyncKindIncremental.
         */
        syncKind: number;
}
-}

data TextDocumentChangeRegistrationOptions =
  TextDocumentChangeRegistrationOptions
    { TextDocumentChangeRegistrationOptions -> Maybe DocumentSelector
_documentSelector :: Maybe DocumentSelector
    , TextDocumentChangeRegistrationOptions -> TextDocumentSyncKind
_syncKind         :: TextDocumentSyncKind
    } deriving (Int -> TextDocumentChangeRegistrationOptions -> ShowS
[TextDocumentChangeRegistrationOptions] -> ShowS
TextDocumentChangeRegistrationOptions -> String
(Int -> TextDocumentChangeRegistrationOptions -> ShowS)
-> (TextDocumentChangeRegistrationOptions -> String)
-> ([TextDocumentChangeRegistrationOptions] -> ShowS)
-> Show TextDocumentChangeRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDocumentChangeRegistrationOptions] -> ShowS
$cshowList :: [TextDocumentChangeRegistrationOptions] -> ShowS
show :: TextDocumentChangeRegistrationOptions -> String
$cshow :: TextDocumentChangeRegistrationOptions -> String
showsPrec :: Int -> TextDocumentChangeRegistrationOptions -> ShowS
$cshowsPrec :: Int -> TextDocumentChangeRegistrationOptions -> ShowS
Show, ReadPrec [TextDocumentChangeRegistrationOptions]
ReadPrec TextDocumentChangeRegistrationOptions
Int -> ReadS TextDocumentChangeRegistrationOptions
ReadS [TextDocumentChangeRegistrationOptions]
(Int -> ReadS TextDocumentChangeRegistrationOptions)
-> ReadS [TextDocumentChangeRegistrationOptions]
-> ReadPrec TextDocumentChangeRegistrationOptions
-> ReadPrec [TextDocumentChangeRegistrationOptions]
-> Read TextDocumentChangeRegistrationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextDocumentChangeRegistrationOptions]
$creadListPrec :: ReadPrec [TextDocumentChangeRegistrationOptions]
readPrec :: ReadPrec TextDocumentChangeRegistrationOptions
$creadPrec :: ReadPrec TextDocumentChangeRegistrationOptions
readList :: ReadS [TextDocumentChangeRegistrationOptions]
$creadList :: ReadS [TextDocumentChangeRegistrationOptions]
readsPrec :: Int -> ReadS TextDocumentChangeRegistrationOptions
$creadsPrec :: Int -> ReadS TextDocumentChangeRegistrationOptions
Read, TextDocumentChangeRegistrationOptions
-> TextDocumentChangeRegistrationOptions -> Bool
(TextDocumentChangeRegistrationOptions
 -> TextDocumentChangeRegistrationOptions -> Bool)
-> (TextDocumentChangeRegistrationOptions
    -> TextDocumentChangeRegistrationOptions -> Bool)
-> Eq TextDocumentChangeRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDocumentChangeRegistrationOptions
-> TextDocumentChangeRegistrationOptions -> Bool
$c/= :: TextDocumentChangeRegistrationOptions
-> TextDocumentChangeRegistrationOptions -> Bool
== :: TextDocumentChangeRegistrationOptions
-> TextDocumentChangeRegistrationOptions -> Bool
$c== :: TextDocumentChangeRegistrationOptions
-> TextDocumentChangeRegistrationOptions -> Bool
Eq)

deriveJSON lspOptions ''TextDocumentChangeRegistrationOptions

-- ---------------------------------------------------------------------
{-

New in 3.0
----------

WillSaveTextDocument Notification

The document will save notification is sent from the client to the server before
the document is actually saved.

Notification:

    method: 'textDocument/willSave'
    params: WillSaveTextDocumentParams defined as follows:

/**
 * The parameters send in a will save text document notification.
 */
export interface WillSaveTextDocumentParams {
        /**
         * The document that will be saved.
         */
        textDocument: TextDocumentIdentifier;

        /**
         * The 'TextDocumentSaveReason'.
         */
        reason: number;
}

/**
 * Represents reasons why a text document is saved.
 */
export namespace TextDocumentSaveReason {

        /**
         * Manually triggered, e.g. by the user pressing save, by starting debugging,
         * or by an API call.
         */
        export const Manual = 1;

        /**
         * Automatic after a delay.
         */
        export const AfterDelay = 2;

        /**
         * When the editor lost focus.
         */
        export const FocusOut = 3;
}
Registration Options: TextDocumentRegistrationOptions
-}

data TextDocumentSaveReason
  = SaveManual
         -- ^ Manually triggered, e.g. by the user pressing save, by starting
         -- debugging, or by an API call.
  | SaveAfterDelay -- ^ Automatic after a delay
  | SaveFocusOut   -- ^ When the editor lost focus
  deriving (Int -> TextDocumentSaveReason -> ShowS
[TextDocumentSaveReason] -> ShowS
TextDocumentSaveReason -> String
(Int -> TextDocumentSaveReason -> ShowS)
-> (TextDocumentSaveReason -> String)
-> ([TextDocumentSaveReason] -> ShowS)
-> Show TextDocumentSaveReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TextDocumentSaveReason] -> ShowS
$cshowList :: [TextDocumentSaveReason] -> ShowS
show :: TextDocumentSaveReason -> String
$cshow :: TextDocumentSaveReason -> String
showsPrec :: Int -> TextDocumentSaveReason -> ShowS
$cshowsPrec :: Int -> TextDocumentSaveReason -> ShowS
Show, ReadPrec [TextDocumentSaveReason]
ReadPrec TextDocumentSaveReason
Int -> ReadS TextDocumentSaveReason
ReadS [TextDocumentSaveReason]
(Int -> ReadS TextDocumentSaveReason)
-> ReadS [TextDocumentSaveReason]
-> ReadPrec TextDocumentSaveReason
-> ReadPrec [TextDocumentSaveReason]
-> Read TextDocumentSaveReason
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TextDocumentSaveReason]
$creadListPrec :: ReadPrec [TextDocumentSaveReason]
readPrec :: ReadPrec TextDocumentSaveReason
$creadPrec :: ReadPrec TextDocumentSaveReason
readList :: ReadS [TextDocumentSaveReason]
$creadList :: ReadS [TextDocumentSaveReason]
readsPrec :: Int -> ReadS TextDocumentSaveReason
$creadsPrec :: Int -> ReadS TextDocumentSaveReason
Read, TextDocumentSaveReason -> TextDocumentSaveReason -> Bool
(TextDocumentSaveReason -> TextDocumentSaveReason -> Bool)
-> (TextDocumentSaveReason -> TextDocumentSaveReason -> Bool)
-> Eq TextDocumentSaveReason
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TextDocumentSaveReason -> TextDocumentSaveReason -> Bool
$c/= :: TextDocumentSaveReason -> TextDocumentSaveReason -> Bool
== :: TextDocumentSaveReason -> TextDocumentSaveReason -> Bool
$c== :: TextDocumentSaveReason -> TextDocumentSaveReason -> Bool
Eq)

instance A.ToJSON TextDocumentSaveReason where
  toJSON :: TextDocumentSaveReason -> Value
toJSON TextDocumentSaveReason
SaveManual     = Scientific -> Value
A.Number Scientific
1
  toJSON TextDocumentSaveReason
SaveAfterDelay = Scientific -> Value
A.Number Scientific
2
  toJSON TextDocumentSaveReason
SaveFocusOut   = Scientific -> Value
A.Number Scientific
3

instance A.FromJSON TextDocumentSaveReason where
  parseJSON :: Value -> Parser TextDocumentSaveReason
parseJSON (A.Number Scientific
1) = TextDocumentSaveReason -> Parser TextDocumentSaveReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextDocumentSaveReason
SaveManual
  parseJSON (A.Number Scientific
2) = TextDocumentSaveReason -> Parser TextDocumentSaveReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextDocumentSaveReason
SaveAfterDelay
  parseJSON (A.Number Scientific
3) = TextDocumentSaveReason -> Parser TextDocumentSaveReason
forall (f :: * -> *) a. Applicative f => a -> f a
pure TextDocumentSaveReason
SaveFocusOut
  parseJSON Value
_            = Parser TextDocumentSaveReason
forall a. Monoid a => a
mempty

data WillSaveTextDocumentParams =
  WillSaveTextDocumentParams
    { WillSaveTextDocumentParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
    , WillSaveTextDocumentParams -> TextDocumentSaveReason
_reason       :: TextDocumentSaveReason
    } deriving (Int -> WillSaveTextDocumentParams -> ShowS
[WillSaveTextDocumentParams] -> ShowS
WillSaveTextDocumentParams -> String
(Int -> WillSaveTextDocumentParams -> ShowS)
-> (WillSaveTextDocumentParams -> String)
-> ([WillSaveTextDocumentParams] -> ShowS)
-> Show WillSaveTextDocumentParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WillSaveTextDocumentParams] -> ShowS
$cshowList :: [WillSaveTextDocumentParams] -> ShowS
show :: WillSaveTextDocumentParams -> String
$cshow :: WillSaveTextDocumentParams -> String
showsPrec :: Int -> WillSaveTextDocumentParams -> ShowS
$cshowsPrec :: Int -> WillSaveTextDocumentParams -> ShowS
Show, ReadPrec [WillSaveTextDocumentParams]
ReadPrec WillSaveTextDocumentParams
Int -> ReadS WillSaveTextDocumentParams
ReadS [WillSaveTextDocumentParams]
(Int -> ReadS WillSaveTextDocumentParams)
-> ReadS [WillSaveTextDocumentParams]
-> ReadPrec WillSaveTextDocumentParams
-> ReadPrec [WillSaveTextDocumentParams]
-> Read WillSaveTextDocumentParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WillSaveTextDocumentParams]
$creadListPrec :: ReadPrec [WillSaveTextDocumentParams]
readPrec :: ReadPrec WillSaveTextDocumentParams
$creadPrec :: ReadPrec WillSaveTextDocumentParams
readList :: ReadS [WillSaveTextDocumentParams]
$creadList :: ReadS [WillSaveTextDocumentParams]
readsPrec :: Int -> ReadS WillSaveTextDocumentParams
$creadsPrec :: Int -> ReadS WillSaveTextDocumentParams
Read, WillSaveTextDocumentParams -> WillSaveTextDocumentParams -> Bool
(WillSaveTextDocumentParams -> WillSaveTextDocumentParams -> Bool)
-> (WillSaveTextDocumentParams
    -> WillSaveTextDocumentParams -> Bool)
-> Eq WillSaveTextDocumentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WillSaveTextDocumentParams -> WillSaveTextDocumentParams -> Bool
$c/= :: WillSaveTextDocumentParams -> WillSaveTextDocumentParams -> Bool
== :: WillSaveTextDocumentParams -> WillSaveTextDocumentParams -> Bool
$c== :: WillSaveTextDocumentParams -> WillSaveTextDocumentParams -> Bool
Eq)

deriveJSON lspOptions ''WillSaveTextDocumentParams

type WillSaveTextDocumentNotification = NotificationMessage ClientMethod WillSaveTextDocumentParams

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

WillSaveWaitUntilTextDocument Request

The document will save request is sent from the client to the server before the
document is actually saved. The request can return an array of TextEdits which
will be applied to the text document before it is saved. Please note that
clients might drop results if computing the text edits took too long or if a
server constantly fails on this request. This is done to keep the save fast and
reliable.

Request:

    method: 'textDocument/willSaveWaitUntil'
    params: WillSaveTextDocumentParams

Response:

    result: TextEdit[]
    error: code and message set in case an exception happens during the willSaveWaitUntil request.

Registration Options: TextDocumentRegistrationOptions
-}

type WillSaveWaitUntilTextDocumentRequest = RequestMessage ClientMethod WillSaveTextDocumentParams (List TextEdit)
type WillSaveWaitUntilTextDocumentResponse = ResponseMessage (List TextEdit)

-- ---------------------------------------------------------------------
{-
DidSaveTextDocument Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didsavetextdocument-notification

    New: The document save notification is sent from the client to the server
    when the document was saved in the client.

    method: 'textDocument/didSave'
    params: DidSaveTextDocumentParams defined as follows:

interface DidSaveTextDocumentParams {
    /**
     * The document that was saved.
     */
    textDocument: TextDocumentIdentifier;
}
-}
data DidSaveTextDocumentParams =
  DidSaveTextDocumentParams
    { DidSaveTextDocumentParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
    } deriving (ReadPrec [DidSaveTextDocumentParams]
ReadPrec DidSaveTextDocumentParams
Int -> ReadS DidSaveTextDocumentParams
ReadS [DidSaveTextDocumentParams]
(Int -> ReadS DidSaveTextDocumentParams)
-> ReadS [DidSaveTextDocumentParams]
-> ReadPrec DidSaveTextDocumentParams
-> ReadPrec [DidSaveTextDocumentParams]
-> Read DidSaveTextDocumentParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidSaveTextDocumentParams]
$creadListPrec :: ReadPrec [DidSaveTextDocumentParams]
readPrec :: ReadPrec DidSaveTextDocumentParams
$creadPrec :: ReadPrec DidSaveTextDocumentParams
readList :: ReadS [DidSaveTextDocumentParams]
$creadList :: ReadS [DidSaveTextDocumentParams]
readsPrec :: Int -> ReadS DidSaveTextDocumentParams
$creadsPrec :: Int -> ReadS DidSaveTextDocumentParams
Read,Int -> DidSaveTextDocumentParams -> ShowS
[DidSaveTextDocumentParams] -> ShowS
DidSaveTextDocumentParams -> String
(Int -> DidSaveTextDocumentParams -> ShowS)
-> (DidSaveTextDocumentParams -> String)
-> ([DidSaveTextDocumentParams] -> ShowS)
-> Show DidSaveTextDocumentParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidSaveTextDocumentParams] -> ShowS
$cshowList :: [DidSaveTextDocumentParams] -> ShowS
show :: DidSaveTextDocumentParams -> String
$cshow :: DidSaveTextDocumentParams -> String
showsPrec :: Int -> DidSaveTextDocumentParams -> ShowS
$cshowsPrec :: Int -> DidSaveTextDocumentParams -> ShowS
Show,DidSaveTextDocumentParams -> DidSaveTextDocumentParams -> Bool
(DidSaveTextDocumentParams -> DidSaveTextDocumentParams -> Bool)
-> (DidSaveTextDocumentParams -> DidSaveTextDocumentParams -> Bool)
-> Eq DidSaveTextDocumentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidSaveTextDocumentParams -> DidSaveTextDocumentParams -> Bool
$c/= :: DidSaveTextDocumentParams -> DidSaveTextDocumentParams -> Bool
== :: DidSaveTextDocumentParams -> DidSaveTextDocumentParams -> Bool
$c== :: DidSaveTextDocumentParams -> DidSaveTextDocumentParams -> Bool
Eq)

deriveJSON lspOptions ''DidSaveTextDocumentParams

type DidSaveTextDocumentNotification = NotificationMessage ClientMethod DidSaveTextDocumentParams



-- ---------------------------------------------------------------------
{-
DidCloseTextDocument Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didclosetextdocument-notification

The document close notification is sent from the client to the server when the
document got closed in the client. The document's truth now exists where the
document's uri points to (e.g. if the document's uri is a file uri the truth now
exists on disk).

    Changed: In 2.0 the params are of type DidCloseTextDocumentParams which
    contains a reference to a text document.

Notification:

    method: 'textDocument/didClose'
    params: DidCloseTextDocumentParams defined as follows:

interface DidCloseTextDocumentParams {
    /**
     * The document that was closed.
     */
    textDocument: TextDocumentIdentifier;
}
-}
data DidCloseTextDocumentParams =
  DidCloseTextDocumentParams
    { DidCloseTextDocumentParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
    } deriving (ReadPrec [DidCloseTextDocumentParams]
ReadPrec DidCloseTextDocumentParams
Int -> ReadS DidCloseTextDocumentParams
ReadS [DidCloseTextDocumentParams]
(Int -> ReadS DidCloseTextDocumentParams)
-> ReadS [DidCloseTextDocumentParams]
-> ReadPrec DidCloseTextDocumentParams
-> ReadPrec [DidCloseTextDocumentParams]
-> Read DidCloseTextDocumentParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidCloseTextDocumentParams]
$creadListPrec :: ReadPrec [DidCloseTextDocumentParams]
readPrec :: ReadPrec DidCloseTextDocumentParams
$creadPrec :: ReadPrec DidCloseTextDocumentParams
readList :: ReadS [DidCloseTextDocumentParams]
$creadList :: ReadS [DidCloseTextDocumentParams]
readsPrec :: Int -> ReadS DidCloseTextDocumentParams
$creadsPrec :: Int -> ReadS DidCloseTextDocumentParams
Read,Int -> DidCloseTextDocumentParams -> ShowS
[DidCloseTextDocumentParams] -> ShowS
DidCloseTextDocumentParams -> String
(Int -> DidCloseTextDocumentParams -> ShowS)
-> (DidCloseTextDocumentParams -> String)
-> ([DidCloseTextDocumentParams] -> ShowS)
-> Show DidCloseTextDocumentParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidCloseTextDocumentParams] -> ShowS
$cshowList :: [DidCloseTextDocumentParams] -> ShowS
show :: DidCloseTextDocumentParams -> String
$cshow :: DidCloseTextDocumentParams -> String
showsPrec :: Int -> DidCloseTextDocumentParams -> ShowS
$cshowsPrec :: Int -> DidCloseTextDocumentParams -> ShowS
Show,DidCloseTextDocumentParams -> DidCloseTextDocumentParams -> Bool
(DidCloseTextDocumentParams -> DidCloseTextDocumentParams -> Bool)
-> (DidCloseTextDocumentParams
    -> DidCloseTextDocumentParams -> Bool)
-> Eq DidCloseTextDocumentParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidCloseTextDocumentParams -> DidCloseTextDocumentParams -> Bool
$c/= :: DidCloseTextDocumentParams -> DidCloseTextDocumentParams -> Bool
== :: DidCloseTextDocumentParams -> DidCloseTextDocumentParams -> Bool
$c== :: DidCloseTextDocumentParams -> DidCloseTextDocumentParams -> Bool
Eq)

deriveJSON lspOptions ''DidCloseTextDocumentParams


type DidCloseTextDocumentNotification = NotificationMessage ClientMethod DidCloseTextDocumentParams

-- ---------------------------------------------------------------------
{-
DidChangeWatchedFiles Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#didchangewatchedfiles-notification

The watched files notification is sent from the client to the server when the
client detects changes to files watched by the language client.

Notification:

    method: 'workspace/didChangeWatchedFiles'
    params: DidChangeWatchedFilesParams defined as follows:

interface DidChangeWatchedFilesParams {
    /**
     * The actual file events.
     */
    changes: FileEvent[];
}

Where FileEvents are described as follows:

/**
 * The file event type.
 */
enum FileChangeType {
    /**
     * The file got created.
     */
    Created = 1,
    /**
     * The file got changed.
     */
    Changed = 2,
    /**
     * The file got deleted.
     */
    Deleted = 3
}

/**
 * An event describing a file change.
 */
interface FileEvent {
    /**
     * The file's URI.
     */
    uri: string;
    /**
     * The change type.
     */
    type: number;
-}
data FileChangeType = FcCreated
                    | FcChanged
                    | FcDeleted
       deriving (ReadPrec [FileChangeType]
ReadPrec FileChangeType
Int -> ReadS FileChangeType
ReadS [FileChangeType]
(Int -> ReadS FileChangeType)
-> ReadS [FileChangeType]
-> ReadPrec FileChangeType
-> ReadPrec [FileChangeType]
-> Read FileChangeType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileChangeType]
$creadListPrec :: ReadPrec [FileChangeType]
readPrec :: ReadPrec FileChangeType
$creadPrec :: ReadPrec FileChangeType
readList :: ReadS [FileChangeType]
$creadList :: ReadS [FileChangeType]
readsPrec :: Int -> ReadS FileChangeType
$creadsPrec :: Int -> ReadS FileChangeType
Read,Int -> FileChangeType -> ShowS
[FileChangeType] -> ShowS
FileChangeType -> String
(Int -> FileChangeType -> ShowS)
-> (FileChangeType -> String)
-> ([FileChangeType] -> ShowS)
-> Show FileChangeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileChangeType] -> ShowS
$cshowList :: [FileChangeType] -> ShowS
show :: FileChangeType -> String
$cshow :: FileChangeType -> String
showsPrec :: Int -> FileChangeType -> ShowS
$cshowsPrec :: Int -> FileChangeType -> ShowS
Show,FileChangeType -> FileChangeType -> Bool
(FileChangeType -> FileChangeType -> Bool)
-> (FileChangeType -> FileChangeType -> Bool) -> Eq FileChangeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileChangeType -> FileChangeType -> Bool
$c/= :: FileChangeType -> FileChangeType -> Bool
== :: FileChangeType -> FileChangeType -> Bool
$c== :: FileChangeType -> FileChangeType -> Bool
Eq)

instance A.ToJSON FileChangeType where
  toJSON :: FileChangeType -> Value
toJSON FileChangeType
FcCreated = Scientific -> Value
A.Number Scientific
1
  toJSON FileChangeType
FcChanged = Scientific -> Value
A.Number Scientific
2
  toJSON FileChangeType
FcDeleted = Scientific -> Value
A.Number Scientific
3

instance A.FromJSON FileChangeType where
  parseJSON :: Value -> Parser FileChangeType
parseJSON (A.Number Scientific
1) = FileChangeType -> Parser FileChangeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChangeType
FcCreated
  parseJSON (A.Number Scientific
2) = FileChangeType -> Parser FileChangeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChangeType
FcChanged
  parseJSON (A.Number Scientific
3) = FileChangeType -> Parser FileChangeType
forall (f :: * -> *) a. Applicative f => a -> f a
pure FileChangeType
FcDeleted
  parseJSON Value
_            = Parser FileChangeType
forall a. Monoid a => a
mempty


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

data FileEvent =
  FileEvent
    { FileEvent -> Uri
_uri   :: Uri
    , FileEvent -> FileChangeType
_xtype :: FileChangeType
    } deriving (ReadPrec [FileEvent]
ReadPrec FileEvent
Int -> ReadS FileEvent
ReadS [FileEvent]
(Int -> ReadS FileEvent)
-> ReadS [FileEvent]
-> ReadPrec FileEvent
-> ReadPrec [FileEvent]
-> Read FileEvent
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileEvent]
$creadListPrec :: ReadPrec [FileEvent]
readPrec :: ReadPrec FileEvent
$creadPrec :: ReadPrec FileEvent
readList :: ReadS [FileEvent]
$creadList :: ReadS [FileEvent]
readsPrec :: Int -> ReadS FileEvent
$creadsPrec :: Int -> ReadS FileEvent
Read,Int -> FileEvent -> ShowS
[FileEvent] -> ShowS
FileEvent -> String
(Int -> FileEvent -> ShowS)
-> (FileEvent -> String)
-> ([FileEvent] -> ShowS)
-> Show FileEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileEvent] -> ShowS
$cshowList :: [FileEvent] -> ShowS
show :: FileEvent -> String
$cshow :: FileEvent -> String
showsPrec :: Int -> FileEvent -> ShowS
$cshowsPrec :: Int -> FileEvent -> ShowS
Show,FileEvent -> FileEvent -> Bool
(FileEvent -> FileEvent -> Bool)
-> (FileEvent -> FileEvent -> Bool) -> Eq FileEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileEvent -> FileEvent -> Bool
$c/= :: FileEvent -> FileEvent -> Bool
== :: FileEvent -> FileEvent -> Bool
$c== :: FileEvent -> FileEvent -> Bool
Eq)

deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''FileEvent

data DidChangeWatchedFilesParams =
  DidChangeWatchedFilesParams
    { DidChangeWatchedFilesParams -> List FileEvent
_changes :: List FileEvent
    } deriving (ReadPrec [DidChangeWatchedFilesParams]
ReadPrec DidChangeWatchedFilesParams
Int -> ReadS DidChangeWatchedFilesParams
ReadS [DidChangeWatchedFilesParams]
(Int -> ReadS DidChangeWatchedFilesParams)
-> ReadS [DidChangeWatchedFilesParams]
-> ReadPrec DidChangeWatchedFilesParams
-> ReadPrec [DidChangeWatchedFilesParams]
-> Read DidChangeWatchedFilesParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DidChangeWatchedFilesParams]
$creadListPrec :: ReadPrec [DidChangeWatchedFilesParams]
readPrec :: ReadPrec DidChangeWatchedFilesParams
$creadPrec :: ReadPrec DidChangeWatchedFilesParams
readList :: ReadS [DidChangeWatchedFilesParams]
$creadList :: ReadS [DidChangeWatchedFilesParams]
readsPrec :: Int -> ReadS DidChangeWatchedFilesParams
$creadsPrec :: Int -> ReadS DidChangeWatchedFilesParams
Read,Int -> DidChangeWatchedFilesParams -> ShowS
[DidChangeWatchedFilesParams] -> ShowS
DidChangeWatchedFilesParams -> String
(Int -> DidChangeWatchedFilesParams -> ShowS)
-> (DidChangeWatchedFilesParams -> String)
-> ([DidChangeWatchedFilesParams] -> ShowS)
-> Show DidChangeWatchedFilesParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DidChangeWatchedFilesParams] -> ShowS
$cshowList :: [DidChangeWatchedFilesParams] -> ShowS
show :: DidChangeWatchedFilesParams -> String
$cshow :: DidChangeWatchedFilesParams -> String
showsPrec :: Int -> DidChangeWatchedFilesParams -> ShowS
$cshowsPrec :: Int -> DidChangeWatchedFilesParams -> ShowS
Show,DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
(DidChangeWatchedFilesParams
 -> DidChangeWatchedFilesParams -> Bool)
-> (DidChangeWatchedFilesParams
    -> DidChangeWatchedFilesParams -> Bool)
-> Eq DidChangeWatchedFilesParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
$c/= :: DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
== :: DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
$c== :: DidChangeWatchedFilesParams -> DidChangeWatchedFilesParams -> Bool
Eq)

deriveJSON lspOptions ''DidChangeWatchedFilesParams


type DidChangeWatchedFilesNotification = NotificationMessage ClientMethod DidChangeWatchedFilesParams

-- ---------------------------------------------------------------------
{-
PublishDiagnostics Notification

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#publishdiagnostics-notification

Diagnostics notification are sent from the server to the client to signal
results of validation runs.

Notification

    method: 'textDocument/publishDiagnostics'
    params: PublishDiagnosticsParams defined as follows:

interface PublishDiagnosticsParams {
    /**
     * The URI for which diagnostic information is reported.
     */
    uri: string;

    /**
     * An array of diagnostic information items.
     */
    diagnostics: Diagnostic[];
}
-}

data PublishDiagnosticsParams =
  PublishDiagnosticsParams
    { PublishDiagnosticsParams -> Uri
_uri         :: Uri
    , PublishDiagnosticsParams -> List Diagnostic
_diagnostics :: List Diagnostic
    } deriving (ReadPrec [PublishDiagnosticsParams]
ReadPrec PublishDiagnosticsParams
Int -> ReadS PublishDiagnosticsParams
ReadS [PublishDiagnosticsParams]
(Int -> ReadS PublishDiagnosticsParams)
-> ReadS [PublishDiagnosticsParams]
-> ReadPrec PublishDiagnosticsParams
-> ReadPrec [PublishDiagnosticsParams]
-> Read PublishDiagnosticsParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PublishDiagnosticsParams]
$creadListPrec :: ReadPrec [PublishDiagnosticsParams]
readPrec :: ReadPrec PublishDiagnosticsParams
$creadPrec :: ReadPrec PublishDiagnosticsParams
readList :: ReadS [PublishDiagnosticsParams]
$creadList :: ReadS [PublishDiagnosticsParams]
readsPrec :: Int -> ReadS PublishDiagnosticsParams
$creadsPrec :: Int -> ReadS PublishDiagnosticsParams
Read,Int -> PublishDiagnosticsParams -> ShowS
[PublishDiagnosticsParams] -> ShowS
PublishDiagnosticsParams -> String
(Int -> PublishDiagnosticsParams -> ShowS)
-> (PublishDiagnosticsParams -> String)
-> ([PublishDiagnosticsParams] -> ShowS)
-> Show PublishDiagnosticsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PublishDiagnosticsParams] -> ShowS
$cshowList :: [PublishDiagnosticsParams] -> ShowS
show :: PublishDiagnosticsParams -> String
$cshow :: PublishDiagnosticsParams -> String
showsPrec :: Int -> PublishDiagnosticsParams -> ShowS
$cshowsPrec :: Int -> PublishDiagnosticsParams -> ShowS
Show,PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
(PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool)
-> (PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool)
-> Eq PublishDiagnosticsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
$c/= :: PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
== :: PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
$c== :: PublishDiagnosticsParams -> PublishDiagnosticsParams -> Bool
Eq)

deriveJSON lspOptions ''PublishDiagnosticsParams


type PublishDiagnosticsNotification = NotificationMessage ServerMethod PublishDiagnosticsParams

-- ---------------------------------------------------------------------
{-
Signature Help Request

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

The signature help request is sent from the client to the server to request
signature information at a given cursor position.

    Changed: In 2.0 the request uses TextDocumentPositionParams with proper
    textDocument and position properties. In 1.0 the uri of the referenced text
    document was inlined into the params object.

Request

    method: 'textDocument/signatureHelp'
    params: TextDocumentPositionParams

Response

    result: SignatureHelp defined as follows:

/**
 * Signature help represents the signature of something
 * callable. There can be multiple signature but only one
 * active and only one active parameter.
 */
interface SignatureHelp {
    /**
     * One or more signatures.
     */
    signatures: SignatureInformation[];

    /**
     * The active signature.
     */
    activeSignature?: number;

    /**
     * The active parameter of the active signature.
     */
    activeParameter?: number;
}

/**
 * Represents the signature of something callable. A signature
 * can have a label, like a function-name, a doc-comment, and
 * a set of parameters.
 */
interface SignatureInformation {
    /**
     * The label of this signature. Will be shown in
     * the UI.
     */
    label: string;

    /**
     * The human-readable doc-comment of this signature. Will be shown
     * in the UI but can be omitted.
     */
    documentation?: string;

    /**
     * The parameters of this signature.
     */
    parameters?: ParameterInformation[];
}

/**
 * Represents a parameter of a callable-signature. A parameter can
 * have a label and a doc-comment.
 */
interface ParameterInformation {
    /**
     * The label of this signature. Will be shown in
     * the UI.
     */
    label: string;

    /**
     * The human-readable doc-comment of this signature. Will be shown
     * in the UI but can be omitted.
     */
    documentation?: string;
}

    error: code and message set in case an exception happens during the
    signature help request.
-}


data ParameterInformation =
  ParameterInformation
    { ParameterInformation -> Text
_label         :: Text
    , ParameterInformation -> Maybe Text
_documentation :: Maybe Text
    } deriving (ReadPrec [ParameterInformation]
ReadPrec ParameterInformation
Int -> ReadS ParameterInformation
ReadS [ParameterInformation]
(Int -> ReadS ParameterInformation)
-> ReadS [ParameterInformation]
-> ReadPrec ParameterInformation
-> ReadPrec [ParameterInformation]
-> Read ParameterInformation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ParameterInformation]
$creadListPrec :: ReadPrec [ParameterInformation]
readPrec :: ReadPrec ParameterInformation
$creadPrec :: ReadPrec ParameterInformation
readList :: ReadS [ParameterInformation]
$creadList :: ReadS [ParameterInformation]
readsPrec :: Int -> ReadS ParameterInformation
$creadsPrec :: Int -> ReadS ParameterInformation
Read,Int -> ParameterInformation -> ShowS
[ParameterInformation] -> ShowS
ParameterInformation -> String
(Int -> ParameterInformation -> ShowS)
-> (ParameterInformation -> String)
-> ([ParameterInformation] -> ShowS)
-> Show ParameterInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ParameterInformation] -> ShowS
$cshowList :: [ParameterInformation] -> ShowS
show :: ParameterInformation -> String
$cshow :: ParameterInformation -> String
showsPrec :: Int -> ParameterInformation -> ShowS
$cshowsPrec :: Int -> ParameterInformation -> ShowS
Show,ParameterInformation -> ParameterInformation -> Bool
(ParameterInformation -> ParameterInformation -> Bool)
-> (ParameterInformation -> ParameterInformation -> Bool)
-> Eq ParameterInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ParameterInformation -> ParameterInformation -> Bool
$c/= :: ParameterInformation -> ParameterInformation -> Bool
== :: ParameterInformation -> ParameterInformation -> Bool
$c== :: ParameterInformation -> ParameterInformation -> Bool
Eq)
deriveJSON lspOptions ''ParameterInformation


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

data SignatureInformation =
  SignatureInformation
    { SignatureInformation -> Text
_label         :: Text
    , SignatureInformation -> Maybe Text
_documentation :: Maybe Text
    , SignatureInformation -> Maybe [ParameterInformation]
_parameters    :: Maybe [ParameterInformation]
    } deriving (ReadPrec [SignatureInformation]
ReadPrec SignatureInformation
Int -> ReadS SignatureInformation
ReadS [SignatureInformation]
(Int -> ReadS SignatureInformation)
-> ReadS [SignatureInformation]
-> ReadPrec SignatureInformation
-> ReadPrec [SignatureInformation]
-> Read SignatureInformation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignatureInformation]
$creadListPrec :: ReadPrec [SignatureInformation]
readPrec :: ReadPrec SignatureInformation
$creadPrec :: ReadPrec SignatureInformation
readList :: ReadS [SignatureInformation]
$creadList :: ReadS [SignatureInformation]
readsPrec :: Int -> ReadS SignatureInformation
$creadsPrec :: Int -> ReadS SignatureInformation
Read,Int -> SignatureInformation -> ShowS
[SignatureInformation] -> ShowS
SignatureInformation -> String
(Int -> SignatureInformation -> ShowS)
-> (SignatureInformation -> String)
-> ([SignatureInformation] -> ShowS)
-> Show SignatureInformation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureInformation] -> ShowS
$cshowList :: [SignatureInformation] -> ShowS
show :: SignatureInformation -> String
$cshow :: SignatureInformation -> String
showsPrec :: Int -> SignatureInformation -> ShowS
$cshowsPrec :: Int -> SignatureInformation -> ShowS
Show,SignatureInformation -> SignatureInformation -> Bool
(SignatureInformation -> SignatureInformation -> Bool)
-> (SignatureInformation -> SignatureInformation -> Bool)
-> Eq SignatureInformation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureInformation -> SignatureInformation -> Bool
$c/= :: SignatureInformation -> SignatureInformation -> Bool
== :: SignatureInformation -> SignatureInformation -> Bool
$c== :: SignatureInformation -> SignatureInformation -> Bool
Eq)

deriveJSON lspOptions ''SignatureInformation

data SignatureHelp =
  SignatureHelp
    { SignatureHelp -> List SignatureInformation
_signatures      :: List SignatureInformation
    , SignatureHelp -> Maybe Int
_activeSignature :: Maybe Int -- ^ The active signature
    , SignatureHelp -> Maybe Int
_activeParameter :: Maybe Int -- ^ The active parameter of the active signature
    } deriving (ReadPrec [SignatureHelp]
ReadPrec SignatureHelp
Int -> ReadS SignatureHelp
ReadS [SignatureHelp]
(Int -> ReadS SignatureHelp)
-> ReadS [SignatureHelp]
-> ReadPrec SignatureHelp
-> ReadPrec [SignatureHelp]
-> Read SignatureHelp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignatureHelp]
$creadListPrec :: ReadPrec [SignatureHelp]
readPrec :: ReadPrec SignatureHelp
$creadPrec :: ReadPrec SignatureHelp
readList :: ReadS [SignatureHelp]
$creadList :: ReadS [SignatureHelp]
readsPrec :: Int -> ReadS SignatureHelp
$creadsPrec :: Int -> ReadS SignatureHelp
Read,Int -> SignatureHelp -> ShowS
[SignatureHelp] -> ShowS
SignatureHelp -> String
(Int -> SignatureHelp -> ShowS)
-> (SignatureHelp -> String)
-> ([SignatureHelp] -> ShowS)
-> Show SignatureHelp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureHelp] -> ShowS
$cshowList :: [SignatureHelp] -> ShowS
show :: SignatureHelp -> String
$cshow :: SignatureHelp -> String
showsPrec :: Int -> SignatureHelp -> ShowS
$cshowsPrec :: Int -> SignatureHelp -> ShowS
Show,SignatureHelp -> SignatureHelp -> Bool
(SignatureHelp -> SignatureHelp -> Bool)
-> (SignatureHelp -> SignatureHelp -> Bool) -> Eq SignatureHelp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureHelp -> SignatureHelp -> Bool
$c/= :: SignatureHelp -> SignatureHelp -> Bool
== :: SignatureHelp -> SignatureHelp -> Bool
$c== :: SignatureHelp -> SignatureHelp -> Bool
Eq)

deriveJSON lspOptions ''SignatureHelp

type SignatureHelpRequest = RequestMessage ClientMethod TextDocumentPositionParams SignatureHelp
type SignatureHelpResponse = ResponseMessage SignatureHelp

-- -------------------------------------
{-
New in 3.0
----------
Registration Options: SignatureHelpRegistrationOptions defined as follows:

export interface SignatureHelpRegistrationOptions extends TextDocumentRegistrationOptions {
        /**
         * The characters that trigger signature help
         * automatically.
         */
        triggerCharacters?: string[];
}
-}

data SignatureHelpRegistrationOptions =
  SignatureHelpRegistrationOptions
    { SignatureHelpRegistrationOptions -> Maybe DocumentSelector
_documentSelector  :: Maybe DocumentSelector
    , SignatureHelpRegistrationOptions -> Maybe (List String)
_triggerCharacters :: Maybe (List String)
    } deriving (Int -> SignatureHelpRegistrationOptions -> ShowS
[SignatureHelpRegistrationOptions] -> ShowS
SignatureHelpRegistrationOptions -> String
(Int -> SignatureHelpRegistrationOptions -> ShowS)
-> (SignatureHelpRegistrationOptions -> String)
-> ([SignatureHelpRegistrationOptions] -> ShowS)
-> Show SignatureHelpRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignatureHelpRegistrationOptions] -> ShowS
$cshowList :: [SignatureHelpRegistrationOptions] -> ShowS
show :: SignatureHelpRegistrationOptions -> String
$cshow :: SignatureHelpRegistrationOptions -> String
showsPrec :: Int -> SignatureHelpRegistrationOptions -> ShowS
$cshowsPrec :: Int -> SignatureHelpRegistrationOptions -> ShowS
Show, ReadPrec [SignatureHelpRegistrationOptions]
ReadPrec SignatureHelpRegistrationOptions
Int -> ReadS SignatureHelpRegistrationOptions
ReadS [SignatureHelpRegistrationOptions]
(Int -> ReadS SignatureHelpRegistrationOptions)
-> ReadS [SignatureHelpRegistrationOptions]
-> ReadPrec SignatureHelpRegistrationOptions
-> ReadPrec [SignatureHelpRegistrationOptions]
-> Read SignatureHelpRegistrationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SignatureHelpRegistrationOptions]
$creadListPrec :: ReadPrec [SignatureHelpRegistrationOptions]
readPrec :: ReadPrec SignatureHelpRegistrationOptions
$creadPrec :: ReadPrec SignatureHelpRegistrationOptions
readList :: ReadS [SignatureHelpRegistrationOptions]
$creadList :: ReadS [SignatureHelpRegistrationOptions]
readsPrec :: Int -> ReadS SignatureHelpRegistrationOptions
$creadsPrec :: Int -> ReadS SignatureHelpRegistrationOptions
Read, SignatureHelpRegistrationOptions
-> SignatureHelpRegistrationOptions -> Bool
(SignatureHelpRegistrationOptions
 -> SignatureHelpRegistrationOptions -> Bool)
-> (SignatureHelpRegistrationOptions
    -> SignatureHelpRegistrationOptions -> Bool)
-> Eq SignatureHelpRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignatureHelpRegistrationOptions
-> SignatureHelpRegistrationOptions -> Bool
$c/= :: SignatureHelpRegistrationOptions
-> SignatureHelpRegistrationOptions -> Bool
== :: SignatureHelpRegistrationOptions
-> SignatureHelpRegistrationOptions -> Bool
$c== :: SignatureHelpRegistrationOptions
-> SignatureHelpRegistrationOptions -> Bool
Eq)

deriveJSON lspOptions ''SignatureHelpRegistrationOptions

-- ---------------------------------------------------------------------
{-
Goto Definition Request

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

The goto definition request is sent from the client to the server to resolve the
definition location of a symbol at a given text document position.

    Changed: In 2.0 the request uses TextDocumentPositionParams with proper
    textDocument and position properties. In 1.0 the uri of the referenced text
    document was inlined into the params object.

Request

    method: 'textDocument/definition'
    params: TextDocumentPositionParams

Response:

    result: Location | Location[]
    error: code and message set in case an exception happens during the definition request.


-}

-- {"jsonrpc":"2.0","id":1,"method":"textDocument/definition","params":{"textDocument":{"uri":"file:///tmp/Foo.hs"},"position":{"line":1,"character":8}}}

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

instance A.ToJSON LocationResponseParams where
  toJSON :: LocationResponseParams -> Value
toJSON (SingleLoc Location
x) = Location -> Value
forall a. ToJSON a => a -> Value
toJSON Location
x
  toJSON (MultiLoc [Location]
xs) = [Location] -> Value
forall a. ToJSON a => a -> Value
toJSON [Location]
xs

instance A.FromJSON LocationResponseParams where
  parseJSON :: Value -> Parser LocationResponseParams
parseJSON xs :: Value
xs@(A.Array Array
_) = [Location] -> LocationResponseParams
MultiLoc ([Location] -> LocationResponseParams)
-> Parser [Location] -> Parser LocationResponseParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [Location]
forall a. FromJSON a => Value -> Parser a
parseJSON Value
xs
  parseJSON Value
x              = Location -> LocationResponseParams
SingleLoc (Location -> LocationResponseParams)
-> Parser Location -> Parser LocationResponseParams
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Location
forall a. FromJSON a => Value -> Parser a
parseJSON Value
x

type DefinitionRequest  = RequestMessage ClientMethod TextDocumentPositionParams LocationResponseParams
type DefinitionResponse = ResponseMessage LocationResponseParams

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

{-
Goto Type Definition Request (:leftwards_arrow_with_hook:)
Since version 3.6.0

The goto type definition request is sent from the client to the server to resolve the type definition location of a symbol at a given text document position.

Request:

method: ‘textDocument/typeDefinition’
params: TextDocumentPositionParams
Response:

result: Location | Location[] | null
error: code and message set in case an exception happens during the definition request.
Registration Options: TextDocumentRegistrationOptions
-}

type TypeDefinitionRequest = RequestMessage ClientMethod TextDocumentPositionParams LocationResponseParams
type TypeDefinitionResponse = ResponseMessage LocationResponseParams

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

{-
Goto Implementation Request (:leftwards_arrow_with_hook:)
Since version 3.6.0

The goto implementation request is sent from the client to the server to resolve the implementation location of a symbol at a given text document position.

Request:

method: ‘textDocument/implementation’
params: TextDocumentPositionParams
Response:

result: Location | Location[] | null
error: code and message set in case an exception happens during the definition request.
Registration Options: TextDocumentRegistrationOptions
-}


type ImplementationRequest  = RequestMessage ClientMethod TextDocumentPositionParams LocationResponseParams
type ImplementationResponse = ResponseMessage LocationResponseParams

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

{-
Find References Request

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

The references request is sent from the client to the server to resolve
project-wide references for the symbol denoted by the given text document
position.

    Changed: In 2.0 the request uses TextDocumentPositionParams with proper
    textDocument and position properties. In 1.0 the uri of the referenced text
    document was inlined into the params object.

Request

    method: 'textDocument/references'
    params: ReferenceParams defined as follows:

interface ReferenceParams extends TextDocumentPositionParams {
    context: ReferenceContext
}

interface ReferenceContext {
    /**
     * Include the declaration of the current symbol.
     */
    includeDeclaration: boolean;
}

Response:

    result: Location[]
    error: code and message set in case an exception happens during the
           reference request.
-}

data ReferenceContext =
  ReferenceContext
    { ReferenceContext -> Bool
_includeDeclaration :: Bool
    } deriving (ReadPrec [ReferenceContext]
ReadPrec ReferenceContext
Int -> ReadS ReferenceContext
ReadS [ReferenceContext]
(Int -> ReadS ReferenceContext)
-> ReadS [ReferenceContext]
-> ReadPrec ReferenceContext
-> ReadPrec [ReferenceContext]
-> Read ReferenceContext
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReferenceContext]
$creadListPrec :: ReadPrec [ReferenceContext]
readPrec :: ReadPrec ReferenceContext
$creadPrec :: ReadPrec ReferenceContext
readList :: ReadS [ReferenceContext]
$creadList :: ReadS [ReferenceContext]
readsPrec :: Int -> ReadS ReferenceContext
$creadsPrec :: Int -> ReadS ReferenceContext
Read,Int -> ReferenceContext -> ShowS
[ReferenceContext] -> ShowS
ReferenceContext -> String
(Int -> ReferenceContext -> ShowS)
-> (ReferenceContext -> String)
-> ([ReferenceContext] -> ShowS)
-> Show ReferenceContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceContext] -> ShowS
$cshowList :: [ReferenceContext] -> ShowS
show :: ReferenceContext -> String
$cshow :: ReferenceContext -> String
showsPrec :: Int -> ReferenceContext -> ShowS
$cshowsPrec :: Int -> ReferenceContext -> ShowS
Show,ReferenceContext -> ReferenceContext -> Bool
(ReferenceContext -> ReferenceContext -> Bool)
-> (ReferenceContext -> ReferenceContext -> Bool)
-> Eq ReferenceContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceContext -> ReferenceContext -> Bool
$c/= :: ReferenceContext -> ReferenceContext -> Bool
== :: ReferenceContext -> ReferenceContext -> Bool
$c== :: ReferenceContext -> ReferenceContext -> Bool
Eq)

deriveJSON lspOptions ''ReferenceContext


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

deriveJSON lspOptions ''ReferenceParams


type ReferencesRequest  = RequestMessage ClientMethod ReferenceParams (List Location)
type ReferencesResponse = ResponseMessage (List Location)

-- ---------------------------------------------------------------------
{-
Document Highlights Request

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

The document highlight request is sent from the client to the server to resolve
a document highlights for a given text document position. For programming
languages this usually highlights all references to the symbol scoped to this
file. However we kept 'textDocument/documentHighlight' and
'textDocument/references' separate requests since the first one is allowed to be
more fuzzy. Symbol matches usually have a DocumentHighlightKind of Read or Write
whereas fuzzy or textual matches use Textas the kind.

    Changed: In 2.0 the request uses TextDocumentPositionParams with proper
    textDocument and position properties. In 1.0 the uri of the referenced text
    document was inlined into the params object.

Request

    method: 'textDocument/documentHighlight'
    params: TextDocumentPositionParams

Response

    result: DocumentHighlight[] defined as follows:

/**
 * A document highlight is a range inside a text document which deserves
 * special attention. Usually a document highlight is visualized by changing
 * the background color of its range.
 *
 */
interface DocumentHighlight {
    /**
     * The range this highlight applies to.
     */
    range: Range;

    /**
     * The highlight kind, default is DocumentHighlightKind.Text.
     */
    kind?: number;
}

/**
 * A document highlight kind.
 */
enum DocumentHighlightKind {
    /**
     * A textual occurrance.
     */
    Text = 1,

    /**
     * Read-access of a symbol, like reading a variable.
     */
    Read = 2,

    /**
     * Write-access of a symbol, like writing to a variable.
     */
    Write = 3
}

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

Registration Options: TextDocumentRegistrationOptions

-}

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

instance A.ToJSON DocumentHighlightKind where
  toJSON :: DocumentHighlightKind -> Value
toJSON DocumentHighlightKind
HkText  = Scientific -> Value
A.Number Scientific
1
  toJSON DocumentHighlightKind
HkRead  = Scientific -> Value
A.Number Scientific
2
  toJSON DocumentHighlightKind
HkWrite = Scientific -> Value
A.Number Scientific
3

instance A.FromJSON DocumentHighlightKind where
  parseJSON :: Value -> Parser DocumentHighlightKind
parseJSON (A.Number Scientific
1) = DocumentHighlightKind -> Parser DocumentHighlightKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure DocumentHighlightKind
HkText
  parseJSON (A.Number Scientific
2) = DocumentHighlightKind -> Parser DocumentHighlightKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure DocumentHighlightKind
HkRead
  parseJSON (A.Number Scientific
3) = DocumentHighlightKind -> Parser DocumentHighlightKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure DocumentHighlightKind
HkWrite
  parseJSON Value
_            = Parser DocumentHighlightKind
forall a. Monoid a => a
mempty

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

data DocumentHighlight =
  DocumentHighlight
    { DocumentHighlight -> Range
_range :: Range
    , DocumentHighlight -> Maybe DocumentHighlightKind
_kind  :: Maybe DocumentHighlightKind
    } deriving (ReadPrec [DocumentHighlight]
ReadPrec DocumentHighlight
Int -> ReadS DocumentHighlight
ReadS [DocumentHighlight]
(Int -> ReadS DocumentHighlight)
-> ReadS [DocumentHighlight]
-> ReadPrec DocumentHighlight
-> ReadPrec [DocumentHighlight]
-> Read DocumentHighlight
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentHighlight]
$creadListPrec :: ReadPrec [DocumentHighlight]
readPrec :: ReadPrec DocumentHighlight
$creadPrec :: ReadPrec DocumentHighlight
readList :: ReadS [DocumentHighlight]
$creadList :: ReadS [DocumentHighlight]
readsPrec :: Int -> ReadS DocumentHighlight
$creadsPrec :: Int -> ReadS DocumentHighlight
Read,Int -> DocumentHighlight -> ShowS
[DocumentHighlight] -> ShowS
DocumentHighlight -> String
(Int -> DocumentHighlight -> ShowS)
-> (DocumentHighlight -> String)
-> ([DocumentHighlight] -> ShowS)
-> Show DocumentHighlight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentHighlight] -> ShowS
$cshowList :: [DocumentHighlight] -> ShowS
show :: DocumentHighlight -> String
$cshow :: DocumentHighlight -> String
showsPrec :: Int -> DocumentHighlight -> ShowS
$cshowsPrec :: Int -> DocumentHighlight -> ShowS
Show,DocumentHighlight -> DocumentHighlight -> Bool
(DocumentHighlight -> DocumentHighlight -> Bool)
-> (DocumentHighlight -> DocumentHighlight -> Bool)
-> Eq DocumentHighlight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentHighlight -> DocumentHighlight -> Bool
$c/= :: DocumentHighlight -> DocumentHighlight -> Bool
== :: DocumentHighlight -> DocumentHighlight -> Bool
$c== :: DocumentHighlight -> DocumentHighlight -> Bool
Eq)

deriveJSON lspOptions ''DocumentHighlight

type DocumentHighlightRequest = RequestMessage ClientMethod TextDocumentPositionParams (List DocumentHighlight)
type DocumentHighlightsResponse = ResponseMessage (List DocumentHighlight)

-- ---------------------------------------------------------------------
{-
Workspace Symbols Request

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

The workspace symbol request is sent from the client to the server to list
project-wide symbols matching the query string.

Request

    method: 'workspace/symbol'
    params: WorkspaceSymbolParams defined as follows:

/**
 * The parameters of a Workspace Symbol Request.
 */
interface WorkspaceSymbolParams {
    /**
     * A non-empty query string
     */
    query: string;
}

Response

    result: SymbolInformation[] as defined above.
    error: code and message set in case an exception happens during the
           workspace symbol request.
-}

data WorkspaceSymbolParams =
  WorkspaceSymbolParams
    { WorkspaceSymbolParams -> Text
_query :: Text -- ^ A query string to filter symbols by. Clients may send an empty string here to request all symbols.
    , WorkspaceSymbolParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken -- ^ An optional token that a server can use to report work done progress.
    } deriving (ReadPrec [WorkspaceSymbolParams]
ReadPrec WorkspaceSymbolParams
Int -> ReadS WorkspaceSymbolParams
ReadS [WorkspaceSymbolParams]
(Int -> ReadS WorkspaceSymbolParams)
-> ReadS [WorkspaceSymbolParams]
-> ReadPrec WorkspaceSymbolParams
-> ReadPrec [WorkspaceSymbolParams]
-> Read WorkspaceSymbolParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WorkspaceSymbolParams]
$creadListPrec :: ReadPrec [WorkspaceSymbolParams]
readPrec :: ReadPrec WorkspaceSymbolParams
$creadPrec :: ReadPrec WorkspaceSymbolParams
readList :: ReadS [WorkspaceSymbolParams]
$creadList :: ReadS [WorkspaceSymbolParams]
readsPrec :: Int -> ReadS WorkspaceSymbolParams
$creadsPrec :: Int -> ReadS WorkspaceSymbolParams
Read,Int -> WorkspaceSymbolParams -> ShowS
[WorkspaceSymbolParams] -> ShowS
WorkspaceSymbolParams -> String
(Int -> WorkspaceSymbolParams -> ShowS)
-> (WorkspaceSymbolParams -> String)
-> ([WorkspaceSymbolParams] -> ShowS)
-> Show WorkspaceSymbolParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WorkspaceSymbolParams] -> ShowS
$cshowList :: [WorkspaceSymbolParams] -> ShowS
show :: WorkspaceSymbolParams -> String
$cshow :: WorkspaceSymbolParams -> String
showsPrec :: Int -> WorkspaceSymbolParams -> ShowS
$cshowsPrec :: Int -> WorkspaceSymbolParams -> ShowS
Show,WorkspaceSymbolParams -> WorkspaceSymbolParams -> Bool
(WorkspaceSymbolParams -> WorkspaceSymbolParams -> Bool)
-> (WorkspaceSymbolParams -> WorkspaceSymbolParams -> Bool)
-> Eq WorkspaceSymbolParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WorkspaceSymbolParams -> WorkspaceSymbolParams -> Bool
$c/= :: WorkspaceSymbolParams -> WorkspaceSymbolParams -> Bool
== :: WorkspaceSymbolParams -> WorkspaceSymbolParams -> Bool
$c== :: WorkspaceSymbolParams -> WorkspaceSymbolParams -> Bool
Eq)

deriveJSON lspOptions ''WorkspaceSymbolParams

type WorkspaceSymbolRequest  = RequestMessage ClientMethod WorkspaceSymbolParams (List SymbolInformation)
type WorkspaceSymbolsResponse = ResponseMessage (List SymbolInformation)

-- ---------------------------------------------------------------------
{-
Code Lens Request

The code lens request is sent from the client to the server to compute code
lenses for a given text document.

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

Request

    method: 'textDocument/codeLens'
    params: CodeLensParams defined as follows:

interface CodeLensParams {
    /**
     * The document to request code lens for.
     */
    textDocument: TextDocumentIdentifier;
}

Response

    result: CodeLens[] defined as follows:

/**
 * A code lens represents a command that should be shown along with
 * source text, like the number of references, a way to run tests, etc.
 *
 * A code lens is _unresolved_ when no command is associated to it. For performance
 * reasons the creation of a code lens and resolving should be done in two stages.
 */
interface CodeLens {
    /**
     * The range in which this code lens is valid. Should only span a single line.
     */
    range: Range;

    /**
     * The command this code lens represents.
     */
    command?: Command;

    /**
     * A data entry field that is preserved on a code lens item between
     * a code lens and a code lens resolve request.
     */
    data?: any
}

    error: code and message set in case an exception happens during the code
           lens request.
-}

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

deriveJSON lspOptions ''CodeLensParams


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

data CodeLens =
  CodeLens
    { CodeLens -> Range
_range   :: Range
    , CodeLens -> Maybe Command
_command :: Maybe Command
    , CodeLens -> Maybe Value
_xdata   :: Maybe A.Value
    } deriving (ReadPrec [CodeLens]
ReadPrec CodeLens
Int -> ReadS CodeLens
ReadS [CodeLens]
(Int -> ReadS CodeLens)
-> ReadS [CodeLens]
-> ReadPrec CodeLens
-> ReadPrec [CodeLens]
-> Read CodeLens
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodeLens]
$creadListPrec :: ReadPrec [CodeLens]
readPrec :: ReadPrec CodeLens
$creadPrec :: ReadPrec CodeLens
readList :: ReadS [CodeLens]
$creadList :: ReadS [CodeLens]
readsPrec :: Int -> ReadS CodeLens
$creadsPrec :: Int -> ReadS CodeLens
Read,Int -> CodeLens -> ShowS
[CodeLens] -> ShowS
CodeLens -> String
(Int -> CodeLens -> ShowS)
-> (CodeLens -> String) -> ([CodeLens] -> ShowS) -> Show CodeLens
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeLens] -> ShowS
$cshowList :: [CodeLens] -> ShowS
show :: CodeLens -> String
$cshow :: CodeLens -> String
showsPrec :: Int -> CodeLens -> ShowS
$cshowsPrec :: Int -> CodeLens -> ShowS
Show,CodeLens -> CodeLens -> Bool
(CodeLens -> CodeLens -> Bool)
-> (CodeLens -> CodeLens -> Bool) -> Eq CodeLens
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeLens -> CodeLens -> Bool
$c/= :: CodeLens -> CodeLens -> Bool
== :: CodeLens -> CodeLens -> Bool
$c== :: CodeLens -> CodeLens -> Bool
Eq)

deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''CodeLens


type CodeLensRequest = RequestMessage ClientMethod CodeLensParams (List CodeLens)
type CodeLensResponse = ResponseMessage (List CodeLens)

-- -------------------------------------
{-
Registration Options: CodeLensRegistrationOptions defined as follows:

export interface CodeLensRegistrationOptions extends TextDocumentRegistrationOptions {
        /**
         * Code lens has a resolve provider as well.
         */
        resolveProvider?: boolean;
}
-}

data CodeLensRegistrationOptions =
  CodeLensRegistrationOptions
    { CodeLensRegistrationOptions -> Maybe DocumentSelector
_documentSelector :: Maybe DocumentSelector
    , CodeLensRegistrationOptions -> Maybe Bool
_resolveProvider  :: Maybe Bool
    } deriving (Int -> CodeLensRegistrationOptions -> ShowS
[CodeLensRegistrationOptions] -> ShowS
CodeLensRegistrationOptions -> String
(Int -> CodeLensRegistrationOptions -> ShowS)
-> (CodeLensRegistrationOptions -> String)
-> ([CodeLensRegistrationOptions] -> ShowS)
-> Show CodeLensRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CodeLensRegistrationOptions] -> ShowS
$cshowList :: [CodeLensRegistrationOptions] -> ShowS
show :: CodeLensRegistrationOptions -> String
$cshow :: CodeLensRegistrationOptions -> String
showsPrec :: Int -> CodeLensRegistrationOptions -> ShowS
$cshowsPrec :: Int -> CodeLensRegistrationOptions -> ShowS
Show, ReadPrec [CodeLensRegistrationOptions]
ReadPrec CodeLensRegistrationOptions
Int -> ReadS CodeLensRegistrationOptions
ReadS [CodeLensRegistrationOptions]
(Int -> ReadS CodeLensRegistrationOptions)
-> ReadS [CodeLensRegistrationOptions]
-> ReadPrec CodeLensRegistrationOptions
-> ReadPrec [CodeLensRegistrationOptions]
-> Read CodeLensRegistrationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CodeLensRegistrationOptions]
$creadListPrec :: ReadPrec [CodeLensRegistrationOptions]
readPrec :: ReadPrec CodeLensRegistrationOptions
$creadPrec :: ReadPrec CodeLensRegistrationOptions
readList :: ReadS [CodeLensRegistrationOptions]
$creadList :: ReadS [CodeLensRegistrationOptions]
readsPrec :: Int -> ReadS CodeLensRegistrationOptions
$creadsPrec :: Int -> ReadS CodeLensRegistrationOptions
Read, CodeLensRegistrationOptions -> CodeLensRegistrationOptions -> Bool
(CodeLensRegistrationOptions
 -> CodeLensRegistrationOptions -> Bool)
-> (CodeLensRegistrationOptions
    -> CodeLensRegistrationOptions -> Bool)
-> Eq CodeLensRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CodeLensRegistrationOptions -> CodeLensRegistrationOptions -> Bool
$c/= :: CodeLensRegistrationOptions -> CodeLensRegistrationOptions -> Bool
== :: CodeLensRegistrationOptions -> CodeLensRegistrationOptions -> Bool
$c== :: CodeLensRegistrationOptions -> CodeLensRegistrationOptions -> Bool
Eq)

deriveJSON lspOptions ''CodeLensRegistrationOptions

-- ---------------------------------------------------------------------
{-
Code Lens Resolve Request

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#code-lens-resolve-request

The code lens resolve request is sent from the client to the server to resolve
the command for a given code lens item.

Request

    method: 'codeLens/resolve'
    params: CodeLens

Response

    result: CodeLens
    error: code and message set in case an exception happens during the code
           lens resolve request.


-}

type CodeLensResolveRequest  = RequestMessage ClientMethod CodeLens CodeLens
type CodeLensResolveResponse = ResponseMessage CodeLens

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

Document Link Request

The document links request is sent from the client to the server to request the
location of links in a document.

Request:

    method: 'textDocument/documentLink'
    params: DocumentLinkParams, defined as follows

interface DocumentLinkParams {
        /**
         * The document to provide document links for.
         */
        textDocument: TextDocumentIdentifier;
}

Response:

    result: An array of DocumentLink, or null.

/**
 * A document link is a range in a text document that links to an internal or external resource, like another
 * text document or a web site.
 */
interface DocumentLink {
        /**
         * The range this link applies to.
         */
        range: Range;
        /**
         * The uri this link points to. If missing a resolve request is sent later.
         */
        target?: DocumentUri;
}

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

Registration Options: DocumentLinkRegistrationOptions defined as follows:

export interface DocumentLinkRegistrationOptions extends TextDocumentRegistrationOptions {
        /**
         * Document links have a resolve provider as well.
         */
        resolveProvider?: boolean;
}
-}

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

deriveJSON lspOptions ''DocumentLinkParams

data DocumentLink =
  DocumentLink
    { DocumentLink -> Range
_range  :: Range
    , DocumentLink -> Maybe Text
_target :: Maybe Text
    } deriving (Int -> DocumentLink -> ShowS
[DocumentLink] -> ShowS
DocumentLink -> String
(Int -> DocumentLink -> ShowS)
-> (DocumentLink -> String)
-> ([DocumentLink] -> ShowS)
-> Show DocumentLink
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentLink] -> ShowS
$cshowList :: [DocumentLink] -> ShowS
show :: DocumentLink -> String
$cshow :: DocumentLink -> String
showsPrec :: Int -> DocumentLink -> ShowS
$cshowsPrec :: Int -> DocumentLink -> ShowS
Show, ReadPrec [DocumentLink]
ReadPrec DocumentLink
Int -> ReadS DocumentLink
ReadS [DocumentLink]
(Int -> ReadS DocumentLink)
-> ReadS [DocumentLink]
-> ReadPrec DocumentLink
-> ReadPrec [DocumentLink]
-> Read DocumentLink
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentLink]
$creadListPrec :: ReadPrec [DocumentLink]
readPrec :: ReadPrec DocumentLink
$creadPrec :: ReadPrec DocumentLink
readList :: ReadS [DocumentLink]
$creadList :: ReadS [DocumentLink]
readsPrec :: Int -> ReadS DocumentLink
$creadsPrec :: Int -> ReadS DocumentLink
Read, DocumentLink -> DocumentLink -> Bool
(DocumentLink -> DocumentLink -> Bool)
-> (DocumentLink -> DocumentLink -> Bool) -> Eq DocumentLink
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentLink -> DocumentLink -> Bool
$c/= :: DocumentLink -> DocumentLink -> Bool
== :: DocumentLink -> DocumentLink -> Bool
$c== :: DocumentLink -> DocumentLink -> Bool
Eq)

deriveJSON lspOptions ''DocumentLink

type DocumentLinkRequest = RequestMessage ClientMethod DocumentLinkParams (List DocumentLink)
type DocumentLinkResponse = ResponseMessage (List DocumentLink)

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

Document Link Resolve Request

The document link resolve request is sent from the client to the server to resolve the target of a given document link.

Request:

    method: 'documentLink/resolve'
    params: DocumentLink

Response:

    result: DocumentLink
    error: code and message set in case an exception happens during the document link resolve request.

-}

type DocumentLinkResolveRequest  = RequestMessage ClientMethod DocumentLink DocumentLink
type DocumentLinkResolveResponse = ResponseMessage DocumentLink

-- ---------------------------------------------------------------------
{-
Document Formatting Request

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

The document formatting request is sent from the server to the client to format
a whole document.

Request

    method: 'textDocument/formatting'
    params: DocumentFormattingParams defined as follows

interface DocumentFormattingParams {
    /**
     * The document to format.
     */
    textDocument: TextDocumentIdentifier;

    /**
     * The format options.
     */
    options: FormattingOptions;
}

/**
 * Value-object describing what options formatting should use.
 */
interface FormattingOptions {
    /**
     * Size of a tab in spaces.
     */
    tabSize: number;

    /**
     * Prefer spaces over tabs.
     */
    insertSpaces: boolean;

    /**
     * Signature for further properties.
     */
    [key: string]: boolean | number | string;
}

Response

    result: TextEdit[] describing the modification to the document to be
            formatted.
    error: code and message set in case an exception happens during the
           formatting request.

Registration Options: TextDocumentRegistrationOptions
-}

data FormattingOptions =
  FormattingOptions
    { FormattingOptions -> Int
_tabSize      :: Int
    , FormattingOptions -> Bool
_insertSpaces :: Bool -- ^ Prefer spaces over tabs
    -- Note: May be more properties
    } deriving (ReadPrec [FormattingOptions]
ReadPrec FormattingOptions
Int -> ReadS FormattingOptions
ReadS [FormattingOptions]
(Int -> ReadS FormattingOptions)
-> ReadS [FormattingOptions]
-> ReadPrec FormattingOptions
-> ReadPrec [FormattingOptions]
-> Read FormattingOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FormattingOptions]
$creadListPrec :: ReadPrec [FormattingOptions]
readPrec :: ReadPrec FormattingOptions
$creadPrec :: ReadPrec FormattingOptions
readList :: ReadS [FormattingOptions]
$creadList :: ReadS [FormattingOptions]
readsPrec :: Int -> ReadS FormattingOptions
$creadsPrec :: Int -> ReadS FormattingOptions
Read,Int -> FormattingOptions -> ShowS
[FormattingOptions] -> ShowS
FormattingOptions -> String
(Int -> FormattingOptions -> ShowS)
-> (FormattingOptions -> String)
-> ([FormattingOptions] -> ShowS)
-> Show FormattingOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FormattingOptions] -> ShowS
$cshowList :: [FormattingOptions] -> ShowS
show :: FormattingOptions -> String
$cshow :: FormattingOptions -> String
showsPrec :: Int -> FormattingOptions -> ShowS
$cshowsPrec :: Int -> FormattingOptions -> ShowS
Show,FormattingOptions -> FormattingOptions -> Bool
(FormattingOptions -> FormattingOptions -> Bool)
-> (FormattingOptions -> FormattingOptions -> Bool)
-> Eq FormattingOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FormattingOptions -> FormattingOptions -> Bool
$c/= :: FormattingOptions -> FormattingOptions -> Bool
== :: FormattingOptions -> FormattingOptions -> Bool
$c== :: FormattingOptions -> FormattingOptions -> Bool
Eq)

deriveJSON lspOptions ''FormattingOptions

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

deriveJSON lspOptions ''DocumentFormattingParams

type DocumentFormattingRequest  = RequestMessage ClientMethod DocumentFormattingParams (List TextEdit)
type DocumentFormattingResponse = ResponseMessage (List TextEdit)

-- ---------------------------------------------------------------------
{-
Document Range Formatting Request

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

The document range formatting request is sent from the client to the server to
format a given range in a document.

Request

    method: 'textDocument/rangeFormatting',
    params: DocumentRangeFormattingParams defined as follows

interface DocumentRangeFormattingParams {
    /**
     * The document to format.
     */
    textDocument: TextDocumentIdentifier;

    /**
     * The range to format
     */
    range: Range;

    /**
     * The format options
     */
    options: FormattingOptions;
}

Response

    result: TextEdit[] describing the modification to the document to be
            formatted.
    error: code and message set in case an exception happens during the range
           formatting request.
-}

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

deriveJSON lspOptions ''DocumentRangeFormattingParams

type DocumentRangeFormattingRequest  = RequestMessage ClientMethod DocumentRangeFormattingParams (List TextEdit)
type DocumentRangeFormattingResponse = ResponseMessage (List TextEdit)

-- ---------------------------------------------------------------------
{-
Document on Type Formatting Request

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

The document on type formatting request is sent from the client to the server to
format parts of the document during typing.

Request

    method: 'textDocument/onTypeFormatting'
    params: DocumentOnTypeFormattingParams defined as follows

interface DocumentOnTypeFormattingParams {
    /**
     * The document to format.
     */
    textDocument: TextDocumentIdentifier;

    /**
     * The position at which this request was sent.
     */
    position: Position;

    /**
     * The character that has been typed.
     */
    ch: string;

    /**
     * The format options.
     */
    options: FormattingOptions;
}

Response

    result: TextEdit[] describing the modification to the document.
    error: code and message set in case an exception happens during the range
           formatting request.

Registration Options: DocumentOnTypeFormattingRegistrationOptions defined as follows:

export interface DocumentOnTypeFormattingRegistrationOptions extends TextDocumentRegistrationOptions {
        /**
         * A character on which formatting should be triggered, like `}`.
         */
        firstTriggerCharacter: string;
        /**
         * More trigger characters.
         */
        moreTriggerCharacter?: string[]
}
-}

data DocumentOnTypeFormattingParams =
  DocumentOnTypeFormattingParams
    { DocumentOnTypeFormattingParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier
    , DocumentOnTypeFormattingParams -> Position
_position     :: Position
    , DocumentOnTypeFormattingParams -> Text
_ch           :: Text
    , DocumentOnTypeFormattingParams -> FormattingOptions
_options      :: FormattingOptions
    } deriving (ReadPrec [DocumentOnTypeFormattingParams]
ReadPrec DocumentOnTypeFormattingParams
Int -> ReadS DocumentOnTypeFormattingParams
ReadS [DocumentOnTypeFormattingParams]
(Int -> ReadS DocumentOnTypeFormattingParams)
-> ReadS [DocumentOnTypeFormattingParams]
-> ReadPrec DocumentOnTypeFormattingParams
-> ReadPrec [DocumentOnTypeFormattingParams]
-> Read DocumentOnTypeFormattingParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentOnTypeFormattingParams]
$creadListPrec :: ReadPrec [DocumentOnTypeFormattingParams]
readPrec :: ReadPrec DocumentOnTypeFormattingParams
$creadPrec :: ReadPrec DocumentOnTypeFormattingParams
readList :: ReadS [DocumentOnTypeFormattingParams]
$creadList :: ReadS [DocumentOnTypeFormattingParams]
readsPrec :: Int -> ReadS DocumentOnTypeFormattingParams
$creadsPrec :: Int -> ReadS DocumentOnTypeFormattingParams
Read,Int -> DocumentOnTypeFormattingParams -> ShowS
[DocumentOnTypeFormattingParams] -> ShowS
DocumentOnTypeFormattingParams -> String
(Int -> DocumentOnTypeFormattingParams -> ShowS)
-> (DocumentOnTypeFormattingParams -> String)
-> ([DocumentOnTypeFormattingParams] -> ShowS)
-> Show DocumentOnTypeFormattingParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentOnTypeFormattingParams] -> ShowS
$cshowList :: [DocumentOnTypeFormattingParams] -> ShowS
show :: DocumentOnTypeFormattingParams -> String
$cshow :: DocumentOnTypeFormattingParams -> String
showsPrec :: Int -> DocumentOnTypeFormattingParams -> ShowS
$cshowsPrec :: Int -> DocumentOnTypeFormattingParams -> ShowS
Show,DocumentOnTypeFormattingParams
-> DocumentOnTypeFormattingParams -> Bool
(DocumentOnTypeFormattingParams
 -> DocumentOnTypeFormattingParams -> Bool)
-> (DocumentOnTypeFormattingParams
    -> DocumentOnTypeFormattingParams -> Bool)
-> Eq DocumentOnTypeFormattingParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentOnTypeFormattingParams
-> DocumentOnTypeFormattingParams -> Bool
$c/= :: DocumentOnTypeFormattingParams
-> DocumentOnTypeFormattingParams -> Bool
== :: DocumentOnTypeFormattingParams
-> DocumentOnTypeFormattingParams -> Bool
$c== :: DocumentOnTypeFormattingParams
-> DocumentOnTypeFormattingParams -> Bool
Eq)

deriveJSON lspOptions ''DocumentOnTypeFormattingParams

type DocumentOnTypeFormattingRequest  = RequestMessage ClientMethod DocumentOnTypeFormattingParams (List TextEdit)
type DocumentOnTypeFormattingResponse = ResponseMessage (List TextEdit)

data DocumentOnTypeFormattingRegistrationOptions =
  DocumentOnTypeFormattingRegistrationOptions
    { DocumentOnTypeFormattingRegistrationOptions -> Text
_firstTriggerCharacter :: Text
    , DocumentOnTypeFormattingRegistrationOptions -> Maybe (List String)
_moreTriggerCharacter  :: Maybe (List String)
    } deriving (Int -> DocumentOnTypeFormattingRegistrationOptions -> ShowS
[DocumentOnTypeFormattingRegistrationOptions] -> ShowS
DocumentOnTypeFormattingRegistrationOptions -> String
(Int -> DocumentOnTypeFormattingRegistrationOptions -> ShowS)
-> (DocumentOnTypeFormattingRegistrationOptions -> String)
-> ([DocumentOnTypeFormattingRegistrationOptions] -> ShowS)
-> Show DocumentOnTypeFormattingRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DocumentOnTypeFormattingRegistrationOptions] -> ShowS
$cshowList :: [DocumentOnTypeFormattingRegistrationOptions] -> ShowS
show :: DocumentOnTypeFormattingRegistrationOptions -> String
$cshow :: DocumentOnTypeFormattingRegistrationOptions -> String
showsPrec :: Int -> DocumentOnTypeFormattingRegistrationOptions -> ShowS
$cshowsPrec :: Int -> DocumentOnTypeFormattingRegistrationOptions -> ShowS
Show, ReadPrec [DocumentOnTypeFormattingRegistrationOptions]
ReadPrec DocumentOnTypeFormattingRegistrationOptions
Int -> ReadS DocumentOnTypeFormattingRegistrationOptions
ReadS [DocumentOnTypeFormattingRegistrationOptions]
(Int -> ReadS DocumentOnTypeFormattingRegistrationOptions)
-> ReadS [DocumentOnTypeFormattingRegistrationOptions]
-> ReadPrec DocumentOnTypeFormattingRegistrationOptions
-> ReadPrec [DocumentOnTypeFormattingRegistrationOptions]
-> Read DocumentOnTypeFormattingRegistrationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DocumentOnTypeFormattingRegistrationOptions]
$creadListPrec :: ReadPrec [DocumentOnTypeFormattingRegistrationOptions]
readPrec :: ReadPrec DocumentOnTypeFormattingRegistrationOptions
$creadPrec :: ReadPrec DocumentOnTypeFormattingRegistrationOptions
readList :: ReadS [DocumentOnTypeFormattingRegistrationOptions]
$creadList :: ReadS [DocumentOnTypeFormattingRegistrationOptions]
readsPrec :: Int -> ReadS DocumentOnTypeFormattingRegistrationOptions
$creadsPrec :: Int -> ReadS DocumentOnTypeFormattingRegistrationOptions
Read, DocumentOnTypeFormattingRegistrationOptions
-> DocumentOnTypeFormattingRegistrationOptions -> Bool
(DocumentOnTypeFormattingRegistrationOptions
 -> DocumentOnTypeFormattingRegistrationOptions -> Bool)
-> (DocumentOnTypeFormattingRegistrationOptions
    -> DocumentOnTypeFormattingRegistrationOptions -> Bool)
-> Eq DocumentOnTypeFormattingRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DocumentOnTypeFormattingRegistrationOptions
-> DocumentOnTypeFormattingRegistrationOptions -> Bool
$c/= :: DocumentOnTypeFormattingRegistrationOptions
-> DocumentOnTypeFormattingRegistrationOptions -> Bool
== :: DocumentOnTypeFormattingRegistrationOptions
-> DocumentOnTypeFormattingRegistrationOptions -> Bool
$c== :: DocumentOnTypeFormattingRegistrationOptions
-> DocumentOnTypeFormattingRegistrationOptions -> Bool
Eq)

deriveJSON lspOptions ''DocumentOnTypeFormattingRegistrationOptions

-- ---------------------------------------------------------------------
{-
Rename Request

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

The rename request is sent from the client to the server to perform a
workspace-wide rename of a symbol.

Request

    method: 'textDocument/rename'
    params: RenameParams defined as follows

interface RenameParams {
    /**
     * The document to format.
     */
    textDocument: TextDocumentIdentifier;

    /**
     * The position at which this request was sent.
     */
    position: Position;

    /**
     * The new name of the symbol. If the given name is not valid the
     * request must return a [ResponseError](#ResponseError) with an
     * appropriate message set.
     */
    newName: string;
}

Response

    result: WorkspaceEdit describing the modification to the workspace.
    error: code and message set in case an exception happens during the rename
           request.

Registration Options: TextDocumentRegistrationOptions

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

deriveJSON lspOptions ''RenameParams


-- {\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"textDocument/rename\",\"params\":{\"textDocument\":{\"uri\":\"file:///home/alanz/mysrc/github/alanz/haskell-lsp/src/HieVscode.hs\"},\"position\":{\"line\":37,\"character\":17},\"newName\":\"getArgs'\"}}

type RenameRequest  = RequestMessage ClientMethod RenameParams WorkspaceEdit
type RenameResponse = ResponseMessage WorkspaceEdit

-- ---------------------------------------------------------------------
{-
Prepare Rename Request

Since version 3.12.0

The prepare rename request is sent from the client to the server to setup
and test the validity of a rename operation at a given location.

Request:

    method: ‘textDocument/prepareRename’
    params: TextDocumentPositionParams

Response:

    result: Range | { range: Range, placeholder: string } | null describing
            the range of the string to rename and optionally a placeholder
            text of the string content to be renamed. If null is returned
            then it is deemed that a ‘textDocument/rename’ request is not
            valid at the given position.
    error: code and message set in case an exception happens during the
           prepare rename request.

-}

-- {\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"textDocument/rename\",\"params\":{\"textDocument\":{\"uri\":\"file:///home/alanz/mysrc/github/alanz/haskell-lsp/src/HieVscode.hs\"},\"position\":{\"line\":37,\"character\":17},\"newName\":\"getArgs'\"}}

data RangeWithPlaceholder =
  RangeWithPlaceholder
    {
    RangeWithPlaceholder -> Range
_range :: Range
    , RangeWithPlaceholder -> Text
_placeholder :: Text
    }

deriveJSON lspOptions { sumEncoding = A.UntaggedValue } ''RangeWithPlaceholder

data RangeOrRangeWithPlaceholder = RangeWithPlaceholderValue RangeWithPlaceholder
                                 | RangeValue Range

deriveJSON lspOptions { sumEncoding = A.UntaggedValue } ''RangeOrRangeWithPlaceholder

type PrepareRenameRequest  = RequestMessage ClientMethod TextDocumentPositionParams Range
type PrepareRenameResponse = ResponseMessage (Maybe RangeOrRangeWithPlaceholder)

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

Execute a command

The workspace/executeCommand request is sent from the client to the server to
trigger command execution on the server. In most cases the server creates a
WorkspaceEdit structure and applies the changes to the workspace using the
request workspace/applyEdit which is sent from the server to the client.

Request:

    method: 'workspace/executeCommand'
    params: ExecuteCommandParams defined as follows:

export interface ExecuteCommandParams {

        /**
         * The identifier of the actual command handler.
         */
        command: string;
        /**
         * Arguments that the command should be invoked with.
         */
        arguments?: any[];
}

The arguments are typically specified when a command is returned from the server
to the client. Example requests that return a command are
textDocument/codeAction or textDocument/codeLens.

Response:

    result: any
    error: code and message set in case an exception happens during the request.

Registration Options: ExecuteCommandRegistrationOptions defined as follows:

/**
 * Execute command registration options.
 */
export interface ExecuteCommandRegistrationOptions {
        /**
         * The commands to be executed on the server
         */
        commands: string[]
}
-}

data ExecuteCommandParams =
  ExecuteCommandParams
    { ExecuteCommandParams -> Text
_command   :: Text -- ^ The identifier of the actual command handler.
    , ExecuteCommandParams -> Maybe (List Value)
_arguments :: Maybe (List A.Value) -- ^ Arguments that the command should be invoked with.
    , ExecuteCommandParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken -- ^ An optional token that a server can use to report work done progress.
    } deriving (Int -> ExecuteCommandParams -> ShowS
[ExecuteCommandParams] -> ShowS
ExecuteCommandParams -> String
(Int -> ExecuteCommandParams -> ShowS)
-> (ExecuteCommandParams -> String)
-> ([ExecuteCommandParams] -> ShowS)
-> Show ExecuteCommandParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteCommandParams] -> ShowS
$cshowList :: [ExecuteCommandParams] -> ShowS
show :: ExecuteCommandParams -> String
$cshow :: ExecuteCommandParams -> String
showsPrec :: Int -> ExecuteCommandParams -> ShowS
$cshowsPrec :: Int -> ExecuteCommandParams -> ShowS
Show, ReadPrec [ExecuteCommandParams]
ReadPrec ExecuteCommandParams
Int -> ReadS ExecuteCommandParams
ReadS [ExecuteCommandParams]
(Int -> ReadS ExecuteCommandParams)
-> ReadS [ExecuteCommandParams]
-> ReadPrec ExecuteCommandParams
-> ReadPrec [ExecuteCommandParams]
-> Read ExecuteCommandParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecuteCommandParams]
$creadListPrec :: ReadPrec [ExecuteCommandParams]
readPrec :: ReadPrec ExecuteCommandParams
$creadPrec :: ReadPrec ExecuteCommandParams
readList :: ReadS [ExecuteCommandParams]
$creadList :: ReadS [ExecuteCommandParams]
readsPrec :: Int -> ReadS ExecuteCommandParams
$creadsPrec :: Int -> ReadS ExecuteCommandParams
Read, ExecuteCommandParams -> ExecuteCommandParams -> Bool
(ExecuteCommandParams -> ExecuteCommandParams -> Bool)
-> (ExecuteCommandParams -> ExecuteCommandParams -> Bool)
-> Eq ExecuteCommandParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
$c/= :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
== :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
$c== :: ExecuteCommandParams -> ExecuteCommandParams -> Bool
Eq)

deriveJSON lspOptions ''ExecuteCommandParams

type ExecuteCommandRequest = RequestMessage ClientMethod ExecuteCommandParams A.Value
type ExecuteCommandResponse = ResponseMessage A.Value

data ExecuteCommandRegistrationOptions =
  ExecuteCommandRegistrationOptions
    { ExecuteCommandRegistrationOptions -> List Text
_commands :: List Text
    } deriving (Int -> ExecuteCommandRegistrationOptions -> ShowS
[ExecuteCommandRegistrationOptions] -> ShowS
ExecuteCommandRegistrationOptions -> String
(Int -> ExecuteCommandRegistrationOptions -> ShowS)
-> (ExecuteCommandRegistrationOptions -> String)
-> ([ExecuteCommandRegistrationOptions] -> ShowS)
-> Show ExecuteCommandRegistrationOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExecuteCommandRegistrationOptions] -> ShowS
$cshowList :: [ExecuteCommandRegistrationOptions] -> ShowS
show :: ExecuteCommandRegistrationOptions -> String
$cshow :: ExecuteCommandRegistrationOptions -> String
showsPrec :: Int -> ExecuteCommandRegistrationOptions -> ShowS
$cshowsPrec :: Int -> ExecuteCommandRegistrationOptions -> ShowS
Show, ReadPrec [ExecuteCommandRegistrationOptions]
ReadPrec ExecuteCommandRegistrationOptions
Int -> ReadS ExecuteCommandRegistrationOptions
ReadS [ExecuteCommandRegistrationOptions]
(Int -> ReadS ExecuteCommandRegistrationOptions)
-> ReadS [ExecuteCommandRegistrationOptions]
-> ReadPrec ExecuteCommandRegistrationOptions
-> ReadPrec [ExecuteCommandRegistrationOptions]
-> Read ExecuteCommandRegistrationOptions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExecuteCommandRegistrationOptions]
$creadListPrec :: ReadPrec [ExecuteCommandRegistrationOptions]
readPrec :: ReadPrec ExecuteCommandRegistrationOptions
$creadPrec :: ReadPrec ExecuteCommandRegistrationOptions
readList :: ReadS [ExecuteCommandRegistrationOptions]
$creadList :: ReadS [ExecuteCommandRegistrationOptions]
readsPrec :: Int -> ReadS ExecuteCommandRegistrationOptions
$creadsPrec :: Int -> ReadS ExecuteCommandRegistrationOptions
Read, ExecuteCommandRegistrationOptions
-> ExecuteCommandRegistrationOptions -> Bool
(ExecuteCommandRegistrationOptions
 -> ExecuteCommandRegistrationOptions -> Bool)
-> (ExecuteCommandRegistrationOptions
    -> ExecuteCommandRegistrationOptions -> Bool)
-> Eq ExecuteCommandRegistrationOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExecuteCommandRegistrationOptions
-> ExecuteCommandRegistrationOptions -> Bool
$c/= :: ExecuteCommandRegistrationOptions
-> ExecuteCommandRegistrationOptions -> Bool
== :: ExecuteCommandRegistrationOptions
-> ExecuteCommandRegistrationOptions -> Bool
$c== :: ExecuteCommandRegistrationOptions
-> ExecuteCommandRegistrationOptions -> Bool
Eq)

deriveJSON lspOptions ''ExecuteCommandRegistrationOptions

-- ---------------------------------------------------------------------
{-
New in 3.0
----------

Applies a WorkspaceEdit

The workspace/applyEdit request is sent from the server to the client to modify
resource on the client side.

Request:

    method: 'workspace/applyEdit'
    params: ApplyWorkspaceEditParams defined as follows:

export interface ApplyWorkspaceEditParams {
        /**
         * The edits to apply.
         */
        edit: WorkspaceEdit;
}

Response:

    result: ApplyWorkspaceEditResponse defined as follows:

export interface ApplyWorkspaceEditResponse {
        /**
         * Indicates whether the edit was applied or not.
         */
        applied: boolean;
}

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

-}
data ApplyWorkspaceEditParams =
  ApplyWorkspaceEditParams
    { ApplyWorkspaceEditParams -> WorkspaceEdit
_edit :: WorkspaceEdit
    } deriving (Int -> ApplyWorkspaceEditParams -> ShowS
[ApplyWorkspaceEditParams] -> ShowS
ApplyWorkspaceEditParams -> String
(Int -> ApplyWorkspaceEditParams -> ShowS)
-> (ApplyWorkspaceEditParams -> String)
-> ([ApplyWorkspaceEditParams] -> ShowS)
-> Show ApplyWorkspaceEditParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyWorkspaceEditParams] -> ShowS
$cshowList :: [ApplyWorkspaceEditParams] -> ShowS
show :: ApplyWorkspaceEditParams -> String
$cshow :: ApplyWorkspaceEditParams -> String
showsPrec :: Int -> ApplyWorkspaceEditParams -> ShowS
$cshowsPrec :: Int -> ApplyWorkspaceEditParams -> ShowS
Show, ReadPrec [ApplyWorkspaceEditParams]
ReadPrec ApplyWorkspaceEditParams
Int -> ReadS ApplyWorkspaceEditParams
ReadS [ApplyWorkspaceEditParams]
(Int -> ReadS ApplyWorkspaceEditParams)
-> ReadS [ApplyWorkspaceEditParams]
-> ReadPrec ApplyWorkspaceEditParams
-> ReadPrec [ApplyWorkspaceEditParams]
-> Read ApplyWorkspaceEditParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplyWorkspaceEditParams]
$creadListPrec :: ReadPrec [ApplyWorkspaceEditParams]
readPrec :: ReadPrec ApplyWorkspaceEditParams
$creadPrec :: ReadPrec ApplyWorkspaceEditParams
readList :: ReadS [ApplyWorkspaceEditParams]
$creadList :: ReadS [ApplyWorkspaceEditParams]
readsPrec :: Int -> ReadS ApplyWorkspaceEditParams
$creadsPrec :: Int -> ReadS ApplyWorkspaceEditParams
Read, ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
(ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool)
-> (ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool)
-> Eq ApplyWorkspaceEditParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
$c/= :: ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
== :: ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
$c== :: ApplyWorkspaceEditParams -> ApplyWorkspaceEditParams -> Bool
Eq)

deriveJSON lspOptions ''ApplyWorkspaceEditParams

data ApplyWorkspaceEditResponseBody =
  ApplyWorkspaceEditResponseBody
    { ApplyWorkspaceEditResponseBody -> Bool
_applied :: Bool
    } deriving (Int -> ApplyWorkspaceEditResponseBody -> ShowS
[ApplyWorkspaceEditResponseBody] -> ShowS
ApplyWorkspaceEditResponseBody -> String
(Int -> ApplyWorkspaceEditResponseBody -> ShowS)
-> (ApplyWorkspaceEditResponseBody -> String)
-> ([ApplyWorkspaceEditResponseBody] -> ShowS)
-> Show ApplyWorkspaceEditResponseBody
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApplyWorkspaceEditResponseBody] -> ShowS
$cshowList :: [ApplyWorkspaceEditResponseBody] -> ShowS
show :: ApplyWorkspaceEditResponseBody -> String
$cshow :: ApplyWorkspaceEditResponseBody -> String
showsPrec :: Int -> ApplyWorkspaceEditResponseBody -> ShowS
$cshowsPrec :: Int -> ApplyWorkspaceEditResponseBody -> ShowS
Show, ReadPrec [ApplyWorkspaceEditResponseBody]
ReadPrec ApplyWorkspaceEditResponseBody
Int -> ReadS ApplyWorkspaceEditResponseBody
ReadS [ApplyWorkspaceEditResponseBody]
(Int -> ReadS ApplyWorkspaceEditResponseBody)
-> ReadS [ApplyWorkspaceEditResponseBody]
-> ReadPrec ApplyWorkspaceEditResponseBody
-> ReadPrec [ApplyWorkspaceEditResponseBody]
-> Read ApplyWorkspaceEditResponseBody
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ApplyWorkspaceEditResponseBody]
$creadListPrec :: ReadPrec [ApplyWorkspaceEditResponseBody]
readPrec :: ReadPrec ApplyWorkspaceEditResponseBody
$creadPrec :: ReadPrec ApplyWorkspaceEditResponseBody
readList :: ReadS [ApplyWorkspaceEditResponseBody]
$creadList :: ReadS [ApplyWorkspaceEditResponseBody]
readsPrec :: Int -> ReadS ApplyWorkspaceEditResponseBody
$creadsPrec :: Int -> ReadS ApplyWorkspaceEditResponseBody
Read, ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
(ApplyWorkspaceEditResponseBody
 -> ApplyWorkspaceEditResponseBody -> Bool)
-> (ApplyWorkspaceEditResponseBody
    -> ApplyWorkspaceEditResponseBody -> Bool)
-> Eq ApplyWorkspaceEditResponseBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
$c/= :: ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
== :: ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
$c== :: ApplyWorkspaceEditResponseBody
-> ApplyWorkspaceEditResponseBody -> Bool
Eq)

deriveJSON lspOptions ''ApplyWorkspaceEditResponseBody

-- | Sent from the server to the client
type ApplyWorkspaceEditRequest  = RequestMessage ServerMethod ApplyWorkspaceEditParams ApplyWorkspaceEditResponseBody
type ApplyWorkspaceEditResponse = ResponseMessage ApplyWorkspaceEditResponseBody

-- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

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

data TraceParams =
  TraceParams {
    TraceParams -> Text
_value :: Text
  } deriving (Int -> TraceParams -> ShowS
[TraceParams] -> ShowS
TraceParams -> String
(Int -> TraceParams -> ShowS)
-> (TraceParams -> String)
-> ([TraceParams] -> ShowS)
-> Show TraceParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceParams] -> ShowS
$cshowList :: [TraceParams] -> ShowS
show :: TraceParams -> String
$cshow :: TraceParams -> String
showsPrec :: Int -> TraceParams -> ShowS
$cshowsPrec :: Int -> TraceParams -> ShowS
Show, ReadPrec [TraceParams]
ReadPrec TraceParams
Int -> ReadS TraceParams
ReadS [TraceParams]
(Int -> ReadS TraceParams)
-> ReadS [TraceParams]
-> ReadPrec TraceParams
-> ReadPrec [TraceParams]
-> Read TraceParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TraceParams]
$creadListPrec :: ReadPrec [TraceParams]
readPrec :: ReadPrec TraceParams
$creadPrec :: ReadPrec TraceParams
readList :: ReadS [TraceParams]
$creadList :: ReadS [TraceParams]
readsPrec :: Int -> ReadS TraceParams
$creadsPrec :: Int -> ReadS TraceParams
Read, TraceParams -> TraceParams -> Bool
(TraceParams -> TraceParams -> Bool)
-> (TraceParams -> TraceParams -> Bool) -> Eq TraceParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceParams -> TraceParams -> Bool
$c/= :: TraceParams -> TraceParams -> Bool
== :: TraceParams -> TraceParams -> Bool
$c== :: TraceParams -> TraceParams -> Bool
Eq)

deriveJSON lspOptions ''TraceParams


data TraceNotification =
  TraceNotification {
    TraceNotification -> TraceParams
_params :: TraceParams
  } deriving (Int -> TraceNotification -> ShowS
[TraceNotification] -> ShowS
TraceNotification -> String
(Int -> TraceNotification -> ShowS)
-> (TraceNotification -> String)
-> ([TraceNotification] -> ShowS)
-> Show TraceNotification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceNotification] -> ShowS
$cshowList :: [TraceNotification] -> ShowS
show :: TraceNotification -> String
$cshow :: TraceNotification -> String
showsPrec :: Int -> TraceNotification -> ShowS
$cshowsPrec :: Int -> TraceNotification -> ShowS
Show, ReadPrec [TraceNotification]
ReadPrec TraceNotification
Int -> ReadS TraceNotification
ReadS [TraceNotification]
(Int -> ReadS TraceNotification)
-> ReadS [TraceNotification]
-> ReadPrec TraceNotification
-> ReadPrec [TraceNotification]
-> Read TraceNotification
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TraceNotification]
$creadListPrec :: ReadPrec [TraceNotification]
readPrec :: ReadPrec TraceNotification
$creadPrec :: ReadPrec TraceNotification
readList :: ReadS [TraceNotification]
$creadList :: ReadS [TraceNotification]
readsPrec :: Int -> ReadS TraceNotification
$creadsPrec :: Int -> ReadS TraceNotification
Read, TraceNotification -> TraceNotification -> Bool
(TraceNotification -> TraceNotification -> Bool)
-> (TraceNotification -> TraceNotification -> Bool)
-> Eq TraceNotification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceNotification -> TraceNotification -> Bool
$c/= :: TraceNotification -> TraceNotification -> Bool
== :: TraceNotification -> TraceNotification -> Bool
$c== :: TraceNotification -> TraceNotification -> Bool
Eq)

deriveJSON lspOptions ''TraceNotification