{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE UndecidableInstances       #-}
{-# LANGUAGE TypeFamilies               #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE DuplicateRecordFields      #-}
{-# LANGUAGE ConstraintKinds            #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeInType                 #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE TupleSections              #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

module Language.LSP.Types.Message where

import           Language.LSP.Types.Cancellation
import           Language.LSP.Types.CodeAction
import           Language.LSP.Types.CodeLens
import           Language.LSP.Types.Command
import           Language.LSP.Types.Common
import           Language.LSP.Types.Configuration
import           Language.LSP.Types.Completion
import           Language.LSP.Types.Declaration
import           Language.LSP.Types.Definition
import           Language.LSP.Types.Diagnostic
import           Language.LSP.Types.DocumentColor
import           Language.LSP.Types.DocumentHighlight
import           Language.LSP.Types.DocumentLink
import           Language.LSP.Types.DocumentSymbol
import           Language.LSP.Types.FoldingRange
import           Language.LSP.Types.Formatting
import           Language.LSP.Types.Hover
import           Language.LSP.Types.Implementation
import           Language.LSP.Types.Initialize
import           Language.LSP.Types.Location
import           Language.LSP.Types.LspId
import           Language.LSP.Types.Method
import           Language.LSP.Types.Progress
import           Language.LSP.Types.Registration
import           Language.LSP.Types.Rename
import           Language.LSP.Types.References
import           Language.LSP.Types.SelectionRange
import           Language.LSP.Types.SignatureHelp
import           Language.LSP.Types.TextDocument
import           Language.LSP.Types.TypeDefinition
import           Language.LSP.Types.Utils
import           Language.LSP.Types.Window
import           Language.LSP.Types.WatchedFiles
import           Language.LSP.Types.WorkspaceEdit
import           Language.LSP.Types.WorkspaceFolders
import           Language.LSP.Types.WorkspaceSymbol
import qualified Data.HashMap.Strict as HM

import Data.Kind
import Data.Aeson
import Data.Aeson.Types
import Data.Aeson.TH
import Data.GADT.Compare
import Data.Text (Text)
import Data.Type.Equality
import Data.Function (on)
import GHC.Generics

-- ---------------------------------------------------------------------
-- PARAMS definition
-- Map Methods to params/responses
-- ---------------------------------------------------------------------

-- | Map a method to the message payload type
type family MessageParams (m :: Method f t) :: Type where
-- Client
  -- General
  MessageParams Initialize                         = InitializeParams
  MessageParams Initialized                        = Maybe InitializedParams
  MessageParams Shutdown                           = Empty
  MessageParams Exit                               = Empty
  -- Workspace
  MessageParams WorkspaceDidChangeWorkspaceFolders = DidChangeWorkspaceFoldersParams
  MessageParams WorkspaceDidChangeConfiguration    = DidChangeConfigurationParams
  MessageParams WorkspaceDidChangeWatchedFiles     = DidChangeWatchedFilesParams
  MessageParams WorkspaceSymbol                    = WorkspaceSymbolParams
  MessageParams WorkspaceExecuteCommand            = ExecuteCommandParams
  -- Sync/Document state
  MessageParams TextDocumentDidOpen                = DidOpenTextDocumentParams
  MessageParams TextDocumentDidChange              = DidChangeTextDocumentParams
  MessageParams TextDocumentWillSave               = WillSaveTextDocumentParams
  MessageParams TextDocumentWillSaveWaitUntil      = WillSaveTextDocumentParams
  MessageParams TextDocumentDidSave                = DidSaveTextDocumentParams
  MessageParams TextDocumentDidClose               = DidCloseTextDocumentParams
  -- Completion
  MessageParams TextDocumentCompletion             = CompletionParams
  MessageParams CompletionItemResolve              = CompletionItem
  -- Language Queries
  MessageParams TextDocumentHover                  = HoverParams
  MessageParams TextDocumentSignatureHelp          = SignatureHelpParams
  MessageParams TextDocumentDeclaration            = DeclarationParams
  MessageParams TextDocumentDefinition             = DefinitionParams
  MessageParams TextDocumentTypeDefinition         = TypeDefinitionParams
  MessageParams TextDocumentImplementation         = ImplementationParams
  MessageParams TextDocumentReferences             = ReferenceParams
  MessageParams TextDocumentDocumentHighlight      = DocumentHighlightParams
  MessageParams TextDocumentDocumentSymbol         = DocumentSymbolParams
  -- Code Action/Lens/Link
  MessageParams TextDocumentCodeAction             = CodeActionParams
  MessageParams TextDocumentCodeLens               = CodeLensParams
  MessageParams CodeLensResolve                    = CodeLens
  MessageParams TextDocumentDocumentLink           = DocumentLinkParams
  MessageParams DocumentLinkResolve                = DocumentLink
  -- Syntax highlighting/coloring
  MessageParams TextDocumentDocumentColor          = DocumentColorParams
  MessageParams TextDocumentColorPresentation      = ColorPresentationParams
  -- Formatting
  MessageParams TextDocumentFormatting             = DocumentFormattingParams
  MessageParams TextDocumentRangeFormatting        = DocumentRangeFormattingParams
  MessageParams TextDocumentOnTypeFormatting       = DocumentOnTypeFormattingParams
  -- Rename
  MessageParams TextDocumentRename                 = RenameParams
  MessageParams TextDocumentPrepareRename          = PrepareRenameParams
  -- Folding Range
  MessageParams TextDocumentFoldingRange           = FoldingRangeParams
  -- Selection Range
  MessageParams TextDocumentSelectionRange         = SelectionRangeParams
-- Server
    -- Window
  MessageParams WindowShowMessage                  = ShowMessageParams
  MessageParams WindowShowMessageRequest           = ShowMessageRequestParams
  MessageParams WindowLogMessage                   = LogMessageParams
  -- Progress
  MessageParams WindowWorkDoneProgressCreate       = WorkDoneProgressCreateParams
  MessageParams WindowWorkDoneProgressCancel       = WorkDoneProgressCancelParams
  MessageParams Progress                           = ProgressParams SomeProgressParams
  -- Telemetry
  MessageParams TelemetryEvent                     = Value
  -- Client
  MessageParams ClientRegisterCapability           = RegistrationParams
  MessageParams ClientUnregisterCapability         = UnregistrationParams
  -- Workspace
  MessageParams WorkspaceWorkspaceFolders          = Empty
  MessageParams WorkspaceConfiguration             = ConfigurationParams
  MessageParams WorkspaceApplyEdit                 = ApplyWorkspaceEditParams
  -- Document/Diagnostic
  MessageParams TextDocumentPublishDiagnostics     = PublishDiagnosticsParams
  -- Cancel
  MessageParams CancelRequest                      = CancelParams
  -- Custom
  MessageParams CustomMethod                       = Value

-- | Map a request method to the response payload type
type family ResponseResult (m :: Method f Request) :: Type where
-- Even though the specification mentions that the result types are
-- @x | y | ... | null@, they don't actually need to be wrapped in a Maybe since
-- (we think) this is just to account for how the response field is always
-- nullable. I.e. if it is null, then the error field is set

-- Client
  -- General
  ResponseResult Initialize                    = InitializeResult
  ResponseResult Shutdown                      = Empty
  -- Workspace
  ResponseResult WorkspaceSymbol               = List SymbolInformation
  ResponseResult WorkspaceExecuteCommand       = Value
  -- Sync/Document state
  ResponseResult TextDocumentWillSaveWaitUntil = List TextEdit
  -- Completion
  ResponseResult TextDocumentCompletion        = List CompletionItem |? CompletionList
  ResponseResult CompletionItemResolve         = CompletionItem
  -- Language Queries
  ResponseResult TextDocumentHover             = Maybe Hover
  ResponseResult TextDocumentSignatureHelp     = SignatureHelp
  ResponseResult TextDocumentDeclaration       = Location |? List Location |? List LocationLink
  ResponseResult TextDocumentDefinition        = Location |? List Location |? List LocationLink
  ResponseResult TextDocumentTypeDefinition    = Location |? List Location |? List LocationLink
  ResponseResult TextDocumentImplementation    = Location |? List Location |? List LocationLink
  ResponseResult TextDocumentReferences        = List Location
  ResponseResult TextDocumentDocumentHighlight = List DocumentHighlight
  ResponseResult TextDocumentDocumentSymbol    = List DocumentSymbol |? List SymbolInformation
  -- Code Action/Lens/Link
  ResponseResult TextDocumentCodeAction        = List (Command |? CodeAction)
  ResponseResult TextDocumentCodeLens          = List CodeLens
  ResponseResult CodeLensResolve               = CodeLens
  ResponseResult TextDocumentDocumentLink      = List DocumentLink
  ResponseResult DocumentLinkResolve           = DocumentLink
  -- Syntax highlighting/coloring
  ResponseResult TextDocumentDocumentColor     = List ColorInformation
  ResponseResult TextDocumentColorPresentation = List ColorPresentation
  -- Formatting
  ResponseResult TextDocumentFormatting        = List TextEdit
  ResponseResult TextDocumentRangeFormatting   = List TextEdit
  ResponseResult TextDocumentOnTypeFormatting  = List TextEdit
  -- Rename
  ResponseResult TextDocumentRename            = WorkspaceEdit
  ResponseResult TextDocumentPrepareRename     = Range |? RangeWithPlaceholder
  -- FoldingRange
  ResponseResult TextDocumentFoldingRange      = List FoldingRange
  ResponseResult TextDocumentSelectionRange    = List SelectionRange
  -- Custom can be either a notification or a message
-- Server
  -- Window
  ResponseResult WindowShowMessageRequest      = Maybe MessageActionItem
  ResponseResult WindowWorkDoneProgressCreate  = ()
  -- Capability
  ResponseResult ClientRegisterCapability      = Empty
  ResponseResult ClientUnregisterCapability    = Empty
  -- Workspace
  ResponseResult WorkspaceWorkspaceFolders     = Maybe (List WorkspaceFolder)
  ResponseResult WorkspaceConfiguration        = List Value
  ResponseResult WorkspaceApplyEdit            = ApplyWorkspaceEditResponseBody
-- Custom
  ResponseResult CustomMethod                  = 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 :: Method f Notification) =
  NotificationMessage
    { NotificationMessage m -> Text
_jsonrpc :: Text
    , NotificationMessage m -> SMethod m
_method  :: SMethod m
    , NotificationMessage m -> MessageParams m
_params  :: MessageParams m
    } deriving (forall x. NotificationMessage m -> Rep (NotificationMessage m) x)
-> (forall x.
    Rep (NotificationMessage m) x -> NotificationMessage m)
-> Generic (NotificationMessage m)
forall x. Rep (NotificationMessage m) x -> NotificationMessage m
forall x. NotificationMessage m -> Rep (NotificationMessage m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: From) (m :: Method f 'Notification) x.
Rep (NotificationMessage m) x -> NotificationMessage m
forall (f :: From) (m :: Method f 'Notification) x.
NotificationMessage m -> Rep (NotificationMessage m) x
$cto :: forall (f :: From) (m :: Method f 'Notification) x.
Rep (NotificationMessage m) x -> NotificationMessage m
$cfrom :: forall (f :: From) (m :: Method f 'Notification) x.
NotificationMessage m -> Rep (NotificationMessage m) x
Generic

deriving instance Eq   (MessageParams m) => Eq (NotificationMessage m)
deriving instance Show (MessageParams m) => Show (NotificationMessage m)

instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (NotificationMessage m) where
  parseJSON :: Value -> Parser (NotificationMessage m)
parseJSON = Options -> Value -> Parser (NotificationMessage m)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
lspOptions
instance (ToJSON (MessageParams m)) => ToJSON (NotificationMessage m) where
  toJSON :: NotificationMessage m -> Value
toJSON     = Options -> NotificationMessage m -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
lspOptions
  toEncoding :: NotificationMessage m -> Encoding
toEncoding = Options -> NotificationMessage m -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
lspOptions

data RequestMessage (m :: Method f Request) = RequestMessage
    { RequestMessage m -> Text
_jsonrpc :: Text
    , RequestMessage m -> LspId m
_id      :: LspId m
    , RequestMessage m -> SMethod m
_method  :: SMethod m
    , RequestMessage m -> MessageParams m
_params  :: MessageParams m
    } deriving (forall x. RequestMessage m -> Rep (RequestMessage m) x)
-> (forall x. Rep (RequestMessage m) x -> RequestMessage m)
-> Generic (RequestMessage m)
forall x. Rep (RequestMessage m) x -> RequestMessage m
forall x. RequestMessage m -> Rep (RequestMessage m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: From) (m :: Method f 'Request) x.
Rep (RequestMessage m) x -> RequestMessage m
forall (f :: From) (m :: Method f 'Request) x.
RequestMessage m -> Rep (RequestMessage m) x
$cto :: forall (f :: From) (m :: Method f 'Request) x.
Rep (RequestMessage m) x -> RequestMessage m
$cfrom :: forall (f :: From) (m :: Method f 'Request) x.
RequestMessage m -> Rep (RequestMessage m) x
Generic

deriving instance Eq   (MessageParams m) => Eq (RequestMessage m)
deriving instance (Read (SMethod m), Read (MessageParams m)) => Read (RequestMessage m)
deriving instance Show (MessageParams m) => Show (RequestMessage m)

instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (RequestMessage m) where
  parseJSON :: Value -> Parser (RequestMessage m)
parseJSON = Options -> Value -> Parser (RequestMessage m)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
lspOptions
instance (ToJSON (MessageParams m), FromJSON (SMethod m)) => ToJSON (RequestMessage m) where
  toJSON :: RequestMessage m -> Value
toJSON     = Options -> RequestMessage m -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
lspOptions
  toEncoding :: RequestMessage m -> Encoding
toEncoding = Options -> RequestMessage m -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
lspOptions

-- | A custom message data type is needed to distinguish between
-- notifications and requests, since a CustomMethod can be both!
data CustomMessage f t where
  ReqMess :: RequestMessage (CustomMethod :: Method f Request) -> CustomMessage f Request
  NotMess :: NotificationMessage (CustomMethod :: Method f Notification) -> CustomMessage f Notification

deriving instance Show (CustomMessage p t)

instance ToJSON (CustomMessage p t) where
  toJSON :: CustomMessage p t -> Value
toJSON (ReqMess RequestMessage 'CustomMethod
a) = RequestMessage 'CustomMethod -> Value
forall a. ToJSON a => a -> Value
toJSON RequestMessage 'CustomMethod
a
  toJSON (NotMess NotificationMessage 'CustomMethod
a) = NotificationMessage 'CustomMethod -> Value
forall a. ToJSON a => a -> Value
toJSON NotificationMessage 'CustomMethod
a

instance FromJSON (CustomMessage p Request) where
  parseJSON :: Value -> Parser (CustomMessage p 'Request)
parseJSON Value
v = RequestMessage 'CustomMethod -> CustomMessage p 'Request
forall (f :: From).
RequestMessage 'CustomMethod -> CustomMessage f 'Request
ReqMess (RequestMessage 'CustomMethod -> CustomMessage p 'Request)
-> Parser (RequestMessage 'CustomMethod)
-> Parser (CustomMessage p 'Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (RequestMessage 'CustomMethod)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance FromJSON (CustomMessage p Notification) where
  parseJSON :: Value -> Parser (CustomMessage p 'Notification)
parseJSON Value
v = NotificationMessage 'CustomMethod -> CustomMessage p 'Notification
forall (f :: From).
NotificationMessage 'CustomMethod -> CustomMessage f 'Notification
NotMess (NotificationMessage 'CustomMethod
 -> CustomMessage p 'Notification)
-> Parser (NotificationMessage 'CustomMethod)
-> Parser (CustomMessage p 'Notification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NotificationMessage 'CustomMethod)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

-- ---------------------------------------------------------------------
-- Response Message
-- ---------------------------------------------------------------------

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 ToJSON ErrorCode where
  toJSON :: ErrorCode -> Value
toJSON ErrorCode
ParseError           = Scientific -> Value
Number (-Scientific
32700)
  toJSON ErrorCode
InvalidRequest       = Scientific -> Value
Number (-Scientific
32600)
  toJSON ErrorCode
MethodNotFound       = Scientific -> Value
Number (-Scientific
32601)
  toJSON ErrorCode
InvalidParams        = Scientific -> Value
Number (-Scientific
32602)
  toJSON ErrorCode
InternalError        = Scientific -> Value
Number (-Scientific
32603)
  toJSON ErrorCode
ServerErrorStart     = Scientific -> Value
Number (-Scientific
32099)
  toJSON ErrorCode
ServerErrorEnd       = Scientific -> Value
Number (-Scientific
32000)
  toJSON ErrorCode
ServerNotInitialized = Scientific -> Value
Number (-Scientific
32002)
  toJSON ErrorCode
UnknownErrorCode     = Scientific -> Value
Number (-Scientific
32001)
  toJSON ErrorCode
RequestCancelled     = Scientific -> Value
Number (-Scientific
32800)
  toJSON ErrorCode
ContentModified      = Scientific -> Value
Number (-Scientific
32801)

instance FromJSON ErrorCode where
  parseJSON :: Value -> Parser ErrorCode
parseJSON (Number (-32700)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ParseError
  parseJSON (Number (-32600)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
InvalidRequest
  parseJSON (Number (-32601)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
MethodNotFound
  parseJSON (Number (-32602)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
InvalidParams
  parseJSON (Number (-32603)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
InternalError
  parseJSON (Number (-32099)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ServerErrorStart
  parseJSON (Number (-32000)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ServerErrorEnd
  parseJSON (Number (-32002)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
ServerNotInitialized
  parseJSON (Number (-32001)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
UnknownErrorCode
  parseJSON (Number (-32800)) = ErrorCode -> Parser ErrorCode
forall (f :: * -> *) a. Applicative f => a -> f a
pure ErrorCode
RequestCancelled
  parseJSON (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

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

data ResponseError =
  ResponseError
    { ResponseError -> ErrorCode
_code    :: ErrorCode
    , ResponseError -> Text
_message :: Text
    , ResponseError -> Maybe Value
_xdata   :: Maybe 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 ''ResponseError

-- | Either result or error must be Just.
data ResponseMessage (m :: Method f Request) =
  ResponseMessage
    { ResponseMessage m -> Text
_jsonrpc :: Text
    , ResponseMessage m -> Maybe (LspId m)
_id      :: Maybe (LspId m)
    , ResponseMessage m -> Either ResponseError (ResponseResult m)
_result  :: Either ResponseError (ResponseResult m)
    } deriving (forall x. ResponseMessage m -> Rep (ResponseMessage m) x)
-> (forall x. Rep (ResponseMessage m) x -> ResponseMessage m)
-> Generic (ResponseMessage m)
forall x. Rep (ResponseMessage m) x -> ResponseMessage m
forall x. ResponseMessage m -> Rep (ResponseMessage m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: From) (m :: Method f 'Request) x.
Rep (ResponseMessage m) x -> ResponseMessage m
forall (f :: From) (m :: Method f 'Request) x.
ResponseMessage m -> Rep (ResponseMessage m) x
$cto :: forall (f :: From) (m :: Method f 'Request) x.
Rep (ResponseMessage m) x -> ResponseMessage m
$cfrom :: forall (f :: From) (m :: Method f 'Request) x.
ResponseMessage m -> Rep (ResponseMessage m) x
Generic

deriving instance Eq   (ResponseResult m) => Eq (ResponseMessage m)
deriving instance Read (ResponseResult m) => Read (ResponseMessage m)
deriving instance Show (ResponseResult m) => Show (ResponseMessage m)

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

instance FromJSON (ResponseResult 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"
    Maybe (LspId a)
_id      <- Object
o Object -> Text -> Parser (Maybe (LspId a))
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 (ResponseResult a)
_result  <- Object
o Object -> Text -> Parser (Maybe (ResponseResult 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 (ResponseResult a)
result   <- case (Maybe ResponseError
_error, Maybe (ResponseResult a)
_result) of
      ((Just ResponseError
err), Maybe (ResponseResult a)
Nothing   ) -> Either ResponseError (ResponseResult a)
-> Parser (Either ResponseError (ResponseResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (ResponseResult a)
 -> Parser (Either ResponseError (ResponseResult a)))
-> Either ResponseError (ResponseResult a)
-> Parser (Either ResponseError (ResponseResult a))
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError (ResponseResult a)
forall a b. a -> Either a b
Left ResponseError
err
      (Maybe ResponseError
Nothing   , (Just ResponseResult a
res)) -> Either ResponseError (ResponseResult a)
-> Parser (Either ResponseError (ResponseResult a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (ResponseResult a)
 -> Parser (Either ResponseError (ResponseResult a)))
-> Either ResponseError (ResponseResult a)
-> Parser (Either ResponseError (ResponseResult a))
forall a b. (a -> b) -> a -> b
$ ResponseResult a -> Either ResponseError (ResponseResult a)
forall a b. b -> Either a b
Right ResponseResult a
res
      ((Just ResponseError
_err), (Just ResponseResult a
_res)) -> String -> Parser (Either ResponseError (ResponseResult a))
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Either ResponseError (ResponseResult a)))
-> String -> Parser (Either ResponseError (ResponseResult a))
forall a b. (a -> b) -> a -> b
$ String
"both error and result cannot be present: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Object -> String
forall a. Show a => a -> String
show Object
o
      (Maybe ResponseError
Nothing, Maybe (ResponseResult a)
Nothing) -> String -> Parser (Either ResponseError (ResponseResult 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
-> Maybe (LspId a)
-> Either ResponseError (ResponseResult a)
-> ResponseMessage a
forall (f :: From) (m :: Method f 'Request).
Text
-> Maybe (LspId m)
-> Either ResponseError (ResponseResult m)
-> ResponseMessage m
ResponseMessage Text
_jsonrpc Maybe (LspId a)
_id (Either ResponseError (ResponseResult a) -> ResponseMessage a)
-> Either ResponseError (ResponseResult a) -> ResponseMessage a
forall a b. (a -> b) -> a -> b
$ Either ResponseError (ResponseResult a)
result

-- ---------------------------------------------------------------------
-- Helper Type Families
-- ---------------------------------------------------------------------

-- | Map a method to the Request/Notification type with the correct
-- payload
type family Message (m :: Method f t) :: Type where
  Message (CustomMethod :: Method f t) = CustomMessage f t
  Message (m :: Method f Request) = RequestMessage m
  Message (m :: Method f Notification) = NotificationMessage m

-- Some helpful type synonyms
type ClientMessage (m :: Method FromClient t) = Message m
type ServerMessage (m :: Method FromServer t) = Message m

-- ---------------------------------------------------------------------
-- Working with arbritary messages
-- ---------------------------------------------------------------------

data FromServerMessage' a where
  FromServerMess :: forall t (m :: Method FromServer t) a. SMethod m -> Message m -> FromServerMessage' a
  FromServerRsp  :: forall (m :: Method FromClient Request) a. a m -> ResponseMessage m -> FromServerMessage' a

type FromServerMessage = FromServerMessage' SMethod

instance Eq FromServerMessage where
  == :: FromServerMessage -> FromServerMessage -> Bool
(==) = Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Value -> Value -> Bool)
-> (FromServerMessage -> Value)
-> FromServerMessage
-> FromServerMessage
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` FromServerMessage -> Value
forall a. ToJSON a => a -> Value
toJSON
instance Show FromServerMessage where
  show :: FromServerMessage -> String
show = Value -> String
forall a. Show a => a -> String
show (Value -> String)
-> (FromServerMessage -> Value) -> FromServerMessage -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FromServerMessage -> Value
forall a. ToJSON a => a -> Value
toJSON

instance ToJSON FromServerMessage where
  toJSON :: FromServerMessage -> Value
toJSON (FromServerMess SMethod m
m Message m
p) = SMethod m -> (ToJSON (Message m) => Value) -> Value
forall (t :: MethodType) (m :: Method 'FromServer t) x.
SServerMethod m -> (ToJSON (ServerMessage m) => x) -> x
serverMethodJSON SMethod m
m (Message m -> Value
forall a. ToJSON a => a -> Value
toJSON Message m
p)
  toJSON (FromServerRsp SMethod m
m ResponseMessage m
p) = SMethod m -> (HasJSON (ResponseMessage m) => Value) -> Value
forall (m :: Method 'FromClient 'Request) x.
SClientMethod m -> (HasJSON (ResponseMessage m) => x) -> x
clientResponseJSON SMethod m
m (ResponseMessage m -> Value
forall a. ToJSON a => a -> Value
toJSON ResponseMessage m
p)

fromServerNot :: forall (m :: Method FromServer Notification).
  Message m ~ NotificationMessage m => NotificationMessage m -> FromServerMessage
fromServerNot :: NotificationMessage m -> FromServerMessage
fromServerNot m :: NotificationMessage m
m@NotificationMessage{$sel:_method:NotificationMessage :: forall (f :: From) (m :: Method f 'Notification).
NotificationMessage m -> SMethod m
_method=SMethod m
meth} = SMethod m -> Message m -> FromServerMessage
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod m
meth NotificationMessage m
Message m
m

fromServerReq :: forall (m :: Method FromServer Request).
  Message m ~ RequestMessage m => RequestMessage m -> FromServerMessage
fromServerReq :: RequestMessage m -> FromServerMessage
fromServerReq m :: RequestMessage m
m@RequestMessage{$sel:_method:RequestMessage :: forall (f :: From) (m :: Method f 'Request).
RequestMessage m -> SMethod m
_method=SMethod m
meth} = SMethod m -> Message m -> FromServerMessage
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod m
meth RequestMessage m
Message m
m

data FromClientMessage' a where
  FromClientMess :: forall t (m :: Method FromClient t) a. SMethod m -> Message m -> FromClientMessage' a
  FromClientRsp  :: forall (m :: Method FromServer Request) a. a m -> ResponseMessage m -> FromClientMessage' a

type FromClientMessage = FromClientMessage' SMethod

instance ToJSON FromClientMessage where
  toJSON :: FromClientMessage -> Value
toJSON (FromClientMess SMethod m
m Message m
p) = SMethod m -> (ToJSON (Message m) => Value) -> Value
forall (t :: MethodType) (m :: Method 'FromClient t) x.
SClientMethod m -> (ToJSON (ClientMessage m) => x) -> x
clientMethodJSON SMethod m
m (Message m -> Value
forall a. ToJSON a => a -> Value
toJSON Message m
p)
  toJSON (FromClientRsp SMethod m
m ResponseMessage m
p) = SMethod m -> (HasJSON (ResponseMessage m) => Value) -> Value
forall (m :: Method 'FromServer 'Request) x.
SServerMethod m -> (HasJSON (ResponseMessage m) => x) -> x
serverResponseJSON SMethod m
m (ResponseMessage m -> Value
forall a. ToJSON a => a -> Value
toJSON ResponseMessage m
p)

fromClientNot :: forall (m :: Method FromClient Notification).
  Message m ~ NotificationMessage m => NotificationMessage m -> FromClientMessage
fromClientNot :: NotificationMessage m -> FromClientMessage
fromClientNot m :: NotificationMessage m
m@NotificationMessage{$sel:_method:NotificationMessage :: forall (f :: From) (m :: Method f 'Notification).
NotificationMessage m -> SMethod m
_method=SMethod m
meth} = SMethod m -> Message m -> FromClientMessage
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
meth NotificationMessage m
Message m
m

fromClientReq :: forall (m :: Method FromClient Request).
  Message m ~ RequestMessage m => RequestMessage m -> FromClientMessage
fromClientReq :: RequestMessage m -> FromClientMessage
fromClientReq m :: RequestMessage m
m@RequestMessage{$sel:_method:RequestMessage :: forall (f :: From) (m :: Method f 'Request).
RequestMessage m -> SMethod m
_method=SMethod m
meth} = SMethod m -> Message m -> FromClientMessage
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
meth RequestMessage m
Message m
m

type LookupFunc f a = forall (m :: Method f Request). LspId m -> Maybe (SMethod m, a m)

{-
Message Types we must handle are the following
 
Request      | jsonrpc | id | method | params?
Response     | jsonrpc | id |        |         | response? | error?
Notification | jsonrpc |    | method | params?
-}

parseServerMessage :: LookupFunc FromClient a -> Value -> Parser (FromServerMessage' a)
parseServerMessage :: LookupFunc 'FromClient a -> Value -> Parser (FromServerMessage' a)
parseServerMessage LookupFunc 'FromClient a
lookupId v :: Value
v@(Object Object
o) = do
  case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"method" Object
o of
    Just Value
cmd -> do
      -- Request or Notification
      SomeServerMethod SMethod m
m <- Value -> Parser SomeServerMethod
forall a. FromJSON a => Value -> Parser a
parseJSON Value
cmd
      case SMethod m -> ServerNotOrReq m
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SMethod m
m of
        ServerNotOrReq m
IsServerNot -> SMethod m -> Message m -> FromServerMessage' a
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod m
m (NotificationMessage m -> FromServerMessage' a)
-> Parser (NotificationMessage m) -> Parser (FromServerMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NotificationMessage m)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        ServerNotOrReq m
IsServerReq -> SMethod m -> Message m -> FromServerMessage' a
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod m
m (RequestMessage m -> FromServerMessage' a)
-> Parser (RequestMessage m) -> Parser (FromServerMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (RequestMessage m)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        ServerNotOrReq m
IsServerEither
          | Text -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member Text
"id" Object
o -- Request
          , SCustomMethod Text
cm <- SMethod m
m ->
              let m' :: SMethod 'CustomMethod
m' = (Text -> SMethod 'CustomMethod
forall (f :: From) (t :: MethodType). Text -> SMethod 'CustomMethod
SCustomMethod Text
cm :: SMethod (CustomMethod :: Method FromServer Request))
                  in SMethod 'CustomMethod
-> Message 'CustomMethod -> FromServerMessage' a
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod 'CustomMethod
m' (CustomMessage 'FromServer 'Request -> FromServerMessage' a)
-> Parser (CustomMessage 'FromServer 'Request)
-> Parser (FromServerMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (CustomMessage 'FromServer 'Request)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          | SCustomMethod Text
cm <- SMethod m
m ->
              let m' :: SMethod 'CustomMethod
m' = (Text -> SMethod 'CustomMethod
forall (f :: From) (t :: MethodType). Text -> SMethod 'CustomMethod
SCustomMethod Text
cm :: SMethod (CustomMethod :: Method FromServer Notification))
                  in SMethod 'CustomMethod
-> Message 'CustomMethod -> FromServerMessage' a
forall (t :: MethodType) (m :: Method 'FromServer t)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod 'CustomMethod
m' (CustomMessage 'FromServer 'Notification -> FromServerMessage' a)
-> Parser (CustomMessage 'FromServer 'Notification)
-> Parser (FromServerMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (CustomMessage 'FromServer 'Notification)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Maybe Value
Nothing -> do
      case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"id" Object
o of
        Just Value
i' -> do
          LspId Any
i <- Value -> Parser (LspId Any)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
i'
          case LspId Any -> Maybe (SMethod Any, a Any)
LookupFunc 'FromClient a
lookupId LspId Any
i of
            Just (SMethod Any
m,a Any
res) -> SMethod Any
-> (HasJSON (ResponseMessage Any) => Parser (FromServerMessage' a))
-> Parser (FromServerMessage' a)
forall (m :: Method 'FromClient 'Request) x.
SClientMethod m -> (HasJSON (ResponseMessage m) => x) -> x
clientResponseJSON SMethod Any
m ((HasJSON (ResponseMessage Any) => Parser (FromServerMessage' a))
 -> Parser (FromServerMessage' a))
-> (HasJSON (ResponseMessage Any) => Parser (FromServerMessage' a))
-> Parser (FromServerMessage' a)
forall a b. (a -> b) -> a -> b
$ a Any -> ResponseMessage Any -> FromServerMessage' a
forall (m :: Method 'FromClient 'Request)
       (a :: Method 'FromClient 'Request -> *).
a m -> ResponseMessage m -> FromServerMessage' a
FromServerRsp a Any
res (ResponseMessage Any -> FromServerMessage' a)
-> Parser (ResponseMessage Any) -> Parser (FromServerMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ResponseMessage Any)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
            Maybe (SMethod Any, a Any)
Nothing -> String -> Parser (FromServerMessage' a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (FromServerMessage' a))
-> String -> Parser (FromServerMessage' a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Failed in looking up response type of", Value -> String
forall a. Show a => a -> String
show Value
v]
        Maybe Value
Nothing -> String -> Parser (FromServerMessage' a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (FromServerMessage' a))
-> String -> Parser (FromServerMessage' a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Got unexpected message without method or id"]
parseServerMessage LookupFunc 'FromClient a
_ Value
v = String -> Parser (FromServerMessage' a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (FromServerMessage' a))
-> String -> Parser (FromServerMessage' a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"parseServerMessage expected object, got:",Value -> String
forall a. Show a => a -> String
show Value
v]

parseClientMessage :: LookupFunc FromServer a -> Value -> Parser (FromClientMessage' a)
parseClientMessage :: LookupFunc 'FromServer a -> Value -> Parser (FromClientMessage' a)
parseClientMessage LookupFunc 'FromServer a
lookupId v :: Value
v@(Object Object
o) = do
  case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"method" Object
o of
    Just Value
cmd -> do
      -- Request or Notification
      SomeClientMethod SMethod m
m <- Value -> Parser SomeClientMethod
forall a. FromJSON a => Value -> Parser a
parseJSON Value
cmd
      case SMethod m -> ClientNotOrReq m
forall (t :: MethodType) (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SMethod m
m of
        ClientNotOrReq m
IsClientNot -> SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (NotificationMessage m -> FromClientMessage' a)
-> Parser (NotificationMessage m) -> Parser (FromClientMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (NotificationMessage m)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        ClientNotOrReq m
IsClientReq -> SMethod m -> Message m -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
m (RequestMessage m -> FromClientMessage' a)
-> Parser (RequestMessage m) -> Parser (FromClientMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (RequestMessage m)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
        ClientNotOrReq m
IsClientEither
          | Text -> Object -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member Text
"id" Object
o -- Request
          , SCustomMethod Text
cm <- SMethod m
m ->
              let m' :: SMethod 'CustomMethod
m' = (Text -> SMethod 'CustomMethod
forall (f :: From) (t :: MethodType). Text -> SMethod 'CustomMethod
SCustomMethod Text
cm :: SMethod (CustomMethod :: Method FromClient Request))
                  in SMethod 'CustomMethod
-> Message 'CustomMethod -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod 'CustomMethod
m' (CustomMessage 'FromClient 'Request -> FromClientMessage' a)
-> Parser (CustomMessage 'FromClient 'Request)
-> Parser (FromClientMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (CustomMessage 'FromClient 'Request)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
          | SCustomMethod Text
cm <- SMethod m
m ->
              let m' :: SMethod 'CustomMethod
m' = (Text -> SMethod 'CustomMethod
forall (f :: From) (t :: MethodType). Text -> SMethod 'CustomMethod
SCustomMethod Text
cm :: SMethod (CustomMethod :: Method FromClient Notification))
                  in SMethod 'CustomMethod
-> Message 'CustomMethod -> FromClientMessage' a
forall (t :: MethodType) (m :: Method 'FromClient t)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod 'CustomMethod
m' (CustomMessage 'FromClient 'Notification -> FromClientMessage' a)
-> Parser (CustomMessage 'FromClient 'Notification)
-> Parser (FromClientMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (CustomMessage 'FromClient 'Notification)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
    Maybe Value
Nothing -> do
      case Text -> Object -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup Text
"id" Object
o of
        Just Value
i' -> do
          LspId Any
i <- Value -> Parser (LspId Any)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
i'
          case LspId Any -> Maybe (SMethod Any, a Any)
LookupFunc 'FromServer a
lookupId LspId Any
i of
            Just (SMethod Any
m,a Any
res) -> SMethod Any
-> (HasJSON (ResponseMessage Any) => Parser (FromClientMessage' a))
-> Parser (FromClientMessage' a)
forall (m :: Method 'FromServer 'Request) x.
SServerMethod m -> (HasJSON (ResponseMessage m) => x) -> x
serverResponseJSON SMethod Any
m ((HasJSON (ResponseMessage Any) => Parser (FromClientMessage' a))
 -> Parser (FromClientMessage' a))
-> (HasJSON (ResponseMessage Any) => Parser (FromClientMessage' a))
-> Parser (FromClientMessage' a)
forall a b. (a -> b) -> a -> b
$ a Any -> ResponseMessage Any -> FromClientMessage' a
forall (m :: Method 'FromServer 'Request)
       (a :: Method 'FromServer 'Request -> *).
a m -> ResponseMessage m -> FromClientMessage' a
FromClientRsp a Any
res (ResponseMessage Any -> FromClientMessage' a)
-> Parser (ResponseMessage Any) -> Parser (FromClientMessage' a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (ResponseMessage Any)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
            Maybe (SMethod Any, a Any)
Nothing -> String -> Parser (FromClientMessage' a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (FromClientMessage' a))
-> String -> Parser (FromClientMessage' a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Failed in looking up response type of", Value -> String
forall a. Show a => a -> String
show Value
v]
        Maybe Value
Nothing -> String -> Parser (FromClientMessage' a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (FromClientMessage' a))
-> String -> Parser (FromClientMessage' a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Got unexpected message without method or id"]
parseClientMessage LookupFunc 'FromServer a
_ Value
v = String -> Parser (FromClientMessage' a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (FromClientMessage' a))
-> String -> Parser (FromClientMessage' a)
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"parseClientMessage expected object, got:",Value -> String
forall a. Show a => a -> String
show Value
v]

-- ---------------------------------------------------------------------
-- Helper Utilities
-- ---------------------------------------------------------------------

clientResponseJSON :: SClientMethod m -> (HasJSON (ResponseMessage m) => x) -> x
clientResponseJSON :: SClientMethod m -> (HasJSON (ResponseMessage m) => x) -> x
clientResponseJSON SClientMethod m
m HasJSON (ResponseMessage m) => x
x = case SClientMethod m -> ClientNotOrReq m
forall (t :: MethodType) (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
m of
  ClientNotOrReq m
IsClientReq -> x
HasJSON (ResponseMessage m) => x
x
  ClientNotOrReq m
IsClientEither -> x
HasJSON (ResponseMessage m) => x
x

serverResponseJSON :: SServerMethod m -> (HasJSON (ResponseMessage m) => x) -> x
serverResponseJSON :: SServerMethod m -> (HasJSON (ResponseMessage m) => x) -> x
serverResponseJSON SServerMethod m
m HasJSON (ResponseMessage m) => x
x = case SServerMethod m -> ServerNotOrReq m
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m
m of
  ServerNotOrReq m
IsServerReq -> x
HasJSON (ResponseMessage m) => x
x
  ServerNotOrReq m
IsServerEither -> x
HasJSON (ResponseMessage m) => x
x

clientMethodJSON :: SClientMethod m -> (ToJSON (ClientMessage m) => x) -> x
clientMethodJSON :: SClientMethod m -> (ToJSON (ClientMessage m) => x) -> x
clientMethodJSON SClientMethod m
m ToJSON (ClientMessage m) => x
x =
  case SClientMethod m -> ClientNotOrReq m
forall (t :: MethodType) (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
m of
    ClientNotOrReq m
IsClientNot -> x
ToJSON (ClientMessage m) => x
x
    ClientNotOrReq m
IsClientReq -> x
ToJSON (ClientMessage m) => x
x
    ClientNotOrReq m
IsClientEither -> x
ToJSON (ClientMessage m) => x
x

serverMethodJSON :: SServerMethod m -> (ToJSON (ServerMessage m) => x) -> x
serverMethodJSON :: SServerMethod m -> (ToJSON (ServerMessage m) => x) -> x
serverMethodJSON SServerMethod m
m ToJSON (ServerMessage m) => x
x =
  case SServerMethod m -> ServerNotOrReq m
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m
m of
    ServerNotOrReq m
IsServerNot -> x
ToJSON (ServerMessage m) => x
x
    ServerNotOrReq m
IsServerReq -> x
ToJSON (ServerMessage m) => x
x
    ServerNotOrReq m
IsServerEither -> x
ToJSON (ServerMessage m) => x
x

type HasJSON a = (ToJSON a,FromJSON a,Eq a)

-- Reify universal properties about Client/Server Messages

data ClientNotOrReq (m :: Method FromClient t) where
  IsClientNot
    :: ( HasJSON (ClientMessage m)
       , Message m ~ NotificationMessage m)
    => ClientNotOrReq (m :: Method FromClient Notification)
  IsClientReq
    :: forall (m :: Method FromClient Request).
    ( HasJSON (ClientMessage m)
    , HasJSON (ResponseMessage m)
    , Message m ~ RequestMessage m)
    => ClientNotOrReq m
  IsClientEither
    :: ClientNotOrReq CustomMethod

data ServerNotOrReq (m :: Method FromServer t) where
  IsServerNot
    :: ( HasJSON (ServerMessage m)
       , Message m ~ NotificationMessage m)
    => ServerNotOrReq (m :: Method FromServer Notification)
  IsServerReq
    :: forall (m :: Method FromServer Request).
    ( HasJSON (ServerMessage m)
    , HasJSON (ResponseMessage m)
    , Message m ~ RequestMessage m)
    => ServerNotOrReq m
  IsServerEither
    :: ServerNotOrReq CustomMethod

splitClientMethod :: SClientMethod m -> ClientNotOrReq m
splitClientMethod :: SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
SInitialize = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
SInitialized = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
SShutdown = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
SExit = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
SWorkspaceDidChangeWorkspaceFolders = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
SWorkspaceDidChangeConfiguration = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
SWorkspaceDidChangeWatchedFiles = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
SWorkspaceSymbol = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
SWorkspaceExecuteCommand = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
SWindowWorkDoneProgressCancel = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
STextDocumentDidOpen = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
STextDocumentDidChange = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
STextDocumentWillSave = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
STextDocumentWillSaveWaitUntil = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentDidSave = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
STextDocumentDidClose = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SClientMethod m
STextDocumentCompletion = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
SCompletionItemResolve = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentHover = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentSignatureHelp = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentDeclaration = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentDefinition = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentTypeDefinition = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentImplementation = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentReferences = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentDocumentHighlight = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentDocumentSymbol = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentCodeAction = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentCodeLens = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
SCodeLensResolve = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentDocumentLink = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
SDocumentLinkResolve = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentDocumentColor = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentColorPresentation = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentFormatting = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentRangeFormatting = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentOnTypeFormatting = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentRename = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentPrepareRename = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentFoldingRange = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
STextDocumentSelectionRange = ClientNotOrReq m
forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SClientMethod m
SCancelRequest = ClientNotOrReq m
forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SCustomMethod{} = ClientNotOrReq m
forall (t :: MethodType). ClientNotOrReq 'CustomMethod
IsClientEither

splitServerMethod :: SServerMethod m -> ServerNotOrReq m
splitServerMethod :: SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m
SWindowShowMessage = ServerNotOrReq m
forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SServerMethod m
SWindowShowMessageRequest = ServerNotOrReq m
forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SServerMethod m
SWindowLogMessage = ServerNotOrReq m
forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SServerMethod m
SWindowWorkDoneProgressCreate = ServerNotOrReq m
forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SServerMethod m
SProgress = ServerNotOrReq m
forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SServerMethod m
STelemetryEvent = ServerNotOrReq m
forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SServerMethod m
SClientRegisterCapability = ServerNotOrReq m
forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SServerMethod m
SClientUnregisterCapability = ServerNotOrReq m
forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SServerMethod m
SWorkspaceWorkspaceFolders = ServerNotOrReq m
forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SServerMethod m
SWorkspaceConfiguration = ServerNotOrReq m
forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SServerMethod m
SWorkspaceApplyEdit = ServerNotOrReq m
forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SServerMethod m
STextDocumentPublishDiagnostics = ServerNotOrReq m
forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SServerMethod m
SCancelRequest = ServerNotOrReq m
forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SCustomMethod{} = ServerNotOrReq m
forall (t :: MethodType). ServerNotOrReq 'CustomMethod
IsServerEither

-- | Heterogeneous equality on singleton server methods
mEqServer :: SServerMethod m1 -> SServerMethod m2 -> Maybe (m1 :~~: m2)
mEqServer :: SServerMethod m1 -> SServerMethod m2 -> Maybe (m1 :~~: m2)
mEqServer SServerMethod m1
m1 SServerMethod m2
m2 = case (SServerMethod m1 -> ServerNotOrReq m1
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m1
m1, SServerMethod m2 -> ServerNotOrReq m2
forall (t :: MethodType) (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m2
m2) of
  (ServerNotOrReq m1
IsServerNot, ServerNotOrReq m2
IsServerNot) -> do
    m1 :~: m2
Refl <- SServerMethod m1 -> SMethod m2 -> Maybe (m1 :~: m2)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SServerMethod m1
m1 SMethod m2
SServerMethod m2
m2
    (m1 :~~: m1) -> Maybe (m1 :~~: m1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure m1 :~~: m1
forall k1 (a :: k1). a :~~: a
HRefl
  (ServerNotOrReq m1
IsServerReq, ServerNotOrReq m2
IsServerReq) -> do
    m1 :~: m2
Refl <- SServerMethod m1 -> SMethod m2 -> Maybe (m1 :~: m2)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SServerMethod m1
m1 SMethod m2
SServerMethod m2
m2
    (m1 :~~: m1) -> Maybe (m1 :~~: m1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure m1 :~~: m1
forall k1 (a :: k1). a :~~: a
HRefl
  (ServerNotOrReq m1, ServerNotOrReq m2)
_ -> Maybe (m1 :~~: m2)
forall a. Maybe a
Nothing

-- | Heterogeneous equality on singlton client methods
mEqClient :: SClientMethod m1 -> SClientMethod m2 -> Maybe (m1 :~~: m2)
mEqClient :: SClientMethod m1 -> SClientMethod m2 -> Maybe (m1 :~~: m2)
mEqClient SClientMethod m1
m1 SClientMethod m2
m2 = case (SClientMethod m1 -> ClientNotOrReq m1
forall (t :: MethodType) (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m1
m1, SClientMethod m2 -> ClientNotOrReq m2
forall (t :: MethodType) (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m2
m2) of
  (ClientNotOrReq m1
IsClientNot, ClientNotOrReq m2
IsClientNot) -> do
    m1 :~: m2
Refl <- SClientMethod m1 -> SMethod m2 -> Maybe (m1 :~: m2)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SClientMethod m1
m1 SMethod m2
SClientMethod m2
m2
    (m1 :~~: m1) -> Maybe (m1 :~~: m1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure m1 :~~: m1
forall k1 (a :: k1). a :~~: a
HRefl
  (ClientNotOrReq m1
IsClientReq, ClientNotOrReq m2
IsClientReq) -> do
    m1 :~: m2
Refl <- SClientMethod m1 -> SMethod m2 -> Maybe (m1 :~: m2)
forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SClientMethod m1
m1 SMethod m2
SClientMethod m2
m2
    (m1 :~~: m1) -> Maybe (m1 :~~: m1)
forall (f :: * -> *) a. Applicative f => a -> f a
pure m1 :~~: m1
forall k1 (a :: k1). a :~~: a
HRefl
  (ClientNotOrReq m1, ClientNotOrReq m2)
_ -> Maybe (m1 :~~: m2)
forall a. Maybe a
Nothing