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

import           Control.Applicative
import qualified Data.Aeson                    as A
import           Data.Aeson.TH
import           Data.Scientific                ( Scientific )
import           Data.Text                      ( Text )
import           Language.Haskell.LSP.Types.Command
import           Language.Haskell.LSP.Types.Constants
import           Language.Haskell.LSP.Types.DocumentFilter
import           Language.Haskell.LSP.Types.List
import           Language.Haskell.LSP.Types.Location
import           Language.Haskell.LSP.Types.MarkupContent
import           Language.Haskell.LSP.Types.Message
import           Language.Haskell.LSP.Types.Progress
import           Language.Haskell.LSP.Types.TextDocument
import           Language.Haskell.LSP.Types.Utils
import           Language.Haskell.LSP.Types.WorkspaceEdit

data CompletionItemKind = CiText
                        | CiMethod
                        | CiFunction
                        | CiConstructor
                        | CiField
                        | CiVariable
                        | CiClass
                        | CiInterface
                        | CiModule
                        | CiProperty
                        | CiUnit
                        | CiValue
                        | CiEnum
                        | CiKeyword
                        | CiSnippet
                        | CiColor
                        | CiFile
                        | CiReference
                        | CiFolder
                        | CiEnumMember
                        | CiConstant
                        | CiStruct
                        | CiEvent
                        | CiOperator
                        | CiTypeParameter
         deriving (ReadPrec [CompletionItemKind]
ReadPrec CompletionItemKind
Int -> ReadS CompletionItemKind
ReadS [CompletionItemKind]
(Int -> ReadS CompletionItemKind)
-> ReadS [CompletionItemKind]
-> ReadPrec CompletionItemKind
-> ReadPrec [CompletionItemKind]
-> Read CompletionItemKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionItemKind]
$creadListPrec :: ReadPrec [CompletionItemKind]
readPrec :: ReadPrec CompletionItemKind
$creadPrec :: ReadPrec CompletionItemKind
readList :: ReadS [CompletionItemKind]
$creadList :: ReadS [CompletionItemKind]
readsPrec :: Int -> ReadS CompletionItemKind
$creadsPrec :: Int -> ReadS CompletionItemKind
Read,Int -> CompletionItemKind -> ShowS
[CompletionItemKind] -> ShowS
CompletionItemKind -> String
(Int -> CompletionItemKind -> ShowS)
-> (CompletionItemKind -> String)
-> ([CompletionItemKind] -> ShowS)
-> Show CompletionItemKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionItemKind] -> ShowS
$cshowList :: [CompletionItemKind] -> ShowS
show :: CompletionItemKind -> String
$cshow :: CompletionItemKind -> String
showsPrec :: Int -> CompletionItemKind -> ShowS
$cshowsPrec :: Int -> CompletionItemKind -> ShowS
Show,CompletionItemKind -> CompletionItemKind -> Bool
(CompletionItemKind -> CompletionItemKind -> Bool)
-> (CompletionItemKind -> CompletionItemKind -> Bool)
-> Eq CompletionItemKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionItemKind -> CompletionItemKind -> Bool
$c/= :: CompletionItemKind -> CompletionItemKind -> Bool
== :: CompletionItemKind -> CompletionItemKind -> Bool
$c== :: CompletionItemKind -> CompletionItemKind -> Bool
Eq,Eq CompletionItemKind
Eq CompletionItemKind
-> (CompletionItemKind -> CompletionItemKind -> Ordering)
-> (CompletionItemKind -> CompletionItemKind -> Bool)
-> (CompletionItemKind -> CompletionItemKind -> Bool)
-> (CompletionItemKind -> CompletionItemKind -> Bool)
-> (CompletionItemKind -> CompletionItemKind -> Bool)
-> (CompletionItemKind -> CompletionItemKind -> CompletionItemKind)
-> (CompletionItemKind -> CompletionItemKind -> CompletionItemKind)
-> Ord CompletionItemKind
CompletionItemKind -> CompletionItemKind -> Bool
CompletionItemKind -> CompletionItemKind -> Ordering
CompletionItemKind -> CompletionItemKind -> CompletionItemKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompletionItemKind -> CompletionItemKind -> CompletionItemKind
$cmin :: CompletionItemKind -> CompletionItemKind -> CompletionItemKind
max :: CompletionItemKind -> CompletionItemKind -> CompletionItemKind
$cmax :: CompletionItemKind -> CompletionItemKind -> CompletionItemKind
>= :: CompletionItemKind -> CompletionItemKind -> Bool
$c>= :: CompletionItemKind -> CompletionItemKind -> Bool
> :: CompletionItemKind -> CompletionItemKind -> Bool
$c> :: CompletionItemKind -> CompletionItemKind -> Bool
<= :: CompletionItemKind -> CompletionItemKind -> Bool
$c<= :: CompletionItemKind -> CompletionItemKind -> Bool
< :: CompletionItemKind -> CompletionItemKind -> Bool
$c< :: CompletionItemKind -> CompletionItemKind -> Bool
compare :: CompletionItemKind -> CompletionItemKind -> Ordering
$ccompare :: CompletionItemKind -> CompletionItemKind -> Ordering
$cp1Ord :: Eq CompletionItemKind
Ord)

