{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Neovim.Test (
testWithEmbeddedNeovim,
Seconds(..),
) where
import Neovim
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,
putDoc)
import GHC.IO.Exception (ioe_filename)
import System.Directory
import System.Exit (ExitCode (..))
import System.IO (Handle)
import System.Process
import UnliftIO.Async (async, cancel)
import UnliftIO.Concurrent (threadDelay)
import UnliftIO.Exception
import UnliftIO.STM (atomically,
putTMVar)
newtype Seconds = Seconds Word
testWithEmbeddedNeovim
:: Maybe FilePath
-> Seconds
-> env
-> Neovim env a
-> IO ()
testWithEmbeddedNeovim file timeout r (Internal.Neovim a) =
runTest `catch` catchIfNvimIsNotOnPath
where
runTest = do
(_, _, ph, cfg, cleanUp) <- startEmbeddedNvim file timeout
let testCfg = Internal.retypeConfig r cfg
void $ runReaderT (runResourceT a) testCfg
let Internal.Neovim q = vim_command "qa!"
testRunner <- async . void $ runReaderT (runResourceT q) testCfg
waitForProcess ph >>= \case
ExitFailure i ->
fail $ "Neovim returned with an exit status of: " ++ show i
ExitSuccess ->
return ()
cancel testRunner
cleanUp
catchIfNvimIsNotOnPath :: IOException -> IO ()
catchIfNvimIsNotOnPath e = case ioe_filename e of
Just "nvim" ->
putDoc . annotate (color Red) $ vsep
[ "The neovim executable 'nvim' is not on the PATH."
, "You may not be testing fully!"
]
_ ->
throwIO e
startEmbeddedNvim
:: Maybe FilePath
-> Seconds
-> IO (Handle, Handle, ProcessHandle, Internal.Config RPCConfig, IO ())
startEmbeddedNvim file (Seconds timeout) = do
args <- case file of
Nothing ->
return []
Just f -> do
unlessM (doesFileExist f) . fail $ "File not found: " ++ f
return [f]
(Just hin, Just hout, _, ph) <-
createProcess (proc "nvim" (["-n","-u","NONE","--embed"] ++ args))
{ std_in = CreatePipe
, std_out = CreatePipe
}
cfg <- Internal.newConfig (pure Nothing) newRPCConfig
socketReader <- async . void $ runSocketReader
hout
(cfg { Internal.pluginSettings = Nothing })
eventHandler <- async . void $ runEventHandler
hin
(cfg { Internal.pluginSettings = Nothing })
atomically $ putTMVar
(Internal.globalFunctionMap cfg)
(Internal.mkFunctionMap [])
timeoutAsync <- async . void $ do
threadDelay $ (fromIntegral timeout) * 1000 * 1000
getProcessExitCode ph >>= maybe (terminateProcess ph) (\_ -> return ())
let cleanUp = mapM_ cancel [socketReader, eventHandler, timeoutAsync]
return (hin, hout, ph, cfg, cleanUp)