{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TypeInType #-}
module Language.LSP.Protocol.Message.Parsing where
import Language.LSP.Protocol.Internal.Method
import Language.LSP.Protocol.Message.LspId
import Language.LSP.Protocol.Message.Meta
import Language.LSP.Protocol.Message.Method
import Language.LSP.Protocol.Message.Types
import Data.Aeson
import Data.Aeson.Types
import Data.Function (on)
import Data.GADT.Compare
import Data.Kind
import Data.Proxy
import Data.Type.Equality
import GHC.TypeLits (sameSymbol)
data FromServerMessage' a where
FromServerMess :: forall t (m :: Method ServerToClient t) a. SMethod m -> TMessage m -> FromServerMessage' a
FromServerRsp :: forall (m :: Method ClientToServer Request) a. a m -> TResponseMessage m -> FromServerMessage' a
type FromServerMessage = FromServerMessage' SMethod
instance Eq FromServerMessage where
== :: FromServerMessage -> FromServerMessage -> Bool
(==) = forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a. ToJSON a => a -> Value
toJSON
instance Show FromServerMessage where
show :: FromServerMessage -> String
show = forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON
instance ToJSON FromServerMessage where
toJSON :: FromServerMessage -> Value
toJSON (FromServerMess SMethod m
m TMessage m
p) = forall {t :: MessageKind} (m :: Method 'ServerToClient t) x.
SServerMethod m -> (ToJSON (TServerMessage m) => x) -> x
serverMethodJSON SMethod m
m (forall a. ToJSON a => a -> Value
toJSON TMessage m
p)
toJSON (FromServerRsp SMethod m
m TResponseMessage m
p) = forall (m :: Method 'ClientToServer 'Request) x.
SClientMethod m -> (HasJSON (TResponseMessage m) => x) -> x
clientResponseJSON SMethod m
m (forall a. ToJSON a => a -> Value
toJSON TResponseMessage m
p)
fromServerNot ::
forall (m :: Method ServerToClient Notification).
TMessage m ~ TNotificationMessage m =>
TNotificationMessage m ->
FromServerMessage
fromServerNot :: forall (m :: Method 'ServerToClient 'Notification).
(TMessage m ~ TNotificationMessage m) =>
TNotificationMessage m -> FromServerMessage
fromServerNot m :: TNotificationMessage m
m@TNotificationMessage{$sel:_method:TNotificationMessage :: forall (f :: MessageDirection) (m :: Method f 'Notification).
TNotificationMessage m -> SMethod m
_method = SMethod m
meth} = forall (s :: MessageKind) (m :: Method 'ServerToClient s)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod m
meth TNotificationMessage m
m
fromServerReq ::
forall (m :: Method ServerToClient Request).
TMessage m ~ TRequestMessage m =>
TRequestMessage m ->
FromServerMessage
fromServerReq :: forall (m :: Method 'ServerToClient 'Request).
(TMessage m ~ TRequestMessage m) =>
TRequestMessage m -> FromServerMessage
fromServerReq m :: TRequestMessage m
m@TRequestMessage{$sel:_method:TRequestMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> SMethod m
_method = SMethod m
meth} = forall (s :: MessageKind) (m :: Method 'ServerToClient s)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod m
meth TRequestMessage m
m
data FromClientMessage' a where
FromClientMess :: forall t (m :: Method ClientToServer t) a. SMethod m -> TMessage m -> FromClientMessage' a
FromClientRsp :: forall (m :: Method ServerToClient Request) a. a m -> TResponseMessage m -> FromClientMessage' a
type FromClientMessage = FromClientMessage' SMethod
instance ToJSON FromClientMessage where
toJSON :: FromClientMessage -> Value
toJSON (FromClientMess SMethod m
m TMessage m
p) = forall {t :: MessageKind} (m :: Method 'ClientToServer t) x.
SClientMethod m -> (ToJSON (TClientMessage m) => x) -> x
clientMethodJSON SMethod m
m (forall a. ToJSON a => a -> Value
toJSON TMessage m
p)
toJSON (FromClientRsp SMethod m
m TResponseMessage m
p) = forall (m :: Method 'ServerToClient 'Request) x.
SServerMethod m -> (HasJSON (TResponseMessage m) => x) -> x
serverResponseJSON SMethod m
m (forall a. ToJSON a => a -> Value
toJSON TResponseMessage m
p)
fromClientNot ::
forall (m :: Method ClientToServer Notification).
TMessage m ~ TNotificationMessage m =>
TNotificationMessage m ->
FromClientMessage
fromClientNot :: forall (m :: Method 'ClientToServer 'Notification).
(TMessage m ~ TNotificationMessage m) =>
TNotificationMessage m -> FromClientMessage
fromClientNot m :: TNotificationMessage m
m@TNotificationMessage{$sel:_method:TNotificationMessage :: forall (f :: MessageDirection) (m :: Method f 'Notification).
TNotificationMessage m -> SMethod m
_method = SMethod m
meth} = forall (s :: MessageKind) (m :: Method 'ClientToServer s)
(a :: Method 'ServerToClient 'Request -> *).
SMethod m -> TMessage m -> FromClientMessage' a
FromClientMess SMethod m
meth TNotificationMessage m
m
fromClientReq ::
forall (m :: Method ClientToServer Request).
TMessage m ~ TRequestMessage m =>
TRequestMessage m ->
FromClientMessage
fromClientReq :: forall (m :: Method 'ClientToServer 'Request).
(TMessage m ~ TRequestMessage m) =>
TRequestMessage m -> FromClientMessage
fromClientReq m :: TRequestMessage m
m@TRequestMessage{$sel:_method:TRequestMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> SMethod m
_method = SMethod m
meth} = forall (s :: MessageKind) (m :: Method 'ClientToServer s)
(a :: Method 'ServerToClient 'Request -> *).
SMethod m -> TMessage m -> FromClientMessage' a
FromClientMess SMethod m
meth TRequestMessage m
m
type LookupFunc f a = forall (m :: Method f Request). LspId m -> Maybe (SMethod m, a m)
{-# INLINE parseServerMessage #-}
parseServerMessage :: LookupFunc ClientToServer a -> Value -> Parser (FromServerMessage' a)
parseServerMessage :: forall (a :: Method 'ClientToServer 'Request -> *).
LookupFunc 'ClientToServer a
-> Value -> Parser (FromServerMessage' a)
parseServerMessage LookupFunc 'ClientToServer a
lookupId v :: Value
v@(Object Object
o) = do
Maybe SomeServerMethod
methMaybe <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:! Key
"method"
Maybe (LspId Any)
idMaybe <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:! Key
"id"
case Maybe SomeServerMethod
methMaybe of
Just (SomeServerMethod SMethod m
m) ->
case forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SMethod m
m of
ServerNotOrReq m
IsServerNot -> forall (s :: MessageKind) (m :: Method 'ServerToClient s)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod m
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
ServerNotOrReq m
IsServerReq -> forall (s :: MessageKind) (m :: Method 'ServerToClient s)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod m
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
ServerNotOrReq m
IsServerEither | SMethod_CustomMethod (Proxy s
p :: Proxy s') <- SMethod m
m -> do
case Maybe (LspId Any)
idMaybe of
Just LspId Any
_ ->
let m' :: SMethod ('Method_CustomMethod s)
m' = (forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod Proxy s
p :: SMethod (Method_CustomMethod s' :: Method ServerToClient Request))
in forall (s :: MessageKind) (m :: Method 'ServerToClient s)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod ('Method_CustomMethod s)
m' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Maybe (LspId Any)
Nothing ->
let m' :: SMethod ('Method_CustomMethod s)
m' = (forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod Proxy s
p :: SMethod (Method_CustomMethod s' :: Method ServerToClient Notification))
in forall (s :: MessageKind) (m :: Method 'ServerToClient s)
(a :: Method 'ClientToServer 'Request -> *).
SMethod m -> TMessage m -> FromServerMessage' a
FromServerMess SMethod ('Method_CustomMethod s)
m' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Maybe SomeServerMethod
Nothing -> do
case Maybe (LspId Any)
idMaybe of
Just LspId Any
i -> do
case LookupFunc 'ClientToServer a
lookupId LspId Any
i of
Just (SMethod Any
m, a Any
res) -> forall (m :: Method 'ClientToServer 'Request) x.
SClientMethod m -> (HasJSON (TResponseMessage m) => x) -> x
clientResponseJSON SMethod Any
m forall a b. (a -> b) -> a -> b
$ forall (s :: Method 'ClientToServer 'Request)
(a :: Method 'ClientToServer 'Request -> *).
a s -> TResponseMessage s -> FromServerMessage' a
FromServerRsp a Any
res forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Maybe (SMethod Any, a Any)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Failed in looking up response type of", forall a. Show a => a -> String
show Value
v]
Maybe (LspId Any)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Got unexpected message without method or id"]
parseServerMessage LookupFunc 'ClientToServer a
_ Value
v = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"parseServerMessage expected object, got:", forall a. Show a => a -> String
show Value
v]
{-# INLINE parseClientMessage #-}
parseClientMessage :: LookupFunc ServerToClient a -> Value -> Parser (FromClientMessage' a)
parseClientMessage :: forall (a :: Method 'ServerToClient 'Request -> *).
LookupFunc 'ServerToClient a
-> Value -> Parser (FromClientMessage' a)
parseClientMessage LookupFunc 'ServerToClient a
lookupId v :: Value
v@(Object Object
o) = do
Maybe SomeClientMethod
methMaybe <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:! Key
"method"
Maybe (LspId Any)
idMaybe <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:! Key
"id"
case Maybe SomeClientMethod
methMaybe of
Just (SomeClientMethod SMethod m
m) ->
case forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SMethod m
m of
ClientNotOrReq m
IsClientNot -> forall (s :: MessageKind) (m :: Method 'ClientToServer s)
(a :: Method 'ServerToClient 'Request -> *).
SMethod m -> TMessage m -> FromClientMessage' a
FromClientMess SMethod m
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
ClientNotOrReq m
IsClientReq -> forall (s :: MessageKind) (m :: Method 'ClientToServer s)
(a :: Method 'ServerToClient 'Request -> *).
SMethod m -> TMessage m -> FromClientMessage' a
FromClientMess SMethod m
m forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
ClientNotOrReq m
IsClientEither | SMethod_CustomMethod (Proxy s
p :: Proxy s') <- SMethod m
m -> do
case Maybe (LspId Any)
idMaybe of
Just LspId Any
_ ->
let m' :: SMethod ('Method_CustomMethod s)
m' = (forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod Proxy s
p :: SMethod (Method_CustomMethod s' :: Method ClientToServer Request))
in forall (s :: MessageKind) (m :: Method 'ClientToServer s)
(a :: Method 'ServerToClient 'Request -> *).
SMethod m -> TMessage m -> FromClientMessage' a
FromClientMess SMethod ('Method_CustomMethod s)
m' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Maybe (LspId Any)
Nothing ->
let m' :: SMethod ('Method_CustomMethod s)
m' = (forall {f :: MessageDirection} {t :: MessageKind} (s :: Symbol).
KnownSymbol s =>
Proxy s -> SMethod ('Method_CustomMethod s)
SMethod_CustomMethod Proxy s
p :: SMethod (Method_CustomMethod s' :: Method ClientToServer Notification))
in forall (s :: MessageKind) (m :: Method 'ClientToServer s)
(a :: Method 'ServerToClient 'Request -> *).
SMethod m -> TMessage m -> FromClientMessage' a
FromClientMess SMethod ('Method_CustomMethod s)
m' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Maybe SomeClientMethod
Nothing -> do
case Maybe (LspId Any)
idMaybe of
Just LspId Any
i -> do
case LookupFunc 'ServerToClient a
lookupId LspId Any
i of
Just (SMethod Any
m, a Any
res) -> forall (m :: Method 'ServerToClient 'Request) x.
SServerMethod m -> (HasJSON (TResponseMessage m) => x) -> x
serverResponseJSON SMethod Any
m forall a b. (a -> b) -> a -> b
$ forall (s :: Method 'ServerToClient 'Request)
(a :: Method 'ServerToClient 'Request -> *).
a s -> TResponseMessage s -> FromClientMessage' a
FromClientRsp a Any
res forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
Maybe (SMethod Any, a Any)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Failed in looking up response type of", forall a. Show a => a -> String
show Value
v]
Maybe (LspId Any)
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"Got unexpected message without method or id"]
parseClientMessage LookupFunc 'ServerToClient a
_ Value
v = forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords [String
"parseClientMessage expected object, got:", forall a. Show a => a -> String
show Value
v]
{-# INLINE clientResponseJSON #-}
clientResponseJSON :: SClientMethod m -> (HasJSON (TResponseMessage m) => x) -> x
clientResponseJSON :: forall (m :: Method 'ClientToServer 'Request) x.
SClientMethod m -> (HasJSON (TResponseMessage m) => x) -> x
clientResponseJSON SClientMethod m
m HasJSON (TResponseMessage m) => x
x = case forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
m of
ClientNotOrReq m
IsClientReq -> HasJSON (TResponseMessage m) => x
x
ClientNotOrReq m
IsClientEither -> HasJSON (TResponseMessage m) => x
x
{-# INLINE serverResponseJSON #-}
serverResponseJSON :: SServerMethod m -> (HasJSON (TResponseMessage m) => x) -> x
serverResponseJSON :: forall (m :: Method 'ServerToClient 'Request) x.
SServerMethod m -> (HasJSON (TResponseMessage m) => x) -> x
serverResponseJSON SServerMethod m
m HasJSON (TResponseMessage m) => x
x = case forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m
m of
ServerNotOrReq m
IsServerReq -> HasJSON (TResponseMessage m) => x
x
ServerNotOrReq m
IsServerEither -> HasJSON (TResponseMessage m) => x
x
{-# INLINE clientMethodJSON #-}
clientMethodJSON :: SClientMethod m -> (ToJSON (TClientMessage m) => x) -> x
clientMethodJSON :: forall {t :: MessageKind} (m :: Method 'ClientToServer t) x.
SClientMethod m -> (ToJSON (TClientMessage m) => x) -> x
clientMethodJSON SClientMethod m
m ToJSON (TClientMessage m) => x
x =
case forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m
m of
ClientNotOrReq m
IsClientNot -> ToJSON (TClientMessage m) => x
x
ClientNotOrReq m
IsClientReq -> ToJSON (TClientMessage m) => x
x
ClientNotOrReq m
IsClientEither -> ToJSON (TClientMessage m) => x
x
{-# INLINE serverMethodJSON #-}
serverMethodJSON :: SServerMethod m -> (ToJSON (TServerMessage m) => x) -> x
serverMethodJSON :: forall {t :: MessageKind} (m :: Method 'ServerToClient t) x.
SServerMethod m -> (ToJSON (TServerMessage m) => x) -> x
serverMethodJSON SServerMethod m
m ToJSON (TServerMessage m) => x
x =
case forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m
m of
ServerNotOrReq m
IsServerNot -> ToJSON (TServerMessage m) => x
x
ServerNotOrReq m
IsServerReq -> ToJSON (TServerMessage m) => x
x
ServerNotOrReq m
IsServerEither -> ToJSON (TServerMessage m) => x
x
type HasJSON a = (ToJSON a, FromJSON a, Eq a)
type ClientNotOrReq :: forall t. Method ClientToServer t -> Type
data ClientNotOrReq m where
IsClientNot ::
( HasJSON (TClientMessage m)
, TMessage m ~ TNotificationMessage m
) =>
ClientNotOrReq (m :: Method ClientToServer Notification)
IsClientReq ::
forall (m :: Method ClientToServer Request).
( HasJSON (TClientMessage m)
, HasJSON (TResponseMessage m)
, TMessage m ~ TRequestMessage m
) =>
ClientNotOrReq m
IsClientEither ::
ClientNotOrReq (Method_CustomMethod s)
type ServerNotOrReq :: forall t. Method ServerToClient t -> Type
data ServerNotOrReq m where
IsServerNot ::
( HasJSON (TServerMessage m)
, TMessage m ~ TNotificationMessage m
) =>
ServerNotOrReq (m :: Method ServerToClient Notification)
IsServerReq ::
forall (m :: Method ServerToClient Request).
( HasJSON (TServerMessage m)
, HasJSON (TResponseMessage m)
, TMessage m ~ TRequestMessage m
) =>
ServerNotOrReq m
IsServerEither ::
ServerNotOrReq (Method_CustomMethod s)
{-# INLINE splitClientMethod #-}
splitClientMethod :: SClientMethod m -> ClientNotOrReq m
splitClientMethod :: forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod = \case
SClientMethod m
SMethod_Initialize -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_Initialized -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_Shutdown -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_Exit -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_WorkspaceDidChangeWorkspaceFolders -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_WorkspaceDidChangeConfiguration -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_WorkspaceDidChangeWatchedFiles -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_WorkspaceSymbol -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_WorkspaceExecuteCommand -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_WindowWorkDoneProgressCancel -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_TextDocumentDidOpen -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_TextDocumentDidChange -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_TextDocumentWillSave -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_TextDocumentWillSaveWaitUntil -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentDidSave -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_TextDocumentDidClose -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_TextDocumentCompletion -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentHover -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentSignatureHelp -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentDeclaration -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentDefinition -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentTypeDefinition -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentImplementation -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentReferences -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentDocumentHighlight -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentDocumentSymbol -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentCodeAction -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentCodeLens -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentDocumentLink -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentDocumentColor -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentColorPresentation -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentFormatting -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentRangeFormatting -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentOnTypeFormatting -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentRename -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentPrepareRename -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentFoldingRange -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentSelectionRange -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentPrepareCallHierarchy -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentLinkedEditingRange -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_CallHierarchyIncomingCalls -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_CallHierarchyOutgoingCalls -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentSemanticTokensFull -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentSemanticTokensFullDelta -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentSemanticTokensRange -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_WorkspaceWillCreateFiles -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_WorkspaceWillDeleteFiles -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_WorkspaceWillRenameFiles -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_WorkspaceDidCreateFiles -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_WorkspaceDidDeleteFiles -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_WorkspaceDidRenameFiles -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_TextDocumentMoniker -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentPrepareTypeHierarchy -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TypeHierarchySubtypes -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TypeHierarchySupertypes -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentInlineValue -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentInlayHint -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_TextDocumentDiagnostic -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_WorkspaceDiagnostic -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_CodeLensResolve -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_InlayHintResolve -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_CodeActionResolve -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_DocumentLinkResolve -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_CompletionItemResolve -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_WorkspaceSymbolResolve -> forall (s :: Method 'ClientToServer 'Request).
(HasJSON (TClientMessage s), HasJSON (TResponseMessage s),
TClientMessage s ~ TRequestMessage s) =>
ClientNotOrReq s
IsClientReq
SClientMethod m
SMethod_NotebookDocumentDidChange -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_NotebookDocumentDidClose -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_NotebookDocumentDidOpen -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_NotebookDocumentDidSave -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_SetTrace -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_Progress -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
SClientMethod m
SMethod_CancelRequest -> forall (s :: Method 'ClientToServer 'Notification).
(HasJSON (TClientMessage s),
TClientMessage s ~ TNotificationMessage s) =>
ClientNotOrReq s
IsClientNot
(SMethod_CustomMethod Proxy s
_) -> forall {t :: MessageKind} (s :: Symbol).
ClientNotOrReq ('Method_CustomMethod s)
IsClientEither
{-# INLINE splitServerMethod #-}
splitServerMethod :: SServerMethod m -> ServerNotOrReq m
splitServerMethod :: forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod = \case
SServerMethod m
SMethod_WindowShowMessage -> forall (s :: Method 'ServerToClient 'Notification).
(HasJSON (TServerMessage s),
TServerMessage s ~ TNotificationMessage s) =>
ServerNotOrReq s
IsServerNot
SServerMethod m
SMethod_WindowShowMessageRequest -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WindowShowDocument -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WindowLogMessage -> forall (s :: Method 'ServerToClient 'Notification).
(HasJSON (TServerMessage s),
TServerMessage s ~ TNotificationMessage s) =>
ServerNotOrReq s
IsServerNot
SServerMethod m
SMethod_WindowWorkDoneProgressCreate -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_Progress -> forall (s :: Method 'ServerToClient 'Notification).
(HasJSON (TServerMessage s),
TServerMessage s ~ TNotificationMessage s) =>
ServerNotOrReq s
IsServerNot
SServerMethod m
SMethod_TelemetryEvent -> forall (s :: Method 'ServerToClient 'Notification).
(HasJSON (TServerMessage s),
TServerMessage s ~ TNotificationMessage s) =>
ServerNotOrReq s
IsServerNot
SServerMethod m
SMethod_ClientRegisterCapability -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_ClientUnregisterCapability -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WorkspaceWorkspaceFolders -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WorkspaceConfiguration -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WorkspaceApplyEdit -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_TextDocumentPublishDiagnostics -> forall (s :: Method 'ServerToClient 'Notification).
(HasJSON (TServerMessage s),
TServerMessage s ~ TNotificationMessage s) =>
ServerNotOrReq s
IsServerNot
SServerMethod m
SMethod_LogTrace -> forall (s :: Method 'ServerToClient 'Notification).
(HasJSON (TServerMessage s),
TServerMessage s ~ TNotificationMessage s) =>
ServerNotOrReq s
IsServerNot
SServerMethod m
SMethod_CancelRequest -> forall (s :: Method 'ServerToClient 'Notification).
(HasJSON (TServerMessage s),
TServerMessage s ~ TNotificationMessage s) =>
ServerNotOrReq s
IsServerNot
SServerMethod m
SMethod_WorkspaceCodeLensRefresh -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WorkspaceSemanticTokensRefresh -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WorkspaceInlineValueRefresh -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WorkspaceInlayHintRefresh -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
SServerMethod m
SMethod_WorkspaceDiagnosticRefresh -> forall (s :: Method 'ServerToClient 'Request).
(HasJSON (TServerMessage s), HasJSON (TResponseMessage s),
TServerMessage s ~ TRequestMessage s) =>
ServerNotOrReq s
IsServerReq
(SMethod_CustomMethod Proxy s
_) -> forall {t :: MessageKind} (s :: Symbol).
ServerNotOrReq ('Method_CustomMethod s)
IsServerEither
data CustomEq m1 m2 where
CustomEq ::
(m1 ~ (Method_CustomMethod s :: Method f t1), m2 ~ (Method_CustomMethod s :: Method f t2)) =>
{forall (f :: MessageDirection) (t1 :: MessageKind)
(m1 :: Method f t1) (t2 :: MessageKind) (m2 :: Method f t2).
CustomEq m1 m2 -> (t1 ~ t2) => m1 :~~: m2
runCustomEq :: (t1 ~ t2 => m1 :~~: m2)} ->
CustomEq m1 m2
runEq ::
(t1 ~ t2) =>
(SMethod m1 -> SMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))) ->
SMethod (m1 :: Method f t1) ->
SMethod (m2 :: Method f t2) ->
Maybe (m1 :~~: m2)
runEq :: forall (t1 :: MessageKind) (t2 :: MessageKind)
(f :: MessageDirection) (m1 :: Method f t1) (m2 :: Method f t2).
(t1 ~ t2) =>
(SMethod m1
-> SMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2)))
-> SMethod m1 -> SMethod m2 -> Maybe (m1 :~~: m2)
runEq SMethod m1
-> SMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
f SMethod m1
m1 SMethod m2
m2 = do
Either (CustomEq m1 m2) (m1 :~~: m2)
res <- SMethod m1
-> SMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
f SMethod m1
m1 SMethod m2
m2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case Either (CustomEq m1 m2) (m1 :~~: m2)
res of
Right m1 :~~: m2
eq -> m1 :~~: m2
eq
Left CustomEq m1 m2
ceq -> forall (f :: MessageDirection) (t1 :: MessageKind)
(m1 :: Method f t1) (t2 :: MessageKind) (m2 :: Method f t2).
CustomEq m1 m2 -> (t1 ~ t2) => m1 :~~: m2
runCustomEq CustomEq m1 m2
ceq
mEqServer :: SServerMethod m1 -> SServerMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqServer :: forall {t1 :: MessageKind} {t2 :: MessageKind}
(m1 :: Method 'ServerToClient t1)
(m2 :: Method 'ServerToClient t2).
SServerMethod m1
-> SServerMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqServer SServerMethod m1
m1 SServerMethod m2
m2 = ServerNotOrReq m1
-> ServerNotOrReq m2
-> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
go (forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m1
m1) (forall {t :: MessageKind} (m :: Method 'ServerToClient t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m2
m2)
where
go :: ServerNotOrReq m1
-> ServerNotOrReq m2
-> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
go ServerNotOrReq m1
IsServerNot ServerNotOrReq m2
IsServerNot = do
m1 :~: m2
Refl <- forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SServerMethod m1
m1 SServerMethod m2
m2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall {k1} (a :: k1). a :~~: a
HRefl
go ServerNotOrReq m1
IsServerReq ServerNotOrReq m2
IsServerReq = do
m1 :~: m2
Refl <- forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SServerMethod m1
m1 SServerMethod m2
m2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall {k1} (a :: k1). a :~~: a
HRefl
go ServerNotOrReq m1
IsServerEither ServerNotOrReq m2
IsServerEither
| SMethod_CustomMethod Proxy s
p1 <- SServerMethod m1
m1
, SMethod_CustomMethod Proxy s
p2 <- SServerMethod m2
m2 =
case forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *)
(proxy2 :: Symbol -> *).
(KnownSymbol a, KnownSymbol b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameSymbol Proxy s
p1 Proxy s
p2 of
Just s :~: s
Refl -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (f :: MessageDirection) (t1 :: MessageKind)
(m1 :: Method f t1) (s :: Symbol) (t2 :: MessageKind)
(m2 :: Method f t2).
(m1 ~ 'Method_CustomMethod s, m2 ~ 'Method_CustomMethod s) =>
((t1 ~ t2) => m1 :~~: m2) -> CustomEq m1 m2
CustomEq forall {k1} (a :: k1). a :~~: a
HRefl
Maybe (s :~: s)
_ -> forall a. Maybe a
Nothing
go ServerNotOrReq m1
_ ServerNotOrReq m2
_ = forall a. Maybe a
Nothing
mEqClient :: SClientMethod m1 -> SClientMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqClient :: forall {t1 :: MessageKind} {t2 :: MessageKind}
(m1 :: Method 'ClientToServer t1)
(m2 :: Method 'ClientToServer t2).
SClientMethod m1
-> SClientMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqClient SClientMethod m1
m1 SClientMethod m2
m2 = ClientNotOrReq m1
-> ClientNotOrReq m2
-> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
go (forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m1
m1) (forall {t :: MessageKind} (m :: Method 'ClientToServer t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m2
m2)
where
go :: ClientNotOrReq m1
-> ClientNotOrReq m2
-> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
go ClientNotOrReq m1
IsClientNot ClientNotOrReq m2
IsClientNot = do
m1 :~: m2
Refl <- forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SClientMethod m1
m1 SClientMethod m2
m2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall {k1} (a :: k1). a :~~: a
HRefl
go ClientNotOrReq m1
IsClientReq ClientNotOrReq m2
IsClientReq = do
m1 :~: m2
Refl <- forall k (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
geq SClientMethod m1
m1 SClientMethod m2
m2
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall {k1} (a :: k1). a :~~: a
HRefl
go ClientNotOrReq m1
IsClientEither ClientNotOrReq m2
IsClientEither
| SMethod_CustomMethod Proxy s
p1 <- SClientMethod m1
m1
, SMethod_CustomMethod Proxy s
p2 <- SClientMethod m2
m2 =
case forall (a :: Symbol) (b :: Symbol) (proxy1 :: Symbol -> *)
(proxy2 :: Symbol -> *).
(KnownSymbol a, KnownSymbol b) =>
proxy1 a -> proxy2 b -> Maybe (a :~: b)
sameSymbol Proxy s
p1 Proxy s
p2 of
Just s :~: s
Refl -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall (f :: MessageDirection) (t1 :: MessageKind)
(m1 :: Method f t1) (s :: Symbol) (t2 :: MessageKind)
(m2 :: Method f t2).
(m1 ~ 'Method_CustomMethod s, m2 ~ 'Method_CustomMethod s) =>
((t1 ~ t2) => m1 :~~: m2) -> CustomEq m1 m2
CustomEq forall {k1} (a :: k1). a :~~: a
HRefl
Maybe (s :~: s)
_ -> forall a. Maybe a
Nothing
go ClientNotOrReq m1
_ ClientNotOrReq m2
_ = forall a. Maybe a
Nothing