{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Neovim.Plugin (
startPluginThreads,
wrapPlugin,
NeovimPlugin,
Plugin (..),
Synchronous (..),
CommandOption (..),
addAutocmd,
registerPlugin,
registerFunctionality,
getProviderName,
) where
import Neovim.API.String
( nvim_err_writeln, nvim_get_api_info, vim_call_function )
import Neovim.Classes
( (<+>),
Doc,
AnsiStyle,
Pretty(pretty),
NvimObject(toObject, fromObject),
Dictionary,
(+:) )
import Neovim.Context
( MonadIO(liftIO),
NeovimException,
newUniqueFunctionName,
runNeovim,
FunctionMapEntry,
Neovim,
err )
import Neovim.Context.Internal (
FunctionType (..),
runNeovimInternal,
)
import qualified Neovim.Context.Internal as Internal
import Neovim.Plugin.Classes
( HasFunctionName(nvimMethod),
FunctionName(..),
NeovimEventId(NeovimEventId),
Synchronous(..),
CommandOption(..),
CommandOptions(getCommandOptions),
AutocmdOptions(AutocmdOptions),
FunctionalityDescription(..),
NvimMethod(..) )
import Neovim.Plugin.IPC.Classes
( Notification(Notification),
Request(Request),
Message(fromMessage),
SomeMessage,
readSomeMessage )
import Neovim.Plugin.Internal
( NeovimPlugin(..),
Plugin(..),
getDescription,
getFunction,
wrapPlugin )
import Neovim.RPC.FunctionCall ( respond )
import Control.Monad (foldM, void)
import Data.Foldable (forM_)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Either (rights)
import Data.MessagePack ( Object )
import Data.Text (Text)
import Data.Traversable (forM)
import System.Log.Logger ( debugM, errorM )
import UnliftIO.Async (Async, async, race)
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Exception (SomeException, catch, try)
import UnliftIO.STM
( TVar,
putTMVar,
takeTMVar,
tryReadTMVar,
modifyTVar,
TQueue,
atomically,
newTQueueIO,
newTVarIO,
readTVarIO )
import Prelude
logger :: String
logger :: String
logger = String
"Neovim.Plugin"
startPluginThreads ::
Internal.Config () ->
[Neovim () NeovimPlugin] ->
IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
startPluginThreads :: Config ()
-> [Neovim () NeovimPlugin]
-> IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
startPluginThreads Config ()
cfg = forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal forall (m :: * -> *) a. Monad m => a -> m a
return Config ()
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM ([FunctionMapEntry], [Async ()])
-> Neovim () NeovimPlugin
-> Neovim () ([FunctionMapEntry], [Async ()])
go ([], [])
where
go ::
([FunctionMapEntry], [Async ()]) ->
Neovim () NeovimPlugin ->
Neovim () ([FunctionMapEntry], [Async ()])
go :: ([FunctionMapEntry], [Async ()])
-> Neovim () NeovimPlugin
-> Neovim () ([FunctionMapEntry], [Async ()])
go ([FunctionMapEntry]
es, [Async ()]
tids) Neovim () NeovimPlugin
iop = do
NeovimPlugin Plugin env
p <- Neovim () NeovimPlugin
iop
([FunctionMapEntry]
es', Async ()
tid) <- forall env anyEnv.
Plugin env -> Neovim anyEnv ([FunctionMapEntry], Async ())
registerStatefulFunctionality Plugin env
p
forall (m :: * -> *) a. Monad m => a -> m a
return ([FunctionMapEntry]
es forall a. [a] -> [a] -> [a]
++ [FunctionMapEntry]
es', Async ()
tid forall a. a -> [a] -> [a]
: [Async ()]
tids)
registerWithNeovim :: FunctionalityDescription -> Neovim anyEnv Bool
registerWithNeovim :: forall anyEnv. FunctionalityDescription -> Neovim anyEnv Bool
registerWithNeovim = \case
func :: FunctionalityDescription
func@(Function (F Text
functionName) Synchronous
s) -> do
Either String Int
pName <- forall env. Neovim env (Either String Int)
getProviderName
let (String
defineFunction, Object
host) =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\String
n -> (String
"remote#define#FunctionOnHost", forall o. NvimObject o => o -> Object
toObject String
n))
(\Int
c -> (String
"remote#define#FunctionOnChannel", forall o. NvimObject o => o -> Object
toObject Int
c))
Either String Int
pName
reportError :: NeovimException -> Neovim anyEnv Bool
reportError (NeovimException
e :: NeovimException) = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorM String
logger forall a b. (a -> b) -> a -> b
$
String
"Failed to register function: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
functionName forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NeovimException
e
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
logSuccess :: Neovim anyEnv Bool
logSuccess = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger forall a b. (a -> b) -> a -> b
$
String
"Registered function: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
functionName
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch NeovimException -> Neovim anyEnv Bool
reportError forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall env. String -> [Object] -> Neovim env Object
vim_call_function String
defineFunction forall a b. (a -> b) -> a -> b
$
Object
host forall o. NvimObject o => o -> [Object] -> [Object]
+: NvimMethod -> Text
nvimMethodName (forall a. HasFunctionName a => a -> NvimMethod
nvimMethod FunctionalityDescription
func) forall o. NvimObject o => o -> [Object] -> [Object]
+: Synchronous
s forall o. NvimObject o => o -> [Object] -> [Object]
+: Text
functionName forall o. NvimObject o => o -> [Object] -> [Object]
+: (forall k a. Map k a
Map.empty :: Dictionary) forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Neovim anyEnv Bool
logSuccess
cmd :: FunctionalityDescription
cmd@(Command (F Text
functionName) CommandOptions
copts) -> do
let sync :: Synchronous
sync = case CommandOptions -> [CommandOption]
getCommandOptions CommandOptions
copts of
(CmdSync Synchronous
s : [CommandOption]
_) -> Synchronous
s
[CommandOption]
_ -> Synchronous
Sync
Either String Int
pName <- forall env. Neovim env (Either String Int)
getProviderName
let (String
defineFunction, Object
host) =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\String
n -> (String
"remote#define#CommandOnHost", forall o. NvimObject o => o -> Object
toObject String
n))
(\Int
c -> (String
"remote#define#CommandOnChannel", forall o. NvimObject o => o -> Object
toObject Int
c))
Either String Int
pName
reportError :: NeovimException -> Neovim anyEnv Bool
reportError (NeovimException
e :: NeovimException) = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorM String
logger forall a b. (a -> b) -> a -> b
$
String
"Failed to register command: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
functionName forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NeovimException
e
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
logSuccess :: Neovim anyEnv Bool
logSuccess = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger forall a b. (a -> b) -> a -> b
$
String
"Registered command: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
functionName
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch NeovimException -> Neovim anyEnv Bool
reportError forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall env. String -> [Object] -> Neovim env Object
vim_call_function String
defineFunction forall a b. (a -> b) -> a -> b
$
Object
host forall o. NvimObject o => o -> [Object] -> [Object]
+: NvimMethod -> Text
nvimMethodName (forall a. HasFunctionName a => a -> NvimMethod
nvimMethod FunctionalityDescription
cmd) forall o. NvimObject o => o -> [Object] -> [Object]
+: Synchronous
sync forall o. NvimObject o => o -> [Object] -> [Object]
+: Text
functionName forall o. NvimObject o => o -> [Object] -> [Object]
+: CommandOptions
copts forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Neovim anyEnv Bool
logSuccess
Autocmd Text
acmdType (F Text
functionName) Synchronous
sync AutocmdOptions
opts -> do
Either String Int
pName <- forall env. Neovim env (Either String Int)
getProviderName
let (String
defineFunction, Object
host) =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\String
n -> (String
"remote#define#AutocmdOnHost", forall o. NvimObject o => o -> Object
toObject String
n))
(\Int
c -> (String
"remote#define#AutocmdOnChannel", forall o. NvimObject o => o -> Object
toObject Int
c))
Either String Int
pName
reportError :: NeovimException -> Neovim anyEnv Bool
reportError (NeovimException
e :: NeovimException) = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorM String
logger forall a b. (a -> b) -> a -> b
$
String
"Failed to register autocmd: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
functionName forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show NeovimException
e
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
logSuccess :: Neovim anyEnv Bool
logSuccess = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger forall a b. (a -> b) -> a -> b
$
String
"Registered autocmd: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
functionName
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch NeovimException -> Neovim anyEnv Bool
reportError forall a b. (a -> b) -> a -> b
$ do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
forall env. String -> [Object] -> Neovim env Object
vim_call_function String
defineFunction forall a b. (a -> b) -> a -> b
$
Object
host forall o. NvimObject o => o -> [Object] -> [Object]
+: Text
functionName forall o. NvimObject o => o -> [Object] -> [Object]
+: Synchronous
sync forall o. NvimObject o => o -> [Object] -> [Object]
+: Text
acmdType forall o. NvimObject o => o -> [Object] -> [Object]
+: AutocmdOptions
opts forall o. NvimObject o => o -> [Object] -> [Object]
+: []
Neovim anyEnv Bool
logSuccess
getProviderName :: Neovim env (Either String Int)
getProviderName :: forall env. Neovim env (Either String Int)
getProviderName = do
TMVar (Either String Int)
mp <- forall env a. (Config env -> a) -> Neovim env a
Internal.asks' forall env. Config env -> TMVar (Either String Int)
Internal.providerName
(forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TMVar a -> STM (Maybe a)
tryReadTMVar) TMVar (Either String Int)
mp forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Either String Int
p ->
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Int
p
Maybe (Either String Int)
Nothing -> do
[Object]
api <- forall env. Neovim env [Object]
nvim_get_api_info
case [Object]
api of
[] -> forall env a. Doc AnsiStyle -> Neovim env a
err Doc AnsiStyle
"empty nvim_get_api_info"
(Object
i : [Object]
_) -> do
case forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
i :: Either (Doc AnsiStyle) Int of
Left Doc AnsiStyle
_ ->
forall env a. Doc AnsiStyle -> Neovim env a
err forall a b. (a -> b) -> a -> b
$
Doc AnsiStyle
"Expected an integral value as the first"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"argument of nvim_get_api_info"
Right Int
channelId -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either String Int)
mp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channelId
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channelId
registerFunctionality ::
FunctionalityDescription ->
([Object] -> Neovim env Object) ->
Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
registerFunctionality :: forall env.
FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
registerFunctionality FunctionalityDescription
d [Object] -> Neovim env Object
f = do
forall env a. (Config env -> a) -> Neovim env a
Internal.asks' forall env. Config env -> Maybe (PluginSettings env)
Internal.pluginSettings forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe (PluginSettings env)
Nothing -> do
let msg :: String
msg = String
"Cannot register functionality in this context."
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
errorM String
logger String
msg
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a ann. Pretty a => a -> Doc ann
pretty String
msg
Just (Internal.StatefulSettings FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry)
reg TQueue SomeMessage
q TVar (Map NvimMethod ([Object] -> Neovim env Object))
m) ->
FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry)
reg FunctionalityDescription
d [Object] -> Neovim env Object
f TQueue SomeMessage
q TVar (Map NvimMethod ([Object] -> Neovim env Object))
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just FunctionMapEntry
e -> do
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right FunctionMapEntry
e
Maybe FunctionMapEntry
Nothing ->
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left Doc AnsiStyle
""
registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env ()
registerInGlobalFunctionMap :: forall env. FunctionMapEntry -> Neovim env ()
registerInGlobalFunctionMap FunctionMapEntry
e = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger forall a b. (a -> b) -> a -> b
$ String
"Adding function to global function map." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (a, b) -> a
fst FunctionMapEntry
e)
TMVar FunctionMap
funMap <- forall env a. (Config env -> a) -> Neovim env a
Internal.asks' forall env. Config env -> TMVar FunctionMap
Internal.globalFunctionMap
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$ do
FunctionMap
m <- forall a. TMVar a -> STM a
takeTMVar TMVar FunctionMap
funMap
forall a. TMVar a -> a -> STM ()
putTMVar TMVar FunctionMap
funMap forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ((forall a. HasFunctionName a => a -> NvimMethod
nvimMethod forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) FunctionMapEntry
e) FunctionMapEntry
e FunctionMap
m
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger forall a b. (a -> b) -> a -> b
$ String
"Added function to global function map." forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a b. (a, b) -> a
fst FunctionMapEntry
e)
registerPlugin ::
(FunctionMapEntry -> Neovim env ()) ->
FunctionalityDescription ->
([Object] -> Neovim env Object) ->
TQueue SomeMessage ->
TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->
Neovim env (Maybe FunctionMapEntry)
registerPlugin :: forall env.
(FunctionMapEntry -> Neovim env ())
-> FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry)
registerPlugin FunctionMapEntry -> Neovim env ()
reg FunctionalityDescription
d [Object] -> Neovim env Object
f TQueue SomeMessage
q TVar (Map NvimMethod ([Object] -> Neovim env Object))
tm =
forall anyEnv. FunctionalityDescription -> Neovim anyEnv Bool
registerWithNeovim FunctionalityDescription
d forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> do
let n :: NvimMethod
n = forall a. HasFunctionName a => a -> NvimMethod
nvimMethod FunctionalityDescription
d
e :: FunctionMapEntry
e = (FunctionalityDescription
d, TQueue SomeMessage -> FunctionType
Stateful TQueue SomeMessage
q)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map NvimMethod ([Object] -> Neovim env Object))
tm forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert NvimMethod
n [Object] -> Neovim env Object
f
FunctionMapEntry -> Neovim env ()
reg FunctionMapEntry
e
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just FunctionMapEntry
e)
Bool
False ->
forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
addAutocmd ::
Text ->
Synchronous ->
AutocmdOptions ->
Neovim env () ->
Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
addAutocmd :: forall env.
Text
-> Synchronous
-> AutocmdOptions
-> Neovim env ()
-> Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
addAutocmd Text
event Synchronous
s opts :: AutocmdOptions
opts@AutocmdOptions{} Neovim env ()
f = do
FunctionName
n <- forall env. Neovim env FunctionName
newUniqueFunctionName
forall env.
FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
registerFunctionality (Text
-> FunctionName
-> Synchronous
-> AutocmdOptions
-> FunctionalityDescription
Autocmd Text
event FunctionName
n Synchronous
s AutocmdOptions
opts) (\[Object]
_ -> forall o. NvimObject o => o -> Object
toObject forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Neovim env ()
f)
registerStatefulFunctionality ::
Plugin env ->
Neovim anyEnv ([FunctionMapEntry], Async ())
registerStatefulFunctionality :: forall env anyEnv.
Plugin env -> Neovim anyEnv ([FunctionMapEntry], Async ())
registerStatefulFunctionality (Plugin{environment :: forall env. Plugin env -> env
environment = env
env, exports :: forall env. Plugin env -> [ExportedFunctionality env]
exports = [ExportedFunctionality env]
fs}) = do
TQueue SomeMessage
messageQueue <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
TVar (Map NvimMethod ([Object] -> Neovim env Object))
route <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO forall k a. Map k a
Map.empty
TVar [Notification -> Neovim env ()]
subscribers <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO []
Config anyEnv
cfg <- forall env. Neovim env (Config env)
Internal.ask'
let startupConfig :: Config env
startupConfig =
Config anyEnv
cfg
{ customConfig :: env
Internal.customConfig = env
env
, pluginSettings :: Maybe (PluginSettings env)
Internal.pluginSettings =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
forall env.
(FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry))
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> PluginSettings env
Internal.StatefulSettings
(forall env.
(FunctionMapEntry -> Neovim env ())
-> FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry)
registerPlugin (\FunctionMapEntry
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()))
TQueue SomeMessage
messageQueue
TVar (Map NvimMethod ([Object] -> Neovim env Object))
route
}
Either (Doc AnsiStyle) [Either (Doc AnsiStyle) FunctionMapEntry]
res <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal forall (m :: * -> *) a. Monad m => a -> m a
return Config env
startupConfig forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ExportedFunctionality env]
fs forall a b. (a -> b) -> a -> b
$ \ExportedFunctionality env
f ->
forall env.
FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim env (Either (Doc AnsiStyle) FunctionMapEntry)
registerFunctionality (forall env. ExportedFunctionality env -> FunctionalityDescription
getDescription ExportedFunctionality env
f) (forall env.
ExportedFunctionality env -> [Object] -> Neovim env Object
getFunction ExportedFunctionality env
f)
[FunctionMapEntry]
es <- case Either (Doc AnsiStyle) [Either (Doc AnsiStyle) FunctionMapEntry]
res of
Left Doc AnsiStyle
e -> forall env a. Doc AnsiStyle -> Neovim env a
err Doc AnsiStyle
e
Right [Either (Doc AnsiStyle) FunctionMapEntry]
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. [Either a b] -> [b]
rights [Either (Doc AnsiStyle) FunctionMapEntry]
a
let pluginThreadConfig :: Config env
pluginThreadConfig =
Config anyEnv
cfg
{ customConfig :: env
Internal.customConfig = env
env
, pluginSettings :: Maybe (PluginSettings env)
Internal.pluginSettings =
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$
forall env.
(FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry))
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> PluginSettings env
Internal.StatefulSettings
(forall env.
(FunctionMapEntry -> Neovim env ())
-> FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry)
registerPlugin forall env. FunctionMapEntry -> Neovim env ()
registerInGlobalFunctionMap)
TQueue SomeMessage
messageQueue
TVar (Map NvimMethod ([Object] -> Neovim env Object))
route
}
Async ()
tid <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a env.
NFData a =>
Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovim Config env
pluginThreadConfig forall a b. (a -> b) -> a -> b
$ do
forall env.
TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> TVar [Notification -> Neovim env ()]
-> Neovim env ()
listeningThread TQueue SomeMessage
messageQueue TVar (Map NvimMethod ([Object] -> Neovim env Object))
route TVar [Notification -> Neovim env ()]
subscribers
forall (m :: * -> *) a. Monad m => a -> m a
return ([FunctionMapEntry]
es, Async ()
tid)
where
executeFunction ::
([Object] -> Neovim env Object) ->
[Object] ->
Neovim env (Either String Object)
executeFunction :: forall env.
([Object] -> Neovim env Object)
-> [Object] -> Neovim env (Either String Object)
executeFunction [Object] -> Neovim env Object
f [Object]
args =
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try ([Object] -> Neovim env Object
f [Object]
args) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left SomeException
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (SomeException
e :: SomeException)
Right Object
res -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right Object
res
killAfterSeconds :: Word -> Neovim anyEnv ()
killAfterSeconds :: forall anyEnv. Word -> Neovim anyEnv ()
killAfterSeconds Word
seconds = forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
seconds forall a. Num a => a -> a -> a
* Int
1000 forall a. Num a => a -> a -> a
* Int
1000)
timeoutAndLog :: Word -> FunctionName -> Neovim anyEnv String
timeoutAndLog :: forall anyEnv. Word -> FunctionName -> Neovim anyEnv String
timeoutAndLog Word
seconds FunctionName
functionName = do
forall anyEnv. Word -> Neovim anyEnv ()
killAfterSeconds Word
seconds
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$
forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
functionName forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Any
"has been aborted after"
forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty Word
seconds
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Any
"seconds"
listeningThread ::
TQueue SomeMessage ->
TVar (Map NvimMethod ([Object] -> Neovim env Object)) ->
TVar [Notification -> Neovim env ()] ->
Neovim env ()
listeningThread :: forall env.
TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> TVar [Notification -> Neovim env ()]
-> Neovim env ()
listeningThread TQueue SomeMessage
q TVar (Map NvimMethod ([Object] -> Neovim env Object))
route TVar [Notification -> Neovim env ()]
subscribers = do
SomeMessage
msg <- forall (m :: * -> *).
MonadIO m =>
TQueue SomeMessage -> m SomeMessage
readSomeMessage TQueue SomeMessage
q
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall message. Message message => SomeMessage -> Maybe message
fromMessage SomeMessage
msg) forall a b. (a -> b) -> a -> b
$ \req :: Request
req@(Request fun :: FunctionName
fun@(F Text
methodName) Int64
_ [Object]
args) -> do
let method :: NvimMethod
method = Text -> NvimMethod
NvimMethod Text
methodName
Map NvimMethod ([Object] -> Neovim env Object)
route' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Map NvimMethod ([Object] -> Neovim env Object))
route
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NvimMethod
method Map NvimMethod ([Object] -> Neovim env Object)
route') forall a b. (a -> b) -> a -> b
$ \[Object] -> Neovim env Object
f -> do
forall result env.
NvimObject result =>
Request -> Either String result -> Neovim env ()
respond Request
req forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left forall a. a -> a
id
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race
(forall anyEnv. Word -> FunctionName -> Neovim anyEnv String
timeoutAndLog Word
10 FunctionName
fun)
(forall env.
([Object] -> Neovim env Object)
-> [Object] -> Neovim env (Either String Object)
executeFunction [Object] -> Neovim env Object
f [Object]
args)
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall message. Message message => SomeMessage -> Maybe message
fromMessage SomeMessage
msg) forall a b. (a -> b) -> a -> b
$ \notification :: Notification
notification@(Notification (NeovimEventId Text
methodName) [Object]
args) -> do
let method :: NvimMethod
method = Text -> NvimMethod
NvimMethod Text
methodName
Map NvimMethod ([Object] -> Neovim env Object)
route' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Map NvimMethod ([Object] -> Neovim env Object))
route
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NvimMethod
method Map NvimMethod ([Object] -> Neovim env Object)
route') forall a b. (a -> b) -> a -> b
$ \[Object] -> Neovim env Object
f ->
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall a b. (a -> b) -> a -> b
$ do
Either String Object
result <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left forall a. a -> a
id forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race
(forall anyEnv. Word -> FunctionName -> Neovim anyEnv String
timeoutAndLog Word
600 (Text -> FunctionName
F Text
methodName))
(forall env.
([Object] -> Neovim env Object)
-> [Object] -> Neovim env (Either String Object)
executeFunction [Object] -> Neovim env Object
f [Object]
args)
case Either String Object
result of
Left String
message ->
forall env. String -> Neovim env ()
nvim_err_writeln String
message
Right Object
_ ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
[Notification -> Neovim env ()]
subscribers' <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar [Notification -> Neovim env ()]
subscribers
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Notification -> Neovim env ()]
subscribers' forall a b. (a -> b) -> a -> b
$ \Notification -> Neovim env ()
subscriber ->
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race (Notification -> Neovim env ()
subscriber Notification
notification) (forall anyEnv. Word -> Neovim anyEnv ()
killAfterSeconds Word
10)
forall env.
TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> TVar [Notification -> Neovim env ()]
-> Neovim env ()
listeningThread TQueue SomeMessage
q TVar (Map NvimMethod ([Object] -> Neovim env Object))
route TVar [Notification -> Neovim env ()]
subscribers