module Ribosome.Test.Embed where

import Chiasma.Test.Tmux (withProcessWait)
import Control.Concurrent.Async.Lifted (async, cancel, race)
import Control.Concurrent.Lifted (fork)
import Control.Exception.Lifted (bracket, try)
import Control.Monad.Trans.Resource (runResourceT)
import qualified Data.Map.Strict as Map (fromList, toList, union)
import Hedgehog (TestT)
import Hedgehog.Internal.Property (mkTestT, runTestT)
import Neovim (Neovim, Object)
import Neovim.API.Text (vim_command)
import qualified Neovim.Context.Internal as Internal (
  Config,
  Neovim(Neovim),
  StateTransition(Failure, InitSuccess, Quit),
  globalFunctionMap,
  mkFunctionMap,
  newConfig,
  pluginSettings,
  retypeConfig,
  transitionTo,
  )
import Neovim.Main (standalone)
import Neovim.Plugin (Plugin(Plugin), startPluginThreads)
import Neovim.Plugin.Internal (NeovimPlugin, wrapPlugin)
import Neovim.RPC.Common (RPCConfig, newRPCConfig)
import Neovim.RPC.EventHandler (runEventHandler)
import Neovim.RPC.SocketReader (runSocketReader)
import System.Directory (makeAbsolute)
import System.Exit (ExitCode)
import System.Log.Logger (Priority(ERROR), setLevel, updateGlobalLogger)
import qualified System.Posix.Signals as Signal (killProcess, signalProcess)
import System.Process (getPid)
import System.Process.Typed (
  Process,
  ProcessConfig,
  createPipe,
  getExitCode,
  getStdin,
  getStdout,
  proc,
  setStdin,
  setStdout,
  startProcess,
  stopProcess,
  unsafeProcessHandle,
  )

import Ribosome.Api.Option (rtpCat)
import Ribosome.Control.Exception (tryAny)
import Ribosome.Control.Monad.Ribo (NvimE)
import Ribosome.Control.Ribosome (Ribosome(Ribosome), newRibosomeTMVar)
import qualified Ribosome.Data.ErrorReport as ErrorReport (ErrorReport(..))
import Ribosome.Error.Report.Class (ReportError(errorReport))
import Ribosome.Nvim.Api.IO (vimSetVar)
import Ribosome.Plugin.RpcHandler (RpcHandler(native))
import Ribosome.System.Time (sleep, sleepW)
import Ribosome.Test.Orphans ()

type Runner m = ∀ a . TestConfig -> m a -> m a

newtype Vars =
  Vars (Map Text Object)
  deriving (Vars -> Vars -> Bool
(Vars -> Vars -> Bool) -> (Vars -> Vars -> Bool) -> Eq Vars
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Vars -> Vars -> Bool
$c/= :: Vars -> Vars -> Bool
== :: Vars -> Vars -> Bool
$c== :: Vars -> Vars -> Bool
Eq, Int -> Vars -> ShowS
[Vars] -> ShowS
Vars -> String
(Int -> Vars -> ShowS)
-> (Vars -> String) -> ([Vars] -> ShowS) -> Show Vars
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Vars] -> ShowS
$cshowList :: [Vars] -> ShowS
show :: Vars -> String
$cshow :: Vars -> String
showsPrec :: Int -> Vars -> ShowS
$cshowsPrec :: Int -> Vars -> ShowS
Show)
  deriving newtype (Vars
Vars -> Default Vars
forall a. a -> Default a
def :: Vars
$cdef :: Vars
Default, b -> Vars -> Vars
NonEmpty Vars -> Vars
Vars -> Vars -> Vars
(Vars -> Vars -> Vars)
-> (NonEmpty Vars -> Vars)
-> (forall b. Integral b => b -> Vars -> Vars)
-> Semigroup Vars
forall b. Integral b => b -> Vars -> Vars
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Vars -> Vars
$cstimes :: forall b. Integral b => b -> Vars -> Vars
sconcat :: NonEmpty Vars -> Vars
$csconcat :: NonEmpty Vars -> Vars
<> :: Vars -> Vars -> Vars
$c<> :: Vars -> Vars -> Vars
Semigroup, Semigroup Vars
Vars
Semigroup Vars
-> Vars
-> (Vars -> Vars -> Vars)
-> ([Vars] -> Vars)
-> Monoid Vars
[Vars] -> Vars
Vars -> Vars -> Vars
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [Vars] -> Vars
$cmconcat :: [Vars] -> Vars
mappend :: Vars -> Vars -> Vars
$cmappend :: Vars -> Vars -> Vars
mempty :: Vars
$cmempty :: Vars
$cp1Monoid :: Semigroup Vars
Monoid)

