{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE RecordWildCards #-}
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
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
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
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
[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
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
c, [Object]
os)
(CmdNargs String
"+", ObjectArray (Object
o:[Object]
os)) ->
(CommandArguments
c, Object
o Object -> [Object] -> [Object]
forall a. a -> [a] -> [a]
: [[Object] -> Object
ObjectArray [Object]
os])
(CmdNargs String
"?", ObjectArray [Object
o]) ->
(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
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
c, [])
(CmdNargs String
"1", ObjectArray [Object
o]) ->
(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