{-# 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 #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Language.LSP.Types.Parsing where

import           Language.LSP.Types.LspId
import           Language.LSP.Types.Method
import           Language.LSP.Types.Message

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

-- ---------------------------------------------------------------------
-- Working with arbitrary 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
(==) = 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 Message m
p) = forall {t :: MethodType} (m :: Method 'FromServer t) x.
SServerMethod m -> (ToJSON (ServerMessage m) => x) -> x
serverMethodJSON SMethod m
m (forall a. ToJSON a => a -> Value
toJSON Message m
p)
  toJSON (FromServerRsp SMethod m
m ResponseMessage m
p) = forall (m :: Method 'FromClient 'Request) x.
SClientMethod m -> (HasJSON (ResponseMessage m) => x) -> x
clientResponseJSON SMethod m
m (forall a. ToJSON a => a -> Value
toJSON ResponseMessage m
p)

fromServerNot :: forall (m :: Method FromServer Notification).
  Message m ~ NotificationMessage m => NotificationMessage m -> FromServerMessage
fromServerNot :: forall (m :: Method 'FromServer 'Notification).
(Message m ~ NotificationMessage m) =>
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} = forall (m :: MethodType) (m :: Method 'FromServer m)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod m
meth NotificationMessage m
m

fromServerReq :: forall (m :: Method FromServer Request).
  Message m ~ RequestMessage m => RequestMessage m -> FromServerMessage
fromServerReq :: forall (m :: Method 'FromServer 'Request).
(Message m ~ RequestMessage m) =>
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} = forall (m :: MethodType) (m :: Method 'FromServer m)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod m
meth RequestMessage 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) = forall {t :: MethodType} (m :: Method 'FromClient t) x.
SClientMethod m -> (ToJSON (ClientMessage m) => x) -> x
clientMethodJSON SMethod m
m (forall a. ToJSON a => a -> Value
toJSON Message m
p)
  toJSON (FromClientRsp SMethod m
m ResponseMessage m
p) = forall (m :: Method 'FromServer 'Request) x.
SServerMethod m -> (HasJSON (ResponseMessage m) => x) -> x
serverResponseJSON SMethod m
m (forall a. ToJSON a => a -> Value
toJSON ResponseMessage m
p)

fromClientNot :: forall (m :: Method FromClient Notification).
  Message m ~ NotificationMessage m => NotificationMessage m -> FromClientMessage
fromClientNot :: forall (m :: Method 'FromClient 'Notification).
(Message m ~ NotificationMessage m) =>
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} = forall (m :: MethodType) (m :: Method 'FromClient m)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
meth NotificationMessage m
m

fromClientReq :: forall (m :: Method FromClient Request).
  Message m ~ RequestMessage m => RequestMessage m -> FromClientMessage
fromClientReq :: forall (m :: Method 'FromClient 'Request).
(Message m ~ RequestMessage m) =>
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} = forall (m :: MethodType) (m :: Method 'FromClient m)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod m
meth RequestMessage 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 :: forall (a :: Method 'FromClient 'Request -> *).
LookupFunc 'FromClient a -> Value -> Parser (FromServerMessage' a)
parseServerMessage LookupFunc 'FromClient 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
    -- Request or Notification
    Just (SomeServerMethod SMethod m
m) ->
      case forall {t :: MethodType} (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SMethod m
m of
        ServerNotOrReq m
IsServerNot -> forall (m :: MethodType) (m :: Method 'FromServer m)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message 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 (m :: MethodType) (m :: Method 'FromServer m)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message 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 | SCustomMethod Text
cm <- SMethod m
m -> do
          case Maybe (LspId Any)
idMaybe of
            -- Request
            Just LspId Any
_ ->
              let m' :: SMethod 'CustomMethod
m' = (forall {f :: From} {t :: MethodType}. Text -> SMethod 'CustomMethod
SCustomMethod Text
cm :: SMethod (CustomMethod :: Method FromServer Request))
              in forall (m :: MethodType) (m :: Method 'FromServer m)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod 'CustomMethod
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 'CustomMethod
m' = (forall {f :: From} {t :: MethodType}. Text -> SMethod 'CustomMethod
SCustomMethod Text
cm :: SMethod (CustomMethod :: Method FromServer Notification))
              in forall (m :: MethodType) (m :: Method 'FromServer m)
       (a :: Method 'FromClient 'Request -> *).
SMethod m -> Message m -> FromServerMessage' a
FromServerMess SMethod 'CustomMethod
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 'FromClient a
lookupId LspId Any
i of
            Just (SMethod Any
m,a Any
res) -> forall (m :: Method 'FromClient 'Request) x.
SClientMethod m -> (HasJSON (ResponseMessage m) => x) -> x
clientResponseJSON SMethod Any
m forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromClient 'Request)
       (a :: Method 'FromClient 'Request -> *).
a m -> ResponseMessage m -> 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 'FromClient 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 FromServer a -> Value -> Parser (FromClientMessage' a)
parseClientMessage :: forall (a :: Method 'FromServer 'Request -> *).
LookupFunc 'FromServer a -> Value -> Parser (FromClientMessage' a)
parseClientMessage LookupFunc 'FromServer 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
    -- Request or Notification
    Just (SomeClientMethod SMethod m
m) ->
      case forall {t :: MethodType} (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SMethod m
m of
        ClientNotOrReq m
IsClientNot -> forall (m :: MethodType) (m :: Method 'FromClient m)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message 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 (m :: MethodType) (m :: Method 'FromClient m)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message 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 | SCustomMethod Text
cm <- SMethod m
m -> do
          case Maybe (LspId Any)
idMaybe of
            -- Request
            Just LspId Any
_ ->
              let m' :: SMethod 'CustomMethod
m' = (forall {f :: From} {t :: MethodType}. Text -> SMethod 'CustomMethod
SCustomMethod Text
cm :: SMethod (CustomMethod :: Method FromClient Request))
              in forall (m :: MethodType) (m :: Method 'FromClient m)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod 'CustomMethod
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 'CustomMethod
m' = (forall {f :: From} {t :: MethodType}. Text -> SMethod 'CustomMethod
SCustomMethod Text
cm :: SMethod (CustomMethod :: Method FromClient Notification))
              in forall (m :: MethodType) (m :: Method 'FromClient m)
       (a :: Method 'FromServer 'Request -> *).
SMethod m -> Message m -> FromClientMessage' a
FromClientMess SMethod 'CustomMethod
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 'FromServer a
lookupId LspId Any
i of
            Just (SMethod Any
m,a Any
res) -> forall (m :: Method 'FromServer 'Request) x.
SServerMethod m -> (HasJSON (ResponseMessage m) => x) -> x
serverResponseJSON SMethod Any
m forall a b. (a -> b) -> a -> b
$ forall (m :: Method 'FromServer 'Request)
       (a :: Method 'FromServer 'Request -> *).
a m -> ResponseMessage m -> 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 'FromServer 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]

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

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

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

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

{-# INLINE serverMethodJSON #-}
serverMethodJSON :: SServerMethod m -> (ToJSON (ServerMessage m) => x) -> x
serverMethodJSON :: forall {t :: MethodType} (m :: Method 'FromServer t) x.
SServerMethod m -> (ToJSON (ServerMessage m) => x) -> x
serverMethodJSON SServerMethod m
m ToJSON (ServerMessage m) => x
x =
  case forall {t :: MethodType} (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m
m of
    ServerNotOrReq m
IsServerNot -> ToJSON (ServerMessage m) => x
x
    ServerNotOrReq m
IsServerReq -> ToJSON (ServerMessage m) => x
x
    ServerNotOrReq m
IsServerEither -> 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 :: forall {t :: MethodType} (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SMethod m
SInitialize = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SInitialized = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
SShutdown = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SExit = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
SWorkspaceDidChangeWorkspaceFolders = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
SWorkspaceDidChangeConfiguration = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
SWorkspaceDidChangeWatchedFiles = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
SWorkspaceSymbol = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SWorkspaceExecuteCommand = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SWindowWorkDoneProgressCancel = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
STextDocumentDidOpen = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
STextDocumentDidChange = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
STextDocumentWillSave = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
STextDocumentWillSaveWaitUntil = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentDidSave = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
STextDocumentDidClose = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SMethod m
STextDocumentCompletion = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SCompletionItemResolve = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentHover = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentSignatureHelp = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentDeclaration = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentDefinition = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentTypeDefinition = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentImplementation = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentReferences = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentDocumentHighlight = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentDocumentSymbol = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentCodeAction = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentCodeLens = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SCodeLensResolve = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentDocumentLink = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SDocumentLinkResolve = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentDocumentColor = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentColorPresentation = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentFormatting = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentRangeFormatting = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentOnTypeFormatting = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentRename = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentPrepareRename = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentFoldingRange = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentSelectionRange = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentPrepareCallHierarchy = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SCallHierarchyIncomingCalls = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SCallHierarchyOutgoingCalls = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentSemanticTokens = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentSemanticTokensFull = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentSemanticTokensFullDelta = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
STextDocumentSemanticTokensRange = forall (m :: Method 'FromClient 'Request).
(HasJSON (ClientMessage m), HasJSON (ResponseMessage m),
 ClientMessage m ~ RequestMessage m) =>
ClientNotOrReq m
IsClientReq
splitClientMethod SMethod m
SCancelRequest = forall (m :: Method 'FromClient 'Notification).
(HasJSON (ClientMessage m),
 ClientMessage m ~ NotificationMessage m) =>
ClientNotOrReq m
IsClientNot
splitClientMethod SCustomMethod{} = forall {t :: MethodType}. ClientNotOrReq 'CustomMethod
IsClientEither

{-# INLINE splitServerMethod #-}
splitServerMethod :: SServerMethod m -> ServerNotOrReq m
-- Window
splitServerMethod :: forall {t :: MethodType} (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SMethod m
SWindowShowMessage = forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SMethod m
SWindowShowMessageRequest = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SMethod m
SWindowShowDocument = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SMethod m
SWindowLogMessage = forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SMethod m
SWindowWorkDoneProgressCreate = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SMethod m
SProgress = forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
splitServerMethod SMethod m
STelemetryEvent = forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
-- Client
splitServerMethod SMethod m
SClientRegisterCapability = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SMethod m
SClientUnregisterCapability = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
-- Workspace
splitServerMethod SMethod m
SWorkspaceWorkspaceFolders = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SMethod m
SWorkspaceConfiguration = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SMethod m
SWorkspaceApplyEdit = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
splitServerMethod SMethod m
SWorkspaceSemanticTokensRefresh = forall (m :: Method 'FromServer 'Request).
(HasJSON (ServerMessage m), HasJSON (ResponseMessage m),
 ServerMessage m ~ RequestMessage m) =>
ServerNotOrReq m
IsServerReq
-- Document
splitServerMethod SMethod m
STextDocumentPublishDiagnostics = forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
-- Cancelling
splitServerMethod SMethod m
SCancelRequest = forall (m :: Method 'FromServer 'Notification).
(HasJSON (ServerMessage m),
 ServerMessage m ~ NotificationMessage m) =>
ServerNotOrReq m
IsServerNot
-- Custom
splitServerMethod SCustomMethod{} = 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))
    => { forall (f :: From) (t1 :: MethodType) (m1 :: Method f t1)
       (t2 :: MethodType) (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 :: MethodType) (t2 :: MethodType) (f :: From)
       (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 :: From) (t1 :: MethodType) (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 :: forall {t1 :: MethodType} {t2 :: MethodType}
       (m1 :: Method 'FromServer t1) (m2 :: Method 'FromServer 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 :: MethodType} (m :: Method 'FromServer t).
SServerMethod m -> ServerNotOrReq m
splitServerMethod SServerMethod m1
m1) (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 <- 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
      | SCustomMethod Text
c1 <- SServerMethod m1
m1
      , SCustomMethod Text
c2 <- SServerMethod m2
m2
      , Text
c1 forall a. Eq a => a -> a -> Bool
== Text
c2
      = 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 :: 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 forall {k1} (a :: k1). a :~~: a
HRefl
    go ServerNotOrReq m1
_ ServerNotOrReq 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 :: forall {t1 :: MethodType} {t2 :: MethodType}
       (m1 :: Method 'FromClient t1) (m2 :: Method 'FromClient 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 :: MethodType} (m :: Method 'FromClient t).
SClientMethod m -> ClientNotOrReq m
splitClientMethod SClientMethod m1
m1) (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 <- 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
      | SCustomMethod Text
c1 <- SClientMethod m1
m1
      , SCustomMethod Text
c2 <- SClientMethod m2
m2
      , Text
c1 forall a. Eq a => a -> a -> Bool
== Text
c2
      = 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 :: 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 forall {k1} (a :: k1). a :~~: a
HRefl
    go ClientNotOrReq m1
_ ClientNotOrReq m2
_ = forall a. Maybe a
Nothing