instance A.ToJSON CompletionItemKind where
  toJSON :: CompletionItemKind -> Value
toJSON CompletionItemKind
CiText          = Scientific -> Value
A.Number Scientific
1
  toJSON CompletionItemKind
CiMethod        = Scientific -> Value
A.Number Scientific
2
  toJSON CompletionItemKind
CiFunction      = Scientific -> Value
A.Number Scientific
3
  toJSON CompletionItemKind
CiConstructor   = Scientific -> Value
A.Number Scientific
4
  toJSON CompletionItemKind
CiField         = Scientific -> Value
A.Number Scientific
5
  toJSON CompletionItemKind
CiVariable      = Scientific -> Value
A.Number Scientific
6
  toJSON CompletionItemKind
CiClass         = Scientific -> Value
A.Number Scientific
7
  toJSON CompletionItemKind
CiInterface     = Scientific -> Value
A.Number Scientific
8
  toJSON CompletionItemKind
CiModule        = Scientific -> Value
A.Number Scientific
9
  toJSON CompletionItemKind
CiProperty      = Scientific -> Value
A.Number Scientific
10
  toJSON CompletionItemKind
CiUnit          = Scientific -> Value
A.Number Scientific
11
  toJSON CompletionItemKind
CiValue         = Scientific -> Value
A.Number Scientific
12
  toJSON CompletionItemKind
CiEnum          = Scientific -> Value
A.Number Scientific
13
  toJSON CompletionItemKind
CiKeyword       = Scientific -> Value
A.Number Scientific
14
  toJSON CompletionItemKind
CiSnippet       = Scientific -> Value
A.Number Scientific
15
  toJSON CompletionItemKind
CiColor         = Scientific -> Value
A.Number Scientific
16
  toJSON CompletionItemKind
CiFile          = Scientific -> Value
A.Number Scientific
17
  toJSON CompletionItemKind
CiReference     = Scientific -> Value
A.Number Scientific
18
  toJSON CompletionItemKind
CiFolder        = Scientific -> Value
A.Number Scientific
19
  toJSON CompletionItemKind
CiEnumMember    = Scientific -> Value
A.Number Scientific
20
  toJSON CompletionItemKind
CiConstant      = Scientific -> Value
A.Number Scientific
21
  toJSON CompletionItemKind
CiStruct        = Scientific -> Value
A.Number Scientific
22
  toJSON CompletionItemKind
CiEvent         = Scientific -> Value
A.Number Scientific
23
  toJSON CompletionItemKind
CiOperator      = Scientific -> Value
A.Number Scientific
24
  toJSON CompletionItemKind
CiTypeParameter = Scientific -> Value
A.Number Scientific
25

instance A.FromJSON CompletionItemKind where
  parseJSON :: Value -> Parser CompletionItemKind
parseJSON (A.Number  Scientific
1) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiText
  parseJSON (A.Number  Scientific
2) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiMethod
  parseJSON (A.Number  Scientific
3) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiFunction
  parseJSON (A.Number  Scientific
4) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiConstructor
  parseJSON (A.Number  Scientific
5) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiField
  parseJSON (A.Number  Scientific
6) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiVariable
  parseJSON (A.Number  Scientific
7) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiClass
  parseJSON (A.Number  Scientific
8) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiInterface
  parseJSON (A.Number  Scientific
9) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiModule
  parseJSON (A.Number Scientific
10) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiProperty
  parseJSON (A.Number Scientific
11) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiUnit
  parseJSON (A.Number Scientific
12) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiValue
  parseJSON (A.Number Scientific
13) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiEnum
  parseJSON (A.Number Scientific
14) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiKeyword
  parseJSON (A.Number Scientific
15) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiSnippet
  parseJSON (A.Number Scientific
16) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiColor
  parseJSON (A.Number Scientific
17) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiFile
  parseJSON (A.Number Scientific
18) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiReference
  parseJSON (A.Number Scientific
19) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiFolder
  parseJSON (A.Number Scientific
20) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiEnumMember
  parseJSON (A.Number Scientific
21) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiConstant
  parseJSON (A.Number Scientific
22) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiStruct
  parseJSON (A.Number Scientific
23) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiEvent
  parseJSON (A.Number Scientific
24) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiOperator
  parseJSON (A.Number Scientific
25) = CompletionItemKind -> Parser CompletionItemKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemKind
CiTypeParameter
  parseJSON Value
