{-# LANGUAGE GADTs               #-}
{-# LANGUAGE RecordWildCards     #-}
{- |
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,
    ) 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.Internal
import           Neovim.Plugin.IPC.Classes
import           Neovim.RPC.FunctionCall

import           Control.Applicative
import           Control.Monad                (foldM, void)
import           Control.Monad.Trans.Resource hiding (register)
import           Data.ByteString              (ByteString)
import           Data.Foldable                (forM_)
import           Data.Map                     (Map)
import qualified Data.Map                     as Map
import           Data.Maybe                   (catMaybes)
import           Data.MessagePack
import           Data.Traversable             (forM)
import           System.Log.Logger
import           UnliftIO.Async               (Async, async, race)
import           UnliftIO.Concurrent          (threadDelay)
import           UnliftIO.Exception           (SomeException, try, catch)
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 = (([FunctionMapEntry], [Async ()])
 -> IO ([FunctionMapEntry], [Async ()]))
-> Config ()
-> Neovim () ([FunctionMapEntry], [Async ()])
-> IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal ([FunctionMapEntry], [Async ()])
-> IO ([FunctionMapEntry], [Async ()])
forall (m :: * -> *) a. Monad m => a -> m a
return Config ()
cfg (Neovim () ([FunctionMapEntry], [Async ()])
 -> IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()])))
-> ([Neovim () NeovimPlugin]
    -> Neovim () ([FunctionMapEntry], [Async ()]))
-> [Neovim () NeovimPlugin]
-> IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([FunctionMapEntry], [Async ()])
 -> Neovim () NeovimPlugin
 -> Neovim () ([FunctionMapEntry], [Async ()]))
-> ([FunctionMapEntry], [Async ()])
-> [Neovim () NeovimPlugin]
-> Neovim () ([FunctionMapEntry], [Async ()])
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) <- Plugin env -> Neovim () ([FunctionMapEntry], Async ())
forall env anyEnv.
Plugin env -> Neovim anyEnv ([FunctionMapEntry], Async ())
registerStatefulFunctionality Plugin env
p

        ([FunctionMapEntry], [Async ()])
-> Neovim () ([FunctionMapEntry], [Async ()])
forall (m :: * -> *) a. Monad m => a -> m a
return (([FunctionMapEntry], [Async ()])
 -> Neovim () ([FunctionMapEntry], [Async ()]))
-> ([FunctionMapEntry], [Async ()])
-> Neovim () ([FunctionMapEntry], [Async ()])
forall a b. (a -> b) -> a -> b
$ ([FunctionMapEntry]
es [FunctionMapEntry] -> [FunctionMapEntry] -> [FunctionMapEntry]
forall a. [a] -> [a] -> [a]
++ [FunctionMapEntry]
es', Async ()
tidAsync () -> [Async ()] -> [Async ()]
forall a. a -> [a] -> [a]
:[Async ()]
tids)


-- | Callthe 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 :: FunctionalityDescription -> Neovim anyEnv Bool
registerWithNeovim = \case
    func :: FunctionalityDescription
func@(Function (F ByteString
functionName) Synchronous
s) -> do
        Either String Int
pName <- Neovim anyEnv (Either String Int)
forall env. Neovim env (Either String Int)
getProviderName
        let (String
defineFunction, Object
host) = (String -> (String, Object))
-> (Int -> (String, Object))
-> Either String Int
-> (String, Object)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (\String
n -> (String
"remote#define#FunctionOnHost", String -> Object
forall o. NvimObject o => o -> Object
toObject String
n))
                (\Int
c -> (String
"remote#define#FunctionOnChannel", Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
c))
                Either String Int
pName
            reportError :: NeovimException -> Neovim anyEnv Bool
reportError (NeovimException
e :: NeovimException) = do
                IO () -> Neovim anyEnv ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim anyEnv ())
-> (String -> IO ()) -> String -> Neovim anyEnv ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorM String
logger (String -> Neovim anyEnv ()) -> String -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$
                    String
"Failed to register function: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
functionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ NeovimException -> String
forall a. Show a => a -> String
show NeovimException
e
                Bool -> Neovim anyEnv Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            logSuccess :: Neovim anyEnv Bool
logSuccess = do
                IO () -> Neovim anyEnv ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim anyEnv ())
-> (String -> IO ()) -> String -> Neovim anyEnv ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger (String -> Neovim anyEnv ()) -> String -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$
                    String
"Registered function: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
functionName
                Bool -> Neovim anyEnv Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

        (Neovim anyEnv Bool
 -> (NeovimException -> Neovim anyEnv Bool) -> Neovim anyEnv Bool)
-> (NeovimException -> Neovim anyEnv Bool)
-> Neovim anyEnv Bool
-> Neovim anyEnv Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Neovim anyEnv Bool
-> (NeovimException -> Neovim anyEnv Bool) -> Neovim anyEnv Bool
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch NeovimException -> Neovim anyEnv Bool
reportError (Neovim anyEnv Bool -> Neovim anyEnv Bool)
-> Neovim anyEnv Bool -> Neovim anyEnv Bool
forall a b. (a -> b) -> a -> b
$ do
          Neovim anyEnv Object -> Neovim anyEnv ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Neovim anyEnv Object -> Neovim anyEnv ())
