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(..))
import Control.Applicative
import Control.Concurrent.STM
import Control.Exception.Lifted (throwIO)
import Control.Monad.Reader
import Data.MessagePack
import Data.Monoid
import qualified Text.PrettyPrint.ANSI.Leijen as P
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 r st (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 r st (STM result)
acall' fn parameters = withIgnoredException fn <$> acall fn parameters
scall :: (NvimObject result)
=> FunctionName
-> [Object]
-> Neovim r st (Either NeovimException result)
scall fn parameters = acall fn parameters >>= atomically'
scallThrow :: (NvimObject result)
=> FunctionName
-> [Object]
-> Neovim r st result
scallThrow fn parameters = scall fn parameters >>= either throwIO return
scall' :: NvimObject result => FunctionName -> [Object] -> Neovim r st result
scall' fn = withIgnoredException fn . scall fn
atomically' :: (MonadIO io) => STM result -> io result
atomically' = liftIO . atomically
wait :: Neovim r st (STM result) -> Neovim r st result
wait = (=<<) atomically'
wait' :: Neovim r st (STM result) -> Neovim r st ()
wait' = void . wait
waitErr :: (P.Pretty e)
=> String
-> Neovim r st (STM (Either e result))
-> Neovim r st result
waitErr loc act = wait act >>= either (err . (P.<>) (P.text loc) . P.pretty) return
waitErr' :: (P.Pretty e)
=> String
-> Neovim r st (STM (Either e result))
-> Neovim r st ()
waitErr' loc = void . waitErr loc
respond :: (NvimObject result) => Request -> Either String result -> Neovim r st ()
respond Request{..} result = do
q <- Internal.asks' Internal.eventQueue
atomically' . writeTQueue q . SomeMessage . MsgpackRPC.Response reqId $
either (Left . toObject) (Right . toObject) result