{-# LANGUAGE RecordWildCards #-}
{- |
Module      :  Neovim.RPC.FunctionCall
Description :  Functions for calling functions
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental

-}
module Neovim.RPC.FunctionCall (
    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

-- | Helper function that concurrently puts a 'Message' in the event queue and returns an 'STM' action that returns the result.
acall :: (NvimObject result)
     => FunctionName
     -> [Object]
     -> Neovim env (STM (Either NeovimException result))
acall :: FunctionName
-> [Object] -> Neovim env (STM (Either NeovimException result))
acall FunctionName
fn [Object]
parameters = do
    TQueue SomeMessage
q <- (Config env -> TQueue SomeMessage)
-> Neovim env (TQueue SomeMessage)
forall env a. (Config env -> a) -> Neovim env a
Internal.asks' Config env -> TQueue SomeMessage
forall env. Config env -> TQueue SomeMessage
Internal.eventQueue
    TMVar (Either Object Object)
mv <- IO (TMVar (Either Object Object))
-> Neovim env (TMVar (Either Object Object))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TMVar (Either Object Object))
forall a. IO (TMVar a)
newEmptyTMVarIO
    UTCTime
timestamp <- IO UTCTime -> Neovim env UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    TQueue SomeMessage -> FunctionCall -> Neovim env ()
forall (m :: * -> *) message.
(MonadIO m, Message message) =>
TQueue SomeMessage -> message -> m ()
writeMessage TQueue SomeMessage
q (FunctionCall -> Neovim env ()) -> FunctionCall -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ FunctionName
-> [Object]
-> TMVar (Either Object Object)
-> UTCTime
-> FunctionCall
FunctionCall FunctionName
fn [Object]
parameters TMVar (Either Object Object)
mv UTCTime
timestamp
    STM (Either NeovimException result)
-> Neovim env (STM (Either NeovimException result))
forall (m :: * -> *) a. Monad m => a -> m a
return (STM (Either NeovimException result)
 -> Neovim env (STM (Either NeovimException result)))
-> STM (Either NeovimException result)
-> Neovim env (STM (Either NeovimException result))
forall a b. (a -> b) -> a -> b
$ Either Object Object -> Either NeovimException result
forall result.
NvimObject result =>
Either Object Object -> Either NeovimException result
convertObject (Either Object Object -> Either NeovimException result)
-> STM (Either Object Object)
-> STM (Either NeovimException result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMVar (Either Object Object) -> STM (Either Object Object)
forall a. TMVar a -> STM a
readTMVar TMVar (Either Object Object)
mv
  where
    convertObject :: (NvimObject result)
                  => Either Object Object -> Either NeovimException result
    convertObject :: Either Object Object -> Either NeovimException result
convertObject = \case
        Left Object
e -> NeovimException -> Either NeovimException result
forall a b. a -> Either a b
Left (NeovimException -> Either NeovimException result)
-> NeovimException -> Either NeovimException result
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Object -> NeovimException
ErrorResult (FunctionName -> Doc AnsiStyle
forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
fn) Object
e
        Right Object
o -> case Object -> Either (Doc AnsiStyle) result
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o of
                     Left Doc AnsiStyle
e -> NeovimException -> Either NeovimException result
forall a b. a -> Either a b
Left (NeovimException -> Either NeovimException result)
-> NeovimException -> Either NeovimException result
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> NeovimException
ErrorMessage Doc AnsiStyle
e
                     Right result
r -> result -> Either NeovimException result
forall a b. b -> Either a b
Right result
r

-- | Call a neovim function synchronously. This function blocks until the
-- result is available.
scall :: (NvimObject result)
      => FunctionName
      -> [Object]      -- ^ Parameters in an 'Object' array
      -> Neovim env (Either NeovimException result)
      -- ^ result value of the call or the thrown exception
scall :: FunctionName
-> [Object] -> Neovim env (Either NeovimException result)
scall FunctionName
fn [Object]
parameters = FunctionName
-> [Object] -> Neovim env (STM (Either NeovimException result))
forall result env.
NvimObject result =>
FunctionName
-> [Object] -> Neovim env (STM (Either NeovimException result))
acall FunctionName
fn [Object]
parameters Neovim env (STM (Either NeovimException result))
-> (STM (Either NeovimException result)
    -> Neovim env (Either NeovimException result))
-> Neovim env (Either NeovimException result)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= STM (Either NeovimException result)
-> Neovim env (Either NeovimException result)
forall (io :: * -> *) result. MonadIO io => STM result -> io result
atomically'

-- | Similar to 'scall', but throw a 'NeovimException' instead of returning it.
scallThrow :: (NvimObject result)
           => FunctionName
           -> [Object]
           -> Neovim env result
scallThrow :: FunctionName -> [Object] -> Neovim env result
scallThrow FunctionName
fn [Object]
parameters = FunctionName
-> [Object] -> Neovim env (Either NeovimException result)
forall result env.
NvimObject result =>
FunctionName
-> [Object] -> Neovim env (Either NeovimException result)
scall FunctionName
fn [Object]
parameters Neovim env (Either NeovimException result)
-> (Either NeovimException result -> Neovim env result)
-> Neovim env result
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (NeovimException -> Neovim env result)
-> (result -> Neovim env result)
-> Either NeovimException result
-> Neovim env result
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either NeovimException -> Neovim env result
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO result -> Neovim env result
forall (m :: * -> *) a. Monad m => a -> m a
return


-- | Helper function similar to 'scall' that throws a runtime exception if the
-- result is an error object.
scall' :: NvimObject result => FunctionName -> [Object] -> Neovim env result
scall' :: FunctionName -> [Object] -> Neovim env result
scall' FunctionName
fn = (NeovimException -> Neovim env result)
-> (result -> Neovim env result)
-> Either NeovimException result
-> Neovim env result
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either NeovimException -> Neovim env result
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO result -> Neovim env result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either NeovimException result -> Neovim env result)
-> ([Object] -> Neovim env (Either NeovimException result))
-> [Object]
-> Neovim env result
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FunctionName
-> [Object] -> Neovim env (Either NeovimException result)
forall result env.
NvimObject result =>
FunctionName
-> [Object] -> Neovim env (Either NeovimException result)
scall FunctionName
fn


-- | Lifted variant of 'atomically'.
atomically' :: (MonadIO io) => STM result -> io result
atomically' :: STM result -> io result
atomically' = IO result -> io result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO result -> io result)
-> (STM result -> IO result) -> STM result -> io result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM result -> IO result
forall a. STM a -> IO a
atomically


-- | Wait for the result of the STM action.
--
-- This action possibly blocks as it is an alias for
-- @ \ioSTM -> ioSTM >>= liftIO . atomically@.
wait :: Neovim env (STM result) -> Neovim env result
wait :: Neovim env (STM result) -> Neovim env result
wait = (STM result -> Neovim env result)
-> Neovim env (STM result) -> Neovim env result
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) STM result -> Neovim env result
forall (io :: * -> *) result. MonadIO io => STM result -> io result
atomically'