_             = Parser CompletionItemKind
forall a. Monoid a => a
mempty

data CompletionItemTag
  -- | Render a completion as obsolete, usually using a strike-out.
  = CtDeprecated
  deriving (CompletionItemTag -> CompletionItemTag -> Bool
(CompletionItemTag -> CompletionItemTag -> Bool)
-> (CompletionItemTag -> CompletionItemTag -> Bool)
-> Eq CompletionItemTag
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionItemTag -> CompletionItemTag -> Bool
$c/= :: CompletionItemTag -> CompletionItemTag -> Bool
== :: CompletionItemTag -> CompletionItemTag -> Bool
$c== :: CompletionItemTag -> CompletionItemTag -> Bool
Eq, Eq CompletionItemTag
Eq CompletionItemTag
-> (CompletionItemTag -> CompletionItemTag -> Ordering)
-> (CompletionItemTag -> CompletionItemTag -> Bool)
-> (CompletionItemTag -> CompletionItemTag -> Bool)
-> (CompletionItemTag -> CompletionItemTag -> Bool)
-> (CompletionItemTag -> CompletionItemTag -> Bool)
-> (CompletionItemTag -> CompletionItemTag -> CompletionItemTag)
-> (CompletionItemTag -> CompletionItemTag -> CompletionItemTag)
-> Ord CompletionItemTag
CompletionItemTag -> CompletionItemTag -> Bool
CompletionItemTag -> CompletionItemTag -> Ordering
CompletionItemTag -> CompletionItemTag -> CompletionItemTag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CompletionItemTag -> CompletionItemTag -> CompletionItemTag
$cmin :: CompletionItemTag -> CompletionItemTag -> CompletionItemTag
max :: CompletionItemTag -> CompletionItemTag -> CompletionItemTag
$cmax :: CompletionItemTag -> CompletionItemTag -> CompletionItemTag
>= :: CompletionItemTag -> CompletionItemTag -> Bool
$c>= :: CompletionItemTag -> CompletionItemTag -> Bool
> :: CompletionItemTag -> CompletionItemTag -> Bool
$c> :: CompletionItemTag -> CompletionItemTag -> Bool
<= :: CompletionItemTag -> CompletionItemTag -> Bool
$c<= :: CompletionItemTag -> CompletionItemTag -> Bool
< :: CompletionItemTag -> CompletionItemTag -> Bool
$c< :: CompletionItemTag -> CompletionItemTag -> Bool
compare :: CompletionItemTag -> CompletionItemTag -> Ordering
$ccompare :: CompletionItemTag -> CompletionItemTag -> Ordering
$cp1Ord :: Eq CompletionItemTag
Ord, Int -> CompletionItemTag -> ShowS
[CompletionItemTag] -> ShowS
CompletionItemTag -> String
(Int -> CompletionItemTag -> ShowS)
-> (CompletionItemTag -> String)
-> ([CompletionItemTag] -> ShowS)
-> Show CompletionItemTag
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionItemTag] -> ShowS
$cshowList :: [CompletionItemTag] -> ShowS
show :: CompletionItemTag -> String
$cshow :: CompletionItemTag -> String
showsPrec :: Int -> CompletionItemTag -> ShowS
$cshowsPrec :: Int -> CompletionItemTag -> ShowS
Show, ReadPrec [CompletionItemTag]
ReadPrec CompletionItemTag
Int -> ReadS CompletionItemTag
ReadS [CompletionItemTag]
(Int -> ReadS CompletionItemTag)
-> ReadS [CompletionItemTag]
-> ReadPrec CompletionItemTag
-> ReadPrec [CompletionItemTag]
-> Read CompletionItemTag
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionItemTag]
$creadListPrec :: ReadPrec [CompletionItemTag]
readPrec :: ReadPrec CompletionItemTag
$creadPrec :: ReadPrec CompletionItemTag
readList :: ReadS [CompletionItemTag]
$creadList :: ReadS [CompletionItemTag]
readsPrec :: Int -> ReadS CompletionItemTag
$creadsPrec :: Int -> ReadS CompletionItemTag
Read)

instance A.ToJSON CompletionItemTag where
  toJSON :: CompletionItemTag -> Value
toJSON CompletionItemTag
CtDeprecated  = Scientific -> Value
A.Number Scientific
1

instance A.FromJSON CompletionItemTag where
  parseJSON :: Value -> Parser CompletionItemTag
parseJSON (A.Number Scientific
1) = CompletionItemTag -> Parser CompletionItemTag
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionItemTag
CtDeprecated
  parseJSON Value
_            = Parser CompletionItemTag
forall a. Monoid a => a
mempty

