{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Neovim.RPC.Classes (
Message (..),
) where
import Neovim.Classes
import Neovim.Plugin.Classes (FunctionName (..), NeovimEventId (..))
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 Prettyprinter (hardline, nest, viaShow)
import Prelude
data Message
=
Request IPC.Request
|
Response !Int64 (Either Object Object)
|
Notification IPC.Notification
deriving (Message -> Message -> Bool
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
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
Ord, Int -> Message -> ShowS
[Message] -> ShowS
Message -> String
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. 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 Text
m) Int64
i [Object]
ps) ->
[Object] -> Object
ObjectArray forall a b. (a -> b) -> a -> b
$ (Int64
0 :: Int64) forall o. NvimObject o => o -> [Object] -> [Object]
+: Int64
i forall o. NvimObject o => o -> [Object] -> [Object]
+: Text
m forall o. NvimObject o => o -> [Object] -> [Object]
+: [Object]
ps forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Response Int64
i (Left Object
e) ->
[Object] -> Object
ObjectArray forall a b. (a -> b) -> a -> b
$ (Int64
1 :: Int64) forall o. NvimObject o => o -> [Object] -> [Object]
+: Int64
i forall o. NvimObject o => o -> [Object] -> [Object]
+: Object
e forall o. NvimObject o => o -> [Object] -> [Object]
+: () forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Response Int64
i (Right Object
r) ->
[Object] -> Object
ObjectArray forall a b. (a -> b) -> a -> b
$ (Int64
1 :: Int64) forall o. NvimObject o => o -> [Object] -> [Object]
+: Int64
i forall o. NvimObject o => o -> [Object] -> [Object]
+: () forall o. NvimObject o => o -> [Object] -> [Object]
+: Object
r forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Notification (IPC.Notification (NeovimEventId Text
eventId) [Object]
ps) ->
[Object] -> Object
ObjectArray forall a b. (a -> b) -> a -> b
$ (Int64
2 :: Int64) forall o. NvimObject o => o -> [Object] -> [Object]
+: Text
eventId forall o. NvimObject o => o -> [Object] -> [Object]
+: [Object]
ps 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
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FunctionName
F (forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
m)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
i
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
ps
forall (m :: * -> *) a. Monad m => a -> m a
return 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 -> forall a b. b -> Either a b
Right Object
r
Object
_ -> forall a b. a -> Either a b
Left Object
e
in Int64 -> Either Object Object -> Message
Response forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
i
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Either Object Object
eer
ObjectArray [ObjectInt Int64
2, Object
m, Object
ps] -> do
Notification
n <-
NeovimEventId -> [Object] -> Notification
IPC.Notification
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> NeovimEventId
NeovimEventId (forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
m)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
ps
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Notification -> Message
Notification Notification
n
Object
o ->
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Not a known/valid msgpack-rpc message:" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Show a => a -> Doc ann
viaShow Object
o
instance Pretty Message where
pretty :: forall ann. Message -> Doc ann
pretty = \case
Request Request
request ->
forall a ann. Pretty a => a -> Doc ann
pretty Request
request
Response Int64
i Either Object Object
ret ->
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 forall a b. (a -> b) -> a -> b
$
Doc ann
"Response" forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"#" forall a. Semigroup a => a -> a -> a
<> forall a ann. Pretty a => a -> Doc ann
pretty Int64
i
forall a. Semigroup a => a -> a -> a
<> forall ann. Doc ann
hardline
forall a. Semigroup a => a -> a -> a
<> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a ann. Show a => a -> Doc ann
viaShow forall a ann. Show a => a -> Doc ann
viaShow Either Object Object
ret
Notification Notification
notification ->
forall a ann. Pretty a => a -> Doc ann
pretty Notification
notification