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

import qualified Data.Aeson                                 as A
import           Data.Aeson.TH
import           Data.Aeson.Types
import           Data.Hashable
-- For <= 8.2.2
import           Data.Text                                  (Text)
import           Language.Haskell.LSP.Types.Constants


-- | Id used for a request, Can be either a String or an Int
data LspId = IdInt Int | IdString Text
            deriving (Int -> LspId -> ShowS
[LspId] -> ShowS
LspId -> String
(Int -> LspId -> ShowS)
-> (LspId -> String) -> ([LspId] -> ShowS) -> Show LspId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LspId] -> ShowS
$cshowList :: [LspId] -> ShowS
show :: LspId -> String
$cshow :: LspId -> String
showsPrec :: Int -> LspId -> ShowS
$cshowsPrec :: Int -> LspId -> ShowS
Show,ReadPrec [LspId]
ReadPrec LspId
Int -> ReadS LspId
ReadS [LspId]
(Int -> ReadS LspId)
-> ReadS [LspId]
-> ReadPrec LspId
-> ReadPrec [LspId]
-> Read LspId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LspId]
$creadListPrec :: ReadPrec [LspId]
readPrec :: ReadPrec LspId
$creadPrec :: ReadPrec LspId
readList :: ReadS [LspId]
$creadList :: ReadS [LspId]
readsPrec :: Int -> ReadS LspId
$creadsPrec :: Int -> ReadS LspId
Read,LspId -> LspId -> Bool
(LspId -> LspId -> Bool) -> (LspId -> LspId -> Bool) -> Eq LspId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LspId -> LspId -> Bool
$c/= :: LspId -> LspId -> Bool
== :: LspId -> LspId -> Bool
$c== :: LspId -> LspId -> Bool
Eq,Eq LspId
Eq LspId
-> (LspId -> LspId -> Ordering)
-> (LspId -> LspId -> Bool)
-> (LspId -> LspId -> Bool)
-> (LspId -> LspId -> Bool)
-> (LspId -> LspId -> Bool)
-> (LspId -> LspId -> LspId)
-> (LspId -> LspId -> LspId)
-> Ord LspId
LspId -> LspId -> Bool
LspId -> LspId -> Ordering
LspId -> LspId -> LspId
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 :: LspId -> LspId -> LspId
$cmin :: LspId -> LspId -> LspId
max :: LspId -> LspId -> LspId
$cmax :: LspId -> LspId -> LspId
>= :: LspId -> LspId -> Bool
$c>= :: LspId -> LspId -> Bool
> :: LspId -> LspId -> Bool
$c> :: LspId -> LspId -> Bool
<= :: LspId -> LspId -> Bool
$c<= :: LspId -> LspId -> Bool
< :: LspId -> LspId -> Bool
$c< :: LspId -> LspId -> Bool
compare :: LspId -> LspId -> Ordering
$ccompare :: LspId -> LspId -> Ordering
$cp1Ord :: Eq LspId
Ord)

instance A.ToJSON LspId where
  toJSON :: LspId -> Value
toJSON (IdInt Int
i)    = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i
  toJSON (IdString Text
s) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
s

instance A.FromJSON LspId where
  parseJSON :: Value -> Parser LspId
parseJSON v :: Value
v@(A.Number Scientific
_) = Int -> LspId
IdInt (Int -> LspId) -> Parser Int -> Parser LspId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON  (A.String  Text
s) = LspId -> Parser LspId
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LspId
IdString Text
s)
  parseJSON Value
_              = Parser LspId
forall a. Monoid a => a
mempty

instance Hashable LspId where
  hashWithSalt :: Int -> LspId -> Int
hashWithSalt Int
salt (IdInt Int
i) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Int
i
  hashWithSalt Int
salt (IdString Text
s) = Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Text
s

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

-- | Id used for a response, Can be either a String or an Int, or Null. If a
-- request doesn't provide a result value the receiver of a request still needs
-- to return a response message to conform to the JSON RPC specification. The
-- result property of the ResponseMessage should be set to null in this case to
-- signal a successful request.
data LspIdRsp = IdRspInt Int | IdRspString Text | IdRspNull
            deriving (Int -> LspIdRsp -> ShowS
[LspIdRsp] -> ShowS
LspIdRsp -> String
(Int -> LspIdRsp -> ShowS)
-> (LspIdRsp -> String) -> ([LspIdRsp] -> ShowS) -> Show LspIdRsp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LspIdRsp] -> ShowS
$cshowList :: [LspIdRsp] -> ShowS
show :: LspIdRsp -> String
$cshow :: LspIdRsp -> String
showsPrec :: Int -> LspIdRsp -> ShowS
$cshowsPrec :: Int -> LspIdRsp -> ShowS
Show,ReadPrec [LspIdRsp]
ReadPrec LspIdRsp
Int -> ReadS LspIdRsp
ReadS [LspIdRsp]
(Int -> ReadS LspIdRsp)
-> ReadS [LspIdRsp]
-> ReadPrec LspIdRsp
-> ReadPrec [LspIdRsp]
-> Read LspIdRsp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LspIdRsp]
$creadListPrec :: ReadPrec [LspIdRsp]
readPrec :: ReadPrec LspIdRsp
$creadPrec :: ReadPrec LspIdRsp
readList :: ReadS [LspIdRsp]
$creadList :: ReadS [LspIdRsp]
readsPrec :: Int -> ReadS LspIdRsp
$creadsPrec :: Int -> ReadS LspIdRsp
Read,LspIdRsp -> LspIdRsp -> Bool
(LspIdRsp -> LspIdRsp -> Bool)
-> (LspIdRsp -> LspIdRsp -> Bool) -> Eq LspIdRsp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LspIdRsp -> LspIdRsp -> Bool
$c/= :: LspIdRsp -> LspIdRsp -> Bool
== :: LspIdRsp -> LspIdRsp -> Bool
$c== :: LspIdRsp -> LspIdRsp -> Bool
Eq)

