{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}

{- |
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.Reader
import Data.MessagePack

import Prelude
import UnliftIO (STM, newEmptyTMVarIO, readTMVar, throwIO, atomically)

-- | 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