{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards            #-}
{- |
Module      :  Neovim.RPC.SocketReader
Description :  The component which reads RPC messages from the neovim instance
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental

-}
module Neovim.RPC.SocketReader (
    runSocketReader,
    parseParams,
    ) where

import           Neovim.Classes
import           Neovim.Context
import qualified Neovim.Context.Internal    as Internal
import           Neovim.Plugin.Classes      (CommandArguments (..),
                                             CommandOption (..),
                                             FunctionName (..),
                                             NvimMethod (..),
                                             FunctionalityDescription (..),
                                             getCommandOptions)
import           Neovim.Plugin.IPC.Classes
import qualified Neovim.RPC.Classes         as MsgpackRPC
import           Neovim.RPC.Common
import           Neovim.RPC.FunctionCall

import           Control.Applicative
import           Control.Concurrent.STM
import           Control.Monad              (void)
import           Conduit               as C
import           Data.Conduit.Cereal        (conduitGet2)
import           Data.Default               (def)
import           Data.Foldable              (foldl', forM_)
import qualified Data.Map                   as Map
import           Data.MessagePack
import           Data.Monoid
import qualified Data.Serialize             (get)
import           System.IO                  (Handle)
import           System.Log.Logger
import           UnliftIO.Async             (async, race)
import           UnliftIO.Concurrent        (threadDelay)

import           Prelude

logger :: String
logger :: String
logger = String
"Socket Reader"


type SocketHandler = Neovim RPCConfig


-- | This function will establish a connection to the given socket and read
-- msgpack-rpc events from it.
runSocketReader :: Handle
                -> Internal.Config RPCConfig
                -> IO ()
runSocketReader :: Handle -> Config RPCConfig -> IO ()
runSocketReader Handle
readableHandle Config RPCConfig
cfg =
    IO (Either (Doc AnsiStyle) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (Doc AnsiStyle) ()) -> IO ())
-> (ConduitT () Void (Neovim RPCConfig) ()
    -> IO (Either (Doc AnsiStyle) ()))
-> ConduitT () Void (Neovim RPCConfig) ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config RPCConfig
-> Neovim RPCConfig () -> IO (Either (Doc AnsiStyle) ())
forall a env.
NFData a =>
Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovim (RPCConfig -> Config RPCConfig -> Config RPCConfig
forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig (Config RPCConfig -> RPCConfig
forall env. Config env -> env
Internal.customConfig Config RPCConfig
cfg) Config RPCConfig
cfg) (Neovim RPCConfig () -> IO (Either (Doc AnsiStyle) ()))
-> (ConduitT () Void (Neovim RPCConfig) () -> Neovim RPCConfig ())
-> ConduitT () Void (Neovim RPCConfig) ()
-> IO (Either (Doc AnsiStyle) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitT () Void (Neovim RPCConfig) () -> Neovim RPCConfig ()
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void (Neovim RPCConfig) () -> IO ())
-> ConduitT () Void (Neovim RPCConfig) () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Handle -> ConduitT () ByteString (Neovim RPCConfig) ()
forall (m :: * -> *) i.
MonadIO m =>
Handle -> ConduitT i ByteString m ()
sourceHandle Handle
readableHandle
            ConduitT () ByteString (Neovim RPCConfig) ()
-> ConduitM ByteString Void (Neovim RPCConfig) ()
-> ConduitT () Void (Neovim RPCConfig) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| Get Object -> ConduitT ByteString Object (Neovim RPCConfig) ()
forall (m :: * -> *) o.
MonadThrow m =>
Get o -> ConduitT ByteString o m ()
conduitGet2 Get Object
forall t. Serialize t => Get t
Data.Serialize.get
            ConduitT ByteString Object (Neovim RPCConfig) ()
-> ConduitM Object Void (Neovim RPCConfig) ()
-> ConduitM ByteString Void (Neovim RPCConfig) ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM Object Void (Neovim RPCConfig) ()
messageHandlerSink


-- | Sink that delegates the messages depending on their type.
-- <https://github.com/msgpack-rpc/msgpack-rpc/blob/master/spec.md>
messageHandlerSink :: ConduitT Object Void SocketHandler ()
messageHandlerSink :: ConduitM Object Void (Neovim RPCConfig) ()
messageHandlerSink = (Object -> ConduitM Object Void (Neovim RPCConfig) ())
-> ConduitM Object Void (Neovim RPCConfig) ()
forall (m :: * -> *) i o r.
Monad m =>
(i -> ConduitT i o m r) -> ConduitT i o m ()
awaitForever ((Object -> ConduitM Object Void (Neovim RPCConfig) ())
 -> ConduitM Object Void (Neovim RPCConfig) ())
-> (Object -> ConduitM Object Void (Neovim RPCConfig) ())
-> ConduitM Object Void (Neovim RPCConfig) ()
forall a b. (a -> b) -> a -> b
$ \Object
rpc -> do
    IO () -> ConduitM Object Void (Neovim RPCConfig) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitM Object Void (Neovim RPCConfig) ())
