ribosome-test (empty) → 0.3.0.0
raw patch · 14 files changed
+1021/−0 lines, 14 filesdep +HTFdep +base-nopreludedep +bytestring
Dependencies added: HTF, base-noprelude, bytestring, chiasma, cornea, data-default, directory, exceptions, filepath, free, hslogger, lifted-base, messagepack, monad-control, mtl, nvim-hs, process, relude, resourcet, ribosome, text, transformers, typed-process, unix, unliftio, unliftio-core
Files
- LICENSE +55/−0
- lib/Prelude.hs +5/−0
- lib/Ribosome/Test/Await.hs +47/−0
- lib/Ribosome/Test/Embed.hs +283/−0
- lib/Ribosome/Test/Exists.hs +47/−0
- lib/Ribosome/Test/File.hs +42/−0
- lib/Ribosome/Test/Functional.hs +74/−0
- lib/Ribosome/Test/Input.hs +20/−0
- lib/Ribosome/Test/Orphans.hs +29/−0
- lib/Ribosome/Test/Screenshot.hs +50/−0
- lib/Ribosome/Test/Tmux.hs +180/−0
- lib/Ribosome/Test/Ui.hs +38/−0
- lib/Ribosome/Test/Unit.hs +76/−0
- ribosome-test.cabal +75/−0
+ LICENSE view
@@ -0,0 +1,55 @@+# Blue Oak Model License++Version 1.0.0++## Purpose++This license gives everyone as much permission to work with+this software as possible, while protecting contributors+from liability.++## Acceptance++In order to receive this license, you must agree to its+rules. The rules of this license are both obligations+under that agreement and conditions to your license.+You must not do anything with this software that triggers+a rule that you cannot or will not follow.++## Copyright++Each contributor licenses you to do everything with this+software that would otherwise infringe that contributor's+copyright in it.++## Notices++You must ensure that everyone who gets a copy of+any part of this software from you, with or without+changes, also gets the text of this license or a link to+<https://blueoakcouncil.org/license/1.0.0>.++## Excuse++If anyone notifies you in writing that you have not+complied with [Notices](#notices), you can keep your+license by taking all practical steps to comply within 30+days after the notice. If you do not do so, your license+ends immediately.++## Patent++Each contributor licenses you to do everything with this+software that would otherwise infringe any patent claims+they can license or become able to license.++## Reliability++No contributor can revoke this license.++## No Liability++***As far as the law allows, this software comes as is,+without any warranty or condition, and no contributor+will be liable to anyone for any damages related to this+software or this license, under any kind of legal claim.***
+ lib/Prelude.hs view
@@ -0,0 +1,5 @@+module Prelude (+ module Ribosome.PreludeExport+) where++import Ribosome.PreludeExport
+ lib/Ribosome/Test/Await.hs view
@@ -0,0 +1,47 @@+module Ribosome.Test.Await where++import Control.Exception (throw)+import Control.Monad.Error.Class (MonadError, catchError)+import Control.Monad.IO.Class (MonadIO)+import Control.Monad.Trans.Class (lift)+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Except (ExceptT, runExceptT)+import Test.Framework.AssertM (AssertM)++import Ribosome.Control.Concurrent.Wait (WaitError(Thrown), waitIODef)++await ::+ Show e =>+ MonadError e m =>+ MonadIO m =>+ MonadFail m =>+ MonadBaseControl IO m =>+ AssertM m =>+ (a -> m b) ->+ m a ->+ m b+await assertion acquire = do+ r <- waitIODef acquire' check'+ either failure return r+ where+ acquire' = catchError (Right <$> acquire) (return . Left . show)+ check' (Right a) = Right <$> assertion a+ check' (Left e) = return (Left e)+ failure (Thrown e) = throw e+ failure e = fail $ "await failed with " <> show e++await' ::+ ∀ a b m.+ MonadIO m =>+ MonadFail m =>+ MonadBaseControl IO m =>+ AssertM (ExceptT () m) =>+ (a -> m b) ->+ m a ->+ m b+await' assertion acquire = do+ r <- runExceptT $ await assertion' (lift acquire)+ either (const $ fail "internal error") return r+ where+ assertion' :: a -> ExceptT () m b+ assertion' = lift . assertion
+ lib/Ribosome/Test/Embed.hs view
@@ -0,0 +1,283 @@+module Ribosome.Test.Embed where++import Control.Concurrent (forkIO)+import Control.Monad.IO.Class (MonadIO, liftIO)+import Control.Monad.Reader (runReaderT)+import Control.Monad.Trans.Except (runExceptT)+import Control.Monad.Trans.Resource (runResourceT)+import Data.Default (Default(def))+import Data.Foldable (traverse_)+import Data.Functor (void)+import Data.Maybe (fromMaybe)+import GHC.IO.Handle (Handle)+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, 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,+ unsafeProcessHandle,+ withProcess,+ )+import UnliftIO.Async (async, cancel, race)+import UnliftIO.Exception (bracket, tryAny)+import UnliftIO.MVar (MVar)+import UnliftIO.STM (putTMVar)++import Ribosome.Api.Option (rtpCat)+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 = TestConfig -> m () -> m ()++newtype Vars =+ Vars [(Text, Object)]+ deriving (Eq, Show, Semigroup, Monoid, Default)++data TestConfig =+ TestConfig {+ tcPluginName :: Text,+ tcExtraRtp :: Text,+ tcLogPath :: FilePath,+ tcTimeout :: Word,+ tcCmdline :: Maybe [Text],+ tcCmdArgs :: [Text],+ tcVariables :: Vars+ }++instance Default TestConfig where+ def = TestConfig "ribosome" "test/f/fixtures/rtp" "test/f/temp/log" 10 def def (Vars [])++defaultTestConfigWith :: Text -> Vars -> TestConfig+defaultTestConfigWith name vars =+ def { tcPluginName = name, tcVariables = vars }++defaultTestConfig :: Text -> TestConfig+defaultTestConfig name = defaultTestConfigWith name (Vars [])++setVars :: ∀ m e. NvimE e m => Vars -> m ()+setVars (Vars vars) =+ traverse_ set vars+ where+ set :: (Text, Object) -> m ()+ set = uncurry vimSetVar++setupPluginEnv :: (MonadIO m, NvimE e m) => TestConfig -> m ()+setupPluginEnv (TestConfig _ rtp _ _ _ _ vars) = do+ absRtp <- liftIO $ makeAbsolute (toString rtp)+ rtpCat (toText absRtp)+ setVars vars++killPid :: Integral a => a -> IO ()+killPid =+ void . tryAny . Signal.signalProcess Signal.killProcess . fromIntegral++killProcess :: Process i o e -> IO ()+killProcess prc = do+ let handle = unsafeProcessHandle prc+ mayPid <- getPid handle+ traverse_ killPid mayPid++testNvimProcessConfig :: TestConfig -> ProcessConfig Handle Handle ()+testNvimProcessConfig TestConfig {..} =+ setStdin createPipe . setStdout createPipe . proc "nvim" . fmap toString $ args <> tcCmdArgs+ where+ args = fromMaybe defaultArgs tcCmdline+ defaultArgs = ["--embed", "-n", "-u", "NONE", "-i", "NONE"]++startHandlers :: Handle -> Handle -> TestConfig -> Internal.Config RPCConfig -> IO (IO ())+startHandlers stdoutHandle stdinHandle TestConfig{..} nvimConf = do+ socketReader <- run runSocketReader stdoutHandle+ eventHandler <- run runEventHandler stdinHandle+ atomically $ putTMVar (Internal.globalFunctionMap nvimConf) (Internal.mkFunctionMap [])+ let stopEventHandlers = traverse_ cancel [socketReader, eventHandler]+ return stopEventHandlers+ where+ run runner hand = async . void $ runner hand emptyConf+ emptyConf = nvimConf { Internal.pluginSettings = Nothing }++startStdioHandlers :: NvimProc -> TestConfig -> Internal.Config RPCConfig -> IO (IO ())+startStdioHandlers prc =+ startHandlers (getStdout prc) (getStdin prc)++runNeovimThunk :: Internal.Config e -> Neovim e a -> IO a+runNeovimThunk cfg (Internal.Neovim thunk) =+ runReaderT (runResourceT thunk) cfg++type NvimProc = Process Handle Handle ()++waitQuit :: NvimProc -> IO (Maybe ExitCode)+waitQuit prc =+ wait 30+ where+ wait :: Int -> IO (Maybe ExitCode)+ wait 0 = return Nothing+ wait count = do+ code <- getExitCode prc+ case code of+ Just a -> return $ Just a+ Nothing -> do+ sleep 0.1+ wait $ count - 1++quitNvim :: Internal.Config e -> NvimProc -> IO ()+quitNvim testCfg prc = do+ quitThread <- async $ runNeovimThunk testCfg quit+ result <- waitQuit prc+ case result of+ Just _ -> return ()+ Nothing -> killProcess prc+ cancel quitThread+ where+ quit = vim_command "qall!"++shutdownNvim :: Internal.Config e -> NvimProc -> IO () -> IO ()+shutdownNvim _ prc stopEventHandlers = do+ stopEventHandlers+ killProcess prc+ -- quitNvim testCfg prc++runTest ::+ RpcHandler e env m =>+ ReportError e =>+ TestConfig ->+ Internal.Config env ->+ m () ->+ IO ()+runTest TestConfig{..} testCfg thunk = do+ result <- race (sleepW tcTimeout) (runNeovimThunk testCfg (runExceptT $ native thunk))+ case result of+ Right (Right _) -> return ()+ Right (Left e) -> fail . toString . unlines . ErrorReport._log . errorReport $ e+ Left _ -> fail $ "test exceeded timeout of " <> show tcTimeout <> " seconds"++runEmbeddedNvim ::+ RpcHandler e env m =>+ ReportError e =>+ TestConfig ->+ env ->+ m () ->+ NvimProc ->+ IO ()+runEmbeddedNvim conf ribo thunk prc = do+ nvimConf <- Internal.newConfig (pure Nothing) newRPCConfig+ let testCfg = Internal.retypeConfig ribo nvimConf+ bracket (startStdioHandlers prc conf nvimConf) (shutdownNvim testCfg prc) (const $ runTest conf testCfg thunk)++runEmbedded ::+ RpcHandler e env m =>+ ReportError e =>+ TestConfig ->+ env ->+ m () ->+ IO ()+runEmbedded conf ribo thunk = do+ let pc = testNvimProcessConfig conf+ withProcess pc $ runEmbeddedNvim conf ribo thunk++unsafeEmbeddedSpec ::+ RpcHandler e env m =>+ ReportError e =>+ Runner m ->+ TestConfig ->+ env ->+ m () ->+ IO ()+unsafeEmbeddedSpec runner conf s spec =+ runEmbedded conf s $ runner conf spec++unsafeEmbeddedSpecR ::+ RpcHandler e (Ribosome env) m =>+ ReportError e =>+ Runner m ->+ TestConfig ->+ env ->+ m () ->+ IO ()+unsafeEmbeddedSpecR runner conf env spec = do+ tv <- newRibosomeTMVar env+ let ribo = Ribosome (tcPluginName conf) tv+ unsafeEmbeddedSpec runner conf ribo spec++runPlugin ::+ Handle ->+ Handle ->+ [Neovim () NeovimPlugin] ->+ Internal.Config c ->+ IO (MVar Internal.StateTransition)+runPlugin evHandlerHandle sockreaderHandle plugins baseConf = do+ updateGlobalLogger "Neovim.Plugin" (setLevel ERROR)+ rpcConf <- newRPCConfig+ let conf = Internal.retypeConfig rpcConf baseConf+ ehTid <- async $ runEventHandler evHandlerHandle conf { Internal.pluginSettings = Nothing }+ srTid <- async $ runSocketReader sockreaderHandle conf+ void $ forkIO $ startPluginThreads (Internal.retypeConfig () baseConf) plugins >>= \case+ Left e -> do+ putMVar (Internal.transitionTo conf) $ Internal.Failure e+ standalone [ehTid, srTid] conf+ Right (funMapEntries, pluginTids) -> do+ atomically $ putTMVar (Internal.globalFunctionMap conf) (Internal.mkFunctionMap funMapEntries)+ putMVar (Internal.transitionTo conf) Internal.InitSuccess+ standalone (srTid:ehTid:pluginTids) conf+ return (Internal.transitionTo conf)++runEmbeddedWithPlugin ::+ RpcHandler e () m =>+ ReportError e =>+ TestConfig ->+ Plugin env ->+ m () ->+ IO ()+runEmbeddedWithPlugin conf plugin thunk =+ withProcess (testNvimProcessConfig conf) run+ where+ run prc = do+ nvimConf <- Internal.newConfig (pure Nothing) (pure ())+ bracket (acquire prc nvimConf) release (const $ runTest conf nvimConf thunk)+ acquire prc nvimConf =+ runPlugin (getStdin prc) (getStdout prc) [wrapPlugin plugin] nvimConf <* sleep 0.5+ release transitions =+ tryPutMVar transitions Internal.Quit *> sleep 0.5++integrationSpecDef ::+ RpcHandler e () m =>+ ReportError e =>+ Plugin env ->+ m () ->+ IO ()+integrationSpecDef =+ runEmbeddedWithPlugin def
+ lib/Ribosome/Test/Exists.hs view
@@ -0,0 +1,47 @@+module Ribosome.Test.Exists(+ waitForPlugin,+) where++import Control.Monad.IO.Class (MonadIO)+import Data.MessagePack (Object(ObjectInt))+import Neovim (Neovim, toObject)+import Neovim.API.Text (vim_call_function)+import UnliftIO.Exception (tryAny)++import Ribosome.Data.Text (capitalize)+import Ribosome.System.Time (epochSeconds, sleep)++retry ::+ MonadIO m =>+ MonadFail m =>+ Double ->+ Int ->+ m a ->+ (a -> m (Either Text b)) ->+ m b+retry interval timeout thunk check = do+ start <- epochSeconds+ step start+ where+ step start = do+ result <- thunk+ checked <- check result+ recurse start checked+ recurse _ (Right b) = return b+ recurse start (Left e) = do+ current <- epochSeconds+ if (current - start) < timeout+ then do+ sleep interval+ step start+ else fail (toString e)++waitForPlugin :: Text -> Double -> Int -> Neovim env ()+waitForPlugin name interval timeout =+ retry interval timeout thunk check+ where+ thunk = tryAny $ vim_call_function "exists" $ fromList [toObject $ "*" <> capitalize name <> "Poll"]+ check (Right (ObjectInt 1)) = return $ Right ()+ check (Right a) = return $ Left $ errormsg <> "weird return type " <> show a+ check (Left e) = return $ Left $ errormsg <> show e+ errormsg = "plugin didn't start within " <> show timeout <> " seconds: "
+ lib/Ribosome/Test/File.hs view
@@ -0,0 +1,42 @@+module Ribosome.Test.File where++import Control.Monad.IO.Class (MonadIO, liftIO)+import qualified Data.ByteString as ByteString (readFile)+import System.Directory (canonicalizePath, createDirectoryIfMissing, removePathForcibly)+import System.FilePath ((</>))++testDir :: Text -> IO FilePath+testDir prefix = canonicalizePath $ "test" </> toString prefix++-- raises exception if cwd is not the package root so we don't damage anything+tempDirIO :: Text -> FilePath -> IO FilePath+tempDirIO prefix path = do+ base <- testDir prefix+ let dir = base </> "temp"+ removePathForcibly dir+ createDirectoryIfMissing False dir+ let absPath = dir </> path+ createDirectoryIfMissing True absPath+ return absPath++tempDir :: MonadIO m => Text -> FilePath -> m FilePath+tempDir prefix path =+ liftIO $ tempDirIO prefix path++fixture ::+ MonadIO m =>+ Text ->+ FilePath ->+ m FilePath+fixture prefix path = do+ base <- liftIO $ testDir prefix+ return $ base </> "fixtures" </> path++fixtureContent ::+ MonadIO m =>+ Text ->+ FilePath ->+ m Text+fixtureContent prefix subPath = do+ path <- fixture prefix subPath+ decodeUtf8 <$> liftIO (ByteString.readFile path)
+ lib/Ribosome/Test/Functional.hs view
@@ -0,0 +1,74 @@+module Ribosome.Test.Functional where++-- import Control.Exception (finally)+-- import Control.Monad (when)+-- import Control.Monad.IO.Class+-- import Data.Foldable (traverse_)+-- import Neovim (Neovim, vim_command')+-- import System.Console.ANSI (Color(Green), ColorIntensity(Dull), ConsoleLayer(Foreground), SGR(SetColor, Reset), setSGR)+-- import System.Directory (createDirectoryIfMissing, doesFileExist, getCurrentDirectory, makeAbsolute, removePathForcibly)+-- import System.FilePath (takeDirectory, takeFileName, (</>))++-- import Ribosome.Control.Ribo (Ribo)+-- import Ribosome.Test.Embed (TestConfig(..), setupPluginEnv, unsafeEmbeddedSpec)+-- import Ribosome.Test.Exists (waitForPlugin)+-- import qualified Ribosome.Test.File as F (fixture, tempDir)++-- jobstart :: MonadIO f => Text -> f Text+-- jobstart cmd = do+-- dir <- liftIO getCurrentDirectory+-- return $ "call jobstart('" <> cmd <> "', { 'rpc': v:true, 'cwd': '" <> dir <> "' })"++-- logFile :: TestConfig -> IO FilePath+-- logFile TestConfig{..} = makeAbsolute $ tcLogPath <> "-spec"++-- startPlugin :: TestConfig -> Neovim env ()+-- startPlugin tc@TestConfig{..} = do+-- absLogPath <- liftIO $ makeAbsolute tcLogPath+-- absLogFile <- liftIO $ logFile tc+-- liftIO $ createDirectoryIfMissing True (takeDirectory absLogPath)+-- liftIO $ removePathForcibly absLogFile+-- setupPluginEnv tc+-- cmd <- jobstart $ "stack run -- -l " <> absLogFile <> " -v INFO"+-- vim_command' cmd+-- waitForPlugin tcPluginName 0.1 3++-- fSpec :: TestConfig -> Neovim env () -> Neovim env ()+-- fSpec conf spec = startPlugin conf >> spec++-- showLog' :: Text -> IO ()+-- showLog' output = do+-- putStrLn ""+-- setSGR [SetColor Foreground Dull Green]+-- putStrLn "plugin output:"+-- setSGR [Reset]+-- traverse_ putStrLn (lines output)+-- putStrLn ""++-- showLog :: TestConfig -> IO ()+-- showLog conf = do+-- file <- logFile conf+-- exists <- doesFileExist file+-- when exists $ do+-- output <- readFile file+-- case output of+-- [] -> return ()+-- o -> showLog' o++-- functionalSpec :: TestConfig -> Ribo () () -> IO ()+-- functionalSpec conf spec =+-- finally (unsafeEmbeddedSpec fSpec conf () spec) (showLog conf)++-- fPrefix :: Text+-- fPrefix = "f"++-- tempDir :: FilePath -> Neovim e FilePath+-- tempDir = F.tempDir fPrefix++-- tempFile :: FilePath -> Neovim e FilePath+-- tempFile file = do+-- absDir <- tempDir $ takeDirectory file+-- return $ absDir </> takeFileName file++-- fixture :: MonadIO m => FilePath -> m FilePath+-- fixture = F.fixture fPrefix
+ lib/Ribosome/Test/Input.hs view
@@ -0,0 +1,20 @@+module Ribosome.Test.Input where++import Control.Concurrent.Lifted (fork, killThread)+import Control.Exception.Lifted (bracket)++import Ribosome.Api.Input (syntheticInput)++withInput ::+ NvimE e m =>+ MonadIO m =>+ MonadBaseControl IO m =>+ Maybe Double ->+ [Text] ->+ m a ->+ m a+withInput interval chars thunk =+ bracket (fork input) killThread (const thunk)+ where+ input =+ syntheticInput interval chars
+ lib/Ribosome/Test/Orphans.hs view
@@ -0,0 +1,29 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module Ribosome.Test.Orphans where++import Control.Monad.IO.Class (liftIO)+import Control.Monad.IO.Unlift (withRunInIO)+import Neovim (Neovim)+import Test.Framework.AssertM (AssertM(..))++import Ribosome.Control.Monad.Ribo (Ribo(Ribo, unRibo))++instance AssertM (Neovim e) where+ genericAssertFailure__ l =+ liftIO . genericAssertFailure__ l++ genericSubAssert l msg ma =+ withRunInIO (\f -> genericSubAssert l msg (f ma))++instance AssertM (ExceptT e (Neovim s)) where+ genericAssertFailure__ l = liftIO . genericAssertFailure__ l++ genericSubAssert l msg =+ ExceptT . genericSubAssert l msg . runExceptT++instance AssertM (Ribo s e) where+ genericAssertFailure__ l = liftIO . genericAssertFailure__ l++ genericSubAssert l msg =+ Ribo . ExceptT . genericSubAssert l msg . runExceptT . unRibo
+ lib/Ribosome/Test/Screenshot.hs view
@@ -0,0 +1,50 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Ribosome.Test.Screenshot where++import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Data.TmuxThunk (TmuxThunk)+import qualified Chiasma.Test.Screenshot as Chiasma (screenshot)+import Control.Monad.Catch (MonadMask)+import Control.Monad.DeepError (MonadDeepError)+import Control.Monad.Free.Class (MonadFree)+import Control.Monad.IO.Class (MonadIO)+import Data.Text (Text)+import Test.Framework+import Test.Framework.AssertM (AssertM(..))++import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim)+import Ribosome.Orphans ()+import Ribosome.Test.Orphans ()+import Ribosome.Test.Unit (fixture)+import Ribosome.Tmux.Run (runTmux)++screenshot ::+ MonadFree TmuxThunk m =>+ MonadIO m =>+ Text ->+ Bool ->+ Int ->+ m (Maybe ([Text], [Text]))+screenshot name record pane = do+ storage <- fixture "screenshots"+ Chiasma.screenshot record storage (toString name) pane++assertScreenshot ::+ AssertM m =>+ MonadIO m =>+ MonadRibo m =>+ MonadDeepError e TmuxError m =>+ MonadMask m =>+ Nvim m =>+ Text ->+ Bool ->+ Int ->+ m ()+assertScreenshot name record pane =+ runTmux (screenshot name record pane) >>= check+ where+ check (Just (current, existing)) =+ gassertEqual existing current+ check Nothing =+ return ()
+ lib/Ribosome/Test/Tmux.hs view
@@ -0,0 +1,180 @@+module Ribosome.Test.Tmux where++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)+import qualified Chiasma.Test.Tmux as Chiasma (tmuxGuiSpec, tmuxSpec, tmuxSpec')+import Control.Monad.Trans.Except (runExceptT)+import Data.DeepPrisms (DeepPrisms)+import Data.Default (Default(def))+import Data.Functor (void)+import qualified Neovim.Context.Internal as Internal (Config, newConfig, retypeConfig)+import Neovim.RPC.Common (RPCConfig, SocketType(UnixSocket), createHandle, newRPCConfig)+import System.FilePath ((</>))+import UnliftIO (throwString)+import UnliftIO.Directory (doesPathExist)+import UnliftIO.Exception (bracket)+import UnliftIO.Temporary (withTempDirectory)++import Ribosome.Config.Setting (updateSetting)+import Ribosome.Config.Settings (tmuxSocket)+import Ribosome.Control.Concurrent.Wait (waitIOPredDef)+import Ribosome.Control.Monad.Ribo (Ribo)+import Ribosome.Control.Ribosome (Ribosome(Ribosome), newRibosomeTMVar)+import Ribosome.Error.Report.Class (ReportError)+import Ribosome.Nvim.Api.RpcCall (RpcError)+import Ribosome.Plugin.RpcHandler (RpcHandler)+import Ribosome.Test.Embed (Runner, TestConfig(..), runTest, startHandlers)+import Ribosome.Test.Orphans ()+import Ribosome.Test.Unit (tempDir, uSpec)++startSocketHandlers :: FilePath -> TestConfig -> Internal.Config RPCConfig -> IO (IO ())+startSocketHandlers socket testConfig nvimConf = do+ handle <- createHandle (UnixSocket socket)+ startHandlers handle handle testConfig nvimConf++runTmuxNvim ::+ (RpcHandler e env m, ReportError e) =>+ TestConfig ->+ env ->+ m () ->+ FilePath ->+ IO ()+runTmuxNvim conf ribo specThunk socket = do+ nvimConf <- Internal.newConfig (pure Nothing) newRPCConfig+ let testCfg = Internal.retypeConfig ribo nvimConf+ bracket (startSocketHandlers socket conf nvimConf) id (const $ runTest conf testCfg specThunk)++externalNvimCmdline :: FilePath -> Text+externalNvimCmdline socket =+ "nvim --listen " <> toText socket <> " -n -u NONE -i NONE"++runGui ::+ (RpcHandler e env m, ReportError e) =>+ TmuxNative ->+ FilePath ->+ TestConfig ->+ env ->+ m () ->+ IO ()+runGui api temp conf ribo specThunk = do+ void $ runExceptT @TmuxError $ runTmux api $ sendKeys (PaneId 0) [toString $ externalNvimCmdline socket]+ _ <- waitIOPredDef (pure socket) doesPathExist+ runTmuxNvim conf ribo specThunk socket+ where+ socket = temp </> "nvim-socket"++unsafeGuiSpec ::+ (RpcHandler e env m, ReportError e) =>+ TmuxNative ->+ FilePath ->+ Runner m ->+ TestConfig ->+ env ->+ m () ->+ IO ()+unsafeGuiSpec api temp runner conf s specThunk =+ runGui api temp conf s $ runner conf specThunk++unsafeGuiSpecR ::+ (RpcHandler e (Ribosome env) m, ReportError e) =>+ TmuxNative ->+ FilePath ->+ Runner m ->+ TestConfig ->+ env ->+ m () ->+ IO ()+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 ::+ DeepPrisms e RpcError =>+ ReportError e =>+ TestConfig ->+ TmuxNative ->+ s ->+ Ribo s e () ->+ IO ()+guiSpec conf api env specThunk = do+ socketDir <- tempDir "tmux-socket"+ withTempDirectory socketDir "spec" run+ where+ run tempdir =+ unsafeGuiSpecR api tempdir uSpec conf env specThunk++withTmux ::+ DeepPrisms e RpcError =>+ Ribo s e () ->+ TmuxNative ->+ Ribo s e ()+withTmux thunk (TmuxNative (Just socket)) =+ updateSetting tmuxSocket socket *> thunk+withTmux _ _ =+ throwString "no socket in test tmux"++tmuxSpec ::+ Show s =>+ DeepPrisms e RpcError =>+ ReportError e =>+ Default s =>+ TestConfig ->+ s ->+ Ribo s e () ->+ IO ()+tmuxSpec conf env specThunk =+ Chiasma.tmuxSpec run+ where+ run api = guiSpec conf api env (withTmux specThunk api)++tmuxSpec' ::+ Show s =>+ DeepPrisms e RpcError =>+ ReportError e =>+ Default s =>+ TmuxTestConf ->+ TestConfig ->+ s ->+ Ribo s e () ->+ IO ()+tmuxSpec' tmuxConf conf env specThunk =+ Chiasma.tmuxSpec' tmuxConf run+ where+ run api = guiSpec conf api env (withTmux specThunk api)++tmuxSpecDef ::+ Show s =>+ DeepPrisms e RpcError =>+ ReportError e =>+ Default s =>+ Ribo s e () ->+ IO ()+tmuxSpecDef =+ tmuxSpec def def++tmuxGuiSpec ::+ DeepPrisms e RpcError =>+ ReportError e =>+ Default s =>+ TestConfig ->+ s ->+ Ribo s e () ->+ IO ()+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 () ->+ IO ()+tmuxGuiSpecDef =+ tmuxGuiSpec def def
+ lib/Ribosome/Test/Ui.hs view
@@ -0,0 +1,38 @@+{-# OPTIONS_GHC -F -pgmF htfpp #-}++module Ribosome.Test.Ui where++import Test.Framework++import Ribosome.Api.Window (currentCursor, cursor)+import Ribosome.Control.Monad.Ribo (NvimE)+import Ribosome.Nvim.Api.Data (Window)+import Ribosome.Nvim.Api.IO (nvimListWins)++windowCountIs ::+ NvimE e m =>+ AssertM m =>+ Int ->+ m ()+windowCountIs count = do+ wins <- nvimListWins+ gassertEqual count (length wins)++cursorIs ::+ NvimE e m =>+ AssertM m =>+ Int ->+ Int ->+ Window ->+ m ()+cursorIs line col =+ gassertEqual (line, col) <=< cursor++currentCursorIs ::+ NvimE e m =>+ AssertM m =>+ Int ->+ Int ->+ m ()+currentCursorIs line col =+ gassertEqual (line, col) =<< currentCursor
+ lib/Ribosome/Test/Unit.hs view
@@ -0,0 +1,76 @@+module Ribosome.Test.Unit where++import Control.Monad.IO.Class (MonadIO)+import Data.Default (def)+import System.FilePath (takeDirectory, takeFileName, (</>))+import System.Log.Logger (Priority(DEBUG), setLevel, updateGlobalLogger)++import Ribosome.Control.Monad.Ribo (MonadRibo, NvimE, pluginName)+import Ribosome.Control.Ribosome (Ribosome)+import Ribosome.Error.Report.Class (ReportError)+import Ribosome.Plugin.RpcHandler (RpcHandler)+import Ribosome.Test.Embed (Runner, TestConfig(..), setupPluginEnv, unsafeEmbeddedSpecR)+import qualified Ribosome.Test.File as F (fixture, fixtureContent, tempDir)+import Ribosome.Test.Orphans ()++uPrefix :: Text+uPrefix = "u"++uSpec :: (MonadIO m, NvimE e m) => Runner m+uSpec conf spec = do+ setupPluginEnv conf+ spec++unitSpec ::+ (RpcHandler e (Ribosome env) m, ReportError e, MonadIO m, NvimE e' m) =>+ TestConfig ->+ env ->+ m () ->+ IO ()+unitSpec =+ unsafeEmbeddedSpecR uSpec++unitSpecDef ::+ (RpcHandler e (Ribosome env) m, ReportError e, MonadIO m, NvimE e' m) =>+ env ->+ m () ->+ IO ()+unitSpecDef =+ unitSpec def++unitSpecDef' ::+ (RpcHandler e (Ribosome ()) m, ReportError e, MonadIO m, NvimE e' m) =>+ m () ->+ IO ()+unitSpecDef' =+ unitSpecDef ()++tempDir :: MonadIO m => FilePath -> m FilePath+tempDir = F.tempDir uPrefix++tempFile :: MonadIO m => FilePath -> m FilePath+tempFile file = do+ absDir <- tempDir $ takeDirectory file+ return $ absDir </> takeFileName file++fixture :: MonadIO m => FilePath -> m FilePath+fixture = F.fixture uPrefix++fixtureContent :: MonadIO m => FilePath -> m Text+fixtureContent = F.fixtureContent uPrefix++withLogAs ::+ MonadIO m =>+ Text ->+ m a ->+ m a+withLogAs name thunk = do+ liftIO $ updateGlobalLogger (toString name) (setLevel DEBUG)+ thunk++withLog ::+ MonadRibo m =>+ m a ->+ m a+withLog thunk =+ (`withLogAs` thunk) =<< pluginName
+ ribosome-test.cabal view
@@ -0,0 +1,75 @@+cabal-version: 1.12+name: ribosome-test+version: 0.3.0.0+license: OtherLicense+license-file: LICENSE+copyright: 2019 Torsten Schmits+maintainer: tek@tryp.io+author: Torsten Schmits+homepage: https://github.com/tek/ribosome-hs#readme+bug-reports: https://github.com/tek/ribosome-hs/issues+synopsis: test helpers for ribosome+description:+ Please see the README on GitHub at <https://github.com/tek/ribosome-hs>+category: Neovim+build-type: Simple++source-repository head+ type: git+ location: https://github.com/tek/ribosome-hs++library+ exposed-modules:+ Ribosome.Test.Await+ Ribosome.Test.Embed+ Ribosome.Test.Exists+ Ribosome.Test.File+ Ribosome.Test.Functional+ Ribosome.Test.Input+ Ribosome.Test.Orphans+ Ribosome.Test.Screenshot+ Ribosome.Test.Tmux+ Ribosome.Test.Ui+ Ribosome.Test.Unit+ hs-source-dirs: lib+ other-modules:+ Prelude+ default-language: Haskell2010+ default-extensions: AutoDeriveTypeable BangPatterns BinaryLiterals+ ConstraintKinds DataKinds DefaultSignatures DeriveDataTypeable+ DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable+ DoAndIfThenElse EmptyDataDecls ExistentialQuantification+ FlexibleContexts FlexibleInstances FunctionalDependencies GADTs+ GeneralizedNewtypeDeriving InstanceSigs KindSignatures LambdaCase+ MonadFailDesugaring MultiParamTypeClasses MultiWayIf NamedFieldPuns+ OverloadedStrings PartialTypeSignatures PatternGuards PolyKinds+ RankNTypes RecordWildCards ScopedTypeVariables StandaloneDeriving+ TupleSections TypeApplications TypeFamilies TypeSynonymInstances+ UnicodeSyntax ViewPatterns+ build-depends:+ HTF >=0.13.2.5 && <0.14,+ base-noprelude >=4.7 && <5,+ bytestring >=0.10.8.2 && <0.11,+ chiasma >=0.1.0.0 && <0.2,+ cornea >=0.2.2.0 && <0.3,+ data-default >=0.7.1.1 && <0.8,+ directory >=1.3.1.5 && <1.4,+ exceptions >=0.10.0 && <0.11,+ filepath >=1.4.2 && <1.5,+ free >=5.0.2 && <5.1,+ hslogger >=1.2.12 && <1.3,+ lifted-base >=0.2.3.12 && <0.3,+ messagepack >=0.5.4 && <0.6,+ monad-control >=1.0.2.3 && <1.1,+ mtl >=2.2.2 && <2.3,+ nvim-hs >=2.1.0.0 && <2.2,+ process >=1.6.3.0 && <1.7,+ relude >=0.1.1 && <0.2,+ resourcet >=1.2.2 && <1.3,+ ribosome >=0.2.2.0 && <0.3,+ text >=1.2.3.1 && <1.3,+ transformers >=0.5.5.0 && <0.6,+ typed-process >=0.2.3.0 && <0.3,+ unix >=2.7.2.2 && <2.8,+ unliftio >=0.2.9.0 && <0.3,+ unliftio-core >=0.1.2.0 && <0.2