{-# LANGUAGE GADTs #-}

{- |
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
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)

{- | 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
$
                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
                -- 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
$
                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

{- | 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 ->
                          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