{-# 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,
    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

-- | Simply fail and call 'error' in case an unexpected exception is thrown.
-- This fails with a runtime exception. It is used by the Template Haskell API
-- generator for functions that are defined as not being able to fail. If this
-- exception occurs, it is a bug in neovim.
unexpectedException :: String -> err -> a
unexpectedException :: String -> err -> a
unexpectedException String
fn err
_ = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
    String
"Function threw an exception even though it was declared not to throw one: "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
fn


-- | Strip the error result from the function call. This should only be used by
-- the Template Haskell API generated code for functions that declare
-- themselves as unfailable.
withIgnoredException :: (Functor f)
                     => FunctionName -- ^ For better error messages
                     -> f (Either err result)
                     -> f result
withIgnoredException :: FunctionName -> f (Either err result) -> f result
withIgnoredException FunctionName
fn = (Either err result -> result) -> f (Either err result) -> f result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((err -> result)
-> (result -> result) -> Either err result -> result
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((String -> err -> result
forall err a. String -> err -> a
unexpectedException (String -> err -> result)
-> (FunctionName -> String) -> FunctionName -> err -> result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionName -> String
forall a. Show a => a -> String
show) FunctionName
fn) result -> result
forall a. a -> a
id)


-- | 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
$ Object -> NeovimException
ErrorResult 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

-- | Helper function similar to 'acall' that throws a runtime exception if the
-- result is an error object.
acall' :: (NvimObject result)
       => FunctionName
       -> [Object]
       -> Neovim env (STM result)
acall' :: FunctionName -> [Object] -> Neovim env (STM result)
acall' FunctionName
fn [Object]
parameters = FunctionName -> STM (Either NeovimException result) -> STM result
forall (f :: * -> *) err result.
Functor f =>
FunctionName -> f (Either err result) -> f result
withIgnoredException FunctionName
fn (STM (Either NeovimException result) -> STM result)
-> Neovim env (STM (Either NeovimException result))
-> Neovim env (STM result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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


-- | 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 = FunctionName
-> Neovim env (Either NeovimException result) -> Neovim env result
forall (f :: * -> *) err result.
Functor f =>
FunctionName -> f (Either err result) -> f result
withIgnoredException FunctionName
fn (Neovim env (Either NeovimException result) -> Neovim env result)
-> ([Object] -> Neovim env (Either NeovimException result))
-> [Object]
-> Neovim env result
forall b c a. (b -> c) -> (a -> b) -> a -> 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