-- ---------------------------------------------------------------------
{-
Completion Request

The Completion request is sent from the client to the server to compute
completion items at a given cursor position. Completion items are presented in
the IntelliSense user interface. If computing full completion items is
expensive, servers can additionally provide a handler for the completion item
resolve request ('completionItem/resolve'). This request is sent when a
completion item is selected in the user interface. A typically use case is for
example: the 'textDocument/completion' request doesn't fill in the documentation
property for returned completion items since it is expensive to compute. When
the item is selected in the user interface then a 'completionItem/resolve'
request is sent with the selected completion item as a param. The returned
completion item should have the documentation property filled in.

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

Request

    method: 'textDocument/completion'
    params: TextDocumentPositionParams
-}

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

{-

Response

    result: CompletionItem[] | CompletionList

/**
 * Represents a collection of [completion items](#CompletionItem) to be presented
 * in the editor.
 */
interface CompletionList {
    /**
     * This list it not complete. Further typing should result in recomputing
     * this list.
     */
    isIncomplete: boolean;
    /**
     * The completion items.
     */
    items: CompletionItem[];
}


New in 3.0 : InsertTextFormat

/**
 * Defines whether the insert text in a completion item should be interpreted as
 * plain text or a snippet.
 */
namespace InsertTextFormat {
        /**
         * The primary text to be inserted is treated as a plain string.
         */
        export const PlainText = 1;

        /**
         * The primary text to be inserted is treated as a snippet.
         *
         * A snippet can define tab stops and placeholders with `$1`, `$2`
         * and `${3:foo}`. `$0` defines the final tab stop, it defaults to
         * the end of the snippet. Placeholders with equal identifiers are linked,
         * that is typing in one will update others too.
         *
         * See also: https://github.com/Microsoft/vscode/blob/master/src/vs/editor/contrib/snippet/common/snippet.md
         */
        export const Snippet = 2;
}



interface CompletionItem {
    /**
     * The label of this completion item. By default
     * also the text that is inserted when selecting
     * this completion.
     */
    label: string;
    /**
     * The kind of this completion item. Based of the kind
     * an icon is chosen by the editor.
     */
    kind?: number;
    /**
     * Tags for this completion item.
     */
    tags?: CompletionItemTag[];
    /**
     * A human-readable string with additional information
     * about this item, like type or symbol information.
     */
    detail?: string;
    /**
     * A human-readable string that represents a doc-comment.
     */
    documentation?: string;
    /**
     * A string that shoud be used when comparing this item
     * with other items. When `falsy` the label is used.
     */
    sortText?: string;
    /**
     * A string that should be used when filtering a set of
     * completion items. When `falsy` the label is used.
     */
    filterText?: string;
    /**
     * A string that should be inserted a document when selecting
     * this completion. When `falsy` the label is used.
     */
    insertText?: string;
    -- Following field is new in 3.0
        /**
         * The format of the insert text. The format applies to both the `insertText` property
         * and the `newText` property of a provided `textEdit`.
         */
    insertTextFormat?: InsertTextFormat;
        /**
         * An edit which is applied to a document when selecting this completion. When an edit is provided the value of
         * `insertText` is ignored.
         *
         * *Note:* The range of the edit must be a single line range and it must contain the position at which completion
         * has been requested.
         */

    textEdit?: TextEdit;

    -- Following field is new in 3.0
        /**
         * An optional array of additional text edits that are applied when
         * selecting this completion. Edits must not overlap with the main edit
         * nor with themselves.
         */
    additionalTextEdits?: TextEdit[];
    -- Following field is new in 3.0
        /**
         * An optional command that is executed *after* inserting this completion. *Note* that
         * additional modifications to the current document should be described with the
         * additionalTextEdits-property.
         */

    command?: Command;
        /**
         * An data entry field that is preserved on a completion item between
         * a completion and a completion resolve request.
         */

    data?: any
}

Where CompletionItemKind is defined as follows:

/**
 * The kind of a completion entry.
 */
enum CompletionItemKind {
    Text = 1,
    Method = 2,
    Function = 3,
    Constructor = 4,
    Field = 5,
    Variable = 6,
    Class = 7,
    Interface = 8,
    Module = 9,
    Property = 10,
    Unit = 11,
    Value = 12,
    Enum = 13,
    Keyword = 14,
    Snippet = 15,
    Color = 16,
    File = 17,
    Reference = 18
}

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

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

data InsertTextFormat
  = PlainText -- ^The primary text to be inserted is treated as a plain string.
  | Snippet
      -- ^ The primary text to be inserted is treated as a snippet.
      --
      -- A snippet can define tab stops and placeholders with `$1`, `$2`
      -- and `${3:foo}`. `$0` defines the final tab stop, it defaults to
      -- the end of the snippet. Placeholders with equal identifiers are linked,
      -- that is typing in one will update others too.
      --
      -- See also: https://github.com/Microsoft/vscode/blob/master/src/vs/editor/contrib/snippet/common/snippet.md
    deriving (Int -> InsertTextFormat -> ShowS
[InsertTextFormat] -> ShowS
InsertTextFormat -> String
(Int -> InsertTextFormat -> ShowS)
-> (InsertTextFormat -> String)
-> ([InsertTextFormat] -> ShowS)
-> Show InsertTextFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InsertTextFormat] -> ShowS
$cshowList :: [InsertTextFormat] -> ShowS
show :: InsertTextFormat -> String
$cshow :: InsertTextFormat -> String
showsPrec :: Int -> InsertTextFormat -> ShowS
$cshowsPrec :: Int -> InsertTextFormat -> ShowS
Show, ReadPrec [InsertTextFormat]
ReadPrec InsertTextFormat
Int -> ReadS InsertTextFormat
ReadS [InsertTextFormat]
(Int -> ReadS InsertTextFormat)
-> ReadS [InsertTextFormat]
-> ReadPrec InsertTextFormat
-> ReadPrec [InsertTextFormat]
-> Read InsertTextFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [InsertTextFormat]
$creadListPrec :: ReadPrec [InsertTextFormat]
readPrec :: ReadPrec InsertTextFormat
$creadPrec :: ReadPrec InsertTextFormat
readList :: ReadS [InsertTextFormat]
$creadList :: ReadS [InsertTextFormat]
readsPrec :: Int -> ReadS InsertTextFormat
$creadsPrec :: Int -> ReadS InsertTextFormat
Read, InsertTextFormat -> InsertTextFormat -> Bool
(InsertTextFormat -> InsertTextFormat -> Bool)
-> (InsertTextFormat -> InsertTextFormat -> Bool)
-> Eq InsertTextFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertTextFormat -> InsertTextFormat -> Bool
$c/= :: InsertTextFormat -> InsertTextFormat -> Bool
== :: InsertTextFormat -> InsertTextFormat -> Bool
$c== :: InsertTextFormat -> InsertTextFormat -> Bool
Eq)