-- |left biased
varsUnion :: Vars -> Vars -> Vars
varsUnion :: Vars -> Vars -> Vars
varsUnion (Vars Map Text Object
v1) (Vars Map Text Object
v2) =
  Map Text Object -> Vars
Vars (Map Text Object -> Map Text Object -> Map Text Object
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Text Object
v1 Map Text Object
v2)

varsFromList :: [(Text, Object)] -> Vars
varsFromList :: [(Text, Object)] -> Vars
varsFromList =
  Map Text Object -> Vars
Vars (Map Text Object -> Vars)
-> ([(Text, Object)] -> Map Text Object)
-> [(Text, Object)]
-> Vars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Object)] -> Map Text Object
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList

data TestConfig =
  TestConfig {
    TestConfig -> Text
tcPluginName :: Text,
    TestConfig -> Text
tcExtraRtp :: Text,
    TestConfig -> String
tcLogPath :: FilePath,
    TestConfig -> Word
tcTimeout :: Word,
    TestConfig -> Maybe [Text]
tcCmdline :: Maybe [Text],
    TestConfig -> [Text]
tcCmdArgs :: [Text],
    TestConfig -> Vars
tcVariables :: Vars
  }

instance Default TestConfig where
  def :: TestConfig
def = Text
-> Text
-> String
-> Word
-> Maybe [Text]
-> [Text]
-> Vars
-> TestConfig
TestConfig Text
"ribosome" Text
"test/u/fixtures/rtp" String
"test/u/temp/log" Word
10 Maybe [Text]
forall a. Default a => a
def [Text]
forall a. Default a => a
def Vars
forall a. Default a => a
def

defaultTestConfigWith :: Text -> Vars -> TestConfig
defaultTestConfigWith :: Text -> Vars -> TestConfig
defaultTestConfigWith Text
name Vars
vars =
  TestConfig
forall a. Default a => a
def { $sel:tcPluginName:TestConfig :: Text
tcPluginName = Text
name, $sel:tcVariables:TestConfig :: Vars
tcVariables = Vars
vars }

defaultTestConfig :: Text -> TestConfig
defaultTestConfig :: Text -> TestConfig
defaultTestConfig Text
name = Text -> Vars -> TestConfig
defaultTestConfigWith Text
name Vars
forall a. Default a => a
def

setVars :: ∀ m e. NvimE e m => Vars -> m ()
setVars :: Vars -> m ()
setVars (Vars Map Text Object
vars) =
  ((Text, Object) -> m ()) -> [(Text, Object)] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Text, Object) -> m ()
set (Map Text Object -> [(Text, Object)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Object
vars)
  where
    set :: (Text, Object) -> m ()
    set :: (Text, Object) -> m ()
set =
      (Text -> Object -> m ()) -> (Text, Object) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Object -> m ()
forall (m :: * -> *) e a.
(Nvim m, MonadDeepError e RpcError m, MsgpackDecode a) =>
Text -> Object -> m a
vimSetVar

setupPluginEnv ::
  MonadIO m =>
  NvimE e m =>
  TestConfig ->
  m ()
setupPluginEnv :: TestConfig -> m ()
setupPluginEnv (TestConfig Text
_ Text
rtp String
_ Word
_ Maybe [Text]
_ [Text]
_ Vars
vars) = do
  String
absRtp <- IO String -> m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
makeAbsolute (Text -> String
forall a. ToString a => a -> String
toString Text
rtp)
  Text -> m ()
forall e (m :: * -> *). NvimE e m => Text -> m ()
rtpCat (String -> Text
forall a. ToText a => a -> Text
toText String
absRtp)
  Vars -> m ()
forall (m :: * -> *) e. NvimE e m => Vars -> m ()
setVars Vars
vars

killPid :: Integral a => a -> IO ()
killPid :: a -> IO ()
killPid =
  IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException ()) -> IO ())
-> (a -> IO (Either SomeException ())) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO (Either SomeException ())
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Either SomeException a)
tryAny (IO () -> IO (Either SomeException ()))
-> (a -> IO ()) -> a -> IO (Either SomeException ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signal -> ProcessID -> IO ()
Signal.signalProcess Signal
Signal.killProcess (ProcessID -> IO ()) -> (a -> ProcessID) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ProcessID
forall a b. (Integral a, Num b) => a -> b
fromIntegral

killProcess :: Process i o e -> IO ()
killProcess :: Process i o e -> IO ()
killProcess Process i o e
prc = do
  IO (Either SomeException ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either SomeException ()) -> IO ())
-> IO (Either SomeException ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either SomeException ())
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException do
    let handle :: ProcessHandle
handle = Process i o e -> ProcessHandle
forall stdin stdout stderr.
Process stdin stdout stderr -> ProcessHandle
unsafeProcessHandle Process i o e
prc
    Maybe ProcessID
