{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE RecordWildCards #-}
module Neovim.RPC.Classes
( Message (..),
) where
import Neovim.Classes
import Neovim.Plugin.Classes (FunctionName (..))
import qualified Neovim.Plugin.IPC.Classes as IPC
import Control.Applicative
import Control.Monad.Error.Class
import Data.Data (Typeable)
import Data.MessagePack (Object (..))
import Data.Text.Prettyprint.Doc (hardline, nest, viaShow)
import Prelude
data Message
= Request IPC.Request
| Response !Int64 (Either Object Object)
| Notification IPC.Notification
deriving (Message -> Message -> Bool
(Message -> Message -> Bool)
-> (Message -> Message -> Bool) -> Eq Message
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c== :: Message -> Message -> Bool
Eq, Eq Message
Eq Message
-> (Message -> Message -> Ordering)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Bool)
-> (Message -> Message -> Message)
-> (Message -> Message -> Message)
-> Ord Message
Message -> Message -> Bool
Message -> Message -> Ordering
Message -> Message -> Message
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Message -> Message -> Message
$cmin :: Message -> Message -> Message
max :: Message -> Message -> Message
$cmax :: Message -> Message -> Message
>= :: Message -> Message -> Bool
$c>= :: Message -> Message -> Bool
> :: Message -> Message -> Bool
$c> :: Message -> Message -> Bool
<= :: Message -> Message -> Bool
$c<= :: Message -> Message -> Bool
< :: Message -> Message -> Bool
$c< :: Message -> Message -> Bool
compare :: Message -> Message -> Ordering
$ccompare :: Message -> Message -> Ordering
$cp1Ord :: Eq Message
Ord, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
(Int -> Message -> ShowS)
-> (Message -> String) -> ([Message] -> ShowS) -> Show Message
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Message] -> ShowS
$cshowList :: [Message] -> ShowS
show :: Message -> String
$cshow :: Message -> String
showsPrec :: Int -> Message -> ShowS
$cshowsPrec :: Int -> Message -> ShowS
Show, Typeable, (forall x. Message -> Rep Message x)
-> (forall x. Rep Message x -> Message) -> Generic Message
forall x. Rep Message x -> Message
forall x. Message -> Rep Message x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Message x -> Message
$cfrom :: forall x. Message -> Rep Message x
Generic)
instance NFData Message
instance IPC.Message Message
instance NvimObject Message where
toObject :: Message -> Object
toObject = \case
Request (IPC.Request (F ByteString
m) Int64
i [Object]
ps) ->
[Object] -> Object
ObjectArray ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ (Int64
0 :: Int64) Int64 -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: Int64
i Int64 -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: ByteString
m ByteString -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: [Object]
ps [Object] -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Response Int64
i (Left Object
e) ->
[Object] -> Object
ObjectArray ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ (Int64
1 :: Int64) Int64 -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: Int64
i Int64 -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: Object
e Object -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: () () -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Response Int64
i (Right Object
r) ->
[Object] -> Object
ObjectArray ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ (Int64
1 :: Int64) Int64 -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: Int64
i Int64 -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: () () -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: Object
r Object -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Notification (IPC.Notification (F ByteString
m) [Object]
ps) ->
[Object] -> Object
ObjectArray ([Object] -> Object) -> [Object] -> Object
forall a b. (a -> b) -> a -> b
$ (Int64
2 :: Int64) Int64 -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: ByteString
m ByteString -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: [Object]
ps [Object] -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: []
fromObject :: Object -> Either (Doc AnsiStyle) Message
fromObject = \case
ObjectArray [ObjectInt Int64
0, Object
i, Object
m, Object
ps] -> do
Request
r <- FunctionName -> Int64 -> [Object] -> Request
IPC.Request
(FunctionName -> Int64 -> [Object] -> Request)
-> Either (Doc AnsiStyle) FunctionName
-> Either (Doc AnsiStyle) (Int64 -> [Object] -> Request)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString -> FunctionName)
-> Either (Doc AnsiStyle) ByteString
-> Either (Doc AnsiStyle) FunctionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FunctionName
F (Object -> Either (Doc AnsiStyle) ByteString
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
m))
Either (Doc AnsiStyle) (Int64 -> [Object] -> Request)
-> Either (Doc AnsiStyle) Int64
-> Either (Doc AnsiStyle) ([Object] -> Request)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) Int64
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
i
Either (Doc AnsiStyle) ([Object] -> Request)
-> Either (Doc AnsiStyle) [Object]
-> Either (Doc AnsiStyle) Request
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) [Object]
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
ps
Message -> Either (Doc AnsiStyle) Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Either (Doc AnsiStyle) Message)
-> Message -> Either (Doc AnsiStyle) Message
forall a b. (a -> b) -> a -> b
$ Request -> Message
Request Request
r
ObjectArray [ObjectInt Int64
1, Object
i, Object
e, Object
r] ->
let eer :: Either Object Object
eer = case Object
e of
Object
ObjectNil -> Object -> Either Object Object
forall a b. b -> Either a b
Right Object
r
Object
_ -> Object -> Either Object Object
forall a b. a -> Either a b
Left Object
e
in Int64 -> Either Object Object -> Message
Response (Int64 -> Either Object Object -> Message)
-> Either (Doc AnsiStyle) Int64
-> Either (Doc AnsiStyle) (Either Object Object -> Message)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object -> Either (Doc AnsiStyle) Int64
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
i
Either (Doc AnsiStyle) (Either Object Object -> Message)
-> Either (Doc AnsiStyle) (Either Object Object)
-> Either (Doc AnsiStyle) Message
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either Object Object
-> Either (Doc AnsiStyle) (Either Object Object)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Object Object
eer
ObjectArray [ObjectInt Int64
2, Object
m, Object
ps] -> do
Notification
n <- FunctionName -> [Object] -> Notification
IPC.Notification
(FunctionName -> [Object] -> Notification)
-> Either (Doc AnsiStyle) FunctionName
-> Either (Doc AnsiStyle) ([Object] -> Notification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((ByteString -> FunctionName)
-> Either (Doc AnsiStyle) ByteString
-> Either (Doc AnsiStyle) FunctionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> FunctionName
F (Object -> Either (Doc AnsiStyle) ByteString
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
m))
Either (Doc AnsiStyle) ([Object] -> Notification)
-> Either (Doc AnsiStyle) [Object]
-> Either (Doc AnsiStyle) Notification
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Either (Doc AnsiStyle) [Object]
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
ps
Message -> Either (Doc AnsiStyle) Message
forall (m :: * -> *) a. Monad m => a -> m a
return (Message -> Either (Doc AnsiStyle) Message)
-> Message -> Either (Doc AnsiStyle) Message
forall a b. (a -> b) -> a -> b
$ Notification -> Message
Notification Notification
n
Object
o ->
Doc AnsiStyle -> Either (Doc AnsiStyle) Message
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Doc AnsiStyle -> Either (Doc AnsiStyle) Message)
-> Doc AnsiStyle -> Either (Doc AnsiStyle) Message
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Not a known/valid msgpack-rpc message:" Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Object -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow Object
o
instance Pretty Message where
pretty :: Message -> Doc ann
pretty = \case
Request Request
request ->
Request -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Request
request
Response Int64
i Either Object Object
ret ->
Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Doc ann
"Response" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"#" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Int64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int64
i
Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
hardline Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> (Object -> Doc ann)
-> (Object -> Doc ann) -> Either Object Object -> Doc ann
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Object -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Object -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow Either Object Object
ret
Notification Notification
notification ->
Notification -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Notification
notification