{-# 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.Int (Int64)
import Data.MessagePack (Object (..))
import Data.Text.Prettyprint.Doc (Pretty (..), hardline, nest,
viaShow, (<+>), (<>))
import Prelude
data Message
= Request IPC.Request
| Response !Int64 (Either Object Object)
| Notification IPC.Notification
deriving (Eq, Ord, Show, Typeable, Generic)
instance NFData Message
instance IPC.Message Message
instance NvimObject Message where
toObject = \case
Request (IPC.Request (F m) i ps) ->
ObjectArray $ (0 :: Int64) +: i +: m +: ps +: []
Response i (Left e) ->
ObjectArray $ (1 :: Int64) +: i +: e +: () +: []
Response i (Right r) ->
ObjectArray $ (1 :: Int64) +: i +: () +: r +: []
Notification (IPC.Notification (F m) ps) ->
ObjectArray $ (2 :: Int64) +: m +: ps +: []
fromObject = \case
ObjectArray [ObjectInt 0, i, m, ps] -> do
r <- IPC.Request
<$> (fmap F (fromObject m))
<*> fromObject i
<*> fromObject ps
return $ Request r
ObjectArray [ObjectInt 1, i, e, r] ->
let eer = case e of
ObjectNil -> Right r
_ -> Left e
in Response <$> fromObject i
<*> pure eer
ObjectArray [ObjectInt 2, m, ps] -> do
n <- IPC.Notification
<$> (fmap F (fromObject m))
<*> fromObject ps
return $ Notification n
o ->
throwError $ "Not a known/valid msgpack-rpc message:" <+> viaShow o
instance Pretty Message where
pretty = \case
Request request ->
pretty request
Response i ret ->
nest 2 $ "Response" <+> "#" <> pretty i
<> hardline <> either viaShow viaShow ret
Notification notification ->
pretty notification