{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      :  Neovim.Plugin
Description :  Plugin and functionality registration code
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC
-}
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)

{- | Call the vimL functions to define a function, command or autocmd on the
 neovim side. Returns 'True' if registration was successful.

 Note that this does not have any effect on the side of /nvim-hs/.
-}
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
                -- This works because CommandOptions are sorted and CmdSync is
                -- the smallest element in the sorting
                (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

{- | Return or retrive the provider name that the current instance is associated
 with on the neovim side.
-}
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

{- | Register an autocmd in the current context. This means that, if you are
 currently in a stateful plugin, the function will be called in the current
 thread and has access to the configuration and state of this thread. .

 Note that the function you pass must be fully applied.
-}
addAutocmd ::
    -- | The event to register to (e.g. BufWritePost)
    Text ->
    Synchronous ->
    AutocmdOptions ->
    -- | Fully applied function to register
    Neovim env () ->
    -- | A 'ReleaseKey' if the registration worked
    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)

{- | Create a listening thread for events and add update the 'FunctionMap' with
 the corresponding 'TQueue's (i.e. communication channels).
-}
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) -- NB: dropping release functions/keys here
  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