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 :: 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 IO () -> (IOException -> IO ()) -> IO ()
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) <- Maybe (Path b File)
-> Seconds
-> IO (Process Handle Handle (), Config RPCConfig, IO ())
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 = env -> Config RPCConfig -> Config env
forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig env
r Config RPCConfig
cfg
IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
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
testCfg
let Internal.Neovim ResourceT (ReaderT (Config env) IO) ()
q = Text -> forall env. Neovim env ()
vim_command Text
"qa!"
Async ()
testRunner <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ()))
-> (IO () -> IO ()) -> IO () -> IO (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ ReaderT (Config env) IO () -> Config env -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ResourceT (ReaderT (Config env) IO) ()
-> ReaderT (Config env) IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT ResourceT (ReaderT (Config env) IO) ()
forall env. ResourceT (ReaderT (Config env) IO) ()
q) Config env
testCfg
Process Handle Handle () -> IO ExitCode
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ExitCode
waitExitCode Process Handle Handle ()
nvimProcess IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
ExitFailure Int
i ->
String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Neovim returned with an exit status of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i
ExitCode
ExitSuccess ->
() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Async () -> IO ()
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 String
ioe_filename IOException
e of
Just String
"nvim" ->
Doc AnsiStyle -> IO ()
putDoc (Doc AnsiStyle -> IO ())
-> (Doc AnsiStyle -> Doc AnsiStyle) -> Doc AnsiStyle -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnsiStyle -> Doc AnsiStyle -> Doc AnsiStyle
forall ann. ann -> Doc ann -> Doc ann
annotate (Color -> AnsiStyle
color Color
Red) (Doc AnsiStyle -> IO ()) -> Doc AnsiStyle -> IO ()
forall a b. (a -> b) -> a -> b
$ [Doc AnsiStyle] -> Doc AnsiStyle
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
_ ->
IOException -> IO ()
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 :: Maybe (Path b File)
-> Seconds
-> IO (Process Handle Handle (), Config RPCConfig, IO ())
startEmbeddedNvim Maybe (Path b File)
file (Seconds Word
timeout) = do
[String]
args <- case Maybe (Path b File)
file of
Maybe (Path b File)
Nothing ->
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just Path b File
f -> do
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM (Path b File -> IO Bool
forall (m :: * -> *) b. MonadIO m => Path b File -> m Bool
doesFileExist Path b File
f) (IO () -> IO ()) -> (String -> IO ()) -> String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"File not found: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Path b File -> String
forall a. Show a => a -> String
show Path b File
f
[String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [Path b File -> String
forall b t. Path b t -> String
toFilePath Path b File
f]
Process Handle Handle ()
nvimProcess <- ProcessConfig Handle Handle () -> IO (Process Handle Handle ())
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess
(ProcessConfig Handle Handle () -> IO (Process Handle Handle ()))
-> ProcessConfig Handle Handle () -> IO (Process Handle Handle ())
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STInput Handle
-> ProcessConfig () Handle () -> ProcessConfig Handle Handle ()
forall stdin stdin0 stdout stderr.
StreamSpec 'STInput stdin
-> ProcessConfig stdin0 stdout stderr
-> ProcessConfig stdin stdout stderr
setStdin StreamSpec 'STInput Handle
forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe
(ProcessConfig () Handle () -> ProcessConfig Handle Handle ())
-> ProcessConfig () Handle () -> ProcessConfig Handle Handle ()
forall a b. (a -> b) -> a -> b
$ StreamSpec 'STOutput Handle
-> ProcessConfig () () () -> ProcessConfig () Handle ()
forall stdout stdin stdout0 stderr.
StreamSpec 'STOutput stdout
-> ProcessConfig stdin stdout0 stderr
-> ProcessConfig stdin stdout stderr
setStdout StreamSpec 'STOutput Handle
forall (anyStreamType :: StreamType).
StreamSpec anyStreamType Handle
createPipe
(ProcessConfig () () () -> ProcessConfig () Handle ())
-> ProcessConfig () () () -> ProcessConfig () Handle ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
proc String
"nvim" ([String
"-n",String
"-u",String
"NONE",String
"--embed"] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
args)
Config RPCConfig
cfg <- IO (Maybe String) -> IO RPCConfig -> IO (Config RPCConfig)
forall env. IO (Maybe String) -> IO env -> IO (Config env)
Internal.newConfig (Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing) IO RPCConfig
forall (io :: * -> *). (Applicative io, MonadIO io) => io RPCConfig
newRPCConfig
Async ()
socketReader <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ()))
-> (IO () -> IO ()) -> IO () -> IO (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Handle -> Config RPCConfig -> IO ()
runSocketReader
(Process Handle Handle () -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout Process Handle Handle ()
nvimProcess)
(Config RPCConfig
cfg { pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = Maybe (PluginSettings RPCConfig)
forall a. Maybe a
Nothing })
Async ()
eventHandler <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ()))
-> (IO () -> IO ()) -> IO () -> IO (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ Handle -> Config RPCConfig -> IO ()
runEventHandler
(Process Handle Handle () -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin Process Handle Handle ()
nvimProcess)
(Config RPCConfig
cfg { pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = Maybe (PluginSettings RPCConfig)
forall a. Maybe a
Nothing })
STM () -> IO ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TMVar FunctionMap -> FunctionMap -> STM ()
forall a. TMVar a -> a -> STM ()
putTMVar
(Config RPCConfig -> TMVar FunctionMap
forall env. Config env -> TMVar FunctionMap
Internal.globalFunctionMap Config RPCConfig
cfg)
([FunctionMapEntry] -> FunctionMap
Internal.mkFunctionMap [])
Async ()
timeoutAsync <- IO () -> IO (Async ())
forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (Async a)
async (IO () -> IO (Async ()))
-> (IO () -> IO ()) -> IO () -> IO (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO () -> IO (Async ())) -> IO () -> IO (Async ())
forall a b. (a -> b) -> a -> b
$ do
Int -> IO ()
forall (m :: * -> *). MonadIO m => Int -> m ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
timeout) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000
Process Handle Handle () -> IO (Maybe ExitCode)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m (Maybe ExitCode)
getExitCode Process Handle Handle ()
nvimProcess IO (Maybe ExitCode) -> (Maybe ExitCode -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> (ExitCode -> IO ()) -> Maybe ExitCode -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Process Handle Handle () -> IO ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess Process Handle Handle ()
nvimProcess) (\ExitCode
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
let cleanUp :: IO ()
cleanUp = (Async () -> IO ()) -> [Async ()] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async () -> IO ()
forall (m :: * -> *) a. MonadIO m => Async a -> m ()
cancel [Async ()
socketReader, Async ()
eventHandler, Async ()
timeoutAsync]
(Process Handle Handle (), Config RPCConfig, IO ())
-> IO (Process Handle Handle (), Config RPCConfig, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Process Handle Handle ()
nvimProcess, Config RPCConfig
cfg, IO ()
cleanUp)