{-# 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
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