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

module Language.LSP.Types.Parsing where

import           Language.LSP.Types.LspId
import           Language.LSP.Types.Method
import           Language.LSP.Types.Message
import qualified Data.HashMap.Strict as HM

import Data.Aeson
import Data.Aeson.Types
import Data.GADT.Compare
import Data.Type.Equality
import Data.Function (on)

-- ---------------------------------------------------------------------
-- 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

-- ---------------------------------------------------------------------
-- Parsing
-- ---------------------------------------------------------------------

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?
-}

{-# INLINE parseServerMessage #-}
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]

{-# INLINE parseClientMessage #-}
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
-- ---------------------------------------------------------------------

{-# INLINE clientResponseJSON #-}
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

{-# INLINE serverResponseJSON #-}
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

{-# INLINE clientMethodJSON#-}
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

{-# INLINE serverMethodJSON #-}
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

{-# INLINE splitClientMethod #-}
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

{-# INLINE splitServerMethod #-}
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

-- | Given a witness that two custom methods are of the same type, produce a witness that the methods are the same
data CustomEq m1 m2 where
  CustomEq
    :: (m1 ~ (CustomMethod :: Method f t1), m2 ~ (CustomMethod :: 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 :: (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
  (m1 :~~: m2) -> Maybe (m1 :~~: m2)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((m1 :~~: m2) -> Maybe (m1 :~~: m2))
-> (m1 :~~: m2) -> Maybe (m1 :~~: m2)
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 -> CustomEq m1 m2 -> (t1 ~ t2) => m1 :~~: m2
forall (t1 :: MethodType) (f :: From) (m1 :: Method f t1)
       (t2 :: MethodType) (m2 :: Method f t2).
CustomEq m1 m2 -> (t1 ~ t2) => m1 :~~: m2
runCustomEq CustomEq m1 m2
ceq

-- | Heterogeneous equality on singleton server methods
mEqServer :: SServerMethod m1 -> SServerMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqServer :: 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 (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)
  where
    go :: ServerNotOrReq m1
-> ServerNotOrReq m2
-> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
go 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
      Either (CustomEq m1 m1) (m1 :~~: m1)
-> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (CustomEq m1 m1) (m1 :~~: m1)
 -> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1)))
-> Either (CustomEq m1 m1) (m1 :~~: m1)
-> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1))
forall a b. (a -> b) -> a -> b
$ (m1 :~~: m1) -> Either (CustomEq m1 m1) (m1 :~~: m1)
forall a b. b -> Either a b
Right m1 :~~: m1
forall k1 (a :: k1). a :~~: a
HRefl
    go 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
      Either (CustomEq m1 m1) (m1 :~~: m1)
-> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (CustomEq m1 m1) (m1 :~~: m1)
 -> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1)))
-> Either (CustomEq m1 m1) (m1 :~~: m1)
-> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1))
forall a b. (a -> b) -> a -> b
$ (m1 :~~: m1) -> Either (CustomEq m1 m1) (m1 :~~: m1)
forall a b. b -> Either a b
Right m1 :~~: m1
forall k1 (a :: k1). a :~~: a
HRefl
    go ServerNotOrReq m1
IsServerEither ServerNotOrReq m2
IsServerEither
      | SCustomMethod Text
c1 <- SServerMethod m1
m1
      , SCustomMethod Text
c2 <- SServerMethod m2
m2
      , Text
c1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c2
      = Either
  (CustomEq 'CustomMethod 'CustomMethod)
  ('CustomMethod :~~: 'CustomMethod)
-> Maybe
     (Either
        (CustomEq 'CustomMethod 'CustomMethod)
        ('CustomMethod :~~: 'CustomMethod))
forall a. a -> Maybe a
Just (Either
   (CustomEq 'CustomMethod 'CustomMethod)
   ('CustomMethod :~~: 'CustomMethod)
 -> Maybe
      (Either
         (CustomEq 'CustomMethod 'CustomMethod)
         ('CustomMethod :~~: 'CustomMethod)))
-> Either
     (CustomEq 'CustomMethod 'CustomMethod)
     ('CustomMethod :~~: 'CustomMethod)
-> Maybe
     (Either
        (CustomEq 'CustomMethod 'CustomMethod)
        ('CustomMethod :~~: 'CustomMethod))
forall a b. (a -> b) -> a -> b
$ CustomEq 'CustomMethod 'CustomMethod
-> Either
     (CustomEq 'CustomMethod 'CustomMethod)
     ('CustomMethod :~~: 'CustomMethod)
forall a b. a -> Either a b
Left (CustomEq 'CustomMethod 'CustomMethod
 -> Either
      (CustomEq 'CustomMethod 'CustomMethod)
      ('CustomMethod :~~: 'CustomMethod))
-> CustomEq 'CustomMethod 'CustomMethod
-> Either
     (CustomEq 'CustomMethod 'CustomMethod)
     ('CustomMethod :~~: 'CustomMethod)
