{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

{- |
Module      :  Neovim.Context.Internal
Description :  Abstract description of the plugin provider's internal context
Copyright   :  (c) Sebastian Witte
License     :  Apache-2.0

Maintainer  :  woozletoff@gmail.com
Stability   :  experimental
Portability :  GHC

To shorten function and data type names, import this qualfied as @Internal@.
-}
module Neovim.Context.Internal where

import Neovim.Classes (
    AnsiStyle,
    Doc,
    NFData,
    Pretty (pretty),
 )
import Neovim.Exceptions (
    NeovimException (..),
    exceptionToDoc,
 )
import Neovim.Plugin.Classes (
    FunctionName (..),
    FunctionalityDescription,
    HasFunctionName (nvimMethod),
    NeovimEventId (..),
    NvimMethod,
    Subscription (..),
    SubscriptionId (..),
 )
import Neovim.Plugin.IPC (SomeMessage)

import Control.Monad.IO.Class (MonadIO)
import Data.Functor (void)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.MessagePack (Object)
import Data.Monoid (Ap (Ap))
import Data.Text (Text, pack)
import System.Log.Logger (errorM)
import UnliftIO (
    Exception (fromException),
    Handler (..),
    MVar,
    MonadIO (..),
    MonadUnliftIO,
    SomeException,
    TMVar,
    TQueue,
    TVar,
    atomically,
    catches,
    modifyTVar',
    newEmptyMVar,
    newEmptyTMVarIO,
    newTMVarIO,
    newTQueueIO,
    newTVarIO,
    putTMVar,
    readTVar,
    takeTMVar,
    throwIO,
    try,
 )

import Prettyprinter (viaShow)

import Conduit (MonadThrow)
import Control.Exception (
    ArithException,
    ArrayException,
    ErrorCall,
    PatternMatchFail,
 )
import qualified Control.Monad.Fail as Fail
import Control.Monad.Reader (
    MonadReader (ask, local),
    ReaderT (..),
    asks,
 )
import Prelude
import Control.DeepSeq (deepseq)

{- | This is the environment in which all plugins are initially started.

 Functions have to run in this transformer stack to communicate with neovim.
 If parts of your own functions dont need to communicate with neovim, it is
 good practice to factor them out. This allows you to write tests and spot
 errors easier. Essentially, you should treat this similar to 'IO' in general
 haskell programs.
-}
newtype Neovim env a = Neovim
    {forall env a. Neovim env a -> ReaderT (Config env) IO a
unNeovim :: ReaderT (Config env) IO a}
    deriving newtype ((forall a b. (a -> b) -> Neovim env a -> Neovim env b)
-> (forall a b. a -> Neovim env b -> Neovim env a)
-> Functor (Neovim env)
forall a b. a -> Neovim env b -> Neovim env a
forall a b. (a -> b) -> Neovim env a -> Neovim env b
forall env a b. a -> Neovim env b -> Neovim env a
forall env a b. (a -> b) -> Neovim env a -> Neovim env b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall env a b. (a -> b) -> Neovim env a -> Neovim env b
fmap :: forall a b. (a -> b) -> Neovim env a -> Neovim env b
$c<$ :: forall env a b. a -> Neovim env b -> Neovim env a
<$ :: forall a b. a -> Neovim env b -> Neovim env a
Functor, Functor (Neovim env)
Functor (Neovim env) =>
(forall a. a -> Neovim env a)
-> (forall a b.
    Neovim env (a -> b) -> Neovim env a -> Neovim env b)
-> (forall a b c.
    (a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c)
-> (forall a b. Neovim env a -> Neovim env b -> Neovim env b)
-> (forall a b. Neovim env a -> Neovim env b -> Neovim env a)
-> Applicative (Neovim env)
forall env. Functor (Neovim env)
forall a. a -> Neovim env a
forall env a. a -> Neovim env a
forall a b. Neovim env a -> Neovim env b -> Neovim env a
forall a b. Neovim env a -> Neovim env b -> Neovim env b
forall a b. Neovim env (a -> b) -> Neovim env a -> Neovim env b
forall env a b. Neovim env a -> Neovim env b -> Neovim env a
forall env a b. Neovim env a -> Neovim env b -> Neovim env b
forall env a b. Neovim env (a -> b) -> Neovim env a -> Neovim env b
forall a b c.
(a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c
forall env a b c.
(a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall env a. a -> Neovim env a
pure :: forall a. a -> Neovim env a
$c<*> :: forall env a b. Neovim env (a -> b) -> Neovim env a -> Neovim env b
<*> :: forall a b. Neovim env (a -> b) -> Neovim env a -> Neovim env b
$cliftA2 :: forall env a b c.
(a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c
liftA2 :: forall a b c.
(a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c
$c*> :: forall env a b. Neovim env a -> Neovim env b -> Neovim env b
*> :: forall a b. Neovim env a -> Neovim env b -> Neovim env b
$c<* :: forall env a b. Neovim env a -> Neovim env b -> Neovim env a
<* :: forall a b. Neovim env a -> Neovim env b -> Neovim env a
Applicative, Applicative (Neovim env)
Applicative (Neovim env) =>
(forall a b. Neovim env a -> (a -> Neovim env b) -> Neovim env b)
-> (forall a b. Neovim env a -> Neovim env b -> Neovim env b)
-> (forall a. a -> Neovim env a)
-> Monad (Neovim env)
forall env. Applicative (Neovim env)
forall a. a -> Neovim env a
forall env a. a -> Neovim env a
forall a b. Neovim env a -> Neovim env b -> Neovim env b
forall a b. Neovim env a -> (a -> Neovim env b) -> Neovim env b
forall env a b. Neovim env a -> Neovim env b -> Neovim env b
forall env a b. Neovim env a -> (a -> Neovim env b) -> Neovim env b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall env a b. Neovim env a -> (a -> Neovim env b) -> Neovim env b
>>= :: forall a b. Neovim env a -> (a -> Neovim env b) -> Neovim env b
$c>> :: forall env a b. Neovim env a -> Neovim env b -> Neovim env b
>> :: forall a b. Neovim env a -> Neovim env b -> Neovim env b
$creturn :: forall env a. a -> Neovim env a
return :: forall a. a -> Neovim env a
Monad, Monad (Neovim env)
Monad (Neovim env) =>
(forall a. IO a -> Neovim env a) -> MonadIO (Neovim env)
forall env. Monad (Neovim env)
forall a. IO a -> Neovim env a
forall env a. IO a -> Neovim env a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall env a. IO a -> Neovim env a
liftIO :: forall a. IO a -> Neovim env a
MonadIO, Monad (Neovim env)
Monad (Neovim env) =>
(forall e a. (HasCallStack, Exception e) => e -> Neovim env a)
-> MonadThrow (Neovim env)
forall env. Monad (Neovim env)
forall e a. (HasCallStack, Exception e) => e -> Neovim env a
forall env e a. (HasCallStack, Exception e) => e -> Neovim env a
forall (m :: * -> *).
Monad m =>
(forall e a. (HasCallStack, Exception e) => e -> m a)
-> MonadThrow m
$cthrowM :: forall env e a. (HasCallStack, Exception e) => e -> Neovim env a
throwM :: forall e a. (HasCallStack, Exception e) => e -> Neovim env a
MonadThrow, MonadIO (Neovim env)
MonadIO (Neovim env) =>
(forall b.
 ((forall a. Neovim env a -> IO a) -> IO b) -> Neovim env b)
-> MonadUnliftIO (Neovim env)
forall env. MonadIO (Neovim env)
forall b.
((forall a. Neovim env a -> IO a) -> IO b) -> Neovim env b
forall env b.
((forall a. Neovim env a -> IO a) -> IO b) -> Neovim env b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall env b.
((forall a. Neovim env a -> IO a) -> IO b) -> Neovim env b
withRunInIO :: forall b.
((forall a. Neovim env a -> IO a) -> IO b) -> Neovim env b
MonadUnliftIO)
    deriving (NonEmpty (Neovim env a) -> Neovim env a
Neovim env a -> Neovim env a -> Neovim env a
(Neovim env a -> Neovim env a -> Neovim env a)
-> (NonEmpty (Neovim env a) -> Neovim env a)
-> (forall b. Integral b => b -> Neovim env a -> Neovim env a)
-> Semigroup (Neovim env a)
forall b. Integral b => b -> Neovim env a -> Neovim env a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall env a.
Semigroup a =>
NonEmpty (Neovim env a) -> Neovim env a
forall env a.
Semigroup a =>
Neovim env a -> Neovim env a -> Neovim env a
forall env a b.
(Semigroup a, Integral b) =>
b -> Neovim env a -> Neovim env a
$c<> :: forall env a.
Semigroup a =>
Neovim env a -> Neovim env a -> Neovim env a
<> :: Neovim env a -> Neovim env a -> Neovim env a
$csconcat :: forall env a.
Semigroup a =>
NonEmpty (Neovim env a) -> Neovim env a
sconcat :: NonEmpty (Neovim env a) -> Neovim env a
$cstimes :: forall env a b.
(Semigroup a, Integral b) =>
b -> Neovim env a -> Neovim env a
stimes :: forall b. Integral b => b -> Neovim env a -> Neovim env a
Semigroup, Semigroup (Neovim env a)
Neovim env a
Semigroup (Neovim env a) =>
Neovim env a
-> (Neovim env a -> Neovim env a -> Neovim env a)
-> ([Neovim env a] -> Neovim env a)
-> Monoid (Neovim env a)
[Neovim env a] -> Neovim env a
Neovim env a -> Neovim env a -> Neovim env a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall env a. Monoid a => Semigroup (Neovim env a)
forall env a. Monoid a => Neovim env a
forall env a. Monoid a => [Neovim env a] -> Neovim env a
forall env a.
Monoid a =>
Neovim env a -> Neovim env a -> Neovim env a
$cmempty :: forall env a. Monoid a => Neovim env a
mempty :: Neovim env a
$cmappend :: forall env a.
Monoid a =>
Neovim env a -> Neovim env a -> Neovim env a
mappend :: Neovim env a -> Neovim env a -> Neovim env a
$cmconcat :: forall env a. Monoid a => [Neovim env a] -> Neovim env a
mconcat :: [Neovim env a] -> Neovim env a
Monoid) via (Ap (Neovim env) a)

-- | User facing instance declaration for the reader state.
instance MonadReader env (Neovim env) where
    ask :: Neovim env env
ask = ReaderT (Config env) IO env -> Neovim env env
forall env a. ReaderT (Config env) IO a -> Neovim env a
Neovim (ReaderT (Config env) IO env -> Neovim env env)
-> ReaderT (Config env) IO env -> Neovim env env
forall a b. (a -> b) -> a -> b
$ (Config env -> env) -> ReaderT (Config env) IO env
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Config env -> env
forall env. Config env -> env
customConfig
    local :: forall a. (env -> env) -> Neovim env a -> Neovim env a
local env -> env
f (Neovim ReaderT (Config env) IO a
a) = do
        Config env
r <- ReaderT (Config env) IO (Config env) -> Neovim env (Config env)
forall env a. ReaderT (Config env) IO a -> Neovim env a
Neovim ReaderT (Config env) IO (Config env)
forall r (m :: * -> *). MonadReader r m => m r
ask
        IO a -> Neovim env a
forall a. IO a -> Neovim env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> Neovim env a) -> IO a -> Neovim env a
forall a b. (a -> b) -> a -> b
$ ReaderT (Config env) IO a -> Config env -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Config env) IO a
a (Config env
r{customConfig = f (customConfig r)})

instance Fail.MonadFail (Neovim env) where
    fail :: forall a. String -> Neovim env a
fail = NeovimException -> Neovim env a
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (NeovimException -> Neovim env a)
-> (String -> NeovimException) -> String -> Neovim env a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> NeovimException
ErrorMessage (Doc AnsiStyle -> NeovimException)
-> (String -> Doc AnsiStyle) -> String -> NeovimException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Doc AnsiStyle
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty

-- | Same as 'ask' for the 'InternalConfig'.
ask' :: Neovim env (Config env)
ask' :: forall env. Neovim env (Config env)
ask' = ReaderT (Config env) IO (Config env) -> Neovim env (Config env)
forall env a. ReaderT (Config env) IO a -> Neovim env a
Neovim ReaderT (Config env) IO (Config env)
forall r (m :: * -> *). MonadReader r m => m r
ask

-- | Same as 'asks' for the 'InternalConfig'.
asks' :: (Config env -> a) -> Neovim env a
asks' :: forall env a. (Config env -> a) -> Neovim env a
asks' = ReaderT (Config env) IO a -> Neovim env a
forall env a. ReaderT (Config env) IO a -> Neovim env a
Neovim (ReaderT (Config env) IO a -> Neovim env a)
-> ((Config env -> a) -> ReaderT (Config env) IO a)
-> (Config env -> a)
-> Neovim env a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config env -> a) -> ReaderT (Config env) IO a
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks

exceptionHandlers :: [Handler IO (Either (Doc ann) a)]
exceptionHandlers :: forall ann a. [Handler IO (Either (Doc ann) a)]
exceptionHandlers =
    [ (ArithException -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ArithException -> IO (Either (Doc ann) a))
 -> Handler IO (Either (Doc ann) a))
-> (ArithException -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall a b. (a -> b) -> a -> b
$ \(ArithException
_ :: ArithException) -> Doc ann -> IO (Either (Doc ann) a)
forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"ArithException (e.g. division by 0)"
    , (ArrayException -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ArrayException -> IO (Either (Doc ann) a))
 -> Handler IO (Either (Doc ann) a))
-> (ArrayException -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall a b. (a -> b) -> a -> b
$ \(ArrayException
_ :: ArrayException) -> Doc ann -> IO (Either (Doc ann) a)
forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"ArrayException"
    , (ErrorCall -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((ErrorCall -> IO (Either (Doc ann) a))
 -> Handler IO (Either (Doc ann) a))
-> (ErrorCall -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall a b. (a -> b) -> a -> b
$ \(ErrorCall
_ :: ErrorCall) -> Doc ann -> IO (Either (Doc ann) a)
forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"ErrorCall (e.g. call of undefined or error"
    , (PatternMatchFail -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((PatternMatchFail -> IO (Either (Doc ann) a))
 -> Handler IO (Either (Doc ann) a))
-> (PatternMatchFail -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall a b. (a -> b) -> a -> b
$ \(PatternMatchFail
_ :: PatternMatchFail) -> Doc ann -> IO (Either (Doc ann) a)
forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"Pattern match failure"
    , (SomeException -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler ((SomeException -> IO (Either (Doc ann) a))
 -> Handler IO (Either (Doc ann) a))
-> (SomeException -> IO (Either (Doc ann) a))
-> Handler IO (Either (Doc ann) a)
forall a b. (a -> b) -> a -> b
$ \(SomeException
_ :: SomeException) -> Doc ann -> IO (Either (Doc ann) a)
forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"Unhandled exception"
    ]
  where
    ret :: a -> IO (Either a b)
ret = Either a b -> IO (Either a b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either a b -> IO (Either a b))
-> (a -> Either a b) -> a -> IO (Either a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either a b
forall a b. a -> Either a b
Left

-- | Initialize a 'Neovim' context by supplying an 'InternalEnvironment'.
runNeovim ::
    NFData a =>
    Config env ->
    Neovim env a ->
    IO (Either (Doc AnsiStyle) a)
runNeovim :: forall a env.
NFData a =>
Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovim = (a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal (\a
a -> a
a a -> IO a -> IO a
forall a b. NFData a => a -> b -> b
`deepseq` a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a)

runNeovimInternal ::
    (a -> IO a) ->
    Config env ->
    Neovim env a ->
    IO (Either (Doc AnsiStyle) a)
runNeovimInternal :: forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal a -> IO a
f Config env
r (Neovim ReaderT (Config env) IO a
a) =
    (IO a -> IO (Either SomeException a)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try (IO a -> IO (Either SomeException a))
-> (Config env -> IO a)
-> Config env
-> IO (Either SomeException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT (Config env) IO a -> Config env -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Config env) IO a
a) Config env
r IO (Either SomeException a)
-> (Either SomeException a -> IO (Either (Doc AnsiStyle) a))
-> IO (Either (Doc AnsiStyle) a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Left SomeException
e -> case SomeException -> Maybe NeovimException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
            Just NeovimException
e' ->
                Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a))
-> (NeovimException -> Either (Doc AnsiStyle) a)
-> NeovimException
-> IO (Either (Doc AnsiStyle) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall a b. a -> Either a b
Left (Doc AnsiStyle -> Either (Doc AnsiStyle) a)
-> (NeovimException -> Doc AnsiStyle)
-> NeovimException
-> Either (Doc AnsiStyle) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NeovimException -> Doc AnsiStyle
exceptionToDoc (NeovimException -> IO (Either (Doc AnsiStyle) a))
-> NeovimException -> IO (Either (Doc AnsiStyle) a)
forall a b. (a -> b) -> a -> b
$ (NeovimException
e' :: NeovimException)
            Maybe NeovimException
Nothing -> do
                IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> IO ()
errorM String
"Context" (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Converting Exception to Error message: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
                (Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (Doc AnsiStyle) a -> IO (Either (Doc AnsiStyle) a))
-> (SomeException -> Either (Doc AnsiStyle) a)
-> SomeException
-> IO (Either (Doc AnsiStyle) a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> Either (Doc AnsiStyle) a
forall a b. a -> Either a b
Left (Doc AnsiStyle -> Either (Doc AnsiStyle) a)
-> (SomeException -> Doc AnsiStyle)
-> SomeException
-> Either (Doc AnsiStyle) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> Doc AnsiStyle
forall a ann. Show a => a -> Doc ann
viaShow) SomeException
e
        Right a
res ->
            (a -> Either (Doc AnsiStyle) a
forall a b. b -> Either a b
Right (a -> Either (Doc AnsiStyle) a)
-> IO a -> IO (Either (Doc AnsiStyle) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO a
f a
res) IO (Either (Doc AnsiStyle) a)
-> [Handler IO (Either (Doc AnsiStyle) a)]
-> IO (Either (Doc AnsiStyle) a)
forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` [Handler IO (Either (Doc AnsiStyle) a)]
forall ann a. [Handler IO (Either (Doc ann) a)]
exceptionHandlers

{- | Create a new unique function name. To prevent possible name clashes, digits
 are stripped from the given suffix.
-}
newUniqueFunctionName :: Neovim env FunctionName
newUniqueFunctionName :: forall env. Neovim env FunctionName
newUniqueFunctionName = do
    TVar Integer
tu <- (Config env -> TVar Integer) -> Neovim env (TVar Integer)
forall env a. (Config env -> a) -> Neovim env a
asks' Config env -> TVar Integer
forall env. Config env -> TVar Integer
uniqueCounter
    -- reverseing the integer string should distribute the first character more
    -- evently and hence cause faster termination for comparisons.
    (Integer -> FunctionName)
-> Neovim env Integer -> Neovim env FunctionName
forall a b. (a -> b) -> Neovim env a -> Neovim env b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> FunctionName
F (Text -> FunctionName)
-> (Integer -> Text) -> Integer -> FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack (String -> Text) -> (Integer -> String) -> Integer -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (Integer -> String) -> Integer -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show) (Neovim env Integer -> Neovim env FunctionName)
-> (STM Integer -> Neovim env Integer)
-> STM Integer
-> Neovim env FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Integer -> Neovim env Integer
forall a. IO a -> Neovim env a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Integer -> Neovim env Integer)
-> (STM Integer -> IO Integer) -> STM Integer -> Neovim env Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM Integer -> IO Integer
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Integer -> Neovim env FunctionName)
-> STM Integer -> Neovim env FunctionName
forall a b. (a -> b) -> a -> b
$ do
        Integer
u <- TVar Integer -> STM Integer
forall a. TVar a -> STM a
readTVar TVar Integer
tu
        TVar Integer -> (Integer -> Integer) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Integer
tu Integer -> Integer
forall a. Enum a => a -> a
succ
        Integer -> STM Integer
forall a. a -> STM a
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
u

{- | This data type is used to dispatch a remote function call to the appopriate
 recipient.
-}
newtype FunctionType
    = -- | 'Stateful' functions are handled within a special thread, the 'TQueue'
      -- is the communication endpoint for the arguments we have to pass.
      Stateful (TQueue SomeMessage)

instance Pretty FunctionType where
    pretty :: forall ann. FunctionType -> Doc ann
pretty = \case
        Stateful TQueue SomeMessage
_ -> Doc ann
"\\os -> Neovim env o"

-- | Type of the values stored in the function map.
type FunctionMapEntry = (FunctionalityDescription, FunctionType)

{- | A function map is a map containing the names of functions as keys and some
 context dependent value which contains all the necessary information to
 execute that function in the intended way.

 This type is only used internally and handles two distinct cases. One case
 is a direct function call, wich is simply a function that accepts a list of
 'Object' values and returns a result in the 'Neovim' context. The second
 case is calling a function that has a persistent state. This is mediated to
 a thread that reads from a 'TQueue'. (NB: persistent currently means, that
 state is stored for as long as the plugin provider is running and not
 restarted.)
-}
type FunctionMap = Map NvimMethod FunctionMapEntry

-- | Create a new function map from the given list of 'FunctionMapEntry' values.
mkFunctionMap :: [FunctionMapEntry] -> FunctionMap
mkFunctionMap :: [FunctionMapEntry] -> FunctionMap
mkFunctionMap = [(NvimMethod, FunctionMapEntry)] -> FunctionMap
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(NvimMethod, FunctionMapEntry)] -> FunctionMap)
-> ([FunctionMapEntry] -> [(NvimMethod, FunctionMapEntry)])
-> [FunctionMapEntry]
-> FunctionMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FunctionMapEntry -> (NvimMethod, FunctionMapEntry))
-> [FunctionMapEntry] -> [(NvimMethod, FunctionMapEntry)]
forall a b. (a -> b) -> [a] -> [b]
map (\FunctionMapEntry
e -> (FunctionalityDescription -> NvimMethod
forall a. HasFunctionName a => a -> NvimMethod
nvimMethod (FunctionMapEntry -> FunctionalityDescription
forall a b. (a, b) -> a
fst FunctionMapEntry
e), FunctionMapEntry
e))

data Subscriptions = Subscriptions
    { Subscriptions -> SubscriptionId
nextSubscriptionId :: SubscriptionId
    , Subscriptions -> Map NeovimEventId [Subscription]
byEventId :: Map NeovimEventId [Subscription]
    }

{- | Subscribe to an event. When the event is received, the given callback function
 is run. It is usually necessary to call the appropriate API function in order for
 /neovim/ to send the notifications to /nvim-hs/. The returned subscription can be
 used to 'unsubscribe'.
-}
subscribe :: Text -> ([Object] -> Neovim env ()) -> Neovim env Subscription
subscribe :: forall env.
Text -> ([Object] -> Neovim env ()) -> Neovim env Subscription
subscribe Text
event [Object] -> Neovim env ()
action = do
    let eventId :: NeovimEventId
eventId = Text -> NeovimEventId
NeovimEventId Text
event
    Config env
cfg <- Neovim env (Config env)
forall env. Neovim env (Config env)
ask'
    let subscriptions' :: TMVar Subscriptions
subscriptions' = Config env -> TMVar Subscriptions
forall env. Config env -> TMVar Subscriptions
subscriptions Config env
cfg
    STM Subscription -> Neovim env Subscription
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM Subscription -> Neovim env Subscription)
-> STM Subscription -> Neovim env Subscription
forall a b. (a -> b) -> a -> b
$ do
        Subscriptions
s <- TMVar Subscriptions -> STM Subscriptions
forall a. TMVar a -> STM a
takeTMVar TMVar Subscriptions
subscriptions'
        let subscriptionId :: SubscriptionId
subscriptionId = Subscriptions -> SubscriptionId
nextSubscriptionId Subscriptions
s
        let newSubscription :: Subscription
newSubscription =
                Subscription
                    { subId :: SubscriptionId
subId = SubscriptionId
subscriptionId
                    , subEventId :: NeovimEventId
subEventId = NeovimEventId
eventId
                    , subAction :: [Object] -> IO ()
subAction = IO (Either (Doc AnsiStyle) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (Doc AnsiStyle) ()) -> IO ())
-> ([Object] -> IO (Either (Doc AnsiStyle) ()))
-> [Object]
-> 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
cfg (Neovim env () -> IO (Either (Doc AnsiStyle) ()))
-> ([Object] -> Neovim env ())
-> [Object]
-> IO (Either (Doc AnsiStyle) ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Object] -> Neovim env ()
action
                    }
        TMVar Subscriptions -> Subscriptions -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar
            TMVar Subscriptions
subscriptions'
            Subscriptions
s
                { nextSubscriptionId = succ subscriptionId
                , byEventId = Map.insertWith (<>) eventId [newSubscription] (byEventId s)
                }
        Subscription -> STM Subscription
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Subscription
newSubscription

-- | Remove the subscription that has been returned by 'subscribe'.
unsubscribe :: Subscription -> Neovim env ()
unsubscribe :: forall env. Subscription -> Neovim env ()
unsubscribe Subscription
subscription = do
    TMVar Subscriptions
subscriptions' <- (Config env -> TMVar Subscriptions)
-> Neovim env (TMVar Subscriptions)
forall env a. (Config env -> a) -> Neovim env a
asks' Config env -> TMVar Subscriptions
forall env. Config env -> TMVar Subscriptions
subscriptions
    Neovim env () -> Neovim env ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Neovim env () -> Neovim env ())
-> (STM () -> Neovim env ()) -> STM () -> Neovim env ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> Neovim env ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> Neovim env ()) -> STM () -> Neovim env ()
forall a b. (a -> b) -> a -> b
$ do
        Subscriptions
s <- TMVar Subscriptions -> STM Subscriptions
forall a. TMVar a -> STM a
takeTMVar TMVar Subscriptions
subscriptions'
        let eventId :: NeovimEventId
eventId = Subscription -> NeovimEventId
subEventId Subscription
subscription
            deleteSubscription :: [Subscription] -> Maybe [Subscription]
deleteSubscription = [Subscription] -> Maybe [Subscription]
forall a. a -> Maybe a
Just ([Subscription] -> Maybe [Subscription])
-> ([Subscription] -> [Subscription])
-> [Subscription]
-> Maybe [Subscription]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Subscription -> Bool) -> [Subscription] -> [Subscription]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SubscriptionId -> SubscriptionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Subscription -> SubscriptionId
subId Subscription
subscription) (SubscriptionId -> Bool)
-> (Subscription -> SubscriptionId) -> Subscription -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Subscription -> SubscriptionId
subId)
        TMVar Subscriptions -> Subscriptions -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar
            TMVar Subscriptions
subscriptions'
            Subscriptions
s
                { byEventId = Map.update deleteSubscription eventId (byEventId s)
                }

{- | A wrapper for a reader value that contains extra fields required to
 communicate with the messagepack-rpc components and provide necessary data to
 provide other globally available operations.

 Note that you most probably do not want to change the fields prefixed with an
 underscore.
-}
data Config env = Config
    -- Global settings; initialized once
    { forall env. Config env -> TQueue SomeMessage
eventQueue :: TQueue SomeMessage
    -- ^ A queue of messages that the event handler will propagate to
    -- appropriate threads and handlers.
    , forall env. Config env -> MVar StateTransition
transitionTo :: MVar StateTransition
    -- ^ The main thread will wait for this 'MVar' to be filled with a value
    -- and then perform an action appropriate for the value of type
    -- 'StateTransition'.
    , forall env. Config env -> TMVar (Either String Int)
providerName :: TMVar (Either String Int)
    -- ^ Since nvim-hs must have its "Neovim.RPC.SocketReader" and
    -- "Neovim.RPC.EventHandler" running to determine the actual channel id
    -- (i.e. the 'Int' value here) this field can only be set properly later.
    -- Hence, the value of this field is put in an 'TMVar'.
    -- Name that is used to identify this provider. Assigning such a name is
    -- done in the neovim config (e.g. ~\/.nvim\/nvimrc).
    , forall env. Config env -> TVar Integer
uniqueCounter :: TVar Integer
    -- ^ This 'TVar' is used to generate uniqe function names on the side of
    -- /nvim-hs/. This is useful if you don't want to overwrite existing
    -- functions or if you create autocmd functions.
    , forall env. Config env -> TMVar FunctionMap
globalFunctionMap :: TMVar FunctionMap
    -- ^ This map is used to dispatch received messagepack function calls to
    -- it's appropriate targets.
    , -- Local settings; intialized for each stateful component

      forall env. Config env -> Maybe (PluginSettings env)
pluginSettings :: Maybe (PluginSettings env)
    -- ^ In a registered functionality this field contains a function (and
    -- possibly some context dependent values) to register new functionality.
    , forall env. Config env -> TMVar Subscriptions
subscriptions :: TMVar Subscriptions
    -- ^ Plugins can dynamically subscribe to events that neovim sends.
    , forall env. Config env -> env
customConfig :: env
    -- ^ Plugin author supplyable custom configuration. Queried on the
    -- user-facing side with 'ask' or 'asks'.
    }

{- | Convenient helper to create a new config for the given state and read-only
 config.

 Sets the 'pluginSettings' field to 'Nothing'.
-}
retypeConfig :: env -> Config anotherEnv -> Config env
retypeConfig :: forall env anotherEnv. env -> Config anotherEnv -> Config env
retypeConfig env
r Config anotherEnv
cfg = Config anotherEnv
cfg{pluginSettings = Nothing, customConfig = r}

{- | This GADT is used to share information between stateless and stateful
 plugin threads since they work fundamentally in the same way. They both
 contain a function to register some functionality in the plugin provider
 as well as some values which are specific to the one or the other context.
-}
data PluginSettings env where
    StatefulSettings ::
        ( 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

{- | Create a new 'InternalConfig' object by providing the minimal amount of
 necessary information.

 This function should only be called once per /nvim-hs/ session since the
 arguments are shared across processes.
-}
newConfig :: IO (Maybe String) -> IO env -> IO (Config env)
newConfig :: forall env. IO (Maybe String) -> IO env -> IO (Config env)
newConfig IO (Maybe String)
ioProviderName IO env
r =
    TQueue SomeMessage
-> MVar StateTransition
-> TMVar (Either String Int)
-> TVar Integer
-> TMVar FunctionMap
-> Maybe (PluginSettings env)
-> TMVar Subscriptions
-> env
-> Config env
forall env.
TQueue SomeMessage
-> MVar StateTransition
-> TMVar (Either String Int)
-> TVar Integer
-> TMVar FunctionMap
-> Maybe (PluginSettings env)
-> TMVar Subscriptions
-> env
-> Config env
Config
        (TQueue SomeMessage
 -> MVar StateTransition
 -> TMVar (Either String Int)
 -> TVar Integer
 -> TMVar FunctionMap
 -> Maybe (PluginSettings env)
 -> TMVar Subscriptions
 -> env
 -> Config env)
-> IO (TQueue SomeMessage)
-> IO
     (MVar StateTransition
      -> TMVar (Either String Int)
      -> TVar Integer
      -> TMVar FunctionMap
      -> Maybe (PluginSettings env)
      -> TMVar Subscriptions
      -> env
      -> Config env)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO (TQueue SomeMessage)
forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
        IO
  (MVar StateTransition
   -> TMVar (Either String Int)
   -> TVar Integer
   -> TMVar FunctionMap
   -> Maybe (PluginSettings env)
   -> TMVar Subscriptions
   -> env
   -> Config env)
-> IO (MVar StateTransition)
-> IO
     (TMVar (Either String Int)
      -> TVar Integer
      -> TMVar FunctionMap
      -> Maybe (PluginSettings env)
      -> TMVar Subscriptions
      -> env
      -> Config env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (MVar StateTransition)
forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
        IO
  (TMVar (Either String Int)
   -> TVar Integer
   -> TMVar FunctionMap
   -> Maybe (PluginSettings env)
   -> TMVar Subscriptions
   -> env
   -> Config env)
-> IO (TMVar (Either String Int))
-> IO
     (TVar Integer
      -> TMVar FunctionMap
      -> Maybe (PluginSettings env)
      -> TMVar Subscriptions
      -> env
      -> Config env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (IO (TMVar (Either String Int))
-> (String -> IO (TMVar (Either String Int)))
-> Maybe String
-> IO (TMVar (Either String Int))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO (TMVar (Either String Int))
forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO (Either String Int -> IO (TMVar (Either String Int))
forall (m :: * -> *) a. MonadIO m => a -> m (TMVar a)
newTMVarIO (Either String Int -> IO (TMVar (Either String Int)))
-> (String -> Either String Int)
-> String
-> IO (TMVar (Either String Int))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String Int
forall a b. a -> Either a b
Left) (Maybe String -> IO (TMVar (Either String Int)))
-> IO (Maybe String) -> IO (TMVar (Either String Int))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe String)
ioProviderName)
        IO
  (TVar Integer
   -> TMVar FunctionMap
   -> Maybe (PluginSettings env)
   -> TMVar Subscriptions
   -> env
   -> Config env)
-> IO (TVar Integer)
-> IO
     (TMVar FunctionMap
      -> Maybe (PluginSettings env)
      -> TMVar Subscriptions
      -> env
      -> Config env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Integer -> IO (TVar Integer)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Integer
100
        IO
  (TMVar FunctionMap
   -> Maybe (PluginSettings env)
   -> TMVar Subscriptions
   -> env
   -> Config env)
-> IO (TMVar FunctionMap)
-> IO
     (Maybe (PluginSettings env)
      -> TMVar Subscriptions -> env -> Config env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO (TMVar FunctionMap)
forall (m :: * -> *) a. MonadIO m => m (TMVar a)
newEmptyTMVarIO
        IO
  (Maybe (PluginSettings env)
   -> TMVar Subscriptions -> env -> Config env)
-> IO (Maybe (PluginSettings env))
-> IO (TMVar Subscriptions -> env -> Config env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (PluginSettings env) -> IO (Maybe (PluginSettings env))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PluginSettings env)
forall a. Maybe a
Nothing
        IO (TMVar Subscriptions -> env -> Config env)
-> IO (TMVar Subscriptions) -> IO (env -> Config env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Subscriptions -> IO (TMVar Subscriptions)
forall (m :: * -> *) a. MonadIO m => a -> m (TMVar a)
newTMVarIO (SubscriptionId -> Map NeovimEventId [Subscription] -> Subscriptions
Subscriptions (Int64 -> SubscriptionId
SubscriptionId Int64
1) Map NeovimEventId [Subscription]
forall a. Monoid a => a
mempty)
        IO (env -> Config env) -> IO env -> IO (Config env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO env
r

-- | The state that the plugin provider wants to transition to.
data StateTransition
    = -- | Quit the plugin provider.
      Quit
    | -- | Restart the plugin provider.
      Restart
    | -- | The plugin provider failed to start or some other error occured.
      Failure (Doc AnsiStyle)
    | -- | The plugin provider started successfully.
      InitSuccess
    deriving (Int -> StateTransition -> String -> String
[StateTransition] -> String -> String
StateTransition -> String
(Int -> StateTransition -> String -> String)
-> (StateTransition -> String)
-> ([StateTransition] -> String -> String)
-> Show StateTransition
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> StateTransition -> String -> String
showsPrec :: Int -> StateTransition -> String -> String
$cshow :: StateTransition -> String
show :: StateTransition -> String
$cshowList :: [StateTransition] -> String -> String
showList :: [StateTransition] -> String -> String
Show)