instance A.ToJSON InsertTextFormat where
  toJSON :: InsertTextFormat -> Value
toJSON InsertTextFormat
PlainText = Scientific -> Value
A.Number Scientific
1
  toJSON InsertTextFormat
Snippet   = Scientific -> Value
A.Number Scientific
2

instance A.FromJSON InsertTextFormat where
  parseJSON :: Value -> Parser InsertTextFormat
parseJSON (A.Number  Scientific
1) = InsertTextFormat -> Parser InsertTextFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure InsertTextFormat
PlainText
  parseJSON (A.Number  Scientific
2) = InsertTextFormat -> Parser InsertTextFormat
forall (f :: * -> *) a. Applicative f => a -> f a
pure InsertTextFormat
Snippet
  parseJSON Value
_             = Parser InsertTextFormat
forall a. Monoid a => a
mempty

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

instance A.ToJSON CompletionDoc where
  toJSON :: CompletionDoc -> Value
toJSON (CompletionDocString Text
x) = Text -> Value
forall a. ToJSON a => a -> Value
A.toJSON Text
x
  toJSON (CompletionDocMarkup MarkupContent
x) = MarkupContent -> Value
forall a. ToJSON a => a -> Value
A.toJSON MarkupContent
x

instance A.FromJSON CompletionDoc where
  parseJSON :: Value -> Parser CompletionDoc
parseJSON Value
x = Text -> CompletionDoc
CompletionDocString (Text -> CompletionDoc) -> Parser Text -> Parser CompletionDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Text
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
x Parser CompletionDoc
-> Parser CompletionDoc -> Parser CompletionDoc
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> MarkupContent -> CompletionDoc
CompletionDocMarkup (MarkupContent -> CompletionDoc)
-> Parser MarkupContent -> Parser CompletionDoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser MarkupContent
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
x