mayPid <- ProcessHandle -> IO (Maybe ProcessID)
getPid ProcessHandle
handle
    (ProcessID -> IO ()) -> Maybe ProcessID -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ ProcessID -> IO ()
forall a. Integral a => a -> IO ()
killPid Maybe ProcessID
mayPid

testNvimProcessConfig :: TestConfig -> ProcessConfig Handle Handle ()
testNvimProcessConfig :: TestConfig -> ProcessConfig Handle Handle ()
testNvimProcessConfig TestConfig {String
[Text]
Maybe [Text]
Word
Text
Vars
tcVariables :: Vars
tcCmdArgs :: [Text]
tcCmdline :: Maybe [Text]
tcTimeout :: Word
tcLogPath :: String
tcExtraRtp :: Text
tcPluginName :: Text
$sel:tcVariables:TestConfig :: TestConfig -> Vars
$sel:tcCmdArgs:TestConfig :: TestConfig -> [Text]
$sel:tcCmdline:TestConfig :: TestConfig -> Maybe [Text]
$sel:tcTimeout:TestConfig :: TestConfig -> Word
$sel:tcLogPath:TestConfig :: TestConfig -> String
$sel:tcExtraRtp:TestConfig :: TestConfig -> Text
$sel:tcPluginName:TestConfig :: TestConfig -> Text
..} =
  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 ())
-> ([Text] -> ProcessConfig () Handle ())
-> [Text]
-> ProcessConfig Handle Handle ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ())
-> ([Text] -> ProcessConfig () () ())
-> [Text]
-> ProcessConfig () Handle ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> ProcessConfig () () ()
proc String
"nvim" ([String] -> ProcessConfig () () ())
-> ([Text] -> [String]) -> [Text] -> ProcessConfig () () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> String) -> [Text] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
forall a. ToString a => a -> String
toString ([Text] -> ProcessConfig Handle Handle ())
-> [Text] -> ProcessConfig Handle Handle ()
forall a b. (a -> b) -> a -> b
$ [Text]
args [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
tcCmdArgs
  where
    args :: [Text]
args = [Text] -> Maybe [Text] -> [Text]
forall a. a -> Maybe a -> a
fromMaybe [Text]
defaultArgs Maybe [Text]
tcCmdline
    defaultArgs :: [Text]
defaultArgs = [Item [Text]
"--embed", Item [Text]
"-n", Item [Text]
"-u", Item [Text]
"NONE", Item [Text]
"-i", Item [Text]
"NONE"]

startHandlers ::
  MonadIO m =>
  Handle ->
  Handle ->
  TestConfig ->
  Internal.Config RPCConfig ->
  m (IO ())
startHandlers :: Handle -> Handle -> TestConfig -> Config RPCConfig -> m (IO ())
startHandlers Handle
stdoutHandle Handle
stdinHandle TestConfig{} Config RPCConfig
nvimConf = do
  Async ()
socketReader <- IO (Async ()) -> m (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Handle -> Config RPCConfig -> IO ()) -> Handle -> IO (Async ())
run Handle -> Config RPCConfig -> IO ()
runSocketReader Handle
stdoutHandle)
  Async ()
eventHandler <- IO (Async ()) -> m (Async ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ((Handle -> Config RPCConfig -> IO ()) -> Handle -> IO (Async ())
run Handle -> Config RPCConfig -> IO ()
runEventHandler Handle
stdinHandle)
  STM () -> m ()
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM () -> m ()) -> STM () -> m ()
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
nvimConf) ([FunctionMapEntry] -> FunctionMap
Internal.mkFunctionMap [])
  let stopEventHandlers :: IO ()
