{-# 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 = 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 forall a b. (a -> b) -> a -> b
$ ([FunctionMapEntry]
es forall a. [a] -> [a] -> [a]
++ [FunctionMapEntry]
es', Async ()
tidforall 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 :: forall anyEnv. FunctionalityDescription -> Neovim anyEnv Bool
registerWithNeovim = \case
    func :: FunctionalityDescription
func@(Function (F ByteString
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 ByteString
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 ByteString
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 -> ByteString
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]
+: ByteString
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 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 <- 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 ByteString
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 ByteString
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 -> ByteString
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]
+: ByteString
functionName forall o. NvimObject o => o -> [Object] -> [Object]
+: CommandOptions
copts 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 <- 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 ByteString
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 ByteString
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]
+:  ByteString
functionName forall o. NvimObject o => o -> [Object] -> [Object]
+:  Synchronous
sync  forall o. NvimObject o => o -> [Object] -> [Object]
+:  ByteString
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 (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
registerFunctionality :: forall env anyEnv.
FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
registerFunctionality FunctionalityDescription
d [Object] -> Neovim env Object
f = 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
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
errorM String
logger String
"Cannot register functionality in this context."
        forall (m :: * -> *) a. Monad m => a -> m a
return 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 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 <- forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig () forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall env. Neovim env (Config env)
Internal.ask'
                ReleaseKey
rk <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (forall (m :: * -> *) a. Monad m => a -> m a
return ()) (Config () -> FunctionalityDescription -> () -> IO ()
free Config ()
cfg (forall a b. (a, b) -> a
fst FunctionMapEntry
e))
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just (FunctionMapEntry
e, forall a b. b -> Either a b
Right ReleaseKey
rk)

            Maybe FunctionMapEntry
Nothing ->
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

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

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

        Function{} ->
            forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 ()
_ = forall (f :: * -> *) a. Functor f => f a -> f ()
void 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 ()
cfg forall a b. (a -> b) -> a -> b
$ FunctionalityDescription -> Neovim () ()
freeFun FunctionalityDescription
fd


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 :: 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 :: forall env anyEnv.
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 <- forall env. Neovim env FunctionName
newUniqueFunctionName
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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]
_ -> 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

    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)
  [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
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 anyEnv.
FunctionalityDescription
-> ([Object] -> Neovim env Object)
-> Neovim
     env
     (Maybe (FunctionMapEntry, Either (Neovim anyEnv ()) ReleaseKey))
registerFunctionality (forall env. ExportedFunctionality env -> FunctionalityDescription
getDescription ExportedFunctionality env
f) (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  -> forall env a. Doc AnsiStyle -> Neovim env a
err Doc AnsiStyle
e
        Right [Maybe (FunctionMapEntry, Either (Neovim Any ()) ReleaseKey)]
a -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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 = 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))
-> Neovim env ()
listeningThread TQueue SomeMessage
messageQueue TVar (Map NvimMethod ([Object] -> Neovim env Object))
route

    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map 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 :: 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

    timeoutAndLog :: Word ->  FunctionName -> Neovim anyEnv String
    timeoutAndLog :: forall anyEnv. Word -> FunctionName -> Neovim anyEnv String
timeoutAndLog Word
seconds FunctionName
functionName = do
        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)
        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))
                    -> Neovim env ()
    listeningThread :: 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 = 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 ByteString
methodName) Int64
_ [Object]
args) -> do
            let method :: NvimMethod
method = ByteString -> NvimMethod
NvimMethod ByteString
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 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' <- 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 FunctionName
fun)
                        (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 ()


        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