-> Neovim anyEnv Object -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$ String -> [Object] -> forall env. Neovim env Object
vim_call_function String
defineFunction ([Object] -> forall env. Neovim env Object)
-> [Object] -> forall env. Neovim env Object
forall a b. (a -> b) -> a -> b
$
            Object
host Object -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: NvimMethod -> ByteString
nvimMethodName (FunctionalityDescription -> NvimMethod
forall a. HasFunctionName a => a -> NvimMethod
nvimMethod FunctionalityDescription
func) ByteString -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: Synchronous
s Synchronous -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: ByteString
functionName ByteString -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: (Map ByteString Object
forall k a. Map k a
Map.empty :: Dictionary) Map ByteString Object -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: []
          Neovim anyEnv Bool
logSuccess

    cmd :: FunctionalityDescription
cmd@(Command (F ByteString
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 <- Neovim anyEnv (Either String Int)
forall env. Neovim env (Either String Int)
getProviderName
        let (String
defineFunction, Object
host) = (String -> (String, Object))
-> (Int -> (String, Object))
-> Either String Int
-> (String, Object)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (\String
n -> (String
"remote#define#CommandOnHost", String -> Object
forall o. NvimObject o => o -> Object
toObject String
n))
                (\Int
c -> (String
"remote#define#CommandOnChannel", Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
c))
                Either String Int
pName
            reportError :: NeovimException -> Neovim anyEnv Bool
reportError (NeovimException
e :: NeovimException) = do
                IO () -> Neovim anyEnv ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim anyEnv ())
-> (String -> IO ()) -> String -> Neovim anyEnv ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorM String
logger (String -> Neovim anyEnv ()) -> String -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$
                    String
"Failed to register command: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
functionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ NeovimException -> String
forall a. Show a => a -> String
show NeovimException
e
                Bool -> Neovim anyEnv Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            logSuccess :: Neovim anyEnv Bool
logSuccess = do
                IO () -> Neovim anyEnv ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim anyEnv ())
-> (String -> IO ()) -> String -> Neovim anyEnv ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger (String -> Neovim anyEnv ()) -> String -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$
                    String
"Registered command: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
functionName
                Bool -> Neovim anyEnv Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        (Neovim anyEnv Bool
 -> (NeovimException -> Neovim anyEnv Bool) -> Neovim anyEnv Bool)
-> (NeovimException -> Neovim anyEnv Bool)
-> Neovim anyEnv Bool
-> Neovim anyEnv Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Neovim anyEnv Bool
-> (NeovimException -> Neovim anyEnv Bool) -> Neovim anyEnv Bool
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch NeovimException -> Neovim anyEnv Bool
reportError (Neovim anyEnv Bool -> Neovim anyEnv Bool)
-> Neovim anyEnv Bool -> Neovim anyEnv Bool
forall a b. (a -> b) -> a -> b
$ do
          Neovim anyEnv Object -> Neovim anyEnv ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Neovim anyEnv Object -> Neovim anyEnv ())
-> Neovim anyEnv Object -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$ String -> [Object] -> forall env. Neovim env Object
vim_call_function String
defineFunction ([Object] -> forall env. Neovim env Object)
-> [Object] -> forall env. Neovim env Object
forall a b. (a -> b) -> a -> b
$
            Object
host Object -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: NvimMethod -> ByteString
nvimMethodName (FunctionalityDescription -> NvimMethod
forall a. HasFunctionName a => a -> NvimMethod
nvimMethod FunctionalityDescription
cmd) ByteString -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: Synchronous
sync Synchronous -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: ByteString
functionName ByteString -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: CommandOptions
copts CommandOptions -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+: []
          Neovim anyEnv Bool
logSuccess

    Autocmd ByteString
acmdType (F ByteString
functionName) Synchronous
sync AutocmdOptions
opts -> do
        Either String Int
pName <- Neovim anyEnv (Either String Int)
forall env. Neovim env (Either String Int)
getProviderName
        let (String
defineFunction, Object
host) = (String -> (String, Object))
-> (Int -> (String, Object))
-> Either String Int
-> (String, Object)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
                (\String
n -> (String
"remote#define#AutocmdOnHost", String -> Object
forall o. NvimObject o => o -> Object
toObject String
n))
                (\Int
c -> (String
"remote#define#AutocmdOnChannel", Int -> Object
forall o. NvimObject o => o -> Object
toObject Int
c))
                Either String Int
pName
            reportError :: NeovimException -> Neovim anyEnv Bool
reportError (NeovimException
e :: NeovimException) = do
                IO () -> Neovim anyEnv ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim anyEnv ())
-> (String -> IO ()) -> String -> Neovim anyEnv ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorM String
logger (String -> Neovim anyEnv ()) -> String -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$
                    String
"Failed to register autocmd: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
functionName String -> String -> String
forall a. [a] -> [a] -> [a]
++ NeovimException -> String
forall a. Show a => a -> String
show NeovimException
e
                Bool -> Neovim anyEnv Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            logSuccess :: Neovim anyEnv Bool
logSuccess = do
                IO () -> Neovim anyEnv ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim anyEnv ())