stopEventHandlers = (Async () -> IO ()) -> [Async ()] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ @[] Async () -> IO ()
forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel [Async ()
Item [Async ()]
socketReader, Async ()
Item [Async ()]
eventHandler]
  IO () -> m (IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return IO ()
stopEventHandlers
  where
    run :: (Handle -> Config RPCConfig -> IO ()) -> Handle -> IO (Async ())
run Handle -> Config RPCConfig -> IO ()
runner Handle
hand = IO () -> IO (Async ())
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m 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 ()
runner Handle
hand Config RPCConfig
emptyConf
    emptyConf :: Config RPCConfig
emptyConf = Config RPCConfig
nvimConf { pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = Maybe (PluginSettings RPCConfig)
forall a. Maybe a
Nothing }

startStdioHandlers ::
  MonadIO m =>
  NvimProc ->
  TestConfig ->
  Internal.Config RPCConfig ->
  m (IO ())
startStdioHandlers :: NvimProc -> TestConfig -> Config RPCConfig -> m (IO ())
startStdioHandlers NvimProc
prc =
  Handle -> Handle -> TestConfig -> Config RPCConfig -> m (IO ())
forall (m :: * -> *).
MonadIO m =>
Handle -> Handle -> TestConfig -> Config RPCConfig -> m (IO ())
startHandlers (NvimProc -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout NvimProc
prc) (NvimProc -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin NvimProc
prc)

runNeovimThunk :: Internal.Config e -> Neovim e a -> IO a
runNeovimThunk :: Config e -> Neovim e a -> IO a
runNeovimThunk Config e
cfg (Internal.Neovim ResourceT (ReaderT (Config e) IO) a
thunk) =
  ReaderT (Config e) IO a -> Config e -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (ResourceT (ReaderT (Config e) IO) a -> ReaderT (Config e) IO a
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT ResourceT (ReaderT (Config e) IO) a
thunk) Config e
cfg

type NvimProc = Process Handle Handle ()

waitQuit :: NvimProc -> IO (Maybe ExitCode)
waitQuit :: NvimProc -> IO (Maybe ExitCode)
waitQuit NvimProc
prc =
  Int -> IO (Maybe ExitCode)
wait Int
30
  where
    wait :: Int -> IO (Maybe ExitCode)
    wait :: Int -> IO (Maybe ExitCode)
wait Int
0 = Maybe ExitCode -> IO (Maybe ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ExitCode
forall a. Maybe a
Nothing
    wait Int
count = do
      Maybe ExitCode
code <- NvimProc -> IO (Maybe ExitCode)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m (Maybe ExitCode)
getExitCode NvimProc
prc
      case Maybe ExitCode
code of
        Just ExitCode
a -> Maybe ExitCode -> IO (Maybe ExitCode)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ExitCode -> IO (Maybe ExitCode))
-> Maybe ExitCode -> IO (Maybe ExitCode)
forall a b. (a -> b) -> a -> b
$ ExitCode -> Maybe ExitCode
forall a. a -> Maybe a
Just ExitCode
a
        Maybe ExitCode
Nothing -> do
          Double -> IO ()
forall (m :: * -> *). MonadIO m => Double -> m ()
sleep Double
0.1
          Int -> IO (Maybe ExitCode)
wait (Int -> IO (Maybe ExitCode)) -> Int -> IO (Maybe ExitCode)
forall a b. (a -> b) -> a -> b
$ Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

quitNvim :: Internal.Config e -> NvimProc -> IO ()
quitNvim :: Config e -> NvimProc -> IO ()
quitNvim Config e
testCfg NvimProc
prc = do
  Async ()
quitThread <- IO () -> IO (Async (StM IO ()))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async (IO () -> IO (Async (StM IO ())))
-> IO () -> IO (Async (StM IO ()))
forall a b. (a -> b) -> a -> b
$ Config e -> Neovim e () -> IO ()
forall e a. Config e -> Neovim e a -> IO a
runNeovimThunk Config e
testCfg Neovim e ()
forall env. Neovim env ()
quit
  Maybe ExitCode
result <- NvimProc -> IO (Maybe ExitCode)
waitQuit NvimProc
prc
  case Maybe ExitCode
result of
    Just ExitCode
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Maybe ExitCode
Nothing -> NvimProc -> IO ()
forall i o e. Process i o e -> IO ()
killProcess NvimProc
prc
  Async () -> IO ()
forall (m :: * -> *) a. MonadBase IO m => Async a -> m ()
cancel Async ()
quitThread
  where
    quit :: Neovim env ()
quit = Text -> forall env. Neovim env ()
vim_command Text
"qall!"

shutdownNvim :: Internal.Config e -> NvimProc -> IO () -> IO ()
shutdownNvim :: Config e -> NvimProc -> IO () -> IO ()
shutdownNvim Config e
_ NvimProc
prc IO ()
stopEventHandlers = do
  IO ()
stopEventHandlers
  NvimProc -> IO ()
forall i o e. Process i o e -> IO ()
killProcess NvimProc
prc

runTest ::
  MonadIO m =>
  MonadFail m =>
  ReportError e =>
  RpcHandler e env n =>
  MonadBaseControl IO m =>
  TestConfig ->
  Internal.Config env ->
  n a ->
  m a
runTest :: TestConfig -> Config env -> n a -> m a
runTest TestConfig{String
[Text]
Maybe [Text]
Word
Text
Vars
tcVariables :: Vars
tcCmdArgs :: [Text]
tcCmdline :: Maybe [Text]
tcTimeout :: Word
tcLogPath :: String
tcExtraRtp :: Text
tcPluginName :: Text
$sel:tcVariables:TestConfig :: TestConfig -> Vars
$sel:tcCmdArgs:TestConfig :: TestConfig -> [Text]
$sel:tcCmdline:TestConfig :: TestConfig -> Maybe [Text]
$sel:tcTimeout:TestConfig :: TestConfig -> Word
$sel:tcLogPath:TestConfig :: TestConfig -> String
$sel:tcExtraRtp:TestConfig :: TestConfig -> Text
$sel:tcPluginName:TestConfig :: TestConfig -> Text
..} Config env
testCfg n a
thunk = do
  m () -> m (Either e a) -> m (Either () (Either e a))
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m (Either a b)
race (Word -> m ()
forall (m :: * -> *). MonadIO m => Word -> m ()
sleepW Word
tcTimeout) (IO (Either e a) -> m (Either e a)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Config env -> Neovim env (Either e a) -> IO (Either e a)
forall e a. Config e -> Neovim e a -> IO a
runNeovimThunk Config env
testCfg (ExceptT e (Neovim env) a -> Neovim env (Either e a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT e (Neovim env) a -> Neovim env (Either e a))
-> ExceptT e (Neovim env) a -> Neovim env (Either e a)
forall a b. (a -> b) -> a -> b
$ n a -> ExceptT e (Neovim env) a
forall e env (m :: * -> *) a.
RpcHandler e env m =>
m a -> ExceptT e (Neovim env) a
native n a
thunk))) m (Either () (Either e a))
-> (Either () (Either e a) -> m a) -> m a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Right (Right a
a) -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
    Right (Left e
e) -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> (e -> String) -> e -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> (e -> Text) -> e -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> (e -> [Text]) -> e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ErrorReport -> [Text]
ErrorReport._log (ErrorReport -> [Text]) -> (e -> ErrorReport) -> e -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ErrorReport
forall a. ReportError a => a -> ErrorReport
errorReport (e -> m a) -> e -> m a
forall a b. (a -> b) -> a -> b
$ e
e
    Left ()
