{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeInType #-}
module Language.LSP.Protocol.Message.Types 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.Types
import Language.LSP.Protocol.Utils.Misc
import Data.Aeson hiding (Null)
import Data.Aeson qualified as J
import Data.Aeson.TH
import Data.Kind
import Data.String (IsString (..))
import Data.Text (Text)
import GHC.Generics
import GHC.TypeLits (KnownSymbol)
import Prettyprinter
data NotificationMessage = NotificationMessage
{ NotificationMessage -> Text
_jsonrpc :: Text
, NotificationMessage -> Text
_method :: Text
, NotificationMessage -> Maybe Value
_params :: Maybe Value
}
deriving stock (Int -> NotificationMessage -> ShowS
[NotificationMessage] -> ShowS
NotificationMessage -> String
(Int -> NotificationMessage -> ShowS)
-> (NotificationMessage -> String)
-> ([NotificationMessage] -> ShowS)
-> Show NotificationMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NotificationMessage -> ShowS
showsPrec :: Int -> NotificationMessage -> ShowS
$cshow :: NotificationMessage -> String
show :: NotificationMessage -> String
$cshowList :: [NotificationMessage] -> ShowS
showList :: [NotificationMessage] -> ShowS
Show, NotificationMessage -> NotificationMessage -> Bool
(NotificationMessage -> NotificationMessage -> Bool)
-> (NotificationMessage -> NotificationMessage -> Bool)
-> Eq NotificationMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NotificationMessage -> NotificationMessage -> Bool
== :: NotificationMessage -> NotificationMessage -> Bool
$c/= :: NotificationMessage -> NotificationMessage -> Bool
/= :: NotificationMessage -> NotificationMessage -> Bool
Eq, (forall x. NotificationMessage -> Rep NotificationMessage x)
-> (forall x. Rep NotificationMessage x -> NotificationMessage)
-> Generic NotificationMessage
forall x. Rep NotificationMessage x -> NotificationMessage
forall x. NotificationMessage -> Rep NotificationMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. NotificationMessage -> Rep NotificationMessage x
from :: forall x. NotificationMessage -> Rep NotificationMessage x
$cto :: forall x. Rep NotificationMessage x -> NotificationMessage
to :: forall x. Rep NotificationMessage x -> NotificationMessage
Generic)
deriveJSON lspOptions ''NotificationMessage
deriving via ViaJSON NotificationMessage instance Pretty NotificationMessage
data RequestMessage = RequestMessage
{ RequestMessage -> Text
_jsonrpc :: Text
, RequestMessage -> Int32 |? Text
_id :: Int32 |? Text
, RequestMessage -> Text
_method :: Text
, RequestMessage -> Maybe Value
_params :: Maybe Value
}
deriving stock (Int -> RequestMessage -> ShowS
[RequestMessage] -> ShowS
RequestMessage -> String
(Int -> RequestMessage -> ShowS)
-> (RequestMessage -> String)
-> ([RequestMessage] -> ShowS)
-> Show RequestMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestMessage -> ShowS
showsPrec :: Int -> RequestMessage -> ShowS
$cshow :: RequestMessage -> String
show :: RequestMessage -> String
$cshowList :: [RequestMessage] -> ShowS
showList :: [RequestMessage] -> ShowS
Show, RequestMessage -> RequestMessage -> Bool
(RequestMessage -> RequestMessage -> Bool)
-> (RequestMessage -> RequestMessage -> Bool) -> Eq RequestMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RequestMessage -> RequestMessage -> Bool
== :: RequestMessage -> RequestMessage -> Bool
$c/= :: RequestMessage -> RequestMessage -> Bool
/= :: RequestMessage -> RequestMessage -> Bool
Eq, (forall x. RequestMessage -> Rep RequestMessage x)
-> (forall x. Rep RequestMessage x -> RequestMessage)
-> Generic RequestMessage
forall x. Rep RequestMessage x -> RequestMessage
forall x. RequestMessage -> Rep RequestMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RequestMessage -> Rep RequestMessage x
from :: forall x. RequestMessage -> Rep RequestMessage x
$cto :: forall x. Rep RequestMessage x -> RequestMessage
to :: forall x. Rep RequestMessage x -> RequestMessage
Generic)
deriveJSON lspOptions ''RequestMessage
deriving via ViaJSON RequestMessage instance Pretty RequestMessage
data ResponseError = ResponseError
{ ResponseError -> LSPErrorCodes |? ErrorCodes
_code :: LSPErrorCodes |? ErrorCodes
, ResponseError -> Text
_message :: Text
, ResponseError -> Maybe Value
_xdata :: Maybe Value
}
deriving stock (Int -> ResponseError -> ShowS
[ResponseError] -> ShowS
ResponseError -> String
(Int -> ResponseError -> ShowS)
-> (ResponseError -> String)
-> ([ResponseError] -> ShowS)
-> Show ResponseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseError -> ShowS
showsPrec :: Int -> ResponseError -> ShowS
$cshow :: ResponseError -> String
show :: ResponseError -> String
$cshowList :: [ResponseError] -> ShowS
showList :: [ResponseError] -> ShowS
Show, ResponseError -> ResponseError -> Bool
(ResponseError -> ResponseError -> Bool)
-> (ResponseError -> ResponseError -> Bool) -> Eq ResponseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseError -> ResponseError -> Bool
== :: ResponseError -> ResponseError -> Bool
$c/= :: ResponseError -> ResponseError -> Bool
/= :: ResponseError -> ResponseError -> Bool
Eq, (forall x. ResponseError -> Rep ResponseError x)
-> (forall x. Rep ResponseError x -> ResponseError)
-> Generic ResponseError
forall x. Rep ResponseError x -> ResponseError
forall x. ResponseError -> Rep ResponseError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponseError -> Rep ResponseError x
from :: forall x. ResponseError -> Rep ResponseError x
$cto :: forall x. Rep ResponseError x -> ResponseError
to :: forall x. Rep ResponseError x -> ResponseError
Generic)
deriveToJSON lspOptions ''ResponseError
instance FromJSON ResponseError where
parseJSON :: Value -> Parser ResponseError
parseJSON =
let errorCode :: Value -> Parser ResponseError
errorCode = String
-> (Object -> Parser ResponseError)
-> Value
-> Parser ResponseError
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResponseError" ((Object -> Parser ResponseError) -> Value -> Parser ResponseError)
-> (Object -> Parser ResponseError)
-> Value
-> Parser ResponseError
forall a b. (a -> b) -> a -> b
$ \Object
v ->
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe Value -> ResponseError
ResponseError
((LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe Value -> ResponseError)
-> Parser (LSPErrorCodes |? ErrorCodes)
-> Parser (Text -> Maybe Value -> ResponseError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (LSPErrorCodes |? ErrorCodes)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
Parser (Text -> Maybe Value -> ResponseError)
-> Parser Text -> Parser (Maybe Value -> ResponseError)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
Parser (Maybe Value -> ResponseError)
-> Parser (Maybe Value) -> Parser ResponseError
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Value)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
.:!? Key
"data"
in (ResponseError -> ResponseError)
-> Parser ResponseError -> Parser ResponseError
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResponseError -> ResponseError
go (Parser ResponseError -> Parser ResponseError)
-> (Value -> Parser ResponseError) -> Value -> Parser ResponseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser ResponseError
errorCode
where
go :: ResponseError -> ResponseError
go :: ResponseError -> ResponseError
go x :: ResponseError
x@(ResponseError (InL (LSPErrorCodes_Custom Int32
n)) Text
_ Maybe Value
_) =
ResponseError
x{_code = InR (fromOpenEnumBaseType n)}
go ResponseError
x = ResponseError
x
deriving via ViaJSON ResponseError instance Pretty ResponseError
data ResponseMessage = ResponseMessage
{ ResponseMessage -> Text
_jsonrpc :: Text
, ResponseMessage -> Int32 |? (Text |? Null)
_id :: Int32 |? Text |? Null
, ResponseMessage -> Maybe Value
_result :: Maybe Value
, ResponseMessage -> Maybe ResponseError
_error :: Maybe ResponseError
}
deriving stock (Int -> ResponseMessage -> ShowS
[ResponseMessage] -> ShowS
ResponseMessage -> String
(Int -> ResponseMessage -> ShowS)
-> (ResponseMessage -> String)
-> ([ResponseMessage] -> ShowS)
-> Show ResponseMessage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseMessage -> ShowS
showsPrec :: Int -> ResponseMessage -> ShowS
$cshow :: ResponseMessage -> String
show :: ResponseMessage -> String
$cshowList :: [ResponseMessage] -> ShowS
showList :: [ResponseMessage] -> ShowS
Show, ResponseMessage -> ResponseMessage -> Bool
(ResponseMessage -> ResponseMessage -> Bool)
-> (ResponseMessage -> ResponseMessage -> Bool)
-> Eq ResponseMessage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ResponseMessage -> ResponseMessage -> Bool
== :: ResponseMessage -> ResponseMessage -> Bool
$c/= :: ResponseMessage -> ResponseMessage -> Bool
/= :: ResponseMessage -> ResponseMessage -> Bool
Eq, (forall x. ResponseMessage -> Rep ResponseMessage x)
-> (forall x. Rep ResponseMessage x -> ResponseMessage)
-> Generic ResponseMessage
forall x. Rep ResponseMessage x -> ResponseMessage
forall x. ResponseMessage -> Rep ResponseMessage x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ResponseMessage -> Rep ResponseMessage x
from :: forall x. ResponseMessage -> Rep ResponseMessage x
$cto :: forall x. Rep ResponseMessage x -> ResponseMessage
to :: forall x. Rep ResponseMessage x -> ResponseMessage
Generic)
deriveJSON lspOptions ''ResponseMessage
deriving via ViaJSON ResponseMessage instance Pretty ResponseMessage
data TNotificationMessage (m :: Method f Notification) = TNotificationMessage
{ forall (f :: MessageDirection) (m :: Method f 'Notification).
TNotificationMessage m -> Text
_jsonrpc :: Text
, forall (f :: MessageDirection) (m :: Method f 'Notification).
TNotificationMessage m -> SMethod m
_method :: SMethod m
, forall (f :: MessageDirection) (m :: Method f 'Notification).
TNotificationMessage m -> MessageParams m
_params :: MessageParams m
}
deriving stock ((forall x.
TNotificationMessage m -> Rep (TNotificationMessage m) x)
-> (forall x.
Rep (TNotificationMessage m) x -> TNotificationMessage m)
-> Generic (TNotificationMessage m)
forall x. Rep (TNotificationMessage m) x -> TNotificationMessage m
forall x. TNotificationMessage m -> Rep (TNotificationMessage m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: MessageDirection) (m :: Method f 'Notification) x.
Rep (TNotificationMessage m) x -> TNotificationMessage m
forall (f :: MessageDirection) (m :: Method f 'Notification) x.
TNotificationMessage m -> Rep (TNotificationMessage m) x
$cfrom :: forall (f :: MessageDirection) (m :: Method f 'Notification) x.
TNotificationMessage m -> Rep (TNotificationMessage m) x
from :: forall x. TNotificationMessage m -> Rep (TNotificationMessage m) x
$cto :: forall (f :: MessageDirection) (m :: Method f 'Notification) x.
Rep (TNotificationMessage m) x -> TNotificationMessage m
to :: forall x. Rep (TNotificationMessage m) x -> TNotificationMessage m
Generic)
deriving stock instance Eq (MessageParams m) => Eq (TNotificationMessage m)
deriving stock instance Show (MessageParams m) => Show (TNotificationMessage m)
instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (TNotificationMessage m) where
parseJSON :: Value -> Parser (TNotificationMessage m)
parseJSON = Options -> Value -> Parser (TNotificationMessage m)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
lspOptions (Value -> Parser (TNotificationMessage m))
-> (Value -> Value) -> Value -> Parser (TNotificationMessage m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Value
addNullField String
"params"
instance (ToJSON (MessageParams m)) => ToJSON (TNotificationMessage m) where
toJSON :: TNotificationMessage m -> Value
toJSON = Options -> TNotificationMessage m -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
lspOptions
toEncoding :: TNotificationMessage m -> Encoding
toEncoding = Options -> TNotificationMessage m -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
lspOptions
deriving via ViaJSON (TNotificationMessage m) instance (ToJSON (MessageParams m)) => Pretty (TNotificationMessage m)
data TRequestMessage (m :: Method f Request) = TRequestMessage
{ forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> Text
_jsonrpc :: Text
, forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> LspId m
_id :: LspId m
, forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> SMethod m
_method :: SMethod m
, forall (f :: MessageDirection) (m :: Method f 'Request).
TRequestMessage m -> MessageParams m
_params :: MessageParams m
}
deriving stock ((forall x. TRequestMessage m -> Rep (TRequestMessage m) x)
-> (forall x. Rep (TRequestMessage m) x -> TRequestMessage m)
-> Generic (TRequestMessage m)
forall x. Rep (TRequestMessage m) x -> TRequestMessage m
forall x. TRequestMessage m -> Rep (TRequestMessage m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: MessageDirection) (m :: Method f 'Request) x.
Rep (TRequestMessage m) x -> TRequestMessage m
forall (f :: MessageDirection) (m :: Method f 'Request) x.
TRequestMessage m -> Rep (TRequestMessage m) x
$cfrom :: forall (f :: MessageDirection) (m :: Method f 'Request) x.
TRequestMessage m -> Rep (TRequestMessage m) x
from :: forall x. TRequestMessage m -> Rep (TRequestMessage m) x
$cto :: forall (f :: MessageDirection) (m :: Method f 'Request) x.
Rep (TRequestMessage m) x -> TRequestMessage m
to :: forall x. Rep (TRequestMessage m) x -> TRequestMessage m
Generic)
deriving stock instance Eq (MessageParams m) => Eq (TRequestMessage m)
deriving stock instance Show (MessageParams m) => Show (TRequestMessage m)
instance (FromJSON (MessageParams m), FromJSON (SMethod m)) => FromJSON (TRequestMessage m) where
parseJSON :: Value -> Parser (TRequestMessage m)
parseJSON = Options -> Value -> Parser (TRequestMessage m)
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
lspOptions (Value -> Parser (TRequestMessage m))
-> (Value -> Value) -> Value -> Parser (TRequestMessage m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Value -> Value
addNullField String
"params"
instance (ToJSON (MessageParams m)) => ToJSON (TRequestMessage m) where
toJSON :: TRequestMessage m -> Value
toJSON = Options -> TRequestMessage m -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
lspOptions
toEncoding :: TRequestMessage m -> Encoding
toEncoding = Options -> TRequestMessage m -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
lspOptions
deriving via ViaJSON (TRequestMessage m) instance (ToJSON (MessageParams m)) => Pretty (TRequestMessage m)
data TResponseError (m :: Method f Request) = TResponseError
{ forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseError m -> LSPErrorCodes |? ErrorCodes
_code :: LSPErrorCodes |? ErrorCodes
, forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseError m -> Text
_message :: Text
, forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseError m -> Maybe (ErrorData m)
_xdata :: Maybe (ErrorData m)
}
deriving stock ((forall x. TResponseError m -> Rep (TResponseError m) x)
-> (forall x. Rep (TResponseError m) x -> TResponseError m)
-> Generic (TResponseError m)
forall x. Rep (TResponseError m) x -> TResponseError m
forall x. TResponseError m -> Rep (TResponseError m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: MessageDirection) (m :: Method f 'Request) x.
Rep (TResponseError m) x -> TResponseError m
forall (f :: MessageDirection) (m :: Method f 'Request) x.
TResponseError m -> Rep (TResponseError m) x
$cfrom :: forall (f :: MessageDirection) (m :: Method f 'Request) x.
TResponseError m -> Rep (TResponseError m) x
from :: forall x. TResponseError m -> Rep (TResponseError m) x
$cto :: forall (f :: MessageDirection) (m :: Method f 'Request) x.
Rep (TResponseError m) x -> TResponseError m
to :: forall x. Rep (TResponseError m) x -> TResponseError m
Generic)
deriving stock instance Eq (ErrorData m) => Eq (TResponseError m)
deriving stock instance Show (ErrorData m) => Show (TResponseError m)
instance (FromJSON (ErrorData m)) => FromJSON (TResponseError m) where
parseJSON :: Value -> Parser (TResponseError m)
parseJSON =
let errorCode :: Value -> Parser (TResponseError m)
errorCode = String
-> (Object -> Parser (TResponseError m))
-> Value
-> Parser (TResponseError m)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ResponseError" ((Object -> Parser (TResponseError m))
-> Value -> Parser (TResponseError m))
-> (Object -> Parser (TResponseError m))
-> Value
-> Parser (TResponseError m)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
forall (f :: MessageDirection) (m :: Method f 'Request).
(LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m
TResponseError
((LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe (ErrorData m) -> TResponseError m)
-> Parser (LSPErrorCodes |? ErrorCodes)
-> Parser (Text -> Maybe (ErrorData m) -> TResponseError m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (LSPErrorCodes |? ErrorCodes)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
Parser (Text -> Maybe (ErrorData m) -> TResponseError m)
-> Parser Text -> Parser (Maybe (ErrorData m) -> TResponseError m)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"message"
Parser (Maybe (ErrorData m) -> TResponseError m)
-> Parser (Maybe (ErrorData m)) -> Parser (TResponseError m)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe (ErrorData m))
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
.:!? Key
"data"
in (TResponseError m -> TResponseError m)
-> Parser (TResponseError m) -> Parser (TResponseError m)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TResponseError m -> TResponseError m
go (Parser (TResponseError m) -> Parser (TResponseError m))
-> (Value -> Parser (TResponseError m))
-> Value
-> Parser (TResponseError m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Parser (TResponseError m)
errorCode
where
go :: TResponseError m -> TResponseError m
go :: TResponseError m -> TResponseError m
go x :: TResponseError m
x@(TResponseError (InL (LSPErrorCodes_Custom Int32
n)) Text
_ Maybe (ErrorData m)
_) =
TResponseError m
x{_code = InR (fromOpenEnumBaseType n)}
go TResponseError m
x = TResponseError m
x
instance (ToJSON (ErrorData m)) => ToJSON (TResponseError m) where
toJSON :: TResponseError m -> Value
toJSON = Options -> TResponseError m -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
lspOptions
toEncoding :: TResponseError m -> Encoding
toEncoding = Options -> TResponseError m -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
genericToEncoding Options
lspOptions
deriving via ViaJSON (TResponseError m) instance (ToJSON (ErrorData m)) => Pretty (TResponseError m)
toUntypedResponseError :: (ToJSON (ErrorData m)) => TResponseError m -> ResponseError
toUntypedResponseError :: forall {f :: MessageDirection} (m :: Method f 'Request).
ToJSON (ErrorData m) =>
TResponseError m -> ResponseError
toUntypedResponseError (TResponseError LSPErrorCodes |? ErrorCodes
c Text
m Maybe (ErrorData m)
d) = (LSPErrorCodes |? ErrorCodes)
-> Text -> Maybe Value -> ResponseError
ResponseError LSPErrorCodes |? ErrorCodes
c Text
m ((ErrorData m -> Value) -> Maybe (ErrorData m) -> Maybe Value
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ErrorData m -> Value
forall a. ToJSON a => a -> Value
toJSON Maybe (ErrorData m)
d)
data TResponseMessage (m :: Method f Request) = TResponseMessage
{ forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseMessage m -> Text
_jsonrpc :: Text
, forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseMessage m -> Maybe (LspId m)
_id :: Maybe (LspId m)
,
forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseMessage m -> Either ResponseError (MessageResult m)
_result :: Either ResponseError (MessageResult m)
}
deriving stock ((forall x. TResponseMessage m -> Rep (TResponseMessage m) x)
-> (forall x. Rep (TResponseMessage m) x -> TResponseMessage m)
-> Generic (TResponseMessage m)
forall x. Rep (TResponseMessage m) x -> TResponseMessage m
forall x. TResponseMessage m -> Rep (TResponseMessage m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: MessageDirection) (m :: Method f 'Request) x.
Rep (TResponseMessage m) x -> TResponseMessage m
forall (f :: MessageDirection) (m :: Method f 'Request) x.
TResponseMessage m -> Rep (TResponseMessage m) x
$cfrom :: forall (f :: MessageDirection) (m :: Method f 'Request) x.
TResponseMessage m -> Rep (TResponseMessage m) x
from :: forall x. TResponseMessage m -> Rep (TResponseMessage m) x
$cto :: forall (f :: MessageDirection) (m :: Method f 'Request) x.
Rep (TResponseMessage m) x -> TResponseMessage m
to :: forall x. Rep (TResponseMessage m) x -> TResponseMessage m
Generic)
deriving stock instance (Eq (MessageResult m), Eq (ErrorData m)) => Eq (TResponseMessage m)
deriving stock instance (Show (MessageResult m), Show (ErrorData m)) => Show (TResponseMessage m)
instance (ToJSON (MessageResult m), ToJSON (ErrorData m)) => ToJSON (TResponseMessage m) where
toJSON :: TResponseMessage m -> Value
toJSON TResponseMessage{$sel:_jsonrpc:TResponseMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseMessage m -> Text
_jsonrpc = Text
jsonrpc, $sel:_id:TResponseMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseMessage m -> Maybe (LspId m)
_id = Maybe (LspId m)
lspid, $sel:_result:TResponseMessage :: forall (f :: MessageDirection) (m :: Method f 'Request).
TResponseMessage m -> Either ResponseError (MessageResult m)
_result = Either ResponseError (MessageResult m)
result} =
[Pair] -> Value
object
[ Key
"jsonrpc" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text
jsonrpc
, Key
"id" Key -> Maybe (LspId m) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe (LspId m)
lspid
, case Either ResponseError (MessageResult m)
result of
Left ResponseError
err -> Key
"error" Key -> ResponseError -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ResponseError
err
Right MessageResult m
a -> Key
"result" Key -> MessageResult m -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= MessageResult m
a
]
instance (FromJSON (MessageResult a), FromJSON (ErrorData a)) => FromJSON (TResponseMessage a) where
parseJSON :: Value -> Parser (TResponseMessage a)
parseJSON = String
-> (Object -> Parser (TResponseMessage a))
-> Value
-> Parser (TResponseMessage a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Response" ((Object -> Parser (TResponseMessage a))
-> Value -> Parser (TResponseMessage a))
-> (Object -> Parser (TResponseMessage a))
-> Value
-> Parser (TResponseMessage a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
Text
_jsonrpc <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"jsonrpc"
Maybe (LspId a)
_id <- Object
o Object -> Key -> Parser (Maybe (LspId a))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"id"
Maybe (MessageResult a)
_result <- Object
o Object -> Key -> Parser (Maybe (MessageResult a))
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
.:!? Key
"result"
Maybe ResponseError
_error <- Object
o Object -> Key -> Parser (Maybe ResponseError)
forall v. FromJSON v => Object -> Key -> Parser (Maybe v)
.:!? Key
"error"
Either ResponseError (MessageResult a)
result <- case (Maybe ResponseError
_error, Maybe (MessageResult a)
_result) of
(Just ResponseError
err, Maybe (MessageResult a)
Nothing) -> Either ResponseError (MessageResult a)
-> Parser (Either ResponseError (MessageResult a))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (MessageResult a)
-> Parser (Either ResponseError (MessageResult a)))
-> Either ResponseError (MessageResult a)
-> Parser (Either ResponseError (MessageResult a))
forall a b. (a -> b) -> a -> b
$ ResponseError -> Either ResponseError (MessageResult a)
forall a b. a -> Either a b
Left ResponseError
err
(Maybe ResponseError
Nothing, Just MessageResult a
res) -> Either ResponseError (MessageResult a)
-> Parser (Either ResponseError (MessageResult a))
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either ResponseError (MessageResult a)
-> Parser (Either ResponseError (MessageResult a)))
-> Either ResponseError (MessageResult a)
-> Parser (Either ResponseError (MessageResult a))
forall a b. (a -> b) -> a -> b
$ MessageResult a -> Either ResponseError (MessageResult a)
forall a b. b -> Either a b
Right MessageResult a
res
(Just ResponseError
_err, Just MessageResult a
_res) -> String -> Parser (Either ResponseError (MessageResult a))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Either ResponseError (MessageResult a)))
-> String -> Parser (Either ResponseError (MessageResult a))
forall a b. (a -> b) -> a -> b
$ String
"both error and result cannot be present: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Object -> String
forall a. Show a => a -> String
show Object
o
(Maybe ResponseError
Nothing, Maybe (MessageResult a)
Nothing) -> String -> Parser (Either ResponseError (MessageResult a))
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"both error and result cannot be Nothing"
TResponseMessage a -> Parser (TResponseMessage a)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (TResponseMessage a -> Parser (TResponseMessage a))
-> TResponseMessage a -> Parser (TResponseMessage a)
forall a b. (a -> b) -> a -> b
$ Text
-> Maybe (LspId a)
-> Either ResponseError (MessageResult a)
-> TResponseMessage a
forall (f :: MessageDirection) (m :: Method f 'Request).
Text
-> Maybe (LspId m)
-> Either ResponseError (MessageResult m)
-> TResponseMessage m
TResponseMessage Text
_jsonrpc Maybe (LspId a)
_id Either ResponseError (MessageResult a)
result
deriving via ViaJSON (TResponseMessage m) instance (ToJSON (MessageResult m), ToJSON (ErrorData m)) => Pretty (TResponseMessage m)
data TCustomMessage s f t where
ReqMess :: TRequestMessage (Method_CustomMethod s :: Method f Request) -> TCustomMessage s f Request
NotMess :: TNotificationMessage (Method_CustomMethod s :: Method f Notification) -> TCustomMessage s f Notification
deriving stock instance Show (TCustomMessage s f t)
instance ToJSON (TCustomMessage s f t) where
toJSON :: TCustomMessage s f t -> Value
toJSON (ReqMess TRequestMessage ('Method_CustomMethod s)
a) = TRequestMessage ('Method_CustomMethod s) -> Value
forall a. ToJSON a => a -> Value
toJSON TRequestMessage ('Method_CustomMethod s)
a
toJSON (NotMess TNotificationMessage ('Method_CustomMethod s)
a) = TNotificationMessage ('Method_CustomMethod s) -> Value
forall a. ToJSON a => a -> Value
toJSON TNotificationMessage ('Method_CustomMethod s)
a
instance KnownSymbol s => FromJSON (TCustomMessage s f Request) where
parseJSON :: Value -> Parser (TCustomMessage s f 'Request)
parseJSON Value
v = TRequestMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Request
forall (s :: Symbol) (f :: MessageDirection).
TRequestMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Request
ReqMess (TRequestMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Request)
-> Parser (TRequestMessage ('Method_CustomMethod s))
-> Parser (TCustomMessage s f 'Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (TRequestMessage ('Method_CustomMethod s))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
instance KnownSymbol s => FromJSON (TCustomMessage s f Notification) where
parseJSON :: Value -> Parser (TCustomMessage s f 'Notification)
parseJSON Value
v = TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Notification
forall (s :: Symbol) (f :: MessageDirection).
TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Notification
NotMess (TNotificationMessage ('Method_CustomMethod s)
-> TCustomMessage s f 'Notification)
-> Parser (TNotificationMessage ('Method_CustomMethod s))
-> Parser (TCustomMessage s f 'Notification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (TNotificationMessage ('Method_CustomMethod s))
forall a. FromJSON a => Value -> Parser a
parseJSON Value
v
deriving via ViaJSON (TCustomMessage s f t) instance (KnownSymbol s) => Pretty (TCustomMessage s f t)
type TMessage :: forall f t. Method f t -> Type
type family TMessage m where
TMessage (Method_CustomMethod s :: Method f t) = TCustomMessage s f t
TMessage (m :: Method f Request) = TRequestMessage m
TMessage (m :: Method f Notification) = TNotificationMessage m
type TClientMessage (m :: Method ClientToServer t) = TMessage m
type TServerMessage (m :: Method ServerToClient t) = TMessage m
addNullField :: String -> Value -> Value
addNullField :: String -> Value -> Value
addNullField String
s (Object Object
o) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
o Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> String -> Key
forall a. IsString a => String -> a
fromString String
s Key -> Value -> Object
forall v. ToJSON v => Key -> v -> Object
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Value
J.Null
addNullField String
_ Value
v = Value
v