-> (String -> IO ()) -> String -> Neovim anyEnv ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger (String -> Neovim anyEnv ()) -> String -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$
                    String
"Registered autocmd: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ByteString
functionName
                Bool -> Neovim anyEnv Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        (Neovim anyEnv Bool
 -> (NeovimException -> Neovim anyEnv Bool) -> Neovim anyEnv Bool)
-> (NeovimException -> Neovim anyEnv Bool)
-> Neovim anyEnv Bool
-> Neovim anyEnv Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip Neovim anyEnv Bool
-> (NeovimException -> Neovim anyEnv Bool) -> Neovim anyEnv Bool
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
catch NeovimException -> Neovim anyEnv Bool
reportError (Neovim anyEnv Bool -> Neovim anyEnv Bool)
-> Neovim anyEnv Bool -> Neovim anyEnv Bool
forall a b. (a -> b) -> a -> b
$ do
          Neovim anyEnv Object -> Neovim anyEnv ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Neovim anyEnv Object -> Neovim anyEnv ())
-> Neovim anyEnv Object -> Neovim anyEnv ()
forall a b. (a -> b) -> a -> b
$ String -> [Object] -> forall env. Neovim env Object
vim_call_function String
defineFunction ([Object] -> forall env. Neovim env Object)
-> [Object] -> forall env. Neovim env Object
forall a b. (a -> b) -> a -> b
$
            Object
host Object -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+:  ByteString
functionName ByteString -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+:  Synchronous
sync  Synchronous -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+:  ByteString
acmdType  ByteString -> [Object] -> [Object]
forall o. NvimObject o => o -> [Object] -> [Object]
+:  AutocmdOptions
opts AutocmdOptions -> [Object] -> [Object]
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 :: Neovim env (Either String Int)
getProviderName = do
    TMVar (Either String Int)
mp <- (Config env -> TMVar (Either String Int))
-> Neovim env (TMVar (Either String Int))
forall env a. (Config env -> a) -> Neovim env a
Internal.asks' Config env -> TMVar (Either String Int)
forall env. Config env -> TMVar (Either String Int)
Internal.providerName
    (IO (Maybe (Either String Int))
-> Neovim env (Maybe (Either String Int))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Either String Int))
 -> Neovim env (Maybe (Either String Int)))
-> (TMVar (Either String Int) -> IO (Maybe (Either String Int)))
-> TMVar (Either String Int)
-> Neovim env (Maybe (Either String Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM (Maybe (Either String Int)) -> IO (Maybe (Either String Int))
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM (Maybe (Either String Int)) -> IO (Maybe (Either String Int)))
-> (TMVar (Either String Int) -> STM (Maybe (Either String Int)))
-> TMVar (Either String Int)
-> IO (Maybe (Either String Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar (Either String Int) -> STM (Maybe (Either String Int))
forall a. TMVar a -> STM (Maybe a)
tryReadTMVar) TMVar (Either String Int)
mp Neovim env (Maybe (Either String Int))
-> (Maybe (Either String Int) -> Neovim env (Either String Int))
-> Neovim env (Either String Int)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Either String Int
p ->
            Either String Int -> Neovim env (Either String Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Either String Int
p

        Maybe (Either String Int)
Nothing -> do
            [Object]
api <- Neovim env [Object]
forall env. Neovim env [Object]
nvim_get_api_info
            case [Object]
api of
                [] -> Doc AnsiStyle -> Neovim env (Either String Int)
forall env a. Doc AnsiStyle -> Neovim env a
err Doc AnsiStyle
"empty nvim_get_api_info"
                (Object
i:[Object]
_) -> do
                    case Object -> Either (Doc AnsiStyle) Int
forall o. NvimObject o => Object -> Either (Doc AnsiStyle) o
fromObject Object
i :: Either (Doc AnsiStyle) Int of
                      Left Doc AnsiStyle
_ ->
                          Doc AnsiStyle -> Neovim env (Either String Int)
forall env a. Doc AnsiStyle -> Neovim env a
err (Doc AnsiStyle -> Neovim env (Either String Int))
-> Doc AnsiStyle -> Neovim env (Either String Int)
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Expected an integral value as the first"
                               Doc AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"argument of nvim_get_api_info"
                      Right Int
channelId -> do
                          IO () -> Neovim env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim env ()) -> (Int -> IO ()) -> Int -> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> (Int -> STM ()) -> Int -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TMVar (Either String Int) -> Either String Int -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar (Either String Int)
mp (Either String Int -> STM ())
-> (Int -> Either String Int) -> Int -> STM ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String Int
forall a b. b -> Either a b
Right (Int -> Neovim env ()) -> Int -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channelId
                          Either String Int -> Neovim env (Either String Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Int -> Neovim env (Either String Int))
-> (Int -> Either String Int)
-> Int
-> Neovim env (Either String Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Either String Int
forall a b. b -> Either a b
Right (Int -> Neovim env (Either String Int))
-> Int -> Neovim env (Either String Int)
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
channelId


registerFunctionality :: FunctionalityDescription
                      -> ([Object] -> Neovim env Object)
                      -> Neovim env (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
registerFunctionality :: FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
registerFunctionality FunctionalityDescription
d [Object] -> Neovim env Object
f = (Config env -> Maybe (PluginSettings env))
-> Neovim env (Maybe (PluginSettings env))
forall env a. (Config env -> a) -> Neovim env a
Internal.asks' Config env -> Maybe (PluginSettings env)
forall env. Config env -> Maybe (PluginSettings env)
Internal.pluginSettings Neovim env (Maybe (PluginSettings env))
-> (Maybe (PluginSettings env)
    -> Neovim
         env
         (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)))
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (PluginSettings env)
Nothing -> do
        IO () -> Neovim env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim env ()) -> IO () -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
errorM String
logger String
"Cannot register functionality in this context."
        Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
forall a. Maybe a
Nothing

    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 Neovim env (Maybe FunctionMapEntry)
-> (Maybe FunctionMapEntry
    -> Neovim
         env
         (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)))
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just FunctionMapEntry
e -> do
                -- Redefine fields so that it gains a new type
                Config ()
cfg <- () -> Config env -> Config ()
forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig () (Config env -> Config ())
-> Neovim env (Config env) -> Neovim env (Config ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Neovim env (Config env)
forall env. Neovim env (Config env)
Internal.ask'
                ReleaseKey
rk <- (ReleaseKey, ()) -> ReleaseKey
forall a b. (a, b) -> a
fst ((ReleaseKey, ()) -> ReleaseKey)
-> Neovim env (ReleaseKey, ()) -> Neovim env ReleaseKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> (() -> IO ()) -> Neovim env (ReleaseKey, ())
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Config () -> FunctionalityDescription -> () -> IO ()
free Config ()
cfg (FunctionMapEntry -> FunctionalityDescription
forall a b. (a, b) -> a
fst FunctionMapEntry
e))
                Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
 -> Neovim
      env
      (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)))
-> Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
forall a b. (a -> b) -> a -> b
$ (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
-> Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
forall a. a -> Maybe a
Just (FunctionMapEntry
e, ReleaseKey -> Either (Neovim anyEnv ()) ReleaseKey
forall a b. b -> Either a b
Right ReleaseKey
rk)

            Maybe FunctionMapEntry
Nothing ->
                Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
forall a. Maybe a
Nothing

  where
    freeFun :: FunctionalityDescription -> Neovim () ()
freeFun = \case
        Autocmd ByteString
_ FunctionName
_ Synchronous
_ AutocmdOptions{} -> do
            IO () -> Neovim () ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim () ()) -> IO () -> Neovim () ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
warningM String
logger String
"Free not implemented for autocmds."

        Command{} ->
            IO () -> Neovim () ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim () ()) -> IO () -> Neovim () ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
warningM String
logger String
"Free not implemented for commands."

        Function{} ->
            IO () -> Neovim () ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim () ()) -> IO () -> Neovim () ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
warningM String
logger String
"Free not implemented for functions."


    free :: Config () -> FunctionalityDescription -> () -> IO ()
free Config ()
cfg FunctionalityDescription
fd ()
_ = IO (Either (Doc AnsiStyle) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (Doc AnsiStyle) ()) -> IO ())
-> (Neovim () () -> IO (Either (Doc AnsiStyle) ()))
-> Neovim () ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (() -> IO ())
-> Config () -> Neovim () () -> IO (Either (Doc AnsiStyle) ())
forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return Config ()
cfg (Neovim () () -> IO ()) -> Neovim () () -> IO ()
forall a b. (a -> b) -> a -> b
$ FunctionalityDescription -> Neovim () ()
freeFun FunctionalityDescription
fd


registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env ()
registerInGlobalFunctionMap :: FunctionMapEntry -> Neovim env ()
registerInGlobalFunctionMap FunctionMapEntry
e = do
    IO () -> Neovim env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim env ())
-> (String -> IO ()) -> String -> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger (String -> Neovim env ()) -> String -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ String
"Adding function to global function map." String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionalityDescription -> String
forall a. Show a => a -> String
show (FunctionMapEntry -> FunctionalityDescription
forall a b. (a, b) -> a
fst FunctionMapEntry
e)
    TMVar FunctionMap
funMap <- (Config env -> TMVar FunctionMap) -> Neovim env (TMVar FunctionMap)
forall env a. (Config env -> a) -> Neovim env a
Internal.asks' Config env -> TMVar FunctionMap
forall env. Config env -> TMVar FunctionMap
Internal.globalFunctionMap
    IO () -> Neovim env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim env ())
-> (STM () -> IO ()) -> STM () -> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> Neovim env ()) -> STM () -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ do
        FunctionMap
m <- TMVar FunctionMap -> STM FunctionMap
forall a. TMVar a -> STM a
takeTMVar TMVar FunctionMap
funMap
        TMVar FunctionMap -> FunctionMap -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar TMVar FunctionMap
funMap (FunctionMap -> STM ()) -> FunctionMap -> STM ()
forall a b. (a -> b) -> a -> b
$ NvimMethod -> FunctionMapEntry -> FunctionMap -> FunctionMap
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert ((FunctionalityDescription -> NvimMethod
forall a. HasFunctionName a => a -> NvimMethod
nvimMethod (FunctionalityDescription -> NvimMethod)
-> (FunctionMapEntry -> FunctionalityDescription)
-> FunctionMapEntry
-> NvimMethod
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunctionMapEntry -> FunctionalityDescription
forall a b. (a, b) -> a
fst) FunctionMapEntry
e) FunctionMapEntry
e FunctionMap
m
    IO () -> Neovim env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim env ())