instance A.ToJSON LspIdRsp where
  toJSON :: LspIdRsp -> Value
toJSON (IdRspInt Int
i)    = Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
i
  toJSON (IdRspString Text
s) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
s
  toJSON LspIdRsp
IdRspNull       = Value
A.Null

instance A.FromJSON LspIdRsp where
  parseJSON :: Value -> Parser LspIdRsp
parseJSON v :: Value
v@(A.Number Scientific
_) = Int -> LspIdRsp
IdRspInt (Int -> LspIdRsp) -> Parser Int -> Parser LspIdRsp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser Int
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
  parseJSON  (A.String  Text
s) = LspIdRsp -> Parser LspIdRsp
forall (m :: * -> *) a. Monad m => a -> m a
return (LspIdRsp -> Parser LspIdRsp) -> LspIdRsp -> Parser LspIdRsp
forall a b. (a -> b) -> a -> b
$ Text -> LspIdRsp
IdRspString Text
s
  parseJSON  Value
A.Null        = LspIdRsp -> Parser LspIdRsp
forall (m :: * -> *) a. Monad m => a -> m a
return LspIdRsp
IdRspNull
  parseJSON Value
_              = Parser LspIdRsp
forall a. Monoid a => a
mempty

instance Hashable LspIdRsp where
  hashWithSalt :: Int -> LspIdRsp -> Int
hashWithSalt Int
salt (IdRspInt Int
i) = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Int
i
  hashWithSalt Int
salt (IdRspString Text
s) = Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Text
s
  hashWithSalt Int
_ LspIdRsp
IdRspNull = Int
0

-- | Converts an LspId to its LspIdRsp counterpart.
responseId :: LspId -> LspIdRsp
responseId :: LspId -> LspIdRsp
responseId (IdInt    Int
i) = Int -> LspIdRsp
IdRspInt Int
i
responseId (IdString Text
s) = Text -> LspIdRsp
IdRspString Text
s

-- | Converts an LspIdRsp to its LspId counterpart.
requestId :: LspIdRsp -> LspId
requestId :: LspIdRsp -> LspId
requestId (IdRspInt    Int
i) = Int -> LspId
IdInt Int
i
requestId (IdRspString Text
s) = Text -> LspId
IdString Text
s
requestId LspIdRsp
IdRspNull       = String -> LspId
forall a. HasCallStack => String -> a
error String
"Null response id"

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

-- Client Methods
data ClientMethod =
 -- General
   Initialize
 | Initialized
 | Shutdown
 | Exit
 | CancelRequest
 -- Workspace
 | WorkspaceDidChangeWorkspaceFolders
 | WorkspaceDidChangeConfiguration
 | WorkspaceDidChangeWatchedFiles
 | WorkspaceSymbol
 | WorkspaceExecuteCommand
 -- Progress
 | WorkDoneProgressCancel
 -- Document
 | TextDocumentDidOpen
 | TextDocumentDidChange
 | TextDocumentWillSave
 | TextDocumentWillSaveWaitUntil
 | TextDocumentDidSave
 | TextDocumentDidClose
 | TextDocumentCompletion
 | CompletionItemResolve
 | TextDocumentHover
 | TextDocumentSignatureHelp
 | TextDocumentDefinition
 | TextDocumentTypeDefinition
 | TextDocumentImplementation
 | TextDocumentReferences
 | TextDocumentDocumentHighlight
 | TextDocumentDocumentSymbol
 | TextDocumentCodeAction
 | TextDocumentCodeLens
 | CodeLensResolve
 | TextDocumentDocumentLink
 | DocumentLinkResolve
 | TextDocumentDocumentColor
 | TextDocumentColorPresentation
 | TextDocumentFormatting
 | TextDocumentRangeFormatting
 | TextDocumentOnTypeFormatting
 | TextDocumentRename
 | TextDocumentPrepareRename
 | TextDocumentFoldingRange
 -- A custom message type. It is not enforced that this starts with $/.
 | CustomClientMethod Text
   deriving (ClientMethod -> ClientMethod -> Bool
(ClientMethod -> ClientMethod -> Bool)
-> (ClientMethod -> ClientMethod -> Bool) -> Eq ClientMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClientMethod -> ClientMethod -> Bool
$c/= :: ClientMethod -> ClientMethod -> Bool
== :: ClientMethod -> ClientMethod -> Bool
$c== :: ClientMethod -> ClientMethod -> Bool
Eq,Eq ClientMethod
Eq ClientMethod
-> (ClientMethod -> ClientMethod -> Ordering)
-> (ClientMethod -> ClientMethod -> Bool)
-> (ClientMethod -> ClientMethod -> Bool)
-> (ClientMethod -> ClientMethod -> Bool)
-> (ClientMethod -> ClientMethod -> Bool)
-> (ClientMethod -> ClientMethod -> ClientMethod)
-> (ClientMethod -> ClientMethod -> ClientMethod)
-> Ord ClientMethod
ClientMethod -> ClientMethod -> Bool
ClientMethod -> ClientMethod -> Ordering
ClientMethod -> ClientMethod -> ClientMethod
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 :: ClientMethod -> ClientMethod -> ClientMethod
$cmin :: ClientMethod -> ClientMethod -> ClientMethod
max :: ClientMethod -> ClientMethod -> ClientMethod
$cmax :: ClientMethod -> ClientMethod -> ClientMethod
>= :: ClientMethod -> ClientMethod -> Bool
$c>= :: ClientMethod -> ClientMethod -> Bool
> :: ClientMethod -> ClientMethod -> Bool
$c> :: ClientMethod -> ClientMethod -> Bool
<= :: ClientMethod -> ClientMethod -> Bool
$c<= :: ClientMethod -> ClientMethod -> Bool
< :: ClientMethod -> ClientMethod -> Bool
$c< :: ClientMethod -> ClientMethod -> Bool
compare :: ClientMethod -> ClientMethod -> Ordering
$ccompare :: ClientMethod -> ClientMethod -> Ordering
$cp1Ord :: Eq ClientMethod
Ord,ReadPrec [ClientMethod]
ReadPrec ClientMethod
Int -> ReadS ClientMethod
ReadS [ClientMethod]
(Int -> ReadS ClientMethod)
-> ReadS [ClientMethod]
-> ReadPrec ClientMethod
-> ReadPrec [ClientMethod]
-> Read ClientMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClientMethod]
$creadListPrec :: ReadPrec [ClientMethod]
readPrec :: ReadPrec ClientMethod
$creadPrec :: ReadPrec ClientMethod
readList :: ReadS [ClientMethod]
$creadList :: ReadS [ClientMethod]
readsPrec :: Int -> ReadS ClientMethod
$creadsPrec :: Int -> ReadS ClientMethod
Read,Int -> ClientMethod -> ShowS
[ClientMethod] -> ShowS
ClientMethod -> String
(Int -> ClientMethod -> ShowS)
-> (ClientMethod -> String)
-> ([ClientMethod] -> ShowS)
-> Show ClientMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClientMethod] -> ShowS
$cshowList :: [ClientMethod] -> ShowS
show :: ClientMethod -> String
$cshow :: ClientMethod -> String
showsPrec :: Int -> ClientMethod -> ShowS
$cshowsPrec :: Int -> ClientMethod -> ShowS
Show)

