module Ribosome.Test.Tmux where import Hedgehog (TestT) import Chiasma.Command.Pane (sendKeys) import Chiasma.Data.TmuxError (TmuxError) import Chiasma.Data.TmuxId (PaneId(PaneId)) import Chiasma.Monad.Stream (runTmux) import Chiasma.Native.Api (TmuxNative(TmuxNative)) import Chiasma.Test.Tmux (TmuxTestConf, withSystemTempDir) import qualified Chiasma.Test.Tmux as Chiasma (tmuxGuiSpec, tmuxSpec, tmuxSpec') import Control.Exception.Lifted (bracket) import Data.DeepPrisms (DeepPrisms) import qualified Data.Text.IO as Text import qualified Neovim.Context.Internal as Internal ( StateTransition(Quit), newConfig, retypeConfig, ) import Neovim.Plugin (Plugin(Plugin)) import Neovim.Plugin.Internal (wrapPlugin) import Neovim.RPC.Common (SocketType(UnixSocket), createHandle, newRPCConfig) import System.Directory (doesPathExist) import System.FilePath (()) import Ribosome.Config.Setting (updateSetting) import Ribosome.Config.Settings (tmuxSocket) import Ribosome.Control.Concurrent.Wait (waitIOPredDef) import Ribosome.Control.Exception (catchAny, tryAny) import Ribosome.Control.Monad.Ribo (NvimE, Ribo) import Ribosome.Control.Ribosome (Ribosome(Ribosome), newRibosomeTMVar) import Ribosome.Error.Report.Class (ReportError) import Ribosome.Msgpack.Encode (toMsgpack) import Ribosome.Nvim.Api.IO (vimSetVar) import Ribosome.Nvim.Api.RpcCall (RpcError) import Ribosome.Plugin.RpcHandler (RpcHandler) import Ribosome.System.Time (sleep) import Ribosome.Test.Embed ( Runner, TestConfig(..), inTestT, runPlugin, runTest, startHandlers, testNvimProcessConfig, withProcessTerm, ) import Ribosome.Test.Orphans () import Ribosome.Test.Run (UnitTest) import Ribosome.Test.Unit (uSpec) runSocketNvimHs :: MonadIO m => MonadFail m => ReportError e => RpcHandler e env n => MonadBaseControl IO m => TestConfig -> env -> n a -> Handle -> m a runSocketNvimHs conf ribo specThunk socket = do nvimConf <- liftIO (Internal.newConfig (pure Nothing) newRPCConfig) let testCfg = Internal.retypeConfig ribo nvimConf bracket (startHandlers socket socket conf nvimConf) liftIO (const $ runTest conf testCfg specThunk) externalNvimCmdline :: FilePath -> Text externalNvimCmdline socket = "nvim --listen " <> toText socket <> " -n -u NONE -i NONE" startNvimInTmux :: TmuxNative -> FilePath -> IO Handle startNvimInTmux api temp = do void $ runExceptT @TmuxError $ runTmux api $ sendKeys (PaneId 0) [externalNvimCmdline socket] _ <- waitIOPredDef (pure socket) doesPathExist catchAny err (createHandle (UnixSocket socket)) where socket = temp "nvim-socket" err (SomeException e) = fail ("startNvimInTmux: createHandle failed: " <> show e) runGui :: MonadIO m => MonadFail m => ReportError e => RpcHandler e env n => MonadBaseControl IO m => TmuxNative -> FilePath -> TestConfig -> env -> n a -> m a runGui api temp conf ribo specThunk = runSocketNvimHs conf ribo specThunk =<< liftIO (startNvimInTmux api temp) unsafeGuiSpec :: MonadIO m => MonadFail m => ReportError e => RpcHandler e env n => MonadBaseControl IO m => TmuxNative -> FilePath -> Runner n -> TestConfig -> env -> n a -> m a unsafeGuiSpec api temp runner conf s specThunk = runGui api temp conf s $ runner conf specThunk unsafeGuiSpecR :: MonadIO m => MonadFail m => ReportError e => MonadBaseControl IO m => RpcHandler e (Ribosome env) n => TmuxNative -> FilePath -> Runner n -> TestConfig -> env -> n a -> m a unsafeGuiSpecR api temp runner conf s specThunk = do tv <- newRibosomeTMVar s let ribo = Ribosome (tcPluginName conf) tv unsafeGuiSpec api temp runner conf ribo specThunk guiSpec :: MonadIO m => MonadFail m => ReportError e => MonadBaseControl IO m => DeepPrisms e RpcError => TestConfig -> TmuxNative -> s -> Ribo s e a -> m a guiSpec conf api env specThunk = do withSystemTempDir run where run tempdir = unsafeGuiSpecR api tempdir uSpec conf env specThunk withTmux :: DeepPrisms e RpcError => Ribo s e a -> TmuxNative -> Ribo s e a withTmux thunk (TmuxNative (Just socket)) = updateSetting tmuxSocket socket *> thunk withTmux _ _ = throwText "no socket in test tmux" tmuxSpec :: DeepPrisms e RpcError => ReportError e => TestConfig -> s -> TestT (Ribo s e) () -> UnitTest tmuxSpec conf env specThunk = inTestT specThunk \ th -> Chiasma.tmuxSpec \ api -> guiSpec conf api env (withTmux th api) tmuxSpec' :: DeepPrisms e RpcError => ReportError e => TmuxTestConf -> TestConfig -> s -> TestT (Ribo s e) () -> UnitTest tmuxSpec' tmuxConf conf env specThunk = inTestT specThunk \ th -> Chiasma.tmuxSpec' tmuxConf \ api -> guiSpec conf api env (withTmux th api) tmuxSpecDef :: DeepPrisms e RpcError => ReportError e => Default s => TestT (Ribo s e) () -> UnitTest tmuxSpecDef = tmuxSpec def def tmuxGuiSpec :: DeepPrisms e RpcError => ReportError e => TestConfig -> s -> Ribo s e () -> UnitTest tmuxGuiSpec conf env specThunk = Chiasma.tmuxGuiSpec run where run api = guiSpec conf api env (withTmux specThunk api) tmuxGuiSpecDef :: DeepPrisms e RpcError => ReportError e => Default s => Ribo s e () -> UnitTest tmuxGuiSpecDef = tmuxGuiSpec def def withTmuxInt :: NvimE e m => MonadIO m => Text -> m () -> TmuxNative -> m () withTmuxInt name thunk (TmuxNative (Just socket)) = do () <- vimSetVar (name <> "_tmux_socket") (toMsgpack socket) thunk withTmuxInt _ _ _ = throwText "no socket in test tmux" runTmuxWithPlugin :: MonadIO m => MonadFail m => ReportError e => RpcHandler e env n => MonadBaseControl IO m => TmuxNative -> TestConfig -> Plugin env -> n () -> m () runTmuxWithPlugin api conf plugin@(Plugin env _) thunk = do withSystemTempDir runProc where runProc temp = either logError pure =<< (tryAny (withProcessTerm (testNvimProcessConfig conf) (run temp))) run temp prc = do nvimConf <- liftIO (Internal.newConfig (pure Nothing) (pure env)) bracket (acquire prc nvimConf temp) release (const $ runTest conf nvimConf thunk) acquire _ nvimConf temp = do socket <- liftIO (startNvimInTmux api temp) runPlugin socket socket [wrapPlugin plugin] nvimConf <* sleep 0.5 release transitions = tryPutMVar transitions Internal.Quit *> sleep 0.5 logError (SomeException e) = liftIO (Text.hPutStr stderr ("runTmuxWithPlugin: nvim process failed with: " <> show e)) tmuxIntegrationSpecDef :: NvimE e n => MonadIO m => MonadIO n => MonadFail m => ReportError e => RpcHandler e env n => MonadBaseControl IO m => Text -> Plugin env -> n () -> m () tmuxIntegrationSpecDef name plugin specThunk = Chiasma.tmuxGuiSpec run where run api = runTmuxWithPlugin api def plugin (withTmuxInt name specThunk api)