module Ribosome.Api.Atomic where
import Data.MessagePack (Object(ObjectNil, ObjectArray, ObjectString))
import Neovim.Plugin.Classes (FunctionName(F))
import qualified Ribosome.Nvim.Api.RpcCall as RpcError (RpcError(Atomic))
import Ribosome.Control.Monad.Ribo (NvimE)
import Ribosome.Msgpack.Decode (MsgpackDecode(..), fromMsgpack')
import Ribosome.Msgpack.Encode (MsgpackEncode(toMsgpack))
import Ribosome.Msgpack.Error (DecodeError)
import qualified Ribosome.Msgpack.Util as Util (illegalType)
import Ribosome.Nvim.Api.IO (nvimCallAtomic)
import Ribosome.Nvim.Api.RpcCall (RpcCall(RpcCall))
data AtomicStatus =
Failure Text
|
Success
deriving (AtomicStatus -> AtomicStatus -> Bool
(AtomicStatus -> AtomicStatus -> Bool)
-> (AtomicStatus -> AtomicStatus -> Bool) -> Eq AtomicStatus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AtomicStatus -> AtomicStatus -> Bool
$c/= :: AtomicStatus -> AtomicStatus -> Bool
== :: AtomicStatus -> AtomicStatus -> Bool
$c== :: AtomicStatus -> AtomicStatus -> Bool
Eq, Int -> AtomicStatus -> ShowS
[AtomicStatus] -> ShowS
AtomicStatus -> String
(Int -> AtomicStatus -> ShowS)
-> (AtomicStatus -> String)
-> ([AtomicStatus] -> ShowS)
-> Show AtomicStatus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AtomicStatus] -> ShowS
$cshowList :: [AtomicStatus] -> ShowS
show :: AtomicStatus -> String
$cshow :: AtomicStatus -> String
showsPrec :: Int -> AtomicStatus -> ShowS
$cshowsPrec :: Int -> AtomicStatus -> ShowS
Show)
instance MsgpackDecode AtomicStatus where
fromMsgpack :: Object -> Either Err AtomicStatus
fromMsgpack Object
ObjectNil =
AtomicStatus -> Either Err AtomicStatus
forall a b. b -> Either a b
Right AtomicStatus
Success
fromMsgpack (ObjectArray [Item [Object]
_, Item [Object]
_, ObjectString msg]) =
AtomicStatus -> Either Err AtomicStatus
forall a b. b -> Either a b
Right (Text -> AtomicStatus
Failure (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 ByteString
msg))
fromMsgpack Object
o =
Text -> Object -> Either Err AtomicStatus
forall a. Text -> Object -> Either Err a
Util.illegalType Text
"AtomicStatus" Object
o
atomic ::
MonadDeepError e DecodeError m =>
NvimE e m =>
[RpcCall] ->
m [Object]
atomic :: [RpcCall] -> m [Object]
atomic [RpcCall]
calls = do
([Object]
results, Object
statusObject) <- [Object] -> m ([Object], Object)
forall a (m :: * -> *) e.
(IsList a, MonadError e m, DeepPrisms e RpcError, Show a,
Item a ~ Object) =>
a -> m ([Object], Object)
unpack ([Object] -> m ([Object], Object))
-> m [Object] -> m ([Object], Object)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [Object] -> m [Object]
forall (m :: * -> *) e.
(Nvim m, MonadDeepError e RpcError m) =>
[Object] -> m [Object]
nvimCallAtomic (RpcCall -> Object
call (RpcCall -> Object) -> [RpcCall] -> [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RpcCall]
calls)
AtomicStatus
status <- Object -> m AtomicStatus
forall a e (m :: * -> *).
(MonadDeepError e DecodeError m, MsgpackDecode a) =>
Object -> m a
fromMsgpack' Object
statusObject
[Object] -> AtomicStatus -> m [Object]
forall e (m :: * -> *) a.
(MonadError e m, DeepPrisms e RpcError) =>
a -> AtomicStatus -> m a
check [Object]
results AtomicStatus
status
where
call :: RpcCall -> Object
call (RpcCall (F ByteString
name) [Object]
args) =
[Object] -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack @[Object] [ByteString -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack ByteString
name, [Object] -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack [Object]
args]
unpack :: a -> m ([Object], Object)
unpack [ObjectArray results, Item a
status] =
([Object], Object) -> m ([Object], Object)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object]
results, Item a
Object
status)
unpack a
o =
RpcError -> m ([Object], Object)
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist (Text -> RpcError
RpcError.Atomic (Text
"unexpected result structure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> a -> Text
forall b a. (Show a, IsString b) => a -> b
show a
o))
check :: a -> AtomicStatus -> m a
check a
_ (Failure Text
err) =
RpcError -> m a
forall e e' (m :: * -> *) a. MonadDeepError e e' m => e' -> m a
throwHoist (Text -> RpcError
RpcError.Atomic Text
err)
check a
results AtomicStatus
Success =
a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
results
atomicAs ::
MonadDeepError e DecodeError m =>
MsgpackDecode a =>
NvimE e m =>
[RpcCall] ->
m [a]
atomicAs :: [RpcCall] -> m [a]
atomicAs =
(Object -> m a) -> [Object] -> m [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Object -> m a
forall a e (m :: * -> *).
(MonadDeepError e DecodeError m, MsgpackDecode a) =>
Object -> m a
fromMsgpack' ([Object] -> m [a])
-> ([RpcCall] -> m [Object]) -> [RpcCall] -> m [a]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< [RpcCall] -> m [Object]
forall e (m :: * -> *).
(MonadDeepError e DecodeError m, NvimE e m) =>
[RpcCall] -> m [Object]
atomic