{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Neovim.Test (
runInEmbeddedNeovim,
runInEmbeddedNeovim',
Seconds (..),
TestConfiguration (..),
testWithEmbeddedNeovim,
) where
import Neovim
import Neovim.API.Text (nvim_command, vim_command)
import qualified Neovim.Context.Internal as Internal
import Neovim.RPC.Common (RPCConfig, newRPCConfig)
import Neovim.RPC.EventHandler (runEventHandler)
import Neovim.RPC.SocketReader (runSocketReader)
import Control.Monad.Reader (runReaderT)
import Data.Default (Default)
import Data.Text (pack)
import GHC.IO.Exception (ioe_filename)
import Neovim.Plugin (startPluginThreads)
import Neovim.Util (oneLineErrorMessage)
import Prettyprinter (annotate, vsep)
import Prettyprinter.Render.Terminal (Color (..), color)
import System.Process.Typed (
ExitCode (ExitFailure, ExitSuccess),
Process,
createPipe,
getExitCode,
getStdin,
getStdout,
proc,
setStdin,
setStdout,
startProcess,
stopProcess,
waitExitCode,
)
import UnliftIO (Handle, IOException, async, atomically, cancel, catch, newEmptyMVar, putMVar, putTMVar, throwIO, timeout)
import UnliftIO.Concurrent (takeMVar, threadDelay)
newtype Seconds = Seconds Word
deriving (Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show)
microSeconds :: Integral i => Seconds -> i
microSeconds :: forall i. Integral i => Seconds -> i
microSeconds (Seconds Word
s) = forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
s forall a. Num a => a -> a -> a
* i
1000 forall a. Num a => a -> a -> a
* i
1000
newtype TestConfiguration = TestConfiguration
{ TestConfiguration -> Seconds
cancelAfter :: Seconds
}
deriving (Int -> TestConfiguration -> ShowS
[TestConfiguration] -> ShowS
TestConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TestConfiguration] -> ShowS
$cshowList :: [TestConfiguration] -> ShowS
show :: TestConfiguration -> String
$cshow :: TestConfiguration -> String
showsPrec :: Int -> TestConfiguration -> ShowS
$cshowsPrec :: Int -> TestConfiguration -> ShowS
Show)
instance Default TestConfiguration where
def :: TestConfiguration
def =
TestConfiguration
{ cancelAfter :: Seconds
cancelAfter = Word -> Seconds
Seconds Word
2
}
runInEmbeddedNeovim :: TestConfiguration -> Plugin env -> Neovim env a -> IO ()
runInEmbeddedNeovim :: forall env a.
TestConfiguration -> Plugin env -> Neovim env a -> IO ()
runInEmbeddedNeovim TestConfiguration{Seconds
cancelAfter :: Seconds
cancelAfter :: TestConfiguration -> Seconds
..} Plugin env
plugin Neovim env a
action =
forall a. IO a -> IO ()
warnIfNvimIsNotOnPath IO ()
runTest
where
runTest :: IO ()
runTest = do
MVar a
resultMVar <- forall (m :: * -> *) a. MonadIO m => m (MVar a)
newEmptyMVar
let action' :: Neovim env ()
action' = do
a
result <- Neovim env a
action
MVar StateTransition
q <- forall env a. (Config env -> a) -> Neovim env a
Internal.asks' forall env. Config env -> MVar StateTransition
Internal.transitionTo
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar StateTransition
q StateTransition
Internal.Quit
Async ()
_ <- 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 a b. (a -> b) -> a -> b
$ forall env. Text -> Neovim env ()
vim_command Text
"qa!"
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar MVar a
resultMVar a
result
(Process Handle Handle ()
nvimProcess, IO ()
cleanUp) <- forall env.
Seconds
-> Plugin env
-> Neovim env ()
-> IO (Process Handle Handle (), IO ())
startEmbeddedNvim Seconds
cancelAfter Plugin env
plugin Neovim env ()
action'
Maybe a
result <- forall (m :: * -> *) a.
MonadUnliftIO m =>
Int -> m a -> m (Maybe a)
timeout (forall i. Integral i => Seconds -> i
microSeconds Seconds
cancelAfter) (forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar MVar a
resultMVar)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode Process Handle Handle ()
nvimProcess forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ExitFailure Int
i ->
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Neovim returned with an exit status of: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
i
ExitCode
ExitSuccess -> case Maybe a
result of
Maybe a
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Test timed out"
Just a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
IO ()
cleanUp
type TransitionHandler a = Internal.Config RPCConfig -> IO a
testTransitionHandler :: IO a -> TransitionHandler ()
testTransitionHandler :: forall a. IO a -> TransitionHandler ()
testTransitionHandler IO a
onInitAction Config RPCConfig
cfg =
forall (m :: * -> *) a. MonadIO m => MVar a -> m a
takeMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
StateTransition
Internal.InitSuccess -> do
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
onInitAction
forall a. IO a -> TransitionHandler ()
testTransitionHandler IO a
onInitAction Config RPCConfig
cfg
StateTransition
Internal.Restart -> do
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Restart unexpected"
Internal.Failure Doc AnsiStyle
e -> do
forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> Text
oneLineErrorMessage Doc AnsiStyle
e
StateTransition
Internal.Quit -> do
forall (m :: * -> *) a. Monad m => a -> m a
return ()
runInEmbeddedNeovim' :: TestConfiguration -> Neovim () a -> IO ()
runInEmbeddedNeovim' :: forall a. TestConfiguration -> Neovim () a -> IO ()
runInEmbeddedNeovim' TestConfiguration
testCfg = forall env a.
TestConfiguration -> Plugin env -> Neovim env a -> IO ()
runInEmbeddedNeovim TestConfiguration
testCfg Plugin{environment :: ()
environment = (), exports :: [ExportedFunctionality ()]
exports = []}
{-# DEPRECATED testWithEmbeddedNeovim "Use \"runInEmbeddedNeovim def env action\" and open files with nvim_command \"edit file\"" #-}
testWithEmbeddedNeovim ::
Maybe FilePath ->
Seconds ->
env ->
Neovim env a ->
IO ()
testWithEmbeddedNeovim :: forall env a.
Maybe String -> Seconds -> env -> Neovim env a -> IO ()
testWithEmbeddedNeovim Maybe String
file Seconds
timeoutAfter env
env Neovim env a
action =
forall env a.
TestConfiguration -> Plugin env -> Neovim env a -> IO ()
runInEmbeddedNeovim
forall a. Default a => a
def{cancelAfter :: Seconds
cancelAfter = Seconds
timeoutAfter}
Plugin{environment :: env
environment = env
env, exports :: [ExportedFunctionality env]
exports = []}
(forall {env}. Neovim env ()
openTestFile forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Neovim env a
action)
where
openTestFile :: Neovim env ()
openTestFile = case Maybe String
file of
Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just String
f -> forall env. Text -> Neovim env ()
nvim_command forall a b. (a -> b) -> a -> b
$ String -> Text
pack forall a b. (a -> b) -> a -> b
$ String
"edit " forall a. [a] -> [a] -> [a]
++ String
f
warnIfNvimIsNotOnPath :: IO a -> IO ()
warnIfNvimIsNotOnPath :: forall a. IO a -> IO ()
warnIfNvimIsNotOnPath IO a
test = forall (f :: * -> *) a. Functor f => f a -> f ()
void IO a
test forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \(IOException
e :: IOException) -> case IOException -> Maybe String
ioe_filename IOException
e of
Just String
"nvim" ->
Doc AnsiStyle -> IO ()
putDoc forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red) forall a b. (a -> b) -> a -> b
$
forall ann. [Doc ann] -> Doc ann
vsep
[ Doc AnsiStyle
"The neovim executable 'nvim' is not on the PATH."
, Doc AnsiStyle
"You may not be testing fully!"
]
Maybe String
_ ->
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e
startEmbeddedNvim ::
Seconds ->
Plugin env ->
Neovim env () ->
IO (Process Handle Handle (), IO ())
startEmbeddedNvim :: forall env.
Seconds
-> Plugin env
-> Neovim env ()
-> IO (Process Handle Handle (), IO ())
startEmbeddedNvim Seconds
timeoutAfter Plugin env
plugin (Internal.Neovim ReaderT (Config env) IO ()
action) = do
Process Handle Handle ()
nvimProcess <-
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess forall a b. (a -> b) -> a -> b
$
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe forall a b. (a -> b) -> a -> b
$
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe forall a b. (a -> b) -> a -> b
$
String -> [String] -> ProcessConfig () () ()
proc String
"nvim" [String
"-n", String
"--clean", String
"--embed"]
Config RPCConfig
cfg <- forall env. IO (Maybe String) -> IO env -> IO (Config env)
Internal.newConfig (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing) forall (io :: * -> *).
(Applicative io, MonadUnliftIO io) =>
io RPCConfig
newRPCConfig
Async ()
socketReader <-
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 a b. (a -> b) -> a -> b
$
Handle -> TransitionHandler ()
runSocketReader
(forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process Handle Handle ()
nvimProcess)
(Config RPCConfig
cfg{pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = forall a. Maybe a
Nothing})
Async ()
eventHandler <-
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 a b. (a -> b) -> a -> b
$
Handle -> TransitionHandler ()
runEventHandler
(forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin Process Handle Handle ()
nvimProcess)
(Config RPCConfig
cfg{pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = forall a. Maybe a
Nothing})
let actionCfg :: Config env
actionCfg = forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig (forall env. Plugin env -> env
environment Plugin env
plugin) Config RPCConfig
cfg
action' :: IO ()
action' = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (Config env) IO ()
action Config env
actionCfg
[Async ()]
pluginHandlers <-
Config ()
-> [Neovim () NeovimPlugin]
-> IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
startPluginThreads (forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig () Config RPCConfig
cfg) [forall (m :: * -> *) env.
Applicative m =>
Plugin env -> m NeovimPlugin
wrapPlugin Plugin env
plugin] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Doc AnsiStyle
e -> do
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> StateTransition
Internal.Failure Doc AnsiStyle
e
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
Right ([FunctionMapEntry]
funMapEntries, [Async ()]
pluginTids) -> do
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically forall a b. (a -> b) -> a -> b
$
forall a. TMVar a -> a -> STM ()
putTMVar
(forall env. Config env -> TMVar FunctionMap
Internal.globalFunctionMap Config RPCConfig
cfg)
([FunctionMapEntry] -> FunctionMap
Internal.mkFunctionMap [FunctionMapEntry]
funMapEntries)
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
cfg) StateTransition
Internal.InitSuccess
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Async ()]
pluginTids
Async ()
transitionHandler <- 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 a b. (a -> b) -> a -> b
$ do
forall a. IO a -> TransitionHandler ()
testTransitionHandler IO ()
action' Config RPCConfig
cfg
Async ()
timeoutAsync <- 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 a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay forall a b. (a -> b) -> a -> b
$ forall i. Integral i => Seconds -> i
microSeconds Seconds
timeoutAfter
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m (Maybe ExitCode)
getExitCode Process Handle Handle ()
nvimProcess forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess Process Handle Handle ()
nvimProcess) (\ExitCode
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
let cleanUp :: IO ()
cleanUp =
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel forall a b. (a -> b) -> a -> b
$
[Async ()
socketReader, Async ()
eventHandler, Async ()
timeoutAsync, Async ()
transitionHandler]
forall a. [a] -> [a] -> [a]
++ [Async ()]
pluginHandlers
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Process Handle Handle ()
nvimProcess, IO ()
cleanUp)