{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module Neovim.Context.Internal
where
import Neovim.Classes
import Neovim.Exceptions (NeovimException (..),
exceptionToDoc)
import Neovim.Plugin.Classes
import Neovim.Plugin.IPC (SomeMessage)
import Control.Applicative
import Control.Exception (ArithException,
ArrayException,
ErrorCall,
PatternMatchFail)
import Control.Monad.Except
import Control.Monad.Reader
import Control.Monad.Trans.Resource
import qualified Data.ByteString.UTF8 as U (fromString)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.MessagePack (Object)
import Data.Monoid (Ap(Ap))
import System.Log.Logger
import UnliftIO
import Data.Text.Prettyprint.Doc (viaShow)
import qualified Control.Monad.Fail as Fail
import Prelude
newtype Neovim env a = Neovim
{ Neovim env a -> ResourceT (ReaderT (Config env) IO) a
unNeovim :: ResourceT (ReaderT (Config env) IO) a }
deriving newtype (a -> Neovim env b -> Neovim env a
(a -> b) -> Neovim env a -> Neovim env b
(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
<$ :: a -> Neovim env b -> Neovim env a
$c<$ :: forall env a b. a -> Neovim env b -> Neovim env a
fmap :: (a -> b) -> Neovim env a -> Neovim env b
$cfmap :: forall env a b. (a -> b) -> Neovim env a -> Neovim env b
Functor, Functor (Neovim env)
a -> Neovim env a
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)
Neovim env a -> Neovim env b -> Neovim env b
Neovim env a -> Neovim env b -> Neovim env a
Neovim env (a -> b) -> Neovim env a -> Neovim env b
(a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c
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
<* :: Neovim env a -> Neovim env b -> Neovim env a
$c<* :: forall env a b. Neovim env a -> Neovim env b -> Neovim env a
*> :: Neovim env a -> Neovim env b -> Neovim env b
$c*> :: forall env a b. Neovim env a -> Neovim env b -> Neovim env b
liftA2 :: (a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c
$cliftA2 :: forall env a b c.
(a -> b -> c) -> Neovim env a -> Neovim env b -> Neovim env c
<*> :: Neovim env (a -> b) -> Neovim env a -> Neovim env b
$c<*> :: forall env a b. Neovim env (a -> b) -> Neovim env a -> Neovim env b
pure :: a -> Neovim env a
$cpure :: forall env a. a -> Neovim env a
$cp1Applicative :: forall env. Functor (Neovim env)
Applicative, Applicative (Neovim env)
a -> Neovim env a
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)
Neovim env a -> (a -> Neovim env b) -> Neovim env b
Neovim env a -> Neovim env b -> Neovim env b
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
return :: a -> Neovim env a
$creturn :: forall env a. a -> Neovim env a
>> :: Neovim env a -> Neovim env b -> Neovim env b
$c>> :: forall env a b. Neovim env a -> Neovim env b -> Neovim env b
>>= :: Neovim env a -> (a -> Neovim env b) -> Neovim env b
$c>>= :: forall env a b. Neovim env a -> (a -> Neovim env b) -> Neovim env b
$cp1Monad :: forall env. Applicative (Neovim env)
Monad, Monad (Neovim env)
Monad (Neovim env)
-> (forall a. IO a -> Neovim env a) -> MonadIO (Neovim env)
IO a -> Neovim env a
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
liftIO :: IO a -> Neovim env a
$cliftIO :: forall env a. IO a -> Neovim env a
$cp1MonadIO :: forall env. Monad (Neovim env)
MonadIO, Monad (Neovim env)
e -> Neovim env a
Monad (Neovim env)
-> (forall e a. Exception e => e -> Neovim env a)
-> MonadThrow (Neovim env)
forall env. Monad (Neovim env)
forall e a. Exception e => e -> Neovim env a
forall env e a. Exception e => e -> Neovim env a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: e -> Neovim env a
$cthrowM :: forall env e a. Exception e => e -> Neovim env a
$cp1MonadThrow :: forall env. Monad (Neovim env)
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 a. Neovim env a -> IO a) -> IO b) -> Neovim env b
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
withRunInIO :: ((forall a. Neovim env a -> IO a) -> IO b) -> Neovim env b
$cwithRunInIO :: forall env b.
((forall a. Neovim env a -> IO a) -> IO b) -> Neovim env b
$cp1MonadUnliftIO :: forall env. MonadIO (Neovim env)
MonadUnliftIO)
deriving (b -> Neovim env a -> Neovim env a
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
stimes :: b -> Neovim env a -> Neovim env a
$cstimes :: forall env a b.
(Semigroup a, Integral b) =>
b -> Neovim env a -> Neovim env a
sconcat :: NonEmpty (Neovim env a) -> Neovim env a
$csconcat :: forall env a.
Semigroup a =>
NonEmpty (Neovim env a) -> Neovim env a
<> :: Neovim env a -> Neovim env a -> Neovim env a
$c<> :: forall env a.
Semigroup a =>
Neovim env a -> 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
mconcat :: [Neovim env a] -> Neovim env a
$cmconcat :: forall env a. Monoid a => [Neovim env a] -> Neovim env a
mappend :: Neovim env a -> Neovim env a -> Neovim env a
$cmappend :: forall env a.
Monoid a =>
Neovim env a -> Neovim env a -> Neovim env a
mempty :: Neovim env a
$cmempty :: forall env a. Monoid a => Neovim env a
$cp1Monoid :: forall env a. Monoid a => Semigroup (Neovim env a)
Monoid) via (Ap (Neovim env) a)
instance MonadReader env (Neovim env) where
ask :: Neovim env env
ask = ResourceT (ReaderT (Config env) IO) env -> Neovim env env
forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim (ResourceT (ReaderT (Config env) IO) env -> Neovim env env)
-> ResourceT (ReaderT (Config env) IO) env -> Neovim env env
forall a b. (a -> b) -> a -> b
$ (Config env -> env) -> ResourceT (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 :: (env -> env) -> Neovim env a -> Neovim env a
local env -> env
f (Neovim ResourceT (ReaderT (Config env) IO) a
a) = do
Config env
r <- ResourceT (ReaderT (Config env) IO) (Config env)
-> Neovim env (Config env)
forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim ResourceT (ReaderT (Config env) IO) (Config env)
forall r (m :: * -> *). MonadReader r m => m r
ask
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 (ResourceT (ReaderT (Config env) IO) a -> ReaderT (Config env) IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT ResourceT (ReaderT (Config env) IO) a
a)
(Config env
r { customConfig :: env
customConfig = env -> env
f (Config env -> env
forall env. Config env -> env
customConfig Config env
r)})
instance MonadResource (Neovim env) where
liftResourceT :: ResourceT IO a -> Neovim env a
liftResourceT ResourceT IO a
m = ResourceT (ReaderT (Config env) IO) a -> Neovim env a
forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim (ResourceT (ReaderT (Config env) IO) a -> Neovim env a)
-> ResourceT (ReaderT (Config env) IO) a -> Neovim env a
forall a b. (a -> b) -> a -> b
$ ResourceT IO a -> ResourceT (ReaderT (Config env) IO) a
forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT ResourceT IO a
m
instance Fail.MonadFail (Neovim env) where
fail :: 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 a ann. Pretty a => a -> Doc ann
pretty
ask' :: Neovim env (Config env)
ask' :: Neovim env (Config env)
ask' = ResourceT (ReaderT (Config env) IO) (Config env)
-> Neovim env (Config env)
forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim ResourceT (ReaderT (Config env) IO) (Config env)
forall r (m :: * -> *). MonadReader r m => m r
ask
asks' :: (Config env -> a) -> Neovim env a
asks' :: (Config env -> a) -> Neovim env a
asks' = ResourceT (ReaderT (Config env) IO) a -> Neovim env a
forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim (ResourceT (ReaderT (Config env) IO) a -> Neovim env a)
-> ((Config env -> a) -> ResourceT (ReaderT (Config env) IO) a)
-> (Config env -> a)
-> Neovim env a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Config env -> a) -> ResourceT (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 :: [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 (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
runNeovim :: NFData a
=> Config env
-> Neovim env a
-> IO (Either (Doc AnsiStyle) a)
runNeovim :: 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 (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 :: (a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal a -> IO a
f Config env
r (Neovim ResourceT (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 (ResourceT (ReaderT (Config env) IO) a -> ReaderT (Config env) IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT ResourceT (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 (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 (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 (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 (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
newUniqueFunctionName :: Neovim env FunctionName
newUniqueFunctionName :: 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
(Integer -> FunctionName)
-> Neovim env Integer -> Neovim env FunctionName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> FunctionName
F (ByteString -> FunctionName)
-> (Integer -> ByteString) -> Integer -> FunctionName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
U.fromString (String -> ByteString)
-> (Integer -> String) -> Integer -> ByteString
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 (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 (m :: * -> *) a. Monad m => a -> m a
return Integer
u
newtype FunctionType = Stateful (TQueue SomeMessage)
instance Pretty FunctionType where
pretty :: FunctionType -> Doc ann
pretty = \case
Stateful TQueue SomeMessage
_ -> Doc ann
"\\os -> Neovim env o"
type FunctionMapEntry = (FunctionalityDescription, FunctionType)
type FunctionMap = Map NvimMethod FunctionMapEntry
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 Config env = Config
{ Config env -> TQueue SomeMessage
eventQueue :: TQueue SomeMessage
, Config env -> MVar StateTransition
transitionTo :: MVar StateTransition
, Config env -> TMVar (Either String Int)
providerName :: TMVar (Either String Int)
, Config env -> TVar Integer
uniqueCounter :: TVar Integer
, Config env -> TMVar FunctionMap
globalFunctionMap :: TMVar FunctionMap
, Config env -> Maybe (PluginSettings env)
pluginSettings :: Maybe (PluginSettings env)
, Config env -> env
customConfig :: env
}
retypeConfig :: env -> Config anotherEnv -> Config env
retypeConfig :: env -> Config anotherEnv -> Config env
retypeConfig env
r Config anotherEnv
cfg = Config anotherEnv
cfg { pluginSettings :: Maybe (PluginSettings env)
pluginSettings = Maybe (PluginSettings env)
forall a. Maybe a
Nothing, customConfig :: env
customConfig = env
r }
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
newConfig :: IO (Maybe String) -> IO env -> IO (Config env)
newConfig :: 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)
-> env
-> Config env
forall env.
TQueue SomeMessage
-> MVar StateTransition
-> TMVar (Either String Int)
-> TVar Integer
-> TMVar FunctionMap
-> Maybe (PluginSettings env)
-> env
-> Config env
Config
(TQueue SomeMessage
-> MVar StateTransition
-> TMVar (Either String Int)
-> TVar Integer
-> TMVar FunctionMap
-> Maybe (PluginSettings env)
-> env
-> Config env)
-> IO (TQueue SomeMessage)
-> IO
(MVar StateTransition
-> TMVar (Either String Int)
-> TVar Integer
-> TMVar FunctionMap
-> Maybe (PluginSettings env)
-> 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)
-> env
-> Config env)
-> IO (MVar StateTransition)
-> IO
(TMVar (Either String Int)
-> TVar Integer
-> TMVar FunctionMap
-> Maybe (PluginSettings env)
-> env
-> Config env)
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)
-> env
-> Config env)
-> IO (TMVar (Either String Int))
-> IO
(TVar Integer
-> TMVar FunctionMap
-> Maybe (PluginSettings env)
-> env
-> Config env)
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 (STM (TMVar (Either String Int)) -> IO (TMVar (Either String Int))
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically STM (TMVar (Either String Int))
forall a. STM (TMVar a)
newEmptyTMVar) (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)
-> env
-> Config env)
-> IO (TVar Integer)
-> IO
(TMVar FunctionMap
-> Maybe (PluginSettings env) -> env -> Config env)
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) -> env -> Config env)
-> IO (TMVar FunctionMap)
-> IO (Maybe (PluginSettings env) -> env -> Config env)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STM (TMVar FunctionMap) -> IO (TMVar FunctionMap)
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically STM (TMVar FunctionMap)
forall a. STM (TMVar a)
newEmptyTMVar
IO (Maybe (PluginSettings env) -> env -> Config env)
-> IO (Maybe (PluginSettings env)) -> IO (env -> Config env)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe (PluginSettings env) -> IO (Maybe (PluginSettings env))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (PluginSettings env)
forall a. Maybe a
Nothing
IO (env -> Config env) -> IO env -> IO (Config env)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO env
r
data StateTransition
= Quit
| Restart
| Failure (Doc AnsiStyle)
| 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
showList :: [StateTransition] -> String -> String
$cshowList :: [StateTransition] -> String -> String
show :: StateTransition -> String
$cshow :: StateTransition -> String
showsPrec :: Int -> StateTransition -> String -> String
$cshowsPrec :: Int -> StateTransition -> String -> String
Show)