instance A.FromJSON ClientMethod where
  -- General
  parseJSON :: Value -> Parser ClientMethod
parseJSON (A.String Text
"initialize")                       = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
Initialize
  parseJSON (A.String Text
"initialized")                      = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
Initialized
  parseJSON (A.String Text
"shutdown")                         = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
Shutdown
  parseJSON (A.String Text
"exit")                             = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
Exit
  parseJSON (A.String Text
"$/cancelRequest")                  = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
CancelRequest
 -- Workspace
  parseJSON (A.String Text
"workspace/didChangeWorkspaceFolders") = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
WorkspaceDidChangeWorkspaceFolders
  parseJSON (A.String Text
"workspace/didChangeConfiguration") = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
WorkspaceDidChangeConfiguration
  parseJSON (A.String Text
"workspace/didChangeWatchedFiles")  = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
WorkspaceDidChangeWatchedFiles
  parseJSON (A.String Text
"workspace/symbol")                 = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
WorkspaceSymbol
  parseJSON (A.String Text
"workspace/executeCommand")         = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
WorkspaceExecuteCommand
 -- Document
  parseJSON (A.String Text
"textDocument/didOpen")             = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDidOpen
  parseJSON (A.String Text
"textDocument/didChange")           = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDidChange
  parseJSON (A.String Text
"textDocument/willSave")            = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentWillSave
  parseJSON (A.String Text
"textDocument/willSaveWaitUntil")   = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentWillSaveWaitUntil
  parseJSON (A.String Text
"textDocument/didSave")             = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDidSave
  parseJSON (A.String Text
"textDocument/didClose")            = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDidClose
  parseJSON (A.String Text
"textDocument/completion")          = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentCompletion
  parseJSON (A.String Text
"completionItem/resolve")           = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
CompletionItemResolve
  parseJSON (A.String Text
"textDocument/hover")               = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentHover
  parseJSON (A.String Text
"textDocument/signatureHelp")       = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentSignatureHelp
  parseJSON (A.String Text
"textDocument/definition")          = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDefinition
  parseJSON (A.String Text
"textDocument/typeDefinition")      = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentTypeDefinition
  parseJSON (A.String Text
"textDocument/implementation")      = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentImplementation
  parseJSON (A.String Text
"textDocument/references")          = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentReferences
  parseJSON (A.String Text
"textDocument/documentHighlight")   = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDocumentHighlight
  parseJSON (A.String Text
"textDocument/documentSymbol")      = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDocumentSymbol
  parseJSON (A.String Text
"textDocument/codeAction")          = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentCodeAction
  parseJSON (A.String Text
"textDocument/codeLens")            = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentCodeLens
  parseJSON (A.String Text
"codeLens/resolve")                 = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
CodeLensResolve
  parseJSON (A.String Text
"textDocument/documentLink")        = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDocumentLink
  parseJSON (A.String Text
"documentLink/resolve")             = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
DocumentLinkResolve
  parseJSON (A.String Text
"textDocument/documentColor")       = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentDocumentColor
  parseJSON (A.String Text
"textDocument/colorPresentation")   = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentColorPresentation
  parseJSON (A.String Text
"textDocument/formatting")          = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentFormatting
  parseJSON (A.String Text
"textDocument/rangeFormatting")     = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentRangeFormatting
  parseJSON (A.String Text
"textDocument/onTypeFormatting")    = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentOnTypeFormatting
  parseJSON (A.String Text
"textDocument/rename")              = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentRename
  parseJSON (A.String Text
"textDocument/prepareRename")       = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentPrepareRename
  parseJSON (A.String Text
"textDocument/foldingRange")        = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
TextDocumentFoldingRange
  parseJSON (A.String Text
"window/workDoneProgress/cancel")   = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ClientMethod
WorkDoneProgressCancel
  parseJSON (A.String Text
x)                                  = ClientMethod -> Parser ClientMethod
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ClientMethod
CustomClientMethod Text
x)
  parseJSON Value