-> (String -> IO ()) -> String -> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
debugM String
logger (String -> Neovim env ()) -> String -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ String
"Added function to global function map." String -> String -> String
forall a. [a] -> [a] -> [a]
++ FunctionalityDescription -> String
forall a. Show a => a -> String
show (FunctionMapEntry -> FunctionalityDescription
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 :: (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 = FunctionalityDescription -> Neovim env Bool
forall anyEnv. FunctionalityDescription -> Neovim anyEnv Bool
registerWithNeovim FunctionalityDescription
d Neovim env Bool
-> (Bool -> Neovim env (Maybe FunctionMapEntry))
-> Neovim env (Maybe FunctionMapEntry)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> do
        let n :: NvimMethod
n = FunctionalityDescription -> NvimMethod
forall a. HasFunctionName a => a -> NvimMethod
nvimMethod FunctionalityDescription
d
            e :: FunctionMapEntry
e = (FunctionalityDescription
d, TQueue SomeMessage -> FunctionType
Stateful TQueue SomeMessage
q)
        IO () -> Neovim env ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Neovim env ())
-> ((Map NvimMethod ([Object] -> Neovim env Object)
     -> Map NvimMethod ([Object] -> Neovim env Object))
    -> IO ())
-> (Map NvimMethod ([Object] -> Neovim env Object)
    -> Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ())
-> ((Map NvimMethod ([Object] -> Neovim env Object)
     -> Map NvimMethod ([Object] -> Neovim env Object))
    -> STM ())
-> (Map NvimMethod ([Object] -> Neovim env Object)
    -> Map NvimMethod ([Object] -> Neovim env Object))
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> (Map NvimMethod ([Object] -> Neovim env Object)
    -> Map NvimMethod ([Object] -> Neovim env Object))
-> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Map NvimMethod ([Object] -> Neovim env Object))
tm ((Map NvimMethod ([Object] -> Neovim env Object)
  -> Map NvimMethod ([Object] -> Neovim env Object))
 -> Neovim env ())
