{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE RecordWildCards    #-}
{- |
Module      :  Neovim.RPC.Classes
Description :  Data types and classes for the RPC components
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC

Import this module qualified as @MsgpackRPC@
-}
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

-- | See https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md for
-- details about the msgpack rpc specification.
data Message
    = Request IPC.Request
    -- ^ Request in the sense of the msgpack rpc specification
    --
    -- Parameters
    -- * Message identifier that has to be put in the response to this request
    -- * Function name
    -- * Function arguments

    | Response !Int64 (Either Object Object)
    -- ^ Response in the sense of the msgpack rpc specifcation
    --
    -- Parameters
    -- * Mesage identifier which matches a request
    -- * 'Either' an error 'Object' or a result 'Object'

    | Notification IPC.Notification
    -- ^ Notification in the sense of the msgpack rpc specification
    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