_                                             = Parser ClientMethod
forall a. Monoid a => a
mempty

instance A.ToJSON ClientMethod where
  -- General
  toJSON :: ClientMethod -> Value
toJSON ClientMethod
Initialize                      = Text -> Value
A.String Text
"initialize"
  toJSON ClientMethod
Initialized                     = Text -> Value
A.String Text
"initialized"
  toJSON ClientMethod
Shutdown                        = Text -> Value
A.String Text
"shutdown"
  toJSON ClientMethod
Exit                            = Text -> Value
A.String Text
"exit"
  toJSON ClientMethod
CancelRequest                   = Text -> Value
A.String Text
"$/cancelRequest"
  -- Workspace
  toJSON ClientMethod
WorkspaceDidChangeWorkspaceFolders = Text -> Value
A.String Text
"workspace/didChangeWorkspaceFolders"
  toJSON ClientMethod
WorkspaceDidChangeConfiguration = Text -> Value
A.String Text
"workspace/didChangeConfiguration"
  toJSON ClientMethod
WorkspaceDidChangeWatchedFiles  = Text -> Value
A.String Text
"workspace/didChangeWatchedFiles"
  toJSON ClientMethod
WorkspaceSymbol                 = Text -> Value
A.String Text
"workspace/symbol"
  toJSON ClientMethod
WorkspaceExecuteCommand         = Text -> Value
A.String Text
"workspace/executeCommand"
  -- Document
  toJSON ClientMethod
TextDocumentDidOpen             = Text -> Value
A.String Text
"textDocument/didOpen"
  toJSON ClientMethod
TextDocumentDidChange           = Text -> Value
A.String Text
"textDocument/didChange"
  toJSON ClientMethod
TextDocumentWillSave            = Text -> Value
A.String Text
"textDocument/willSave"
  toJSON ClientMethod
TextDocumentWillSaveWaitUntil   = Text -> Value
A.String Text
"textDocument/willSaveWaitUntil"
  toJSON ClientMethod
TextDocumentDidSave             = Text -> Value
A.String Text
"textDocument/didSave"
  toJSON ClientMethod
TextDocumentDidClose            = Text -> Value
A.String Text
"textDocument/didClose"
  toJSON ClientMethod
TextDocumentCompletion          = Text -> Value
A.String Text
"textDocument/completion"
  toJSON ClientMethod
CompletionItemResolve           = Text -> Value
A.String Text
"completionItem/resolve"
  toJSON ClientMethod
TextDocumentHover               = Text -> Value
A.String Text
"textDocument/hover"
  toJSON ClientMethod
TextDocumentSignatureHelp       = Text -> Value
A.String Text
"textDocument/signatureHelp"
  toJSON ClientMethod
TextDocumentReferences          = Text -> Value
A.String Text
"textDocument/references"
  toJSON ClientMethod
TextDocumentDocumentHighlight   = Text -> Value
A.String Text
"textDocument/documentHighlight"
  toJSON ClientMethod
TextDocumentDocumentSymbol      = Text -> Value
A.String Text
"textDocument/documentSymbol"
  toJSON ClientMethod
TextDocumentDefinition          = Text -> Value
A.String Text
"textDocument/definition"
  toJSON ClientMethod
TextDocumentTypeDefinition      = Text -> Value
A.String Text
"textDocument/typeDefinition"
  toJSON ClientMethod
TextDocumentImplementation      = Text -> Value
A.String Text
"textDocument/implementation"
  toJSON ClientMethod
TextDocumentCodeAction          = Text -> Value
A.String Text
"textDocument/codeAction"
  toJSON ClientMethod
TextDocumentCodeLens            = Text -> Value
A.String Text
"textDocument/codeLens"
  toJSON ClientMethod
CodeLensResolve                 = Text -> Value
A.String Text
"codeLens/resolve"
  toJSON ClientMethod
TextDocumentDocumentColor       = Text -> Value
A.String Text
"textDocument/documentColor"
  toJSON ClientMethod
TextDocumentColorPresentation   = Text -> Value
A.String Text
"textDocument/colorPresentation"
  toJSON ClientMethod
TextDocumentFormatting          = Text -> Value
A.String Text
"textDocument/formatting"
  toJSON ClientMethod
TextDocumentRangeFormatting     = Text -> Value
A.String Text
"textDocument/rangeFormatting"
  toJSON ClientMethod
TextDocumentOnTypeFormatting    = Text -> Value
A.String Text
"textDocument/onTypeFormatting"
  toJSON ClientMethod
TextDocumentRename              = Text -> Value
A.String Text
"textDocument/rename"
  toJSON ClientMethod
TextDocumentPrepareRename       = Text -> Value
A.String Text
"textDocument/prepareRename"
  toJSON ClientMethod
TextDocumentFoldingRange        = Text -> Value
A.String Text
"textDocument/foldingRange"
  toJSON ClientMethod
TextDocumentDocumentLink        = Text -> Value
A.String Text
"textDocument/documentLink"
  toJSON ClientMethod
DocumentLinkResolve             = Text -> Value
A.String Text
"documentLink/resolve"
  toJSON ClientMethod
WorkDoneProgressCancel          = Text -> Value
A.String Text
"window/workDoneProgress/cancel"
  toJSON (CustomClientMethod Text
xs)         = Text -> Value
A.String Text
xs