forall a b. (a -> b) -> a -> b
$ ((t1 ~ t2) => 'CustomMethod :~~: 'CustomMethod)
-> CustomEq 'CustomMethod 'CustomMethod
forall (f :: From) (t1 :: MethodType) (m1 :: Method f t1)
       (t2 :: MethodType) (m2 :: Method f t2).
(m1 ~ 'CustomMethod, m2 ~ 'CustomMethod) =>
((t1 ~ t2) => m1 :~~: m2) -> CustomEq m1 m2
CustomEq (t1 ~ t2) => 'CustomMethod :~~: 'CustomMethod
forall k1 (a :: k1). a :~~: a
HRefl
    go ServerNotOrReq m1
_ ServerNotOrReq m2
_ = Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
forall a. Maybe a
Nothing

-- | Heterogeneous equality on singleton client methods
mEqClient :: SClientMethod m1 -> SClientMethod m2 -> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
mEqClient :: 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 (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)
  where
    go :: ClientNotOrReq m1
-> ClientNotOrReq m2
-> Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
go 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
      Either (CustomEq m1 m1) (m1 :~~: m1)
-> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (CustomEq m1 m1) (m1 :~~: m1)
 -> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1)))
-> Either (CustomEq m1 m1) (m1 :~~: m1)
-> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1))
forall a b. (a -> b) -> a -> b
$ (m1 :~~: m1) -> Either (CustomEq m1 m1) (m1 :~~: m1)
forall a b. b -> Either a b
Right m1 :~~: m1
forall k1 (a :: k1). a :~~: a
HRefl
    go 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
      Either (CustomEq m1 m1) (m1 :~~: m1)
-> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either (CustomEq m1 m1) (m1 :~~: m1)
 -> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1)))
-> Either (CustomEq m1 m1) (m1 :~~: m1)
-> Maybe (Either (CustomEq m1 m1) (m1 :~~: m1))
forall a b. (a -> b) -> a -> b
$ (m1 :~~: m1) -> Either (CustomEq m1 m1) (m1 :~~: m1)
forall a b. b -> Either a b
Right m1 :~~: m1
forall k1 (a :: k1). a :~~: a
HRefl
    go ClientNotOrReq m1
IsClientEither ClientNotOrReq m2
IsClientEither
      | SCustomMethod Text
c1 <- SClientMethod m1
m1
      , SCustomMethod Text
c2 <- SClientMethod m2
m2
      , Text
c1 Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
c2
      = Either
  (CustomEq 'CustomMethod 'CustomMethod)
  ('CustomMethod :~~: 'CustomMethod)
-> Maybe
     (Either
        (CustomEq 'CustomMethod 'CustomMethod)
        ('CustomMethod :~~: 'CustomMethod))
forall a. a -> Maybe a
Just (Either
   (CustomEq 'CustomMethod 'CustomMethod)
   ('CustomMethod :~~: 'CustomMethod)
 -> Maybe
      (Either
         (CustomEq 'CustomMethod 'CustomMethod)
         ('CustomMethod :~~: 'CustomMethod)))
-> Either
     (CustomEq 'CustomMethod 'CustomMethod)
     ('CustomMethod :~~: 'CustomMethod)
-> Maybe
     (Either
        (CustomEq 'CustomMethod 'CustomMethod)
        ('CustomMethod :~~: 'CustomMethod))
forall a b. (a -> b) -> a -> b
$ CustomEq 'CustomMethod 'CustomMethod
-> Either
     (CustomEq 'CustomMethod 'CustomMethod)
     ('CustomMethod :~~: 'CustomMethod)
forall a b. a -> Either a b
Left (CustomEq 'CustomMethod 'CustomMethod
 -> Either
      (CustomEq 'CustomMethod 'CustomMethod)
      ('CustomMethod :~~: 'CustomMethod))
-> CustomEq 'CustomMethod 'CustomMethod
-> Either
     (CustomEq 'CustomMethod 'CustomMethod)
     ('CustomMethod :~~: 'CustomMethod)
forall a b. (a -> b) -> a -> b
$ ((t1 ~ t2) => 'CustomMethod :~~: 'CustomMethod)
-> CustomEq 'CustomMethod 'CustomMethod
forall (f :: From) (t1 :: MethodType) (m1 :: Method f t1)
       (t2 :: MethodType) (m2 :: Method f t2).
(m1 ~ 'CustomMethod, m2 ~ 'CustomMethod) =>
((t1 ~ t2) => m1 :~~: m2) -> CustomEq m1 m2
CustomEq (t1 ~ t2) => 'CustomMethod :~~: 'CustomMethod
forall k1 (a :: k1). a :~~: a
HRefl
    go ClientNotOrReq m1
_ ClientNotOrReq m2
_ = Maybe (Either (CustomEq m1 m2) (m1 :~~: m2))
forall a. Maybe a
Nothing