_ -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"test exceeded timeout of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Word -> String
forall b a. (Show a, IsString b) => a -> b
show Word
tcTimeout String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" seconds"

runEmbeddedNvim ::
  MonadIO m =>
  MonadFail m =>
  MonadBaseControl IO m =>
  RpcHandler e env n =>
  ReportError e =>
  TestConfig ->
  env ->
  n a ->
  NvimProc ->
  m a
runEmbeddedNvim :: TestConfig -> env -> n a -> NvimProc -> m a
runEmbeddedNvim TestConfig
conf env
ribo n a
thunk NvimProc
prc = do
  Config RPCConfig
nvimConf <- IO (Config RPCConfig) -> m (Config RPCConfig)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (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)
  let testCfg :: Config env
testCfg = env -> Config RPCConfig -> Config env
forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig env
ribo Config RPCConfig
nvimConf
  m (IO ()) -> (IO () -> m ()) -> (IO () -> m a) -> m a
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (NvimProc -> TestConfig -> Config RPCConfig -> m (IO ())
forall (m :: * -> *).
MonadIO m =>
NvimProc -> TestConfig -> Config RPCConfig -> m (IO ())
startStdioHandlers NvimProc
prc TestConfig
conf Config RPCConfig
nvimConf) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (IO () -> IO ()) -> IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config env -> NvimProc -> IO () -> IO ()
forall e. Config e -> NvimProc -> IO () -> IO ()
shutdownNvim Config env
testCfg NvimProc
prc) (m a -> IO () -> m a
forall a b. a -> b -> a
const (m a -> IO () -> m a) -> m a -> IO () -> m a
forall a b. (a -> b) -> a -> b
$ TestConfig -> Config env -> n a -> m a
forall (m :: * -> *) e env (n :: * -> *) a.
(MonadIO m, MonadFail m, ReportError e, RpcHandler e env n,
 MonadBaseControl IO m) =>
TestConfig -> Config env -> n a -> m a
runTest TestConfig
conf Config env
testCfg n a
thunk)

withProcessTerm ::
  MonadIO m =>
  MonadBaseControl IO m =>
  ProcessConfig stdin stdout stderr ->
  (Process stdin stdout stderr -> m a) ->
  m a
withProcessTerm :: ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm ProcessConfig stdin stdout stderr
config =
  m (Process stdin stdout stderr)