data ServerMethod =
  -- Window
    WindowShowMessage
  | WindowShowMessageRequest
  | WindowLogMessage
  | WindowWorkDoneProgressCreate
  | Progress
  | TelemetryEvent
  -- Client
  | ClientRegisterCapability
  | ClientUnregisterCapability
  -- Workspace
  | WorkspaceWorkspaceFolders
  | WorkspaceConfiguration
  | WorkspaceApplyEdit
  -- Document
  | TextDocumentPublishDiagnostics
  -- Cancelling
  | CancelRequestServer
  | CustomServerMethod Text
   deriving (ServerMethod -> ServerMethod -> Bool
(ServerMethod -> ServerMethod -> Bool)
-> (ServerMethod -> ServerMethod -> Bool) -> Eq ServerMethod
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerMethod -> ServerMethod -> Bool
$c/= :: ServerMethod -> ServerMethod -> Bool
== :: ServerMethod -> ServerMethod -> Bool
$c== :: ServerMethod -> ServerMethod -> Bool
Eq,Eq ServerMethod
Eq ServerMethod
-> (ServerMethod -> ServerMethod -> Ordering)
-> (ServerMethod -> ServerMethod -> Bool)
-> (ServerMethod -> ServerMethod -> Bool)
-> (ServerMethod -> ServerMethod -> Bool)
-> (ServerMethod -> ServerMethod -> Bool)
-> (ServerMethod -> ServerMethod -> ServerMethod)
-> (ServerMethod -> ServerMethod -> ServerMethod)
-> Ord ServerMethod
ServerMethod -> ServerMethod -> Bool
ServerMethod -> ServerMethod -> Ordering
ServerMethod -> ServerMethod -> ServerMethod
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 :: ServerMethod -> ServerMethod -> ServerMethod
$cmin :: ServerMethod -> ServerMethod -> ServerMethod
max :: ServerMethod -> ServerMethod -> ServerMethod
$cmax :: ServerMethod -> ServerMethod -> ServerMethod
>= :: ServerMethod -> ServerMethod -> Bool
$c>= :: ServerMethod -> ServerMethod -> Bool
> :: ServerMethod -> ServerMethod -> Bool
$c> :: ServerMethod -> ServerMethod -> Bool
<= :: ServerMethod -> ServerMethod -> Bool
$c<= :: ServerMethod -> ServerMethod -> Bool
< :: ServerMethod -> ServerMethod -> Bool
$c< :: ServerMethod -> ServerMethod -> Bool
compare :: ServerMethod -> ServerMethod -> Ordering
$ccompare :: ServerMethod -> ServerMethod -> Ordering
$cp1Ord :: Eq ServerMethod
Ord,ReadPrec [ServerMethod]
ReadPrec ServerMethod
Int -> ReadS ServerMethod
ReadS [ServerMethod]
(Int -> ReadS ServerMethod)
-> ReadS [ServerMethod]
-> ReadPrec ServerMethod
-> ReadPrec [ServerMethod]
-> Read ServerMethod
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ServerMethod]
$creadListPrec :: ReadPrec [ServerMethod]
readPrec :: ReadPrec ServerMethod
$creadPrec :: ReadPrec ServerMethod
readList :: ReadS [ServerMethod]
$creadList :: ReadS [ServerMethod]
readsPrec :: Int -> ReadS ServerMethod
$creadsPrec :: Int -> ReadS ServerMethod
Read,Int -> ServerMethod -> ShowS
[ServerMethod] -> ShowS
ServerMethod -> String
(Int -> ServerMethod -> ShowS)
-> (ServerMethod -> String)
-> ([ServerMethod] -> ShowS)
-> Show ServerMethod
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerMethod] -> ShowS
$cshowList :: [ServerMethod] -> ShowS
show :: ServerMethod -> String
$cshow :: ServerMethod -> String
showsPrec :: Int -> ServerMethod -> ShowS
$cshowsPrec :: Int -> ServerMethod -> ShowS
Show)

instance A.FromJSON ServerMethod where
  -- Window
  parseJSON :: Value -> Parser ServerMethod
parseJSON (A.String Text
"window/showMessage")              = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
WindowShowMessage
  parseJSON (A.String Text
"window/showMessageRequest")       = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
WindowShowMessageRequest
  parseJSON (A.String Text
"window/logMessage")               = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
WindowLogMessage
  parseJSON (A.String Text
"window/workDoneProgress/create")  = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
WindowWorkDoneProgressCreate
  parseJSON (A.String Text
"$/progress")                      = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
Progress
  parseJSON (A.String Text
"telemetry/event")                 = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
TelemetryEvent
  -- Client
  parseJSON (A.String Text
"client/registerCapability")       = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
ClientRegisterCapability
  parseJSON (A.String Text
"client/unregisterCapability")     = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
ClientUnregisterCapability
  -- Workspace
  parseJSON (A.String Text
"workspace/workspaceFolders")      = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
WorkspaceWorkspaceFolders
  parseJSON (A.String Text
"workspace/configuration")         = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
WorkspaceConfiguration
  parseJSON (A.String Text
"workspace/applyEdit")             = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
WorkspaceApplyEdit
  -- Document
  parseJSON (A.String Text
"textDocument/publishDiagnostics") = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
TextDocumentPublishDiagnostics
  -- Cancelling
  parseJSON (A.String Text
"$/cancelRequest")                 = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return ServerMethod
CancelRequestServer
  parseJSON (A.String Text
m)                                 = ServerMethod -> Parser ServerMethod
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> ServerMethod
CustomServerMethod Text
m)
  parseJSON Value
_                                            = Parser ServerMethod
forall a. Monoid a => a
mempty

instance A.ToJSON ServerMethod where
  -- Window
  toJSON :: ServerMethod -> Value