data CompletionItem =
  CompletionItem
    { CompletionItem -> Text
_label               :: Text -- ^ The label of this completion item. By default also
                       -- the text that is inserted when selecting this
                       -- completion.
    , CompletionItem -> Maybe CompletionItemKind
_kind                :: Maybe CompletionItemKind
    , CompletionItem -> Maybe (List CompletionItemTag)
_tags                :: Maybe (List CompletionItemTag) -- ^ Tags for this completion item.
    , CompletionItem -> Maybe Text
_detail              :: Maybe Text -- ^ A human-readable string with additional
                              -- information about this item, like type or
                              -- symbol information.
    , CompletionItem -> Maybe CompletionDoc
_documentation       :: Maybe CompletionDoc -- ^ A human-readable string that represents
                                                  -- a doc-comment.
    , CompletionItem -> Maybe Bool
_deprecated          :: Maybe Bool -- ^ Indicates if this item is deprecated.
    , CompletionItem -> Maybe Bool
_preselect           :: Maybe Bool
         -- ^ Select this item when showing.
         -- *Note* that only one completion item can be selected and that the
         -- tool / client decides which item that is. The rule is that the *first*
         -- item of those that match best is selected.
    , CompletionItem -> Maybe Text
_sortText            :: Maybe Text -- ^ A string that should be used when filtering
                                -- a set of completion items. When `falsy` the
                                -- label is used.
    , CompletionItem -> Maybe Text
_filterText          :: Maybe Text -- ^ A string that should be used when
                                  -- filtering a set of completion items. When
                                  -- `falsy` the label is used.
    , CompletionItem -> Maybe Text
_insertText          :: Maybe Text -- ^ A string that should be inserted a
                                  -- document when selecting this completion.
                                  -- When `falsy` the label is used.
    , CompletionItem -> Maybe InsertTextFormat
_insertTextFormat    :: Maybe InsertTextFormat
         -- ^ The format of the insert text. The format applies to both the
         -- `insertText` property and the `newText` property of a provided
         -- `textEdit`.
    , CompletionItem -> Maybe TextEdit
_textEdit            :: Maybe TextEdit
         -- ^ An edit which is applied to a document when selecting this
         -- completion. When an edit is provided the value of `insertText` is
         -- ignored.
         --
         -- *Note:* The range of the edit must be a single line range and it
         -- must contain the position at which completion has been requested.
    , CompletionItem -> Maybe (List TextEdit)
_additionalTextEdits :: Maybe (List TextEdit)
         -- ^ An optional array of additional text edits that are applied when
         -- selecting this completion. Edits must not overlap with the main edit
         -- nor with themselves.
    , CompletionItem -> Maybe (List Text)
_commitCharacters    :: Maybe (List Text)
         -- ^ An optional set of characters that when pressed while this completion
         -- is active will accept it first and then type that character. *Note*
         -- that all commit characters should have `length=1` and that superfluous
         -- characters will be ignored.
    , CompletionItem -> Maybe Command
_command             :: Maybe Command
        -- ^ An optional command that is executed *after* inserting this
        -- completion. *Note* that additional modifications to the current
        -- document should be described with the additionalTextEdits-property.
    , CompletionItem -> Maybe Value
_xdata               :: Maybe A.Value -- ^ An data entry field that is preserved on a
                              -- completion item between a completion and a
                              -- completion resolve request.
    } deriving (ReadPrec [CompletionItem]
ReadPrec CompletionItem
Int -> ReadS CompletionItem
ReadS [CompletionItem]
(Int -> ReadS CompletionItem)
-> ReadS [CompletionItem]
-> ReadPrec CompletionItem
-> ReadPrec [CompletionItem]
-> Read CompletionItem
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionItem]
$creadListPrec :: ReadPrec [CompletionItem]
readPrec :: ReadPrec CompletionItem
$creadPrec :: ReadPrec CompletionItem
readList :: ReadS [CompletionItem]
$creadList :: ReadS [CompletionItem]
readsPrec :: Int -> ReadS CompletionItem
$creadsPrec :: Int -> ReadS CompletionItem
Read,Int -> CompletionItem -> ShowS
[CompletionItem] -> ShowS
CompletionItem -> String
(Int -> CompletionItem -> ShowS)
-> (CompletionItem -> String)
-> ([CompletionItem] -> ShowS)
-> Show CompletionItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionItem] -> ShowS
$cshowList :: [CompletionItem] -> ShowS
show :: CompletionItem -> String
$cshow :: CompletionItem -> String
showsPrec :: Int -> CompletionItem -> ShowS
$cshowsPrec :: Int -> CompletionItem -> ShowS
Show,CompletionItem -> CompletionItem -> Bool
(CompletionItem -> CompletionItem -> Bool)
-> (CompletionItem -> CompletionItem -> Bool) -> Eq CompletionItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionItem -> CompletionItem -> Bool
$c/= :: CompletionItem -> CompletionItem -> Bool
== :: CompletionItem -> CompletionItem -> Bool
$c== :: CompletionItem -> CompletionItem -> Bool
Eq)

deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''CompletionItem

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

deriveJSON lspOptions ''CompletionListType

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

deriveJSON defaultOptions { fieldLabelModifier = rdrop (length ("CompletionResponseResult"::String)), sumEncoding = UntaggedValue } ''CompletionResponseResult

