{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
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 (..), 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

{- | See https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md for
 details about the msgpack rpc specification.
-}
data Message
    = -- | 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
      Request IPC.Request
    | -- | Response in the sense of the msgpack rpc specifcation
      --
      -- Parameters
      -- * Mesage identifier which matches a request
      -- * 'Either' an error 'Object' or a result 'Object'
      Response !Int64 (Either Object Object)
    | -- | Notification in the sense of the msgpack rpc specification
      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
$c== :: Message -> Message -> Bool
== :: Message -> Message -> Bool
$c/= :: Message -> Message -> Bool
/= :: 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
$ccompare :: Message -> Message -> Ordering
compare :: Message -> Message -> Ordering
$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
>= :: Message -> Message -> Bool
$cmax :: Message -> Message -> Message
max :: Message -> Message -> Message
$cmin :: Message -> Message -> Message
min :: Message -> Message -> 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
$cshowsPrec :: Int -> Message -> ShowS
showsPrec :: Int -> Message -> ShowS
$cshow :: Message -> String
show :: Message -> String
$cshowList :: [Message] -> ShowS
showList :: [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
$cfrom :: forall x. Message -> Rep Message x
from :: forall x. Message -> Rep Message x
$cto :: forall x. Rep Message x -> Message
to :: forall x. Rep Message x -> Message
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 ([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]
+: Text
m Text -> [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 (NeovimEventId Text
eventId) [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]
+: Text
eventId Text -> [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
<$> (Text -> FunctionName)
-> Either (Doc AnsiStyle) Text
-> Either (Doc AnsiStyle) FunctionName
forall a b.
(a -> b) -> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> FunctionName
F (Object -> Either (Doc AnsiStyle) Text
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 a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
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 a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
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 a. a -> Either (Doc AnsiStyle) a
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 a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either Object Object
-> Either (Doc AnsiStyle) (Either Object Object)
forall a. a -> Either (Doc AnsiStyle) a
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
                    (NeovimEventId -> [Object] -> Notification)
-> Either (Doc AnsiStyle) NeovimEventId
-> Either (Doc AnsiStyle) ([Object] -> Notification)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> NeovimEventId)
-> Either (Doc AnsiStyle) Text
-> Either (Doc AnsiStyle) NeovimEventId
forall a b.
(a -> b) -> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> NeovimEventId
NeovimEventId (Object -> Either (Doc AnsiStyle) Text
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 a b.
Either (Doc AnsiStyle) (a -> b)
-> Either (Doc AnsiStyle) a -> Either (Doc AnsiStyle) b
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 a. a -> Either (Doc AnsiStyle) a
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 a. Doc AnsiStyle -> Either (Doc AnsiStyle) a
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 :: forall ann. Message -> Doc ann
pretty = \case
        Request Request
request ->
            Request -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Request -> 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 ann. 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
forall ann. Notification -> Doc ann
pretty Notification
notification