toJSON ServerMethod
WindowShowMessage        = Text -> Value
A.String Text
"window/showMessage"
  toJSON ServerMethod
WindowShowMessageRequest = Text -> Value
A.String Text
"window/showMessageRequest"
  toJSON ServerMethod
WindowLogMessage         = Text -> Value
A.String Text
"window/logMessage"
  toJSON ServerMethod
WindowWorkDoneProgressCreate = Text -> Value
A.String Text
"window/workDoneProgress/create"
  toJSON ServerMethod
Progress                 = Text -> Value
A.String Text
"$/progress"
  toJSON ServerMethod
TelemetryEvent           = Text -> Value
A.String Text
"telemetry/event"
  -- Client
  toJSON ServerMethod
ClientRegisterCapability   = Text -> Value
A.String Text
"client/registerCapability"
  toJSON ServerMethod
ClientUnregisterCapability = Text -> Value
A.String Text
"client/unregisterCapability"
  -- Workspace
  toJSON ServerMethod
WorkspaceWorkspaceFolders = Text -> Value
A.String Text
"workspace/workspaceFolders"
  toJSON ServerMethod
WorkspaceConfiguration    = Text -> Value
A.String Text
"workspace/configuration"
  toJSON ServerMethod
WorkspaceApplyEdit        = Text -> Value
A.String Text
"workspace/applyEdit"
  -- Document
  toJSON ServerMethod
TextDocumentPublishDiagnostics = Text -> Value
A.String Text
"textDocument/publishDiagnostics"
  -- Cancelling
  toJSON ServerMethod
CancelRequestServer = Text -> Value
A.String Text
"$/cancelRequest"
  toJSON (CustomServerMethod Text
m) = Text -> Value
A.String Text
m

data RequestMessage m req resp =
  RequestMessage
    { RequestMessage m req resp -> Text
_jsonrpc :: Text
    , RequestMessage m req resp -> LspId
_id      :: LspId
    , RequestMessage m req resp -> m
_method  :: m
    , RequestMessage m req resp -> req
_params  :: req
    } deriving (ReadPrec [RequestMessage m req resp]
ReadPrec (RequestMessage m req resp)
Int -> ReadS (RequestMessage m req resp)
ReadS [RequestMessage m req resp]
(Int -> ReadS (RequestMessage m req resp))
-> ReadS [RequestMessage m req resp]
-> ReadPrec (RequestMessage m req resp)
-> ReadPrec [RequestMessage m req resp]
-> Read (RequestMessage m req resp)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall m req resp.
(Read m, Read req) =>
ReadPrec [RequestMessage m req resp]
forall m req resp.
(Read m, Read req) =>
ReadPrec (RequestMessage m req resp)
forall m req resp.
(Read m, Read req) =>
Int -> ReadS (RequestMessage m req resp)
forall m req resp.
(Read m, Read req) =>
ReadS [RequestMessage m req resp]
readListPrec :: ReadPrec [RequestMessage m req resp]
$creadListPrec :: forall m req resp.
(Read m, Read req) =>
ReadPrec [RequestMessage m req resp]
readPrec :: ReadPrec (RequestMessage m req resp)
$creadPrec :: forall m req resp.
(Read m, Read req) =>
ReadPrec (RequestMessage m req resp)
readList :: ReadS [RequestMessage m req resp]
$creadList :: forall m req resp.
(Read m, Read req) =>
ReadS [RequestMessage m req resp]
readsPrec :: Int -> ReadS (RequestMessage m req resp)
$creadsPrec :: forall m req resp.
(Read m, Read req) =>
Int -> ReadS (RequestMessage m req resp)
Read,Int -> RequestMessage m req resp -> ShowS
[RequestMessage m req resp] -> ShowS
RequestMessage m req resp -> String
(Int -> RequestMessage m req resp -> ShowS)
-> (RequestMessage m req resp -> String)
-> ([RequestMessage m req resp] -> ShowS)
-> Show (RequestMessage m req resp)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall m req resp.
(Show m, Show req) =>
Int -> RequestMessage m req resp -> ShowS
forall m req resp.
(Show m, Show req) =>
[RequestMessage m req resp] -> ShowS
forall m req resp.
(Show m, Show req) =>
RequestMessage m req resp -> String
showList :: [RequestMessage m req resp] -> ShowS
$cshowList :: forall m req resp.
(Show m, Show req) =>
[RequestMessage m req resp] -> ShowS
show :: RequestMessage m req resp -> String
$cshow :: forall m req resp.
(Show m, Show req) =>
RequestMessage m req resp -> String
showsPrec :: Int -> RequestMessage m req resp -> ShowS
$cshowsPrec :: forall m req resp.
(Show m, Show req) =>
Int -> RequestMessage m req resp -> ShowS
Show,RequestMessage m req resp -> RequestMessage m req resp -> Bool
(RequestMessage m req resp -> RequestMessage m req resp -> Bool)
-> (RequestMessage m req resp -> RequestMessage m req resp -> Bool)
-> Eq (RequestMessage m req resp)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall m req resp.
(Eq m, Eq req) =>
RequestMessage m req resp -> RequestMessage m req resp -> Bool
/= :: RequestMessage m req resp -> RequestMessage m req resp -> Bool
$c/= :: forall m req resp.
(Eq m, Eq req) =>
RequestMessage m req resp -> RequestMessage m req resp -> Bool
== :: RequestMessage m req resp -> RequestMessage m req resp -> Bool
$c== :: forall m req resp.
(Eq m, Eq req) =>
RequestMessage m req resp -> RequestMessage m req resp -> Bool
Eq)

deriveJSON lspOptions ''RequestMessage

