{-# LANGUAGE GADTs #-}
module Neovim.Plugin (
startPluginThreads,
wrapPlugin,
NeovimPlugin,
Plugin (..),
Synchronous (..),
CommandOption (..),
addAutocmd,
registerPlugin,
registerFunctionality,
getProviderName,
) where
import Neovim.API.String
import Neovim.Classes
import Neovim.Context
import Neovim.Context.Internal (
FunctionType (..),
runNeovimInternal,
)
import qualified Neovim.Context.Internal as Internal
import Neovim.Plugin.Classes hiding (register)
import Neovim.Plugin.IPC.Classes
import Neovim.Plugin.Internal
import Neovim.RPC.FunctionCall
import Control.Applicative
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
import Data.Text (Text)
import Data.Traversable (forM)
import System.Log.Logger
import UnliftIO.Async (Async, async, race)
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Exception (SomeException, catch, try)
import UnliftIO.STM
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
$
String -> [Object] -> forall env. 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
$
String -> [Object] -> forall env. 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
$
String -> [Object] -> forall env. 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 ->
String -> forall env. 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