module Ribosome.Nvim.Api.RpcCall where

import Data.MessagePack (Object)
import Data.Text.Prettyprint.Doc (defaultLayoutOptions, layoutPretty)
import Data.Text.Prettyprint.Doc.Render.Text (renderStrict)
import Neovim (Neovim)
import Neovim.Exceptions (NeovimException)
import Neovim.Plugin.Classes (FunctionName)
import Neovim.RPC.FunctionCall (scall)
import System.Log.Logger (Priority(ERROR))

import Ribosome.Data.ErrorReport (ErrorReport(ErrorReport))
import Ribosome.Error.Report.Class (ReportError(..))
import Ribosome.Msgpack.Decode (MsgpackDecode(..))
import Ribosome.Msgpack.Util (Err)

data RpcCall =
  RpcCall {
    RpcCall -> FunctionName
rpcCallName :: FunctionName,
    RpcCall -> [Object]
rpcCallArgs :: [Object]
  }
  deriving (RpcCall -> RpcCall -> Bool
(RpcCall -> RpcCall -> Bool)
-> (RpcCall -> RpcCall -> Bool) -> Eq RpcCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpcCall -> RpcCall -> Bool
$c/= :: RpcCall -> RpcCall -> Bool
== :: RpcCall -> RpcCall -> Bool
$c== :: RpcCall -> RpcCall -> Bool
Eq, Int -> RpcCall -> ShowS
[RpcCall] -> ShowS
RpcCall -> String
(Int -> RpcCall -> ShowS)
-> (RpcCall -> String) -> ([RpcCall] -> ShowS) -> Show RpcCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcCall] -> ShowS
$cshowList :: [RpcCall] -> ShowS
show :: RpcCall -> String
$cshow :: RpcCall -> String
showsPrec :: Int -> RpcCall -> ShowS
$cshowsPrec :: Int -> RpcCall -> ShowS
Show)

newtype AsyncRpcCall =
  AsyncRpcCall { AsyncRpcCall -> RpcCall
asyncRpcCall :: RpcCall }
  deriving (AsyncRpcCall -> AsyncRpcCall -> Bool
(AsyncRpcCall -> AsyncRpcCall -> Bool)
-> (AsyncRpcCall -> AsyncRpcCall -> Bool) -> Eq AsyncRpcCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AsyncRpcCall -> AsyncRpcCall -> Bool
$c/= :: AsyncRpcCall -> AsyncRpcCall -> Bool
== :: AsyncRpcCall -> AsyncRpcCall -> Bool
$c== :: AsyncRpcCall -> AsyncRpcCall -> Bool
Eq, Int -> AsyncRpcCall -> ShowS
[AsyncRpcCall] -> ShowS
AsyncRpcCall -> String
(Int -> AsyncRpcCall -> ShowS)
-> (AsyncRpcCall -> String)
-> ([AsyncRpcCall] -> ShowS)
-> Show AsyncRpcCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AsyncRpcCall] -> ShowS
$cshowList :: [AsyncRpcCall] -> ShowS
show :: AsyncRpcCall -> String
$cshow :: AsyncRpcCall -> String
showsPrec :: Int -> AsyncRpcCall -> ShowS
$cshowsPrec :: Int -> AsyncRpcCall -> ShowS
Show)

newtype SyncRpcCall =
  SyncRpcCall { SyncRpcCall -> RpcCall
syncRpcCall :: RpcCall }
  deriving (SyncRpcCall -> SyncRpcCall -> Bool
(SyncRpcCall -> SyncRpcCall -> Bool)
-> (SyncRpcCall -> SyncRpcCall -> Bool) -> Eq SyncRpcCall
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SyncRpcCall -> SyncRpcCall -> Bool
$c/= :: SyncRpcCall -> SyncRpcCall -> Bool
== :: SyncRpcCall -> SyncRpcCall -> Bool
$c== :: SyncRpcCall -> SyncRpcCall -> Bool
Eq, Int -> SyncRpcCall -> ShowS
[SyncRpcCall] -> ShowS
SyncRpcCall -> String
(Int -> SyncRpcCall -> ShowS)
-> (SyncRpcCall -> String)
-> ([SyncRpcCall] -> ShowS)
-> Show SyncRpcCall
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SyncRpcCall] -> ShowS
$cshowList :: [SyncRpcCall] -> ShowS
show :: SyncRpcCall -> String
$cshow :: SyncRpcCall -> String
showsPrec :: Int -> SyncRpcCall -> ShowS
$cshowsPrec :: Int -> SyncRpcCall -> ShowS
Show)