-- | Variant of 'wait' that discards the result.
wait' :: Neovim env (STM result) -> Neovim env ()
wait' :: Neovim env (STM result) -> Neovim env ()
wait' = Neovim env result -> Neovim env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Neovim env result -> Neovim env ())
-> (Neovim env (STM result) -> Neovim env result)
-> Neovim env (STM result)
-> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Neovim env (STM result) -> Neovim env result
forall env result. Neovim env (STM result) -> Neovim env result
wait


-- | Send the result back to the neovim instance.
respond :: (NvimObject result) => Request -> Either String result -> Neovim env ()
respond :: Request -> Either String result -> Neovim env ()
respond Request{Int64
[Object]
FunctionName
reqArgs :: Request -> [Object]
reqId :: Request -> Int64
reqMethod :: Request -> FunctionName
reqArgs :: [Object]
reqId :: Int64
reqMethod :: FunctionName
..} Either String result
result = do
    TQueue SomeMessage
q <- (Config env -> TQueue SomeMessage)
-> Neovim env (TQueue SomeMessage)
forall env a. (Config env -> a) -> Neovim env a
Internal.asks' Config env -> TQueue SomeMessage
forall env. Config env -> TQueue SomeMessage
Internal.eventQueue
    TQueue SomeMessage -> Message -> Neovim env ()
forall (m :: * -> *) message.
(MonadIO m, Message message) =>
TQueue SomeMessage -> message -> m ()
writeMessage TQueue SomeMessage
q (Message -> Neovim env ())
-> (Either Object Object -> Message)
-> Either Object Object
-> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Either Object Object -> Message
MsgpackRPC.Response Int64
reqId (Either Object Object -> Neovim env ())
-> Either Object Object -> Neovim env ()
forall a b. (a -> b) -> a -> b
$
        (String -> Either Object Object)
-> (result -> Either Object Object)
-> Either String result
-> Either Object Object
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Object -> Either Object Object
forall a b. a -> Either a b
Left (Object -> Either Object Object)
-> (String -> Object) -> String -> Either Object Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Object
forall o. NvimObject o => o -> Object
toObject) (Object -> Either Object Object
forall a b. b -> Either a b
Right (Object -> Either Object Object)
-> (result -> Object) -> result -> Either Object Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. result -> Object
forall o. NvimObject o => o -> Object
toObject) Either String result
result