-- ---------------------------------------------------------------------
{-
interface ResponseError<D> {
    /**
     * A number indicating the error type that occurred.
     */
    code: number;

    /**
     * A string providing a short description of the error.
     */
    message: string;

    /**
     * A Primitive or Structured value that contains additional
     * information about the error. Can be omitted.
     */
    data?: D;
}

export namespace ErrorCodes {
        // Defined by JSON RPC
        export const ParseError: number = -32700;
        export const InvalidRequest: number = -32600;
        export const MethodNotFound: number = -32601;
        export const InvalidParams: number = -32602;
        export const InternalError: number = -32603;
        export const serverErrorStart: number = -32099;
        export const serverErrorEnd: number = -32000;
        export const ServerNotInitialized: number = -32002;
        export const UnknownErrorCode: number = -32001;

        // Defined by the protocol.
        export const RequestCancelled: number = -32800;
        export const ContentModified: number = -32801;
}
-}

data ErrorCode = ParseError
               | InvalidRequest
               | MethodNotFound
               | InvalidParams
               | InternalError
               | ServerErrorStart
               | ServerErrorEnd
               | ServerNotInitialized
               | UnknownErrorCode
               | RequestCancelled
               | ContentModified
               -- ^ Note: server error codes are reserved from -32099 to -32000
               deriving (ReadPrec [ErrorCode]
ReadPrec ErrorCode
Int -> ReadS ErrorCode
ReadS [ErrorCode]
(Int -> ReadS ErrorCode)
-> ReadS [ErrorCode]
-> ReadPrec ErrorCode
-> ReadPrec [ErrorCode]
-> Read ErrorCode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErrorCode]
$creadListPrec :: ReadPrec [ErrorCode]
readPrec :: ReadPrec ErrorCode
$creadPrec :: ReadPrec ErrorCode
readList :: ReadS [ErrorCode]
$creadList :: ReadS [ErrorCode]
readsPrec :: Int -> ReadS ErrorCode
$creadsPrec :: Int -> ReadS ErrorCode
Read,Int -> ErrorCode -> ShowS
[ErrorCode] -> ShowS
ErrorCode -> String
(Int -> ErrorCode -> ShowS)
-> (ErrorCode -> String)
-> ([ErrorCode] -> ShowS)
-> Show ErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ErrorCode] -> ShowS
$cshowList :: [ErrorCode] -> ShowS
show :: ErrorCode -> String
$cshow :: ErrorCode -> String
showsPrec :: Int -> ErrorCode -> ShowS
$cshowsPrec :: Int -> ErrorCode -> ShowS
Show,ErrorCode -> ErrorCode -> Bool
(ErrorCode -> ErrorCode -> Bool)
-> (ErrorCode -> ErrorCode -> Bool) -> Eq ErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorCode -> ErrorCode -> Bool
$c/= :: ErrorCode -> ErrorCode -> Bool
== :: ErrorCode -> ErrorCode -> Bool
$c== :: ErrorCode -> ErrorCode -> Bool
Eq)

instance A.ToJSON ErrorCode where
  toJSON :: ErrorCode -> Value
toJSON ErrorCode
ParseError           = Scientific -> Value
A.Number (-Scientific
32700)
  toJSON ErrorCode
InvalidRequest       = Scientific -> Value
A.Number (-Scientific
32600)
  toJSON ErrorCode
MethodNotFound       = Scientific -> Value
A.Number (-Scientific
32601)
  toJSON ErrorCode
InvalidParams        = Scientific -> Value
A.Number (-Scientific
32602)
  toJSON ErrorCode
InternalError        = Scientific -> Value
A.Number (-Scientific
32603)
  toJSON ErrorCode
ServerErrorStart     = Scientific -> Value
A.Number (-Scientific
32099)
  toJSON ErrorCode
ServerErrorEnd       = Scientific -> Value
A.Number (-Scientific
32000)
  toJSON ErrorCode
ServerNotInitialized = Scientific -> Value
A.Number (-Scientific
32002)
  toJSON ErrorCode
UnknownErrorCode     = Scientific -> Value
A.Number (-Scientific
32001)
  toJSON ErrorCode
RequestCancelled     = Scientific -> Value
A.Number (-Scientific
32800)
  toJSON ErrorCode
ContentModified      = Scientific -> Value
A.Number (-Scientific
32801)

instance A.FromJSON ErrorCode where
  parseJSON :: Value -> Parser ErrorCode