-> (String -> IO ())
-> String
-> ConduitM Object Void (Neovim RPCConfig) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger (String -> ConduitM Object Void (Neovim RPCConfig) ())
-> String -> ConduitM Object Void (Neovim RPCConfig) ()
forall a b. (a -> b) -> a -> b
$ String
"Received: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Object -> String
forall a. Show a => a -> String
show Object
rpc
    case Object -> Either (Doc AnsiStyle) Message
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
rpc of
        Right (MsgpackRPC.Request (Request FunctionName
fn Int64
i [Object]
ps)) ->
            Maybe Int64
-> FunctionName
-> [Object]
-> ConduitM Object Void (Neovim RPCConfig) ()
forall a.
Maybe Int64
-> FunctionName
-> [Object]
-> ConduitT a Void (Neovim RPCConfig) ()
handleRequestOrNotification (Int64 -> Maybe Int64
forall a. a -> Maybe a
Just Int64
i) FunctionName
fn [Object]
ps

        Right (MsgpackRPC.Response Int64
i Either Object Object
r) ->
            Int64
-> Either Object Object
-> ConduitM Object Void (Neovim RPCConfig) ()
forall a.
Int64
-> Either Object Object -> ConduitT a Void (Neovim RPCConfig) ()
handleResponse Int64
i Either Object Object
r

        Right (MsgpackRPC.Notification (Notification FunctionName
fn [Object]
ps)) ->
            Maybe Int64
-> FunctionName
-> [Object]
-> ConduitM Object Void (Neovim RPCConfig) ()
forall a.
Maybe Int64
-> FunctionName
-> [Object]
-> ConduitT a Void (Neovim RPCConfig) ()
handleRequestOrNotification Maybe Int64
forall a. Maybe a
Nothing FunctionName
fn [Object]
ps

        Left Doc AnsiStyle
e -> IO () -> ConduitM Object Void (Neovim RPCConfig) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitM Object Void (Neovim RPCConfig) ())
-> (String -> IO ())
-> String
-> ConduitM Object Void (Neovim RPCConfig) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorM String
logger (String -> ConduitM Object Void (Neovim RPCConfig) ())
-> String -> ConduitM Object Void (Neovim RPCConfig) ()
forall a b. (a -> b) -> a -> b
$
            String
"Unhandled rpc message: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Doc AnsiStyle -> String
forall a. Show a => a -> String
show Doc AnsiStyle
e


handleResponse :: Int64 -> Either Object Object
               -> ConduitT a Void SocketHandler ()
handleResponse :: Int64
-> Either Object Object -> ConduitT a Void (Neovim RPCConfig) ()
handleResponse Int64
i Either Object Object
result = do
    TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
answerMap <- (RPCConfig
 -> TVar (Map Int64 (UTCTime, TMVar (Either Object Object))))
-> ConduitT
     a
     Void
     (Neovim RPCConfig)
     (TVar (Map Int64 (UTCTime, TMVar (Either Object Object))))
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RPCConfig
-> TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
recipients
    Maybe (UTCTime, TMVar (Either Object Object))