-- | How a completion was triggered
data CompletionTriggerKind = -- | Completion was triggered by typing an identifier (24x7 code
                             -- complete), manual invocation (e.g Ctrl+Space) or via API.
                             CtInvoked
                             -- | Completion was triggered by a trigger character specified by
                             -- the `triggerCharacters` properties of the `CompletionRegistrationOptions`.
                           | CtTriggerCharacter
                             -- | Completion was re-triggered as the current completion list is incomplete.
                           | CtTriggerForIncompleteCompletions
                             -- | An unknown 'CompletionTriggerKind' not yet supported in haskell-lsp.
                           | CtUnknown Scientific
  deriving (ReadPrec [CompletionTriggerKind]
ReadPrec CompletionTriggerKind
Int -> ReadS CompletionTriggerKind
ReadS [CompletionTriggerKind]
(Int -> ReadS CompletionTriggerKind)
-> ReadS [CompletionTriggerKind]
-> ReadPrec CompletionTriggerKind
-> ReadPrec [CompletionTriggerKind]
-> Read CompletionTriggerKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionTriggerKind]
$creadListPrec :: ReadPrec [CompletionTriggerKind]
readPrec :: ReadPrec CompletionTriggerKind
$creadPrec :: ReadPrec CompletionTriggerKind
readList :: ReadS [CompletionTriggerKind]
$creadList :: ReadS [CompletionTriggerKind]
readsPrec :: Int -> ReadS CompletionTriggerKind
$creadsPrec :: Int -> ReadS CompletionTriggerKind
Read, Int -> CompletionTriggerKind -> ShowS
[CompletionTriggerKind] -> ShowS
CompletionTriggerKind -> String
(Int -> CompletionTriggerKind -> ShowS)
-> (CompletionTriggerKind -> String)
-> ([CompletionTriggerKind] -> ShowS)
-> Show CompletionTriggerKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionTriggerKind] -> ShowS
$cshowList :: [CompletionTriggerKind] -> ShowS
show :: CompletionTriggerKind -> String
$cshow :: CompletionTriggerKind -> String
showsPrec :: Int -> CompletionTriggerKind -> ShowS
$cshowsPrec :: Int -> CompletionTriggerKind -> ShowS
Show, CompletionTriggerKind -> CompletionTriggerKind -> Bool
(CompletionTriggerKind -> CompletionTriggerKind -> Bool)
-> (CompletionTriggerKind -> CompletionTriggerKind -> Bool)
-> Eq CompletionTriggerKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionTriggerKind -> CompletionTriggerKind -> Bool
$c/= :: CompletionTriggerKind -> CompletionTriggerKind -> Bool
== :: CompletionTriggerKind -> CompletionTriggerKind -> Bool
$c== :: CompletionTriggerKind -> CompletionTriggerKind -> Bool
Eq)

instance A.ToJSON CompletionTriggerKind where
  toJSON :: CompletionTriggerKind -> Value
toJSON CompletionTriggerKind
CtInvoked                         = Scientific -> Value
A.Number Scientific
1
  toJSON CompletionTriggerKind
CtTriggerCharacter                = Scientific -> Value
A.Number Scientific
2
  toJSON CompletionTriggerKind
CtTriggerForIncompleteCompletions = Scientific -> Value
A.Number Scientific
3
  toJSON (CtUnknown Scientific
x)                     = Scientific -> Value
A.Number Scientific
x

instance A.FromJSON CompletionTriggerKind where
  parseJSON :: Value -> Parser CompletionTriggerKind
parseJSON (A.Number Scientific
1) = CompletionTriggerKind -> Parser CompletionTriggerKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionTriggerKind
CtInvoked
  parseJSON (A.Number Scientific
2) = CompletionTriggerKind -> Parser CompletionTriggerKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionTriggerKind
CtTriggerCharacter
  parseJSON (A.Number Scientific
3) = CompletionTriggerKind -> Parser CompletionTriggerKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure CompletionTriggerKind
CtTriggerForIncompleteCompletions
  parseJSON (A.Number Scientific
x) = CompletionTriggerKind -> Parser CompletionTriggerKind
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> CompletionTriggerKind
CtUnknown Scientific
x)
  parseJSON Value
_          = Parser CompletionTriggerKind
forall a. Monoid a => a
mempty