-> (Process stdin stdout stderr -> m (Either SomeException ()))
-> (Process stdin stdout stderr -> m a)
-> m a
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr
-> m (Process stdin stdout stderr)
startProcess ProcessConfig stdin stdout stderr
config) (forall a.
(MonadBaseControl IO m, Exception SomeException) =>
m a -> m (Either SomeException a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try @_ @SomeException (m () -> m (Either SomeException ()))
-> (Process stdin stdout stderr -> m ())
-> Process stdin stdout stderr
-> m (Either SomeException ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Process stdin stdout stderr -> m ()
forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
Process stdin stdout stderr -> m ()
stopProcess)

runEmbedded ::
  MonadIO m =>
  MonadFail m =>
  MonadBaseControl IO m =>
  RpcHandler e env n =>
  ReportError e =>
  TestConfig ->
  env ->
  n a ->
  m a
runEmbedded :: TestConfig -> env -> n a -> m a
runEmbedded TestConfig
conf env
ribo n a
thunk = do
  let pc :: ProcessConfig Handle Handle ()
pc = TestConfig -> ProcessConfig Handle Handle ()
testNvimProcessConfig TestConfig
conf
  ProcessConfig Handle Handle () -> (NvimProc -> m a) -> m a
forall (m :: * -> *) stdin stdout stderr a.
(MonadIO m, MonadBaseControl IO m) =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessWait ProcessConfig Handle Handle ()
pc ((NvimProc -> m a) -> m a) -> (NvimProc -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ TestConfig -> env -> n a -> NvimProc -> m a
forall (m :: * -> *) e env (n :: * -> *) a.
(MonadIO m, MonadFail m, MonadBaseControl IO m, RpcHandler e env n,
 ReportError e) =>
TestConfig -> env -> n a -> NvimProc -> m a
runEmbeddedNvim TestConfig
conf env
ribo n a
thunk

unsafeEmbeddedSpec ::
  MonadIO m =>
  MonadFail m =>
  MonadBaseControl IO m =>
  RpcHandler e env n =>
  ReportError e =>
  Runner n ->
  TestConfig ->
  env ->
  n a ->
  m a
unsafeEmbeddedSpec :: Runner n -> TestConfig -> env -> n a -> m a
unsafeEmbeddedSpec Runner n
runner TestConfig
conf env
s n a
spec =
  TestConfig -> env -> n a -> m a
forall (m :: * -> *) e env (n :: * -> *) a.
(MonadIO m, MonadFail m, MonadBaseControl IO m, RpcHandler e env n,
 ReportError e) =>
TestConfig -> env -> n a -> m a
runEmbedded TestConfig
conf env
s (n a -> m a) -> n a -> m a
forall a b. (a -> b) -> a -> b
$ TestConfig -> n a -> n a
Runner n
runner TestConfig
conf n a
spec

unsafeEmbeddedSpecR ::
  MonadIO m =>
  MonadFail m =>
  ReportError e =>
  MonadBaseControl IO m =>
  RpcHandler e (Ribosome env) n =>
  Runner n ->
  TestConfig ->
  env ->
  n a ->
  m a
unsafeEmbeddedSpecR :: Runner n -> TestConfig -> env -> n a -> m a
unsafeEmbeddedSpecR Runner n
runner TestConfig
conf env
env n a
spec = do
  TMVar (RibosomeState env)
tv <- env -> m (TMVar (RibosomeState env))
forall (m :: * -> *) s.
MonadIO m =>
s -> m (TMVar (RibosomeState s))
newRibosomeTMVar env
env
  let ribo :: Ribosome env
ribo = Text -> TMVar (RibosomeState env) -> Ribosome env
forall s. Text -> TMVar (RibosomeState s) -> Ribosome s
Ribosome (TestConfig -> Text
tcPluginName TestConfig
conf) TMVar (RibosomeState env)
tv
  Runner n -> TestConfig -> Ribosome env -> n a -> m a
forall (m :: * -> *) e env (n :: * -> *) a.
(MonadIO m, MonadFail m, MonadBaseControl IO m, RpcHandler e env n,
 ReportError e) =>
Runner n -> TestConfig -> env -> n a -> m a
unsafeEmbeddedSpec Runner n
runner TestConfig
conf Ribosome env
ribo n a
spec

runPlugin ::
  MonadIO m =>
  MonadBaseControl IO m =>
  Handle ->
  Handle ->
  [Neovim () NeovimPlugin] ->
  Internal.Config c ->
  m (MVar Internal.StateTransition)
runPlugin :: Handle
-> Handle
-> [Neovim () NeovimPlugin]
-> Config c
-> m (MVar StateTransition)
runPlugin Handle
evHandlerHandle Handle
sockreaderHandle [Neovim () NeovimPlugin]
plugins Config c
baseConf = do
  IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> (Logger -> Logger) -> IO ()
updateGlobalLogger String
"Neovim.Plugin" (Priority -> Logger -> Logger
setLevel Priority
ERROR))
  RPCConfig
rpcConf <- IO RPCConfig -> m RPCConfig
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO RPCConfig
forall (io :: * -> *). (Applicative io, MonadIO io) => io RPCConfig
newRPCConfig
  let conf :: Config RPCConfig
conf = RPCConfig -> Config c -> Config RPCConfig
forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig RPCConfig
rpcConf Config c
baseConf
  Async ()
ehTid <- ((Async (StM m ()) -> Async ())
-> m (Async (StM m ())) -> m (Async ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Async (StM m ()) -> Async ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Async (StM m ())) -> m (Async ()))
-> (IO () -> m (Async (StM m ()))) -> IO () -> m (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m (Async (StM m ()))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async (m () -> m (Async (StM m ())))
-> (IO () -> m ()) -> IO () -> m (Async (StM m ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO) (Handle -> Config RPCConfig -> IO ()
runEventHandler Handle
evHandlerHandle Config RPCConfig
conf { pluginSettings :: Maybe (PluginSettings RPCConfig)
Internal.pluginSettings = Maybe (PluginSettings RPCConfig)
forall a. Maybe a
Nothing })
  Async ()
srTid <- ((Async (StM m ()) -> Async ())
-> m (Async (StM m ())) -> m (Async ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Async (StM m ()) -> Async ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Async (StM m ())) -> m (Async ()))
-> (IO () -> m (Async (StM m ()))) -> IO () -> m (Async ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m () -> m (Async (StM m ()))
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> m (Async (StM m a))
async (m () -> m (Async (StM m ())))
-> (IO () -> m ()) -> IO () -> m (Async (StM m ()))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO) (Handle -> Config RPCConfig -> IO ()
runSocketReader Handle
sockreaderHandle Config RPCConfig
conf)
  m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ m () -> m ThreadId
forall (m :: * -> *). MonadBaseControl IO m => m () -> m ThreadId
fork (m () -> m ThreadId) -> m () -> m ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Config ()
-> [Neovim () NeovimPlugin]
-> IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
startPluginThreads (() -> Config c -> Config ()
forall env anotherEnv. env -> Config anotherEnv -> Config env
Internal.retypeConfig () Config c
baseConf) [Neovim () NeovimPlugin]
plugins IO (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()]))
-> (Either (Doc AnsiStyle) ([FunctionMapEntry], [Async ()])
    -> IO ())
-> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left Doc AnsiStyle
e -> do
      MVar StateTransition -> StateTransition -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (Config RPCConfig -> MVar StateTransition
forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
conf) (StateTransition -> IO ()) -> StateTransition -> IO ()
forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle -> StateTransition
Internal.Failure Doc AnsiStyle
e
      TransitionHandler ()
standalone [Async ()
Item [Async ()]
ehTid, Async ()
Item [Async ()]
srTid] Config RPCConfig
conf
    Right ([FunctionMapEntry]
funMapEntries, [Async ()]
pluginTids) -> do
      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
conf) ([FunctionMapEntry] -> FunctionMap
Internal.mkFunctionMap [FunctionMapEntry]
funMapEntries)
      MVar StateTransition -> StateTransition -> IO ()
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m ()
putMVar (Config RPCConfig -> MVar StateTransition
forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
conf) StateTransition
Internal.InitSuccess
      TransitionHandler ()
standalone (Async ()
srTid Async () -> [Async ()] -> [Async ()]
forall a. a -> [a] -> [a]
: Async ()
ehTid Async () -> [Async ()] -> [Async ()]
forall a. a -> [a] -> [a]
: [Async ()]
pluginTids) Config RPCConfig
conf
  return (Config RPCConfig -> MVar StateTransition
forall env. Config env -> MVar StateTransition
Internal.transitionTo Config RPCConfig
conf)

inTestT ::
  ∀ n m a .
  TestT n a ->
  (∀ x . n x -> m x) ->
  TestT m a
inTestT :: TestT n a -> (forall x. n x -> m x) -> TestT m a
inTestT TestT n a
ma forall x. n x -> m x
f =
  m (Either Failure a, Journal) -> TestT m a
forall (m :: * -> *) a. m (Either Failure a, Journal) -> TestT m a
mkTestT (n (Either Failure a, Journal) -> m (Either Failure a, Journal)
forall x. n x -> m x
f (TestT n a -> n (Either Failure a, Journal)
forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT TestT n a
ma))

integrationSpec ::
  ∀ n m e env a .
  NvimE e n =>
  MonadIO n =>
  MonadIO m =>
  MonadFail m =>
  ReportError e =>
  RpcHandler e env n =>
  MonadBaseControl IO m =>
  TestConfig ->
  Plugin env ->
  TestT n a ->
  TestT m a
integrationSpec :: TestConfig -> Plugin env -> TestT n a -> TestT m a
integrationSpec TestConfig
conf plugin :: Plugin env
plugin@(Plugin env
env [ExportedFunctionality env]
_) TestT n a
thunk =
  TestT n a -> (forall x. n x -> m x) -> TestT m a
forall (n :: * -> *) (m :: * -> *) a.
TestT n a -> (forall x. n x -> m x) -> TestT m a
inTestT TestT n a
thunk \ n x
na ->
    ProcessConfig Handle Handle () -> (NvimProc -> m x) -> m x
forall (m :: * -> *) stdin stdout stderr a.
(MonadIO m, MonadBaseControl IO m) =>
ProcessConfig stdin stdout stderr
-> (Process stdin stdout stderr -> m a) -> m a
withProcessTerm (TestConfig -> ProcessConfig Handle Handle ()
testNvimProcessConfig TestConfig
conf) (n x -> NvimProc -> m x
forall x. n x -> NvimProc -> m x
run n x
na)
  where
    run :: ∀ x . n x -> Process Handle Handle () -> m x
    run :: n x -> NvimProc -> m x
run n x
na NvimProc
prc = do
      Config env
nvimConf <- IO (Config env) -> m (Config env)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe String) -> IO env -> IO (Config env)
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) (env -> IO env
forall (f :: * -> *) a. Applicative f => a -> f a
pure env
env))
      m (MVar StateTransition)