mReply <- Int64
-> Map Int64 (UTCTime, TMVar (Either Object Object))
-> Maybe (UTCTime, TMVar (Either Object Object))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Int64
i (Map Int64 (UTCTime, TMVar (Either Object Object))
 -> Maybe (UTCTime, TMVar (Either Object Object)))
-> ConduitT
     a
     Void
     (Neovim RPCConfig)
     (Map Int64 (UTCTime, TMVar (Either Object Object)))
-> ConduitT
     a
     Void
     (Neovim RPCConfig)
     (Maybe (UTCTime, TMVar (Either Object Object)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (Map Int64 (UTCTime, TMVar (Either Object Object)))
-> ConduitT
     a
     Void
     (Neovim RPCConfig)
     (Map Int64 (UTCTime, TMVar (Either Object Object)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
-> IO (Map Int64 (UTCTime, TMVar (Either Object Object)))
forall a. TVar a -> IO a
readTVarIO TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
answerMap)
    case Maybe (UTCTime, TMVar (Either Object Object))
mReply of
        Maybe (UTCTime, TMVar (Either Object Object))
Nothing -> IO () -> ConduitT a Void (Neovim RPCConfig) ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ConduitT a Void (Neovim RPCConfig) ())
-> IO () -> ConduitT a Void (Neovim RPCConfig) ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
warningM String
logger
            String
"Received response but could not find a matching recipient."
        Just (UTCTime
_,TMVar (Either Object Object)
reply) -> do
            STM () -> ConduitT a Void (Neovim RPCConfig) ()
forall (io :: * -> *) result. MonadIO io => STM result -> io result
atomically' (STM () -> ConduitT a Void (Neovim RPCConfig) ())
-> ((Map Int64 (UTCTime, TMVar (Either Object Object))
     -> Map Int64 (UTCTime, TMVar (Either Object Object)))
    -> STM ())
-> (Map Int64 (UTCTime, TMVar (Either Object Object))
    -> Map Int64 (UTCTime, TMVar (Either Object Object)))
-> ConduitT a Void (Neovim RPCConfig) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
-> (Map Int64 (UTCTime, TMVar (Either Object Object))
    -> Map Int64 (UTCTime, TMVar (Either Object Object)))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
answerMap ((Map Int64 (UTCTime, TMVar (Either Object Object))
  -> Map Int64 (UTCTime, TMVar (Either Object Object)))
 -> ConduitT a Void (Neovim RPCConfig) ())
-> (Map Int64 (UTCTime, TMVar (Either Object Object))
    -> Map Int64 (UTCTime, TMVar (Either Object Object)))
-> ConduitT a Void (Neovim RPCConfig) ()
forall a b. (a -> b) -> a -> b
$ Int64
-> Map Int64 (UTCTime, TMVar (Either Object Object))
-> Map Int64 (UTCTime, TMVar (Either Object Object))
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Int64
i
            STM () -> ConduitT a Void (Neovim RPCConfig) ()
forall (io :: * -> *) result. MonadIO io => STM result -> io result
atomically' (STM () -> ConduitT a Void (Neovim RPCConfig) ())
-> STM () -> ConduitT a Void (Neovim RPCConfig) ()
forall a b. (a -> b) -> a -> b
$ TMVar (Either Object Object) -> Either Object Object -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either Object Object)
reply Either Object Object
result


-- | Act upon the received request or notification. The main difference between
-- the two is that a notification does not generate a reply. The distinction
-- between those two cases is done via the first paramater which is 'Maybe' the
-- function call identifier.
handleRequestOrNotification :: Maybe Int64 -> FunctionName -> [Object]
                            -> ConduitT a Void SocketHandler ()
handleRequestOrNotification :: Maybe Int64
-> FunctionName
-> [Object]
-> ConduitT a Void (Neovim RPCConfig) ()
handleRequestOrNotification Maybe Int64
requestId functionToCall :: FunctionName
functionToCall@(F ByteString
functionName) [Object]
params = do
    Config RPCConfig
cfg <- Neovim RPCConfig (Config RPCConfig)
-> ConduitT a Void (Neovim RPCConfig) (Config RPCConfig)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Neovim RPCConfig (Config RPCConfig)
forall env. Neovim env (Config env)
Internal.ask'
    ConduitT a Void (Neovim RPCConfig) (Async (Either () ()))
-> ConduitT a Void (Neovim RPCConfig) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ConduitT a Void (Neovim RPCConfig) (Async (Either () ()))
 -> ConduitT a Void (Neovim RPCConfig) ())