data RpcError =
  Decode Err
  |
  Nvim RpcCall NeovimException
  |
  Atomic Text
  deriving Int -> RpcError -> ShowS
[RpcError] -> ShowS
RpcError -> String
(Int -> RpcError -> ShowS)
-> (RpcError -> String) -> ([RpcError] -> ShowS) -> Show RpcError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcError] -> ShowS
$cshowList :: [RpcError] -> ShowS
show :: RpcError -> String
$cshow :: RpcError -> String
showsPrec :: Int -> RpcError -> ShowS
$cshowsPrec :: Int -> RpcError -> ShowS
Show

deepPrisms ''RpcError

class Rpc c a where
  call :: c -> Neovim e (Either RpcError a)

instance Rpc AsyncRpcCall () where
  call :: AsyncRpcCall -> Neovim e (Either RpcError ())
call (AsyncRpcCall c :: RpcCall
c@(RpcCall FunctionName
name [Object]
args)) =
    (NeovimException -> RpcError)
-> Either NeovimException () -> Either RpcError ()
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft (RpcCall -> NeovimException -> RpcError
Nvim RpcCall
c) (Either NeovimException () -> Either RpcError ())
-> Neovim e (Either NeovimException ())
-> Neovim e (Either RpcError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FunctionName -> [Object] -> Neovim e (Either NeovimException ())
forall result env.
NvimObject result =>
FunctionName
-> [Object] -> Neovim env (Either NeovimException result)
scall FunctionName
name [Object]
args

instance MsgpackDecode a => Rpc SyncRpcCall a where
  call :: SyncRpcCall -> Neovim e (Either RpcError a)
call (SyncRpcCall c :: RpcCall
c@(RpcCall FunctionName
name [Object]
args)) =
    (NeovimException -> Either RpcError a)
-> (Object -> Either RpcError a)
-> Either NeovimException Object
-> Either RpcError a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (RpcError -> Either RpcError a
forall a b. a -> Either a b
Left (RpcError -> Either RpcError a)
-> (NeovimException -> RpcError)
-> NeovimException
-> Either RpcError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RpcCall -> NeovimException -> RpcError
Nvim RpcCall
c) ((Err -> RpcError) -> Either Err a -> Either RpcError a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft Err -> RpcError
Decode (Either Err a -> Either RpcError a)
-> (Object -> Either Err a) -> Object -> Either RpcError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Object -> Either Err a
forall a. MsgpackDecode a => Object -> Either Err a
fromMsgpack) (Either NeovimException Object -> Either RpcError a)
-> Neovim e (Either NeovimException Object)
-> Neovim e (Either RpcError a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FunctionName
-> [Object] -> Neovim e (Either NeovimException Object)
forall result env.
NvimObject result =>
FunctionName
-> [Object] -> Neovim env (Either NeovimException result)
scall FunctionName
name [Object]
args

instance ReportError RpcError where
  errorReport :: RpcError -> ErrorReport
errorReport (Decode Err
err) =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"error decoding neovim response" [Item [Text]
"RpcError.Decode:", Text
Item [Text]
rendered] Priority
ERROR
    where
      rendered :: Text
rendered = SimpleDocStream AnsiStyle -> Text
forall ann. SimpleDocStream ann -> Text
renderStrict (SimpleDocStream AnsiStyle -> Text)
-> SimpleDocStream AnsiStyle -> Text
forall a b. (a -> b) -> a -> b
$ LayoutOptions -> Err -> SimpleDocStream AnsiStyle
forall ann. LayoutOptions -> Doc ann -> SimpleDocStream ann
layoutPretty LayoutOptions
defaultLayoutOptions Err
err
  errorReport (Nvim RpcCall
c NeovimException
exc)  =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"error in request to neovim" [Item [Text]
"RpcError.Nvim:", RpcCall -> Text
forall b a. (Show a, IsString b) => a -> b
show RpcCall
c, NeovimException -> Text
forall b a. (Show a, IsString b) => a -> b
show NeovimException
exc] Priority
ERROR
  errorReport (Atomic Text
msg)  =
    Text -> [Text] -> Priority -> ErrorReport
ErrorReport Text
"error in request to neovim" [Item [Text]
"RpcError.Atomic:", Text
Item [Text]
msg] Priority
ERROR