-> (Map NvimMethod ([Object] -> Neovim env Object)
    -> Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env ()
forall a b. (a -> b) -> a -> b
$ NvimMethod
-> ([Object] -> Neovim env Object)
-> Map NvimMethod ([Object] -> Neovim env Object)
-> Map NvimMethod ([Object] -> Neovim env Object)
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
        Maybe FunctionMapEntry -> Neovim env (Maybe FunctionMapEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return (FunctionMapEntry -> Maybe FunctionMapEntry
forall a. a -> Maybe a
Just FunctionMapEntry
e)

    Bool
False ->
        Maybe FunctionMapEntry -> Neovim env (Maybe FunctionMapEntry)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe FunctionMapEntry
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 :: ByteString
           -- ^ The event to register to (e.g. BufWritePost)
           -> Synchronous
           -> AutocmdOptions
           -> (Neovim env ())
           -- ^ Fully applied function to register
           -> Neovim env (Maybe (Either (Neovim anyEnv ()) ReleaseKey))
           -- ^ A 'ReleaseKey' if the registration worked
addAutocmd :: ByteString
-> Synchronous
-> AutocmdOptions
-> Neovim env ()
-> Neovim env (Maybe (Either (Neovim anyEnv ()) ReleaseKey))
addAutocmd ByteString
event Synchronous
s (opts :: AutocmdOptions
opts@AutocmdOptions{}) Neovim env ()
f = do
    FunctionName
n <- Neovim env FunctionName
forall env. Neovim env FunctionName
newUniqueFunctionName
    ((FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
 -> Either (Neovim anyEnv ()) ReleaseKey)
-> Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
-> Maybe (Either (Neovim anyEnv ()) ReleaseKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
-> Either (Neovim anyEnv ()) ReleaseKey
forall a b. (a, b) -> b
snd (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey)
 -> Maybe (Either (Neovim anyEnv ()) ReleaseKey))
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
-> Neovim env (Maybe (Either (Neovim anyEnv ()) ReleaseKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
forall env anyEnv.
FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
registerFunctionality (ByteString
-> FunctionName
-> Synchronous
-> AutocmdOptions
-> FunctionalityDescription
Autocmd ByteString
event FunctionName
n Synchronous
s AutocmdOptions
opts) (\[Object]
_ -> () -> Object
forall o. NvimObject o => o -> Object
toObject (() -> Object) -> Neovim env () -> Neovim env Object
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 :: 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 <- IO (TQueue SomeMessage) -> Neovim anyEnv (TQueue SomeMessage)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (TQueue SomeMessage)
forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
    TVar (Map NvimMethod ([Object] -> Neovim env Object))
route <- IO (TVar (Map NvimMethod ([Object] -> Neovim env Object)))
-> Neovim
     anyEnv (TVar (Map NvimMethod ([Object] -> Neovim env Object)))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TVar (Map NvimMethod ([Object] -> Neovim env Object)))
 -> Neovim
      anyEnv (TVar (Map NvimMethod ([Object] -> Neovim env Object))))
-> IO (TVar (Map NvimMethod ([Object] -> Neovim env Object)))
-> Neovim
     anyEnv (TVar (Map NvimMethod ([Object] -> Neovim env Object)))
forall a b. (a -> b) -> a -> b
$ Map NvimMethod ([Object] -> Neovim env Object)
-> IO (TVar (Map NvimMethod ([Object] -> Neovim env Object)))
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Map NvimMethod ([Object] -> Neovim env Object)
forall k a. Map k a
Map.empty

    Config anyEnv
cfg <- Neovim anyEnv (Config anyEnv)
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 = PluginSettings env -> Maybe (PluginSettings env)
forall a. a -> Maybe a
Just (PluginSettings env -> Maybe (PluginSettings env))
-> PluginSettings env -> Maybe (PluginSettings env)
forall a b. (a -> b) -> a -> b
$ (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
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
                ((FunctionMapEntry -> Neovim env ())
-> FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry)
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 ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())) TQueue SomeMessage
messageQueue TVar (Map NvimMethod ([Object] -> Neovim env Object))
route
            }
    Either
  (Doc AnsiStyle)
  [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
res <- IO
  (Either
     (Doc AnsiStyle)
     [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
-> Neovim
     anyEnv
     (Either
        (Doc AnsiStyle)
        [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Either
      (Doc AnsiStyle)
      [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
 -> Neovim
      anyEnv
      (Either
         (Doc AnsiStyle)
         [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]))
-> ((ExportedFunctionality env
     -> Neovim
          env (Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)))
    -> IO
         (Either
            (Doc AnsiStyle)
            [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]))
-> (ExportedFunctionality env
    -> Neovim
         env (Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)))
-> Neovim
     anyEnv
     (Either
        (Doc AnsiStyle)
        [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
 -> IO
      [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
-> Config env
-> Neovim
     env [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
-> IO
     (Either
        (Doc AnsiStyle)
        [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
-> IO [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
forall (m :: * -> *) a. Monad m => a -> m a
return Config env
startupConfig (Neovim
   env [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
 -> IO
      (Either
         (Doc AnsiStyle)
         [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]))
-> ((ExportedFunctionality env
     -> Neovim
          env (Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)))
    -> Neovim
         env [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
-> (ExportedFunctionality env
    -> Neovim
         env (Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)))
-> IO
     (Either
        (Doc AnsiStyle)
        [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ExportedFunctionality env]
-> (ExportedFunctionality env
    -> Neovim
         env (Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)))
-> Neovim
     env [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ExportedFunctionality env]
fs ((ExportedFunctionality env
  -> Neovim
       env (Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)))
 -> Neovim
      anyEnv
      (Either
         (Doc AnsiStyle)
         [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]))
-> (ExportedFunctionality env
    -> Neovim
         env (Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)))
-> Neovim
     anyEnv
     (Either
        (Doc AnsiStyle)
        [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
forall a b. (a -> b) -> a -> b
$ \ExportedFunctionality env
f ->
            FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim
     env (Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey))
forall env anyEnv.
FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
registerFunctionality (ExportedFunctionality env -> FunctionalityDescription
forall env. ExportedFunctionality env -> FunctionalityDescription
getDescription ExportedFunctionality env
f) (ExportedFunctionality env -> [Object] -> Neovim env Object
forall env.
ExportedFunctionality env -> [Object] -> Neovim env Object
getFunction ExportedFunctionality env
f)
    [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
es <- case Either
  (Doc AnsiStyle)
  [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
res of
        Left Doc AnsiStyle
e  -> Doc AnsiStyle
-> Neovim
     anyEnv [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
forall env a. Doc AnsiStyle -> Neovim env a
err Doc AnsiStyle
e
        Right [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
a -> [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
-> Neovim
     anyEnv [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
 -> Neovim
      anyEnv [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)])
-> [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
-> Neovim
     anyEnv [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
forall a b. (a -> b) -> a -> b
$ [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
-> [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
a

    let pluginThreadConfig :: Config env
pluginThreadConfig = Config anyEnv
cfg
            { customConfig :: env
Internal.customConfig = env
env
            , pluginSettings :: Maybe (PluginSettings env)
Internal.pluginSettings = PluginSettings env -> Maybe (PluginSettings env)
forall a. a -> Maybe a
Just (PluginSettings env -> Maybe (PluginSettings env))
-> PluginSettings env -> Maybe (PluginSettings env)
forall a b. (a -> b) -> a -> b
$ (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
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
                ((FunctionMapEntry -> Neovim env ())
-> FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Maybe FunctionMapEntry)
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 ()
forall env. FunctionMapEntry -> Neovim env ()
registerInGlobalFunctionMap) TQueue SomeMessage
messageQueue TVar (Map NvimMethod ([Object] -> Neovim env Object))
route
            }

    Async ()
tid <- IO (Async ()) -> Neovim anyEnv (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Async ()) -> Neovim anyEnv (Async ()))
-> (Neovim env () -> IO (Async ()))
-> Neovim env ()
-> Neovim anyEnv (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ()))
-> (Neovim env () -> IO ()) -> Neovim env () -> IO (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (Doc AnsiStyle) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (Doc AnsiStyle) ()) -> IO ())
-> (Neovim env () -> IO (Either (Doc AnsiStyle) ()))
-> Neovim env ()
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config env -> Neovim env () -> IO (Either (Doc AnsiStyle) ())
forall a env.
NFData a =>
Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovim Config env
pluginThreadConfig (Neovim env () -> Neovim anyEnv (Async ()))
-> Neovim env () -> Neovim anyEnv (Async ())
forall a b. (a -> b) -> a -> b
$ do
                TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env ()
forall env.
TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env ()
listeningThread TQueue SomeMessage
messageQueue TVar (Map NvimMethod ([Object] -> Neovim env Object))
route

    ([FunctionMapEntry], Async ())
-> Neovim anyEnv ([FunctionMapEntry], Async ())
forall (m :: * -> *) a. Monad m => a -> m a
return (((FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)
 -> FunctionMapEntry)
-> [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
-> [FunctionMapEntry]
forall a b. (a -> b) -> [a] -> [b]
map (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)
-> FunctionMapEntry
forall a b. (a, b) -> a
fst [(FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
es, Async ()
tid) -- NB: dropping release functions/keys here


  where
    executeFunction
        :: ([Object] -> Neovim env Object)
        -> [Object]
        -> Neovim env (Either String Object)
    executeFunction :: ([Object] -> Neovim env Object)
-> [Object] -> Neovim env (Either String Object)
executeFunction [Object] -> Neovim env Object
f [Object]
args = Neovim env Object -> Neovim env (Either SomeException Object)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try ([Object] -> Neovim env Object
f [Object]
args) Neovim env (Either SomeException Object)
-> (Either SomeException Object
    -> Neovim env (Either String Object))
-> Neovim env (Either String Object)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Left SomeException
e -> Either String Object -> Neovim env (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> Neovim env (Either String Object))
-> (String -> Either String Object)
-> String
-> Neovim env (Either String Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Object
forall a b. a -> Either a b
Left (String -> Neovim env (Either String Object))
-> String -> Neovim env (Either String Object)
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show (SomeException
e :: SomeException)
            Right Object
res -> Either String Object -> Neovim env (Either String Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Object -> Neovim env (Either String Object))
-> Either String Object -> Neovim env (Either String Object)
forall a b. (a -> b) -> a -> b
$ Object -> Either String Object
forall a b. b -> Either a b
Right Object
res

    timeoutAndLog :: Word ->  FunctionName -> Neovim anyEnv String
    timeoutAndLog :: Word -> FunctionName -> Neovim anyEnv String
timeoutAndLog Word
seconds FunctionName
functionName = do
        Int -> Neovim anyEnv ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
seconds Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
        String -> Neovim anyEnv String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Neovim anyEnv String)
-> (Doc Any -> String) -> Doc Any -> Neovim anyEnv String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any -> String
forall a. Show a => a -> String
show (Doc Any -> Neovim anyEnv String)
-> Doc Any -> Neovim anyEnv String
forall a b. (a -> b) -> a -> b
$
            FunctionName -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty FunctionName
functionName Doc Any -> Doc Any -> Doc Any
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Any
"has been aborted after"
            Doc Any -> Doc Any -> Doc Any
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Word -> Doc Any
forall a ann. Pretty a => a -> Doc ann
pretty Word
seconds Doc Any -> Doc Any -> Doc Any
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc Any
"seconds"


    listeningThread :: TQueue SomeMessage
                    -> TVar (Map NvimMethod ([Object] -> Neovim env Object))
                    -> Neovim env ()
    listeningThread :: TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env ()
listeningThread TQueue SomeMessage
q TVar (Map NvimMethod ([Object] -> Neovim env Object))
route = do
        SomeMessage
msg <- TQueue SomeMessage -> Neovim env SomeMessage
forall (m :: * -> *).
MonadIO m =>
TQueue SomeMessage -> m SomeMessage
readSomeMessage TQueue SomeMessage
q

        Maybe Request -> (Request -> Neovim env ()) -> Neovim env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (SomeMessage -> Maybe Request
forall message. Message message => SomeMessage -> Maybe message
fromMessage SomeMessage
msg) ((Request -> Neovim env ()) -> Neovim env ())
-> (Request -> Neovim env ()) -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ \req :: Request
req@(Request fun :: FunctionName
fun@(F ByteString
methodName) Int64
_ [Object]
args) -> do
            let method :: NvimMethod
method = ByteString -> NvimMethod
NvimMethod ByteString
methodName
            Map NvimMethod ([Object] -> Neovim env Object)
route' <- IO (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Map NvimMethod ([Object] -> Neovim env Object))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map NvimMethod ([Object] -> Neovim env Object))
 -> Neovim env (Map NvimMethod ([Object] -> Neovim env Object)))
-> IO (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Map NvimMethod ([Object] -> Neovim env Object))
forall a b. (a -> b) -> a -> b
$ TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> IO (Map NvimMethod ([Object] -> Neovim env Object))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Map NvimMethod ([Object] -> Neovim env Object))
route
            Maybe ([Object] -> Neovim env Object)
-> (([Object] -> Neovim env Object) -> Neovim env ())
-> Neovim env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (NvimMethod
-> Map NvimMethod ([Object] -> Neovim env Object)
-> Maybe ([Object] -> Neovim env Object)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NvimMethod
method Map NvimMethod ([Object] -> Neovim env Object)
route') ((([Object] -> Neovim env Object) -> Neovim env ())
 -> Neovim env ())
-> (([Object] -> Neovim env Object) -> Neovim env ())
-> Neovim env ()
forall a b. (a -> b) -> a -> b
$ \[Object] -> Neovim env Object
f -> do
                Request -> Either String Object -> Neovim env ()
forall result env.
NvimObject result =>
Request -> Either String result -> Neovim env ()
respond Request
req (Either String Object -> Neovim env ())
-> (Either String (Either String Object) -> Either String Object)
-> Either String (Either String Object)
-> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Either String Object)
-> (Either String Object -> Either String Object)
-> Either String (Either String Object)
-> Either String Object
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String Object
forall a b. a -> Either a b
Left Either String Object -> Either String Object
forall a. a -> a
id (Either String (Either String Object) -> Neovim env ())
-> Neovim env (Either String (Either String Object))
-> Neovim env ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Neovim env String
-> Neovim env (Either String Object)
-> Neovim env (Either String (Either String Object))
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race
                    (Word -> FunctionName -> Neovim env String
forall anyEnv. Word -> FunctionName -> Neovim anyEnv String
timeoutAndLog Word
10 FunctionName
fun)
                    (([Object] -> Neovim env Object)
-> [Object] -> Neovim env (Either String Object)
forall env.
([Object] -> Neovim env Object)
-> [Object] -> Neovim env (Either String Object)
executeFunction [Object] -> Neovim env Object
f [Object]
args)

        Maybe Notification
-> (Notification -> Neovim env ()) -> Neovim env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (SomeMessage -> Maybe Notification
forall message. Message message => SomeMessage -> Maybe message
fromMessage SomeMessage
msg) ((Notification -> Neovim env ()) -> Neovim env ())
-> (Notification -> Neovim env ()) -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ \(Notification fun :: FunctionName
fun@(F ByteString
methodName) [Object]
args) -> do
            let method :: NvimMethod
method = ByteString -> NvimMethod
NvimMethod ByteString
methodName
            Map NvimMethod ([Object] -> Neovim env Object)
route' <- IO (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Map NvimMethod ([Object] -> Neovim env Object))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Map NvimMethod ([Object] -> Neovim env Object))
 -> Neovim env (Map NvimMethod ([Object] -> Neovim env Object)))
-> IO (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env (Map NvimMethod ([Object] -> Neovim env Object))
forall a b. (a -> b) -> a -> b
$ TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> IO (Map NvimMethod ([Object] -> Neovim env Object))
forall (m :: * -> *) a. MonadIO m => TVar a -> m a
readTVarIO TVar (Map NvimMethod ([Object] -> Neovim env Object))
route
            Maybe ([Object] -> Neovim env Object)
-> (([Object] -> Neovim env Object) -> Neovim env ())
-> Neovim env ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (NvimMethod
-> Map NvimMethod ([Object] -> Neovim env Object)
-> Maybe ([Object] -> Neovim env Object)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup NvimMethod
method Map NvimMethod ([Object] -> Neovim env Object)
route') ((([Object] -> Neovim env Object) -> Neovim env ())
 -> Neovim env ())
-> (([Object] -> Neovim env Object) -> Neovim env ())
-> Neovim env ()
forall a b. (a -> b) -> a -> b
$ \[Object] -> Neovim env Object
f ->
                Neovim env (Async ()) -> Neovim env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Neovim env (Async ()) -> Neovim env ())
-> (Neovim env () -> Neovim env (Async ()))
-> Neovim env ()
-> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Neovim env () -> Neovim env (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (Neovim env () -> Neovim env ()) -> Neovim env () -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ do
                    Either String Object
result <- (String -> Either String Object)
-> (Either String Object -> Either String Object)
-> Either String (Either String Object)
-> Either String Object
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Either String Object
forall a b. a -> Either a b
Left Either String Object -> Either String Object
forall a. a -> a
id (Either String (Either String Object) -> Either String Object)
-> Neovim env (Either String (Either String Object))
-> Neovim env (Either String Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Neovim env String
-> Neovim env (Either String Object)
-> Neovim env (Either String (Either String Object))
forall (m :: * -> *) a b.
MonadUnliftIO m =>
m a -> m b -> m (Either a b)
race
                        (Word -> FunctionName -> Neovim env String
forall anyEnv. Word -> FunctionName -> Neovim anyEnv String
timeoutAndLog Word
600 FunctionName
fun)
                        (([Object] -> Neovim env Object)
-> [Object] -> Neovim env (Either String Object)
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
_ ->
                          () -> Neovim env ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()


        TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env ()
forall env.
TQueue SomeMessage
-> TVar (Map NvimMethod ([Object] -> Neovim env Object))
-> Neovim env ()
listeningThread TQueue SomeMessage
q TVar (Map NvimMethod ([Object] -> Neovim env Object))
route