{-# LANGUAGE LambdaCase #-}
{-# 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.Monad (void, (<=<))
import Control.Monad.Reader
import Data.MessagePack

import UnliftIO (STM, atomically, newEmptyTMVarIO, readTMVar, 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 :: forall result env.
NvimObject result =>
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 a. IO a -> Neovim env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TMVar (Either Object Object))
forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
    UTCTime
timestamp <- IO UTCTime -> Neovim env UTCTime
forall a. IO a -> Neovim env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    TQueue SomeMessage -> FunctionCall -> Neovim env ()
forall (m :: * -> *) message.
(MonadUnliftIO 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 a. a -> Neovim env a
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 :: forall result.
NvimObject result =>
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
forall ann. FunctionName -> 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 ->
    -- | Parameters in an 'Object' array
    [Object] ->
    -- | result value of the call or the thrown exception
    Neovim env (Either NeovimException result)
scall :: forall result env.
NvimObject result =>
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 a b. Neovim env a -> (a -> Neovim env b) -> Neovim env b
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 :: forall result env.
NvimObject result =>
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 a b. Neovim env a -> (a -> Neovim env b) -> Neovim env b
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 a. a -> Neovim env a
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' :: forall result env.
NvimObject result =>
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 a. a -> Neovim env a
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' :: forall (io :: * -> *) result. MonadIO io => STM result -> io result
atomically' = IO result -> io result
forall a. IO a -> io a
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 (io :: * -> *) result. MonadIO io => STM result -> io result
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 :: forall env result. 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' :: forall env result. 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 :: forall result env.
NvimObject result =>
Request -> Either String result -> Neovim env ()
respond Request{Int64
[Object]
FunctionName
reqMethod :: FunctionName
reqId :: Int64
reqArgs :: [Object]
reqMethod :: Request -> FunctionName
reqId :: Request -> Int64
reqArgs :: Request -> [Object]
..} 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.
(MonadUnliftIO 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