{-# 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 <- forall env a. (Config env -> a) -> Neovim env a
Internal.asks' forall env. Config env -> TQueue SomeMessage
Internal.eventQueue
    TMVar (Either Object Object)
mv <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
    UTCTime
timestamp <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
    forall (m :: * -> *) message.
(MonadUnliftIO m, Message message) =>
TQueue SomeMessage -> message -> m ()
writeMessage TQueue SomeMessage
q 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
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall result.
NvimObject result =>
Either Object Object -> Either NeovimException result
convertObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Object -> NeovimException
ErrorResult (forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
fn) Object
e
        Right Object
o -> case forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o of
            Left Doc AnsiStyle
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> NeovimException
ErrorMessage Doc AnsiStyle
e
            Right result
r -> 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 = forall result env.
NvimObject result =>
FunctionName
-> [Object] -> Neovim env (STM (Either NeovimException result))
acall FunctionName
fn [Object]
parameters forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall result env.
NvimObject result =>
FunctionName
-> [Object] -> Neovim env (Either NeovimException result)
scall FunctionName
fn [Object]
parameters forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< 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' = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<) 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' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
reqArgs :: Request -> [Object]
reqId :: Request -> Int64
reqMethod :: Request -> FunctionName
reqArgs :: [Object]
reqId :: Int64
reqMethod :: FunctionName
..} Either String result
result = do
    TQueue SomeMessage
q <- forall env a. (Config env -> a) -> Neovim env a
Internal.asks' forall env. Config env -> TQueue SomeMessage
Internal.eventQueue
    forall (m :: * -> *) message.
(MonadUnliftIO m, Message message) =>
TQueue SomeMessage -> message -> m ()
writeMessage TQueue SomeMessage
q forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Either Object Object -> Message
MsgpackRPC.Response Int64
reqId forall a b. (a -> b) -> a -> b
$
        forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o. NvimObject o => o -> Object
toObject) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o. NvimObject o => o -> Object
toObject) Either String result
result