module Neovim.Test (
testWithEmbeddedNeovim,
Seconds(..),
) where
import Neovim
import Neovim.API.Text
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 Control.Monad.Trans.Resource (runResourceT)
import Data.Text.Prettyprint.Doc (annotate, vsep)
import Data.Text.Prettyprint.Doc.Render.Terminal (Color (..), color)
import GHC.IO.Exception (ioe_filename)
import Path
import Path.IO
import System.Exit (ExitCode (..))
import System.IO (Handle)
import System.Process.Typed
import UnliftIO.Async (async, cancel)
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Exception
import UnliftIO.STM (atomically, putTMVar)
newtype Seconds = Seconds Word
testWithEmbeddedNeovim
:: Maybe (Path b File)
-> Seconds
-> env
-> Neovim env a
-> IO ()
testWithEmbeddedNeovim :: forall b env a.
Maybe (Path b File) -> Seconds -> env -> Neovim env a -> IO ()
testWithEmbeddedNeovim Maybe (Path b File)
file Seconds
timeout env
r (Internal.Neovim ResourceT (ReaderT (Config env) IO) a
a) =
IO ()
runTest forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` IOException -> IO ()
catchIfNvimIsNotOnPath
where
runTest :: IO ()
runTest = do
(Process Handle Handle ()
nvimProcess, Config RPCConfig
cfg, IO ()
cleanUp) <- forall b.
Maybe (Path b File)
-> Seconds
-> IO (Process Handle Handle (), Config RPCConfig, IO ())
startEmbeddedNvim Maybe (Path b File)
file Seconds
timeout
let testCfg :: Config env
testCfg = forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig env
r Config RPCConfig
cfg
forall (f :: * -> *) a. Functor f => f a -> f ()
void 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
testCfg
let Internal.Neovim ResourceT (ReaderT (Config env) IO) ()
q = Text -> forall env. Neovim env ()
vim_command Text
"qa!"
Async ()
testRunner <- 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 r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT forall {env}. ResourceT (ReaderT (Config env) IO) ()
q) Config env
testCfg
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 => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"Neovim returned with an exit status of: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Int
i
ExitCode
ExitSuccess ->
forall (m :: * -> *) a. Monad m => a -> m a
return ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel Async ()
testRunner
IO ()
cleanUp
catchIfNvimIsNotOnPath :: IOException -> IO ()
catchIfNvimIsNotOnPath :: IOException -> IO ()
catchIfNvimIsNotOnPath IOException
e = case IOException -> Maybe FilePath
ioe_filename IOException
e of
Just FilePath
"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 FilePath
_ ->
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO IOException
e
startEmbeddedNvim
:: Maybe (Path b File)
-> Seconds
-> IO (Process Handle Handle (), Internal.Config RPCConfig, IO ())
startEmbeddedNvim :: forall b.
Maybe (Path b File)
-> Seconds
-> IO (Process Handle Handle (), Config RPCConfig, IO ())
startEmbeddedNvim Maybe (Path b File)
file (Seconds Word
timeout) = do
[FilePath]
args <- case Maybe (Path b File)
file of
Maybe (Path b File)
Nothing ->
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Path b File
f -> do
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path b File
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail forall a b. (a -> b) -> a -> b
$ FilePath
"File not found: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> FilePath
show Path b File
f
forall (m :: * -> *) a. Monad m => a -> m a
return [forall b t. Path b t -> FilePath
toFilePath Path b File
f]
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
$ FilePath -> [FilePath] -> ProcessConfig () () ()
proc FilePath
"nvim" ([FilePath
"-n",FilePath
"--clean",FilePath
"--embed"] forall a. [a] -> [a] -> [a]
++ [FilePath]
args)
Config RPCConfig
cfg <- forall env. IO (Maybe FilePath) -> 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, MonadIO 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 -> Config RPCConfig -> IO ()
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 -> Config RPCConfig -> IO ()
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 })
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 [])
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 a b. (Integral a, Num b) => a -> b
fromIntegral Word
timeout) forall a. Num a => a -> a -> a
* Int
1000 forall a. Num a => a -> a -> a
* Int
1000
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 (m :: * -> *) a. Monad m => a -> m a
return ())
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 [Async ()
socketReader, Async ()
eventHandler, Async ()
timeoutAsync]
forall (m :: * -> *) a. Monad m => a -> m a
return (Process Handle Handle ()
nvimProcess, Config RPCConfig
cfg, IO ()
cleanUp)