{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Neovim.RPC.FunctionCall (
acall,
acall',
scall,
scall',
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 Control.Applicative
import Control.Concurrent.STM
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 Object 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 = \case
Left e -> Left e
Right o -> case fromObject o of
Left e -> Left (toObject 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 Object result)
scall fn parameters = acall fn parameters >>= atomically'
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