data CompletionContext =
  CompletionContext
    { CompletionContext -> CompletionTriggerKind
_triggerKind      :: CompletionTriggerKind -- ^ How the completion was triggered.
    , CompletionContext -> Maybe Text
_triggerCharacter :: Maybe Text
      -- ^ The trigger character (a single character) that has trigger code complete.
      -- Is undefined if `triggerKind !== CompletionTriggerKind.TriggerCharacter`
    }
  deriving (ReadPrec [CompletionContext]
ReadPrec CompletionContext
Int -> ReadS CompletionContext
ReadS [CompletionContext]
(Int -> ReadS CompletionContext)
-> ReadS [CompletionContext]
-> ReadPrec CompletionContext
-> ReadPrec [CompletionContext]
-> Read CompletionContext
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionContext]
$creadListPrec :: ReadPrec [CompletionContext]
readPrec :: ReadPrec CompletionContext
$creadPrec :: ReadPrec CompletionContext
readList :: ReadS [CompletionContext]
$creadList :: ReadS [CompletionContext]
readsPrec :: Int -> ReadS CompletionContext
$creadsPrec :: Int -> ReadS CompletionContext
Read, Int -> CompletionContext -> ShowS
[CompletionContext] -> ShowS
CompletionContext -> String
(Int -> CompletionContext -> ShowS)
-> (CompletionContext -> String)
-> ([CompletionContext] -> ShowS)
-> Show CompletionContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionContext] -> ShowS
$cshowList :: [CompletionContext] -> ShowS
show :: CompletionContext -> String
$cshow :: CompletionContext -> String
showsPrec :: Int -> CompletionContext -> ShowS
$cshowsPrec :: Int -> CompletionContext -> ShowS
Show, CompletionContext -> CompletionContext -> Bool
(CompletionContext -> CompletionContext -> Bool)
-> (CompletionContext -> CompletionContext -> Bool)
-> Eq CompletionContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionContext -> CompletionContext -> Bool
$c/= :: CompletionContext -> CompletionContext -> Bool
== :: CompletionContext -> CompletionContext -> Bool
$c== :: CompletionContext -> CompletionContext -> Bool
Eq)

deriveJSON lspOptions ''CompletionContext

data CompletionParams =
  CompletionParams
    { CompletionParams -> TextDocumentIdentifier
_textDocument :: TextDocumentIdentifier -- ^ The text document.
    , CompletionParams -> Position
_position     :: Position -- ^ The position inside the text document.
    , CompletionParams -> Maybe CompletionContext
_context      :: Maybe CompletionContext
      -- ^ The completion context. This is only available if the client specifies
      -- to send this using `ClientCapabilities.textDocument.completion.contextSupport === true`
    , CompletionParams -> Maybe ProgressToken
_workDoneToken :: Maybe ProgressToken -- ^ An optional token that a server can use to report work done progress.
    }
  deriving (ReadPrec [CompletionParams]
ReadPrec CompletionParams
Int -> ReadS CompletionParams
ReadS [CompletionParams]
(Int -> ReadS CompletionParams)
-> ReadS [CompletionParams]
-> ReadPrec CompletionParams
-> ReadPrec [CompletionParams]
-> Read CompletionParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompletionParams]
$creadListPrec :: ReadPrec [CompletionParams]
readPrec :: ReadPrec CompletionParams
$creadPrec :: ReadPrec CompletionParams
readList :: ReadS [CompletionParams]
$creadList :: ReadS [CompletionParams]
readsPrec :: Int -> ReadS CompletionParams
$creadsPrec :: Int -> ReadS CompletionParams
Read, Int -> CompletionParams -> ShowS
[CompletionParams] -> ShowS
CompletionParams -> String
(Int -> CompletionParams -> ShowS)
-> (CompletionParams -> String)
-> ([CompletionParams] -> ShowS)
-> Show CompletionParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionParams] -> ShowS
$cshowList :: [CompletionParams] -> ShowS
show :: CompletionParams -> String
$cshow :: CompletionParams -> String
showsPrec :: Int -> CompletionParams -> ShowS
$cshowsPrec :: Int -> CompletionParams -> ShowS
Show, CompletionParams -> CompletionParams -> Bool
(CompletionParams -> CompletionParams -> Bool)
-> (CompletionParams -> CompletionParams -> Bool)
-> Eq CompletionParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionParams -> CompletionParams -> Bool
$c/= :: CompletionParams -> CompletionParams -> Bool
== :: CompletionParams -> CompletionParams -> Bool
$c== :: CompletionParams -> CompletionParams -> Bool
Eq)

deriveJSON lspOptions ''CompletionParams

type CompletionResponse = ResponseMessage CompletionResponseResult
type CompletionRequest = RequestMessage ClientMethod CompletionParams CompletionResponseResult

-- -------------------------------------
{-
New in 3.0
-----------
Registration Options: CompletionRegistrationOptions options defined as follows:

export interface CompletionRegistrationOptions extends TextDocumentRegistrationOptions {
        /**
         * The characters that trigger completion automatically.
         */
        triggerCharacters?: string[];

        /**
         * The server provides support to resolve additional
         * information for a completion item.
         */
        resolveProvider?: boolean;
}
-}

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

deriveJSON lspOptions ''CompletionRegistrationOptions

-- ---------------------------------------------------------------------
{-
Completion Item Resolve Request

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

The request is sent from the client to the server to resolve additional
information for a given completion item.

Request

    method: 'completionItem/resolve'
    params: CompletionItem

Response

    result: CompletionItem
    error: code and message set in case an exception happens during the completion resolve request.
-}

type CompletionItemResolveRequest  = RequestMessage ClientMethod CompletionItem CompletionItem
type CompletionItemResolveResponse = ResponseMessage CompletionItem