-> (MVar StateTransition -> m ())
-> (MVar StateTransition -> m x)
-> m x
forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket (NvimProc -> Config env -> m (MVar StateTransition)
acquire NvimProc
prc Config env
nvimConf) MVar StateTransition -> m ()
forall (f :: * -> *). MonadIO f => MVar StateTransition -> f ()
release (m x -> MVar StateTransition -> m x
forall a b. a -> b -> a
const (m x -> MVar StateTransition -> m x)
-> m x -> MVar StateTransition -> m x
forall a b. (a -> b) -> a -> b
$ TestConfig -> Config env -> n x -> m x
forall (m :: * -> *) e env (n :: * -> *) a.
(MonadIO m, MonadFail m, ReportError e, RpcHandler e env n,
 MonadBaseControl IO m) =>
TestConfig -> Config env -> n a -> m a
runTest TestConfig
conf Config env
nvimConf (TestConfig -> n ()
forall (m :: * -> *) e.
(MonadIO m, NvimE e m) =>
TestConfig -> m ()
setupPluginEnv TestConfig
conf n () -> n x -> n x
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> n x
na))
    acquire :: NvimProc -> Config env -> m (MVar StateTransition)
acquire NvimProc
prc Config env
nvimConf =
      IO (MVar StateTransition) -> m (MVar StateTransition)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle
-> Handle
-> [Neovim () NeovimPlugin]
-> Config env
-> IO (MVar StateTransition)
forall (m :: * -> *) c.
(MonadIO m, MonadBaseControl IO m) =>
Handle
-> Handle
-> [Neovim () NeovimPlugin]
-> Config c
-> m (MVar StateTransition)
runPlugin (NvimProc -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdin
getStdin NvimProc
prc) (NvimProc -> Handle
forall stdin stdout stderr. Process stdin stdout stderr -> stdout
getStdout NvimProc
prc) [Plugin env -> Neovim () NeovimPlugin
forall (m :: * -> *) env.
Applicative m =>
Plugin env -> m NeovimPlugin
wrapPlugin Plugin env
plugin] Config env
nvimConf IO (MVar StateTransition) -> IO () -> IO (MVar StateTransition)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Double -> IO ()
forall (m :: * -> *). MonadIO m => Double -> m ()
sleep Double
0.5)
    release :: MVar StateTransition -> f ()
release MVar StateTransition
transitions =
      MVar StateTransition -> StateTransition -> f Bool
forall (m :: * -> *) a. MonadIO m => MVar a -> a -> m Bool
tryPutMVar MVar StateTransition
transitions StateTransition
Internal.Quit f Bool -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Double -> f ()
forall (m :: * -> *). MonadIO m => Double -> m ()
sleep Double
0.5

integrationSpecDef ::
  NvimE e n =>
  MonadIO m =>
  MonadIO n =>
  MonadFail m =>
  ReportError e =>
  RpcHandler e env n =>
  MonadBaseControl IO m =>
  Plugin env ->
  TestT n a ->
  TestT m a
integrationSpecDef :: Plugin env -> TestT n a -> TestT m a
integrationSpecDef =
  TestConfig -> Plugin env -> TestT n a -> TestT m a
forall (n :: * -> *) (m :: * -> *) e env a.
(NvimE e n, MonadIO n, MonadIO m, MonadFail m, ReportError e,
 RpcHandler e env n, MonadBaseControl IO m) =>
TestConfig -> Plugin env -> TestT n a -> TestT m a
integrationSpec TestConfig
forall a. Default a => a
def