{-# LANGUAGE RecordWildCards #-}
module Neovim.RPC.FunctionCall (
acall,
acall',
scall,
scall',
scallThrow,
atomically',
wait,
wait',
respond,
) where
import Neovim.Classes
import Neovim.Context
import qualified Neovim.Context.Internal as Internal
import Neovim.Plugin.Classes (FunctionName)
import Neovim.Plugin.IPC.Classes
import qualified Neovim.RPC.Classes as MsgpackRPC
import Control.Applicative
import Control.Concurrent.STM
import Control.Monad.Reader
import Data.MessagePack
import UnliftIO.Exception (throwIO)
import Prelude
unexpectedException :: String -> err -> a
unexpectedException fn _ = error $
"Function threw an exception even though it was declared not to throw one: "
++ fn
withIgnoredException :: (Functor f)
=> FunctionName
-> f (Either err result)
-> f result
withIgnoredException fn = fmap (either ((unexpectedException . show) fn) id)
acall :: (NvimObject result)
=> FunctionName
-> [Object]
-> Neovim env (STM (Either NeovimException result))
acall fn parameters = do
q <- Internal.asks' Internal.eventQueue
mv <- liftIO newEmptyTMVarIO
timestamp <- liftIO getCurrentTime
writeMessage q $ FunctionCall fn parameters mv timestamp
return $ convertObject <$> readTMVar mv
where
convertObject :: (NvimObject result)
=> Either Object Object -> Either NeovimException result
convertObject = \case
Left e -> Left $ ErrorResult e
Right o -> case fromObject o of
Left e -> Left $ ErrorMessage e
Right r -> Right r
acall' :: (NvimObject result)
=> FunctionName
-> [Object]
-> Neovim env (STM result)
acall' fn parameters = withIgnoredException fn <$> acall fn parameters
scall :: (NvimObject result)
=> FunctionName
-> [Object]
-> Neovim env (Either NeovimException result)
scall fn parameters = acall fn parameters >>= atomically'
scallThrow :: (NvimObject result)
=> FunctionName
-> [Object]
-> Neovim env result
scallThrow fn parameters = scall fn parameters >>= either throwIO return
scall' :: NvimObject result => FunctionName -> [Object] -> Neovim env result
scall' fn = withIgnoredException fn . scall fn
atomically' :: (MonadIO io) => STM result -> io result
atomically' = liftIO . atomically
wait :: Neovim env (STM result) -> Neovim env result
wait = (=<<) atomically'
wait' :: Neovim env (STM result) -> Neovim env ()
wait' = void . wait
respond :: (NvimObject result) => Request -> Either String result -> Neovim env ()
respond Request{..} result = do
q <- Internal.asks' Internal.eventQueue
writeMessage q . MsgpackRPC.Response reqId $
either (Left . toObject) (Right . toObject) result