{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Neovim.RPC.FunctionCall (
acall,
acall',
scall,
scall',
scallThrow,
atomically',
wait,
wait',
waitErr,
waitErr',
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 Neovim.Exceptions (NeovimException(..), exceptionToDoc)
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
atomically' . writeTQueue q . SomeMessage $ 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
waitErr :: String
-> Neovim env (STM (Either NeovimException result))
-> Neovim env result
waitErr loc act = wait act >>= \case
Left e ->
err $ pretty loc <+> exceptionToDoc e
Right result ->
return result
waitErr' :: String
-> Neovim env (STM (Either NeovimException result))
-> Neovim env ()
waitErr' loc = void . waitErr loc
respond :: (NvimObject result) => Request -> Either String result -> Neovim env ()
respond Request{..} result = do
q <- Internal.asks' Internal.eventQueue
atomically' . writeTQueue q . SomeMessage . MsgpackRPC.Response reqId $
either (Left . toObject) (Right . toObject) result