{-# 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
{ forall env a. Neovim env a -> ResourceT (ReaderT (Config env) IO) a
unNeovim :: ResourceT (ReaderT (Config env) IO) a }
deriving newtype (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
<$ :: forall a b. a -> Neovim env b -> Neovim env a
$c<$ :: forall env a b. a -> Neovim env b -> Neovim env a
fmap :: forall a b. (a -> b) -> Neovim env a -> Neovim env b
$cfmap :: forall env a b. (a -> b) -> Neovim env a -> Neovim env b
Functor, 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
<* :: forall a b. Neovim env a -> Neovim env b -> Neovim env a
$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 b
$c*> :: forall env a b. Neovim env a -> Neovim env b -> Neovim env b
liftA2 :: forall a b c.
(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
<*> :: forall a b. 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 :: forall a. a -> Neovim env a
$cpure :: forall env a. a -> Neovim env a
Applicative, 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 :: forall a. a -> Neovim env a
$creturn :: forall env a. a -> Neovim env a
>> :: 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 b
>>= :: forall a 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
Monad, 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 :: forall a. IO a -> Neovim env a
$cliftIO :: forall env a. IO a -> Neovim env a
MonadIO, 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 :: forall e a. Exception e => e -> Neovim env a
$cthrowM :: forall env e a. Exception e => e -> Neovim env a
MonadThrow, 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 b.
((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
MonadUnliftIO)
deriving (NonEmpty (Neovim env a) -> Neovim env a
Neovim env a -> Neovim env a -> 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 :: forall b. Integral b => 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, 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
Monoid) via (Ap (Neovim env) a)
instance MonadReader env (Neovim env) where
ask :: Neovim env env
ask = forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall env. Config env -> env
customConfig
local :: forall a. (env -> env) -> Neovim env a -> Neovim env a
local env -> env
f (Neovim ResourceT (ReaderT (Config env) IO) a
a) = do
Config env
r <- forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim forall r (m :: * -> *). MonadReader r m => m r
ask
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 (forall env. Config env -> env
customConfig Config env
r)})
instance MonadResource (Neovim env) where
liftResourceT :: forall a. ResourceT IO a -> Neovim env a
liftResourceT ResourceT IO a
m = forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadResource m => ResourceT IO a -> m a
liftResourceT ResourceT IO a
m
instance Fail.MonadFail (Neovim env) where
fail :: forall a. String -> Neovim env a
fail = forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc AnsiStyle -> NeovimException
ErrorMessage forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Pretty a => a -> Doc ann
pretty
ask' :: Neovim env (Config env)
ask' :: forall env. Neovim env (Config env)
ask' = forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim forall r (m :: * -> *). MonadReader r m => m r
ask
asks' :: (Config env -> a) -> Neovim env a
asks' :: forall env a. (Config env -> a) -> Neovim env a
asks' = forall env a. ResourceT (ReaderT (Config env) IO) a -> Neovim env a
Neovim forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
[ forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \(ArithException
_ :: ArithException) -> forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"ArithException (e.g. division by 0)"
, forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \(ArrayException
_ :: ArrayException) -> forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"ArrayException"
, forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \(ErrorCall
_ :: ErrorCall) -> forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"ErrorCall (e.g. call of undefined or error"
, forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \(PatternMatchFail
_ :: PatternMatchFail) -> forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"Pattern match failure"
, forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Handler forall a b. (a -> b) -> a -> b
$ \(SomeException
_ :: SomeException) -> forall {a} {b}. a -> IO (Either a b)
ret Doc ann
"Unhandled exception"
]
where
ret :: a -> IO (Either a b)
ret = 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
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 = forall a env.
(a -> IO a)
-> Config env -> Neovim env a -> IO (Either (Doc AnsiStyle) a)
runNeovimInternal (\a
a -> a
a forall a b. NFData a => a -> b -> b
`deepseq` 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 ResourceT (ReaderT (Config env) IO) a
a) =
(forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT ResourceT (ReaderT (Config env) IO) a
a)) Config env
r forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left SomeException
e -> case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just NeovimException
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 b c a. (b -> c) -> (a -> b) -> a -> c
. NeovimException -> Doc AnsiStyle
exceptionToDoc forall a b. (a -> b) -> a -> b
$ (NeovimException
e' :: NeovimException)
Maybe NeovimException
Nothing -> 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
"Context" forall a b. (a -> b) -> a -> b
$ String
"Converting Exception to Error message: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show 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 b c a. (b -> c) -> (a -> b) -> a -> c
. forall a ann. Show a => a -> Doc ann
viaShow) SomeException
e
Right a
res ->
(forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> IO a
f a
res) forall (m :: * -> *) a.
MonadUnliftIO m =>
m a -> [Handler m a] -> m a
`catches` forall ann a. [Handler IO (Either (Doc ann) a)]
exceptionHandlers
newUniqueFunctionName :: Neovim env FunctionName
newUniqueFunctionName :: forall env. Neovim env FunctionName
newUniqueFunctionName = do
TVar Integer
tu <- forall env a. (Config env -> a) -> Neovim env a
asks' forall env. Config env -> TVar Integer
uniqueCounter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> FunctionName
F forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
U.fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
Integer
u <- forall a. TVar a -> STM a
readTVar TVar Integer
tu
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Integer
tu forall a. Enum a => a -> a
succ
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
u
newtype FunctionType = 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 FunctionMapEntry = (FunctionalityDescription, FunctionType)
type FunctionMap = Map NvimMethod FunctionMapEntry
mkFunctionMap :: [FunctionMapEntry] -> FunctionMap
mkFunctionMap :: [FunctionMapEntry] -> FunctionMap
mkFunctionMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (\FunctionMapEntry
e -> (forall a. HasFunctionName a => a -> NvimMethod
nvimMethod (forall a b. (a, b) -> a
fst FunctionMapEntry
e), FunctionMapEntry
e))
data Config env = Config
{ forall env. Config env -> TQueue SomeMessage
eventQueue :: TQueue SomeMessage
, forall env. Config env -> MVar StateTransition
transitionTo :: MVar StateTransition
, forall env. Config env -> TMVar (Either String Int)
providerName :: TMVar (Either String Int)
, forall env. Config env -> TVar Integer
uniqueCounter :: TVar Integer
, forall env. Config env -> TMVar FunctionMap
globalFunctionMap :: TMVar FunctionMap
, forall env. Config env -> Maybe (PluginSettings env)
pluginSettings :: Maybe (PluginSettings env)
, forall env. Config env -> env
customConfig :: env
}
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 :: Maybe (PluginSettings env)
pluginSettings = 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 :: forall env. IO (Maybe String) -> IO env -> IO (Config env)
newConfig IO (Maybe String)
ioProviderName IO env
r = forall env.
TQueue SomeMessage
-> MVar StateTransition
-> TMVar (Either String Int)
-> TVar Integer
-> TMVar FunctionMap
-> Maybe (PluginSettings env)
-> env
-> Config env
Config
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => m (TQueue a)
newTQueueIO
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a. STM (TMVar a)
newEmptyTMVar) (forall (m :: * -> *) a. MonadIO m => a -> m (TMVar a)
newTMVarIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO (Maybe String)
ioProviderName)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Integer
100
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a. STM (TMVar a)
newEmptyTMVar
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
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 -> ShowS
[StateTransition] -> ShowS
StateTransition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StateTransition] -> ShowS
$cshowList :: [StateTransition] -> ShowS
show :: StateTransition -> String
$cshow :: StateTransition -> String
showsPrec :: Int -> StateTransition -> ShowS
$cshowsPrec :: Int -> StateTransition -> ShowS
Show)