-> (IO (Either () ())
    -> ConduitT a Void (Neovim RPCConfig) (Async (Either () ())))
-> IO (Either () ())
-> ConduitT a Void (Neovim RPCConfig) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Async (Either () ()))
-> ConduitT a Void (Neovim RPCConfig) (Async (Either () ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async (Either () ()))
 -> ConduitT a Void (Neovim RPCConfig) (Async (Either () ())))
-> (IO (Either () ()) -> IO (Async (Either () ())))
-> IO (Either () ())
-> ConduitT a Void (Neovim RPCConfig) (Async (Either () ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either () ()) -> IO (Async (Either () ()))
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO (Either () ()) -> ConduitT a Void (Neovim RPCConfig) ())
-> IO (Either () ()) -> ConduitT a Void (Neovim RPCConfig) ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO () -> IO (Either () ())
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race IO ()
logTimeout (Config RPCConfig -> IO ()
handle Config RPCConfig
cfg)
    () -> ConduitT a Void (Neovim RPCConfig) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

  where
    lookupFunction
        :: TMVar Internal.FunctionMap
        -> STM (Maybe (FunctionalityDescription, Internal.FunctionType))
    lookupFunction :: TMVar FunctionMap
-> STM (Maybe (FunctionalityDescription, FunctionType))
lookupFunction TMVar FunctionMap
funMap = NvimMethod
-> FunctionMap -> Maybe (FunctionalityDescription, FunctionType)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (ByteString -> NvimMethod
NvimMethod ByteString
functionName) (FunctionMap -> Maybe (FunctionalityDescription, FunctionType))
-> STM FunctionMap
-> STM (Maybe (FunctionalityDescription, FunctionType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TMVar FunctionMap -> STM FunctionMap
forall a. TMVar a -> STM a
readTMVar TMVar FunctionMap
funMap

    logTimeout :: IO ()
    logTimeout :: IO ()
logTimeout = do
        let seconds :: Int
seconds = Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
        Int -> IO ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
seconds)
        String -> String -> IO ()
debugM String
logger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Cancelled another action before it was finished"

    handle :: Internal.Config RPCConfig -> IO ()
    handle :: Config RPCConfig -> IO ()
handle Config RPCConfig
rpc = STM (Maybe (FunctionalityDescription, FunctionType))
-> IO (Maybe (FunctionalityDescription, FunctionType))
forall a. STM a -> IO a
atomically (TMVar FunctionMap
-> STM (Maybe (FunctionalityDescription, FunctionType))
lookupFunction (Config RPCConfig -> TMVar FunctionMap
forall env. Config env -> TMVar FunctionMap
Internal.globalFunctionMap Config RPCConfig
rpc)) IO (Maybe (FunctionalityDescription, FunctionType))
-> (Maybe (FunctionalityDescription, FunctionType) -> IO ())
-> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case

        Maybe (FunctionalityDescription, FunctionType)
Nothing -> do
            let errM :: String
errM = String
"No provider for: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> FunctionName -> String
forall a. Show a => a -> String
show FunctionName
functionToCall
            String -> String -> IO ()
debugM String
logger String
errM
            Maybe Int64 -> (Int64 -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ Maybe Int64
requestId ((Int64 -> IO ()) -> IO ()) -> (Int64 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int64
i -> TQueue SomeMessage -> Message -> IO ()
forall (m :: * -> *) message.
(MonadIO m, Message message) =>
TQueue SomeMessage -> message -> m ()
writeMessage (Config RPCConfig -> TQueue SomeMessage
forall env. Config env -> TQueue SomeMessage
Internal.eventQueue Config RPCConfig
rpc) (Message -> IO ()) -> Message -> IO ()
forall a b. (a -> b) -> a -> b
$
                Int64 -> Either Object Object -> Message
MsgpackRPC.Response Int64
i (Object -> Either Object Object
forall a b. a -> Either a b
Left (String -> Object
forall o. NvimObject o => o -> Object
toObject String
errM))

        Just (FunctionalityDescription
copts, Internal.Stateful TQueue SomeMessage
c) -> do
            UTCTime
now <- IO UTCTime -> IO UTCTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
            TMVar (Either Object Object)
reply <- IO (TMVar (Either Object Object))
-> IO (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
            let q :: TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
q = (RPCConfig
-> TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
recipients (RPCConfig
 -> TVar (Map Int64 (UTCTime, TMVar (Either Object Object))))
-> (Config RPCConfig -> RPCConfig)
-> Config RPCConfig
-> TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config RPCConfig -> RPCConfig
forall env. Config env -> env
Internal.customConfig) Config RPCConfig
rpc
            IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Executing stateful function with ID: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Maybe Int64 -> String
forall a. Show a => a -> String
show Maybe Int64
requestId
            case Maybe Int64
requestId of
                Just Int64
i -> do
                    STM () -> IO ()
forall (io :: * -> *) result. MonadIO io => STM result -> io result
atomically' (STM () -> IO ())
-> ((Map Int64 (UTCTime, TMVar (Either Object Object))
     -> Map Int64 (UTCTime, TMVar (Either Object Object)))
    -> STM ())
-> (Map Int64 (UTCTime, TMVar (Either Object Object))
    -> Map Int64 (UTCTime, TMVar (Either Object Object)))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
-> (Map Int64 (UTCTime, TMVar (Either Object Object))
    -> Map Int64 (UTCTime, TMVar (Either Object Object)))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map Int64 (UTCTime, TMVar (Either Object Object)))
q ((Map Int64 (UTCTime, TMVar (Either Object Object))
  -> Map Int64 (UTCTime, TMVar (Either Object Object)))
 -> IO ())
-> (Map Int64 (UTCTime, TMVar (Either Object Object))
    -> Map Int64 (UTCTime, TMVar (Either Object Object)))
-> IO ()
forall a b. (a -> b) -> a -> b
$ Int64
-> (UTCTime, TMVar (Either Object Object))
-> Map Int64 (UTCTime, TMVar (Either Object Object))
-> Map Int64 (UTCTime, TMVar (Either Object Object))
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Int64
i (UTCTime
now, TMVar (Either Object Object)
reply)
                    TQueue SomeMessage -> Request -> IO ()
forall (m :: * -> *) message.
(MonadIO m, Message message) =>
TQueue SomeMessage -> message -> m ()
writeMessage TQueue SomeMessage
c (Request -> IO ()) -> Request -> IO ()
forall a b. (a -> b) -> a -> b
$ FunctionName -> Int64 -> [Object] -> Request
Request FunctionName
functionToCall Int64
i (FunctionalityDescription -> [Object] -> [Object]
parseParams FunctionalityDescription
copts [Object]
params)

                Maybe Int64
Nothing ->
                    TQueue SomeMessage -> Notification -> IO ()
forall (m :: * -> *) message.
(MonadIO m, Message message) =>
TQueue SomeMessage -> message -> m ()
writeMessage TQueue SomeMessage
c (Notification -> IO ()) -> Notification -> IO ()
forall a b. (a -> b) -> a -> b
$ FunctionName -> [Object] -> Notification
Notification FunctionName
functionToCall (FunctionalityDescription -> [Object] -> [Object]
parseParams FunctionalityDescription
copts [Object]
params)


parseParams :: FunctionalityDescription -> [Object] -> [Object]
parseParams :: FunctionalityDescription -> [Object] -> [Object]
parseParams (Function FunctionName
_ Synchronous
_) [Object]
args = case [Object]
args of
    -- Defining a function on the remote host creates a function that, that
    -- passes all arguments in a list. At the time of this writing, no other
    -- arguments are passed for such a function.
    --
    -- The function generating the function on neovim side is called:
    -- @remote#define#FunctionOnHost@
    [ObjectArray [Object]
fArgs] -> [Object]
fArgs
    [Object]
_                   -> [Object]
args

parseParams cmd :: FunctionalityDescription
cmd@(Command FunctionName
_ CommandOptions
opts) [Object]
args = case [Object]
args of
    (ObjectArray [Object]
_ : [Object]
_) ->
        let cmdArgs :: [CommandOption]
cmdArgs = (CommandOption -> Bool) -> [CommandOption] -> [CommandOption]
forall a. (a -> Bool) -> [a] -> [a]
filter CommandOption -> Bool
isPassedViaRPC (CommandOptions -> [CommandOption]
getCommandOptions CommandOptions
opts)
            (CommandArguments
c,[Object]
args') =
                ((CommandArguments, [Object])
 -> (CommandOption, Object) -> (CommandArguments, [Object]))
-> (CommandArguments, [Object])
-> [(CommandOption, Object)]
-> (CommandArguments, [Object])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (CommandArguments, [Object])
-> (CommandOption, Object) -> (CommandArguments, [Object])
createCommandArguments (CommandArguments
forall a. Default a => a
def, []) ([(CommandOption, Object)] -> (CommandArguments, [Object]))
-> [(CommandOption, Object)] -> (CommandArguments, [Object])
forall a b. (a -> b) -> a -> b
$
                    [CommandOption] -> [Object] -> [(CommandOption, Object)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CommandOption]
cmdArgs [Object]
args
        in CommandArguments -> Object
forall o. NvimObject o => o -> Object
toObject CommandArguments
c Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [Object]
args'

    [Object]
_ -> FunctionalityDescription -> [Object] -> [Object]
parseParams FunctionalityDescription
cmd ([Object] -> [Object]) -> [Object] -> [Object]
forall a b. (a -> b) -> a -> b
$ [[Object] -> Object
ObjectArray [Object]
args]
  where
    isPassedViaRPC :: CommandOption -> Bool
    isPassedViaRPC :: CommandOption -> Bool
isPassedViaRPC = \case
        CmdSync{}  -> Bool
False
        CommandOption
_          -> Bool
True

    -- Neovim passes arguments in a special form, depending on the
    -- CommandOption values used to export the (command) function (e.g. via
    -- 'command' or 'command'').
    createCommandArguments :: (CommandArguments, [Object])
                           -> (CommandOption, Object)
                           -> (CommandArguments, [Object])
    createCommandArguments :: (CommandArguments, [Object])
-> (CommandOption, Object) -> (CommandArguments, [Object])
createCommandArguments old :: (CommandArguments, [Object])
old@(CommandArguments
c, [Object]
args') = \case
        (CmdRange RangeSpecification
_, Object
o) ->
            (Doc AnsiStyle -> (CommandArguments, [Object]))
-> ((Int, Int) -> (CommandArguments, [Object]))
-> Either (Doc AnsiStyle) (Int, Int)
-> (CommandArguments, [Object])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((CommandArguments, [Object])
-> Doc AnsiStyle -> (CommandArguments, [Object])
forall a b. a -> b -> a
const (CommandArguments, [Object])
old) (\(Int, Int)
r -> (CommandArguments
c { range :: Maybe (Int, Int)
range = (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int, Int)
r }, [Object]
args')) (Either (Doc AnsiStyle) (Int, Int) -> (CommandArguments, [Object]))
-> Either (Doc AnsiStyle) (Int, Int)
-> (CommandArguments, [Object])
forall a b. (a -> b) -> a -> b
$ Object -> Either (Doc AnsiStyle) (Int, Int)
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o

        (CmdCount Word
_, Object
o) ->
            (Doc AnsiStyle -> (CommandArguments, [Object]))
-> (Int -> (CommandArguments, [Object]))
-> Either (Doc AnsiStyle) Int
-> (CommandArguments, [Object])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((CommandArguments, [Object])
-> Doc AnsiStyle -> (CommandArguments, [Object])
forall a b. a -> b -> a
const (CommandArguments, [Object])
old) (\Int
n -> (CommandArguments
c { count :: Maybe Int
count = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
n }, [Object]
args')) (Either (Doc AnsiStyle) Int -> (CommandArguments, [Object]))
-> Either (Doc AnsiStyle) Int -> (CommandArguments, [Object])
forall a b. (a -> b) -> a -> b
$ Object -> Either (Doc AnsiStyle) Int
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o

        (CommandOption
CmdBang, Object
o) ->
            (Doc AnsiStyle -> (CommandArguments, [Object]))
-> (Bool -> (CommandArguments, [Object]))
-> Either (Doc AnsiStyle) Bool
-> (CommandArguments, [Object])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((CommandArguments, [Object])
-> Doc AnsiStyle -> (CommandArguments, [Object])
forall a b. a -> b -> a
const (CommandArguments, [Object])
old) (\Bool
b -> (CommandArguments
c { bang :: Maybe Bool
bang = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
b }, [Object]
args')) (Either (Doc AnsiStyle) Bool -> (CommandArguments, [Object]))
-> Either (Doc AnsiStyle) Bool -> (CommandArguments, [Object])
forall a b. (a -> b) -> a -> b
$ Object -> Either (Doc AnsiStyle) Bool
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o

        (CmdNargs String
"*", ObjectArray [Object]
os) ->
            -- CommandArguments -> [String] -> Neovim r st a
            (CommandArguments
c, [Object]
os)
        (CmdNargs String
"+", ObjectArray (Object
o:[Object]
os)) ->
            -- CommandArguments -> String -> [String] -> Neovim r st a
            (CommandArguments
c, Object
o Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [[Object] -> Object
ObjectArray [Object]
os])
        (CmdNargs String
"?", ObjectArray [Object
o]) ->
            -- CommandArguments -> Maybe String -> Neovim r st a
            (CommandArguments
c, [Maybe Object -> Object
forall o. NvimObject o => o -> Object
toObject (Object -> Maybe Object
forall a. a -> Maybe a
Just Object
o)])

        (CmdNargs String
"?", ObjectArray []) ->
            -- CommandArguments -> Maybe String -> Neovim r st a
            (CommandArguments
c, [Maybe Object -> Object
forall o. NvimObject o => o -> Object
toObject (Maybe Object
forall a. Maybe a
Nothing :: Maybe Object)])

        (CmdNargs String
"0", ObjectArray []) ->
            -- CommandArguments -> Neovim r st a
            (CommandArguments
c, [])

        (CmdNargs String
"1", ObjectArray [Object
o]) ->
            -- CommandArguments -> String -> Neovim r st a
            (CommandArguments
c, [Object
o])

        (CommandOption
CmdRegister, Object
o) ->
            (Doc AnsiStyle -> (CommandArguments, [Object]))
-> (String -> (CommandArguments, [Object]))
-> Either (Doc AnsiStyle) String
-> (CommandArguments, [Object])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((CommandArguments, [Object])
-> Doc AnsiStyle -> (CommandArguments, [Object])
forall a b. a -> b -> a
const (CommandArguments, [Object])
old) (\String
r -> (CommandArguments
c { register :: Maybe String
register = String -> Maybe String
forall a. a -> Maybe a
Just String
r }, [Object]
args')) (Either (Doc AnsiStyle) String -> (CommandArguments, [Object]))
-> Either (Doc AnsiStyle) String -> (CommandArguments, [Object])
forall a b. (a -> b) -> a -> b
$ Object -> Either (Doc AnsiStyle) String
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
o

        (CommandOption, Object)
_ -> (CommandArguments, [Object])
old

parseParams (Autocmd ByteString
_ FunctionName
_ Synchronous
_ AutocmdOptions
_) [Object]
args = case [Object]
args of
    [ObjectArray [Object]
fArgs] -> [Object]
fArgs
    [Object]
_ -> [Object]
args