parseJSON (A.Number (-32700)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ParseError
  parseJSON (A.Number (-32600)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
InvalidRequest
  parseJSON (A.Number (-32601)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
MethodNotFound
  parseJSON (A.Number (-32602)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
InvalidParams
  parseJSON (A.Number (-32603)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
InternalError
  parseJSON (A.Number (-32099)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ServerErrorStart
  parseJSON (A.Number (-32000)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ServerErrorEnd
  parseJSON (A.Number (-32002)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ServerNotInitialized
  parseJSON (A.Number (-32001)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
UnknownErrorCode
  parseJSON (A.Number (-32800)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
RequestCancelled
  parseJSON (A.Number (-32801)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ContentModified
  parseJSON Value
_                   = Parser ErrorCode
forall a. Monoid a => a
mempty

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

{-
  https://microsoft.github.io/language-server-protocol/specification#responseMessage

  interface ResponseError {
    /**
    * A number indicating the error type that occurred.
    */
    code: number;

    /**
    * A string providing a short description of the error.
    */
    message: string;

    /**
    * A primitive or structured value that contains additional
    * information about the error. Can be omitted.
    */
    data?: string | number | boolean | array | object | null;
  }
-}

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

deriveJSON lspOptions{ fieldLabelModifier = customModifier } ''ResponseError

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

{-
  https://microsoft.github.io/language-server-protocol/specification#responseMessage

  interface ResponseMessage extends Message {
    /**
    * The request id.
    */
    id: number | string | null;

    /**
    * The result of a request. This member is REQUIRED on success.
    * This member MUST NOT exist if there was an error invoking the method.
    */
    result?: string | number | boolean | object | null;

    /**
    * The error object in case a request fails.
    */
    error?: ResponseError;
  }
-}

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

instance ToJSON a => ToJSON (ResponseMessage a) where
  toJSON :: ResponseMessage a -> Value
toJSON (ResponseMessage { $sel:_jsonrpc:ResponseMessage :: forall a. ResponseMessage a -> Text
_jsonrpc = Text
jsonrpc, $sel:_id:ResponseMessage :: forall a. ResponseMessage a -> LspIdRsp
_id = LspIdRsp
lspid, $sel:_result:ResponseMessage :: forall a. ResponseMessage a -> Either ResponseError a
_result = Either ResponseError a
result })
    = [Pair] -> Value
object
      [ Text
"jsonrpc" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Text
jsonrpc
      , Text
"id" Text -> LspIdRsp -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= LspIdRsp
lspid
      , case Either ResponseError a
result of
        Left  ResponseError
err -> Text
"error" Text -> ResponseError -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ResponseError
err
        Right a
a   -> Text
"result" Text -> a -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= a
a
      ]

instance FromJSON a => FromJSON (ResponseMessage a) where
  parseJSON :: Value -> Parser (ResponseMessage a)
parseJSON = String
-> (Object -> Parser (ResponseMessage a))
-> Value
-> Parser (ResponseMessage a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Response" ((Object -> Parser (ResponseMessage a))
 -> Value -> Parser (ResponseMessage a))
-> (Object -> Parser (ResponseMessage a))
-> Value
-> Parser (ResponseMessage a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
_jsonrpc <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"jsonrpc"
    LspIdRsp
_id      <- Object
o Object -> Text -> Parser LspIdRsp
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
    -- It is important to use .:! so that "result = null" (without error) gets decoded as Just Null
    Maybe a
_result  <- Object
o Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:! Text
"result"
    Maybe ResponseError
_error   <- Object
o Object -> Text -> Parser (Maybe ResponseError)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"error"
    Either ResponseError a
result   <- case (Maybe ResponseError
_error, Maybe a
_result) of
      ((Just ResponseError
err), Maybe a
Nothing   ) -> Either ResponseError a -> Parser (Either ResponseError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError a -> Parser (Either ResponseError a))
-> Either ResponseError a -> Parser (Either ResponseError a)
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError a
forall a b. a -> Either a b
Left ResponseError
err
      (Maybe ResponseError
Nothing   , (Just a
res)) -> Either ResponseError a -> Parser (Either ResponseError a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError a -> Parser (Either ResponseError a))
-> Either ResponseError a -> Parser (Either ResponseError a)
forall a b. (a -> b) -> a -> b
$ a -> Either ResponseError a
forall a b. b -> Either a b
Right a
res
      ((Just   ResponseError
_), (Just   a
_)) -> String -> Parser (Either ResponseError a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Either ResponseError a))
-> String -> Parser (Either ResponseError a)
forall a b. (a -> b) -> a -> b
$ String
"Both error and result cannot be present"
      (Maybe ResponseError
Nothing, Maybe a
Nothing) -> String -> Parser (Either ResponseError a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Both error and result cannot be Nothing"
    ResponseMessage a -> Parser (ResponseMessage a)
forall (m :: * -> *) a. Monad m => a -> m a
return (ResponseMessage a -> Parser (ResponseMessage a))
-> ResponseMessage a -> Parser (ResponseMessage a)
forall a b. (a -> b) -> a -> b
$ Text -> LspIdRsp -> Either ResponseError a -> ResponseMessage a
forall a.
Text -> LspIdRsp -> Either ResponseError a -> ResponseMessage a
ResponseMessage Text
_jsonrpc LspIdRsp
_id (Either ResponseError a -> ResponseMessage a)
-> Either ResponseError a -> ResponseMessage a
forall a b. (a -> b) -> a -> b
$ Either ResponseError a
result

type ErrorResponse = ResponseMessage ()

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

type BareResponseMessage = ResponseMessage A.Value

-- ---------------------------------------------------------------------
{-
$ Notifications and Requests

Notification and requests ids starting with '$/' are messages which are protocol
implementation dependent and might not be implementable in all clients or
servers. For example if the server implementation uses a single threaded
synchronous programming language then there is little a server can do to react
to a '$/cancelRequest'. If a server or client receives notifications or requests
starting with '$/' it is free to ignore them if they are unknown.
-}

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

deriveJSON lspOptions ''NotificationMessage

-- ---------------------------------------------------------------------
{-
Cancellation Support

https://github.com/Microsoft/language-server-protocol/blob/master/protocol.md#cancellation-support

    New: The base protocol now offers support for request cancellation. To
    cancel a request, a notification message with the following properties is
    sent:

Notification:

    method: '$/cancelRequest'
    params: CancelParams defined as follows:

interface CancelParams {
    /**
     * The request id to cancel.
     */
    id: number | string;
}

A request that got canceled still needs to return from the server and send a
response back. It can not be left open / hanging. This is in line with the JSON
RPC protocol that requires that every request sends a response back. In addition
it allows for returning partial results on cancel.
-}

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

deriveJSON lspOptions ''CancelParams

type CancelNotification = NotificationMessage ClientMethod CancelParams
type CancelNotificationServer = NotificationMessage ServerMethod CancelParams

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