packages feed

ribosome-test 0.3.0.1 → 0.9.9.9

raw patch · 31 files changed

Files

LICENSE view
@@ -1,55 +1,34 @@-# 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+Copyright (c) 2022 Torsten Schmits -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.+Redistribution and use in source and binary forms, with or without modification, are permitted provided that the+following conditions are met: -## Patent+  1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following+  disclaimer.+  2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following+  disclaimer in the documentation and/or other materials provided with the distribution. -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.+Subject to the terms and conditions of this license, each copyright holder and contributor hereby grants to those+receiving rights under this license a perpetual, worldwide, non-exclusive, no-charge, royalty-free, irrevocable (except+for failure to satisfy the conditions of this license) patent license to make, have made, use, offer to sell, sell,+import, and otherwise transfer this software, where such license applies only to those patent claims, already acquired+or hereafter acquired, licensable by such copyright holder or contributor that are necessarily infringed by: -## Reliability+  (a) their Contribution(s) (the licensed copyrights of copyright holders and non-copyrightable additions of+  contributors, in source or binary form) alone; or+  (b) combination of their Contribution(s) with the work of authorship to which such Contribution(s) was added by such+  copyright holder or contributor, if, at the time the Contribution is added, such addition causes such combination to+  be necessarily infringed. The patent license shall not apply to any other combinations which include the Contribution. -No contributor can revoke this license.+Except as expressly stated above, no rights or licenses from any copyright holder or contributor is granted under this+license, whether expressly, by implication, estoppel or otherwise. -## No Liability+DISCLAIMER -***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.***+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES,+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,+WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF+THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
− lib/Prelude.hs 
@@ -1,5 +0,0 @@-module Prelude (-  module Ribosome.PreludeExport-) where--import Ribosome.PreludeExport
+ lib/Ribosome/Handler.hs view
@@ -0,0 +1,21 @@+module Ribosome.Handler (+  module Ribosome.Host.Data.RpcType,+  module Ribosome.Host.Handler,+) where++import Ribosome.Host.Data.RpcType (+  AutocmdEvents (..),+  AutocmdGroup (..),+  AutocmdOptions (..),+  AutocmdPatterns (..),+  CommandCompletion (..),+  CommandOptions (..),+  CompleteStyle (..),+  RpcType (..),+  )+import Ribosome.Host.Handler (+  complete,+  completeBuiltin,+  completeCustom,+  completeWith,+  )
+ lib/Ribosome/Test.hs view
@@ -0,0 +1,164 @@+module Ribosome.Test (+  -- * Introduction+  -- $intro++  -- * Embedded testing+  -- $embed++  -- * tmux testing+  -- $tmux++  -- * Embedded test API+  testPlugin,+  testEmbed,+  testPluginEmbed,+  runEmbedTest,+  runTest,+  testPluginConf,+  testPlugin_,+  testEmbedConf,+  testEmbed_,+  testEmbedLevel,+  testEmbedLevel_,+  testEmbedDebug,+  testEmbedDebug_,+  testEmbedTrace,+  testEmbedTrace_,+  runTestConf,+  runTestLogConf,+  EmbedStackWith,+  EmbedStack,+  EmbedHandlerStack,+  TestEffects,+  TestConfig (TestConfig),+  TmuxTestConfig (TmuxTestConfig),+  -- * Error handling+  module Ribosome.Test.Error,+  module Ribosome.Host.Data.Report,+  -- * Assertions for Neovim UI elements+  windowCountIs,+  cursorIs,+  currentCursorIs,+  awaitScreenshot,+  -- * Assertions that are made repeatedly until the succeed+  assertWait,+  assertWaitFor,+) where++import Ribosome.Host.Data.Report (resumeReportFail, stopReportToFail)+import Ribosome.Test.Data.TestConfig (TestConfig (TestConfig), TmuxTestConfig (TmuxTestConfig))+import Ribosome.Test.Embed (+  EmbedHandlerStack,+  EmbedStack,+  EmbedStackWith,+  TestEffects,+  runEmbedTest,+  runTest,+  runTestConf,+  runTestLogConf,+  testEmbed,+  testEmbedConf,+  testEmbedLevel,+  testEmbedLevel_,+  testEmbedTrace,+  testEmbedDebug,+  testEmbedTrace_,+  testEmbedDebug_,+  testEmbed_,+  testPlugin,+  testPluginConf,+  testPluginEmbed,+  testPlugin_,+  )+import Ribosome.Test.Error+import Ribosome.Test.Screenshot (awaitScreenshot)+import Ribosome.Test.Ui+import Ribosome.Test.Wait++-- $intro+-- This is the test library for the "Ribosome" Neoivm plugin framework.+--+-- Three different test environments are available:+--+-- - "Ribosome.Test.Embed" runs Neovim as a subprocess and connects over stdio+--+-- - "Ribosome.Test.EmbedTmux" is like "Ribosome.Test.Embed", but provides a tmux server+--+-- - "Ribosome.Test.SocketTmux" runs Neovim in a window in a fresh tmux server, either headless in a pseudo terminal+-- or in an @xterm@ instance+--+-- This module reexports "Ribosome.Test.Embed".++-- $embed+-- Running a test against an embedded Neovim process is the simplest approach that is suited for unit testing plugin+-- logic where the integration with Neovim startup isn't important.+--+-- Handlers can be registered in Neovim and triggered via RPC API functions like 'nvimCallFunction' and 'nvimCommand'.+-- Most of the time this is only interesting if a handler has complex parameters and you want to test that they are+-- decoded correctly, or that the handler is triggered properly by an autocmd.+-- In more basic cases, where only the interaction with Neovim from within the handler is relevant, it can simply be run+-- directly.+--+-- > import Polysemy.Test+-- > import Ribosome+-- > import Ribosome.Api+-- > import Ribosome.Test+-- >+-- > store ::+-- >   Member (Rpc !! RpcError) r =>+-- >   Args ->+-- >   Handler r ()+-- > store (Args msg) =+-- >   ignoreRpcError do+-- >     nvimSetVar "message" msg+-- >+-- > test_direct :: UnitTest+-- > test_direct =+-- >   testEmbed_ do+-- >     store "test directly"+-- >     assertEq "test directly" =<< nvimGetVar @Text "message"+-- >+-- > test_rpc :: UnitTest+-- > test_rpc =+-- >   testPlugin_ [rpcCommand "Store" Sync store] do+-- >     nvimCommand "Store test RPC"+-- >     assertEq "test RPC" =<< nvimGetVar @Text "message"+--+-- See [Ribosome.Test.Embed]("Ribosome.Test.Embed") for more options.++-- $tmux+-- It is possible to run a standalone Neovim instance to test against.+-- This is useful to observe the UI's behaviour for debugging purposes, but might also be desired to test a feature in+-- the full environment that is used in production.+--+-- Ribosome provides a testing mode that starts a terminal with a tmux server, in which Neovim is executed as a regular+-- shell process.+-- Variants of this that run tmux in a pseudo terminal that is not rendered, or simply run a tmux server for use in an+-- embedded test, are also available.+--+-- In the terminal case, the test connects the plugin over a socket.+-- It is possible to take \"screenshots\" (capturing the tmux pane running Neovim) that are automatically stored in the+-- @fixtures@ directory of the test suite and compared to previous recordings on subsequent runs, as in this example+-- that runs tmux in a terminal and tests some syntax rules:+--+-- > import Polysemy.Test+-- > import Ribosome.Api+-- > import Ribosome.Syntax+-- > import Ribosome.Test+-- > import Ribosome.Test.SocketTmux+-- >+-- > syntax :: Syntax+-- > syntax =+-- >   Syntax [syntaxMatch "TestColons" "::"] [+-- >     syntaxHighlight "TestColons" [("cterm", "reverse"), ("ctermfg", "1"), ("gui", "reverse"), ("guifg", "#dc322f")]+-- >   ] []+-- >+-- > test_syntax :: UnitTest+-- > test_syntax =+-- >   testSocketTmuxGui do+-- >     setCurrentBufferContent ["function :: String -> Int", "function _ = 5"]+-- >     _ <- executeSyntax syntax+-- >     awaitScreenshot False "syntax" 0+-- >+-- > See [Ribosome.Test.SocketTmux]("Ribosome.Test.SocketTmux") and [Ribosome.Test.EmbedTmux]("Ribosome.Test.EmbedTmux")+-- > for more options.
− lib/Ribosome/Test/Await.hs 
@@ -1,47 +0,0 @@-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/Data/TestConfig.hs view
@@ -0,0 +1,28 @@+module Ribosome.Test.Data.TestConfig where++import qualified Chiasma.Test.Data.TmuxTestConfig as Chiasma++import Ribosome.Data.PluginConfig (PluginConfig (PluginConfig))+import Ribosome.Host.Data.HostConfig (HostConfig (HostConfig), dataLogConc)++data TestConfig =+  TestConfig {+    freeze :: Bool,+    plugin :: PluginConfig ()+  }+  deriving stock (Eq, Show, Generic)++instance Default TestConfig where+  def =+    TestConfig False (PluginConfig "test" (HostConfig def { dataLogConc = False }) unit)++data TmuxTestConfig =+  TmuxTestConfig {+    core :: TestConfig,+    tmux :: Chiasma.TmuxTestConfig+  }+  deriving stock (Eq, Show, Generic)++instance Default TmuxTestConfig where+  def =+    TmuxTestConfig def def { Chiasma.gui = False }
lib/Ribosome/Test/Embed.hs view
@@ -1,283 +1,278 @@-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)+module Ribosome.Test.Embed (+  -- * Embedded Neovim testing+  -- $intro -data TestConfig =-  TestConfig {-    tcPluginName :: Text,-    tcExtraRtp :: Text,-    tcLogPath :: FilePath,-    tcTimeout :: Word,-    tcCmdline :: Maybe [Text],-    tcCmdArgs :: [Text],-    tcVariables :: Vars-  }+  testPlugin,+  testEmbed,+  testPluginEmbed,+  runEmbedTest,+  runTest,+  testPluginConf,+  testPlugin_,+  testEmbedConf,+  testEmbed_,+  testEmbedLevel,+  testEmbedLevel_,+  testEmbedTrace,+  testEmbedDebug,+  testEmbedTrace_,+  testEmbedDebug_,+  runTestConf,+  runTestLogConf,+  EmbedStackWith,+  EmbedStack,+  EmbedHandlerStack,+  TestEffects,+) where -instance Default TestConfig where-  def = TestConfig "ribosome" "test/f/fixtures/rtp" "test/f/temp/log" 10 def def (Vars [])+import Log (Severity (Debug, Trace))+import Polysemy.Test (TestError, UnitTest) -defaultTestConfigWith :: Text -> Vars -> TestConfig-defaultTestConfigWith name vars =-  def { tcPluginName = name, tcVariables = vars }+import Ribosome.Data.PluginConfig (PluginConfig (PluginConfig))+import Ribosome.Data.PluginName (PluginName)+import Ribosome.Data.SettingError (SettingError)+import Ribosome.Effect.Scratch (Scratch)+import Ribosome.Effect.Settings (Settings)+import Ribosome.Embed (HandlerEffects, embedPlugin, interpretPluginEmbed)+import Ribosome.Host.Data.BootError (BootError)+import Ribosome.Host.Data.HostConfig (setStderr)+import Ribosome.Host.Data.Report (Report)+import Ribosome.Host.Data.RpcError (RpcError)+import Ribosome.Host.Data.RpcHandler (RpcHandler)+import Ribosome.Host.Effect.Rpc (Rpc)+import Ribosome.Host.Error (resumeBootError)+import Ribosome.Host.Interpret (HigherOrder)+import Ribosome.Host.Interpreter.Handlers (withHandlers)+import Ribosome.Host.Interpreter.Host (HostDeps)+import qualified Ribosome.Host.Test.Data.TestConfig as Host+import qualified Ribosome.Host.Test.Run as Host+import Ribosome.Host.Test.Run (TestConfStack, TestStack, runUnitTest)+import Ribosome.Plugin.Builtin (BuiltinHandlersDeps)+import Ribosome.Test.Data.TestConfig (TestConfig (TestConfig))+import Ribosome.Test.Error (testError, testHandler)+import Ribosome.Test.Log (testLogLevel) -defaultTestConfig :: Text -> TestConfig-defaultTestConfig name = defaultTestConfigWith name (Vars [])+-- $intro+-- The function 'testPluginEmbed' starts an embedded Neovim subprocess and a Ribosome main loop, then executes the+-- supplied 'Sem'.+--+-- This can be interpreted into a "Hedgehog" 'Hedgehog.TestT' by using the functions 'runEmbedTest' and 'runTest'.+--+-- The functions 'testPluginConf' and 'testPlugin' run a full Ribosome plugin with RPC handlers and extra effects in+-- addition to the above.+-- This can be used to test calling RPC handlers from Neovim, which usually shouldn't be necessary but may be helpful+-- for some edge cases.+--+-- The functions 'testEmbedConf' and 'testEmbed' run tests with extra effects, but no handlers.+-- This is the most advisable way to test plugins, running handlers directly as Haskell functions instead of routing+-- them through Neovim, in particular for those that don't have any parameters. -setVars :: ∀ m e. NvimE e m => Vars -> m ()-setVars (Vars vars) =-  traverse_ set vars-  where-    set :: (Text, Object) -> m ()-    set = uncurry vimSetVar+-- |The extra effects that tests are expected to use, related to errors.+--+-- The plugin effects 'Scratch', 'Settings' and 'Rpc' are allowed without 'Resume', causing tests to terminate+-- immediately if one of these effects is used and throws an error.+--+-- Additionally, the two core errors, 'LogReport' and 'RpcError' are executed directly via 'Stop'.+type TestEffects =+  [+    Stop Report,+    Stop RpcError,+    Scratch,+    Settings,+    Rpc+  ] -setupPluginEnv :: (MonadIO m, NvimE e m) => TestConfig -> m ()-setupPluginEnv (TestConfig _ rtp _ _ _ _ vars) = do-  absRtp <- liftIO $ makeAbsolute (toString rtp)-  rtpCat (toText absRtp)-  setVars vars+-- |The full test stack below test effects and extra effects.+type EmbedHandlerStack =+  HandlerEffects ++ Reader PluginName : TestStack -killPid :: Integral a => a -> IO ()-killPid =-  void . tryAny . Signal.signalProcess Signal.killProcess . fromIntegral+-- |The full test stack with additional effects.+type EmbedStackWith r =+  TestEffects ++ r ++ EmbedHandlerStack -killProcess :: Process i o e -> IO ()-killProcess prc = do-  let handle = unsafeProcessHandle prc-  mayPid <- getPid handle-  traverse_ killPid mayPid+-- |The full test stack with no additional effects.+type EmbedStack =+  EmbedStackWith '[] -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"]+-- |Interpret the basic test effects without 'IO' related effects.+runTestLogConf ::+  Members [Error BootError, Resource, Race, Async, Embed IO] r =>+  TestConfig ->+  InterpretersFor (Reader PluginName : TestConfStack) r+runTestLogConf (TestConfig freezeTime (PluginConfig name conf _)) =+  Host.runTestLogConf (Host.TestConfig freezeTime conf) .+  runReader name -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 }+-- |Run the basic test effects as a "Hedgehog" test.+runTestConf ::+  HasCallStack =>+  TestConfig ->+  Sem (Reader PluginName : TestStack) () ->+  UnitTest+runTestConf conf =+  runUnitTest .+  runTestLogConf conf -startStdioHandlers :: NvimProc -> TestConfig -> Internal.Config RPCConfig -> IO (IO ())-startStdioHandlers prc =-  startHandlers (getStdout prc) (getStdin prc)+-- |Run the plugin stack and the test stack, using the supplied config.+runEmbedTest ::+  HasCallStack =>+  TestConfig ->+  Sem EmbedHandlerStack () ->+  UnitTest+runEmbedTest conf =+  runTestConf conf .+  interpretPluginEmbed -runNeovimThunk :: Internal.Config e -> Neovim e a -> IO a-runNeovimThunk cfg (Internal.Neovim thunk) =-  runReaderT (runResourceT thunk) cfg+-- |Run the plugin stack and the test stack, using the default config.+runTest ::+  HasCallStack =>+  Sem EmbedHandlerStack () ->+  UnitTest+runTest =+  runEmbedTest def -type NvimProc = Process Handle Handle ()+-- |Run the test plugin effects, 'TestEffects', and start an embedded Neovim subprocess.+testPluginEmbed ::+  Members (HostDeps er) r =>+  Members BuiltinHandlersDeps r =>+  Members [Settings !! SettingError, Error TestError] r =>+  InterpretersFor TestEffects r+testPluginEmbed =+  embedPlugin .+  resumeBootError @Rpc .+  resumeBootError @Settings .+  resumeBootError @Scratch .+  testError .+  testHandler .+  insertAt @4 -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+-- |Run a full plugin test, using extra effects and RPC handlers.+testPluginConf ::+  ∀ r .+  HasCallStack =>+  HigherOrder r EmbedHandlerStack =>+  TestConfig ->+  InterpretersFor r EmbedHandlerStack ->+  [RpcHandler (r ++ EmbedHandlerStack)] ->+  Sem (EmbedStackWith r) () ->+  UnitTest+testPluginConf conf effs handlers =+  runEmbedTest conf .+  effs .+  withHandlers handlers .+  testPluginEmbed -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!"+-- |Run a full plugin test, using extra effects and RPC handlers.+testPlugin ::+  ∀ r .+  HasCallStack =>+  HigherOrder r EmbedHandlerStack =>+  InterpretersFor r EmbedHandlerStack ->+  [RpcHandler (r ++ EmbedHandlerStack)] ->+  Sem (EmbedStackWith r) () ->+  UnitTest+testPlugin =+  testPluginConf @r def -shutdownNvim :: Internal.Config e -> NvimProc -> IO () -> IO ()-shutdownNvim _ prc stopEventHandlers = do-  stopEventHandlers-  killProcess prc-  -- quitNvim testCfg prc+-- |Run a plugin test with RPC handlers.+testPlugin_ ::+  HasCallStack =>+  [RpcHandler EmbedHandlerStack] ->+  Sem EmbedStack () ->+  UnitTest+testPlugin_ =+  testPlugin @'[] id -runTest ::-  RpcHandler e env m =>-  ReportError e =>+-- |Run a plugin test with extra effects but no RPC handlers.+testEmbedConf ::+  ∀ r .+  HasCallStack =>+  HigherOrder r EmbedHandlerStack =>   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"+  InterpretersFor r EmbedHandlerStack ->+  Sem (EmbedStackWith r) () ->+  UnitTest+testEmbedConf conf effs =+  testPluginConf @r conf effs mempty -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)+-- |Run a plugin test with extra effects but no RPC handlers.+testEmbed ::+  ∀ r .+  HasCallStack =>+  HigherOrder r EmbedHandlerStack =>+  InterpretersFor r EmbedHandlerStack ->+  Sem (EmbedStackWith r) () ->+  UnitTest+testEmbed =+  testEmbedConf @r def -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+-- |Run a plugin test with extra effects but no RPC handlers.+--+-- Takes a log level, for which the default is to only print critical errors.+testEmbedLevel ::+  ∀ r .+  HasCallStack =>+  HigherOrder r EmbedHandlerStack =>+  Severity ->+  InterpretersFor r EmbedHandlerStack ->+  Sem (EmbedStackWith r) () ->+  UnitTest+testEmbedLevel level =+  testEmbedConf @r (def & #plugin . #host %~ setStderr level) -unsafeEmbeddedSpec ::-  RpcHandler e env m =>-  ReportError e =>-  Runner m ->-  TestConfig ->-  env ->-  m () ->-  IO ()-unsafeEmbeddedSpec runner conf s spec =-  runEmbedded conf s $ runner conf spec+-- |Run a plugin test with extra effects but no RPC handlers at the 'Debug' log level.+testEmbedDebug ::+  ∀ r .+  HasCallStack =>+  HigherOrder r EmbedHandlerStack =>+  InterpretersFor r EmbedHandlerStack ->+  Sem (EmbedStackWith r) () ->+  UnitTest+testEmbedDebug effs =+  testLogLevel Debug \ conf -> testEmbedConf @r conf effs -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+-- |Run a plugin test with extra effects but no RPC handlers at the 'Trace' log level for debugging RPC traffic.+testEmbedTrace ::+  ∀ r .+  HasCallStack =>+  HigherOrder r EmbedHandlerStack =>+  InterpretersFor r EmbedHandlerStack ->+  Sem (EmbedStackWith r) () ->+  UnitTest+testEmbedTrace effs =+  testLogLevel Trace \ conf -> testEmbedConf @r conf effs -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)+-- |Run a plugin test without extra effects and RPC handlers.+testEmbed_ ::+  HasCallStack =>+  Sem EmbedStack () ->+  UnitTest+testEmbed_ =+  testPlugin_ mempty -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+-- |Run a plugin test without extra effects and RPC handlers.+--+-- Takes a log level, for which the default is to only print critical errors.+testEmbedLevel_ ::+  HasCallStack =>+  Severity ->+  Sem EmbedStack () ->+  UnitTest+testEmbedLevel_ level =+  testEmbedConf @'[] (def & #plugin . #host %~ setStderr level) id -integrationSpecDef ::-  RpcHandler e () m =>-  ReportError e =>-  Plugin env ->-  m () ->-  IO ()-integrationSpecDef =-  runEmbeddedWithPlugin def+-- |Run a plugin test without extra effects and RPC handlers at the 'Debug' log level.+testEmbedDebug_ ::+  HasCallStack =>+  Sem EmbedStack () ->+  UnitTest+testEmbedDebug_ =+  testEmbedLevel_ Debug++-- |Run a plugin test without extra effects and RPC handlers at the 'Trace' log level for debugging RPC traffic.+testEmbedTrace_ ::+  HasCallStack =>+  Sem EmbedStack () ->+  UnitTest+testEmbedTrace_ =+  testEmbedLevel_ Trace
+ lib/Ribosome/Test/EmbedTmux.hs view
@@ -0,0 +1,83 @@+module Ribosome.Test.EmbedTmux where++import Polysemy.Test (UnitTest)++import Ribosome.Embed (HandlerEffects, interpretPluginEmbed)+import Ribosome.Host.Data.RpcHandler (RpcHandler)+import Ribosome.Host.Interpreter.Handlers (withHandlers)+import Ribosome.Test.Data.TestConfig (TmuxTestConfig)+import Ribosome.Test.Embed (TestEffects, testPluginEmbed)+import Ribosome.Test.TmuxCommon (TmuxStack, runTmuxNvim)++type HandlerStack =+  HandlerEffects ++ TmuxStack++type EmbedTmuxWith r =+  TestEffects ++ r ++ HandlerStack++type EmbedTmux =+  EmbedTmuxWith '[]++runEmbedTmuxTestConf ::+  HasCallStack =>+  TmuxTestConfig ->+  Sem HandlerStack () ->+  UnitTest+runEmbedTmuxTestConf conf =+  runTmuxNvim conf .+  interpretPluginEmbed++runEmbedTmuxTest ::+  HasCallStack =>+  Sem HandlerStack () ->+  UnitTest+runEmbedTmuxTest =+  runEmbedTmuxTestConf def++runEmbedTmuxGuiTest ::+  HasCallStack =>+  Sem HandlerStack () ->+  UnitTest+runEmbedTmuxGuiTest =+  runEmbedTmuxTestConf (def & #tmux . #gui .~ True)++testPluginEmbedTmuxConf ::+  ∀ r .+  HasCallStack =>+  Members HandlerStack (r ++ HandlerStack) =>+  TmuxTestConfig ->+  InterpretersFor r HandlerStack ->+  [RpcHandler (r ++ HandlerStack)] ->+  Sem (EmbedTmuxWith r) () ->+  UnitTest+testPluginEmbedTmuxConf conf effs handlers =+  runEmbedTmuxTestConf conf .+  effs .+  withHandlers handlers .+  testPluginEmbed++testPluginEmbedTmux ::+  ∀ r .+  HasCallStack =>+  Members HandlerStack (r ++ HandlerStack) =>+  InterpretersFor r HandlerStack ->+  [RpcHandler (r ++ HandlerStack)] ->+  Sem (EmbedTmuxWith r) () ->+  UnitTest+testPluginEmbedTmux =+  testPluginEmbedTmuxConf @r def++testPluginEmbedTmux_ ::+  HasCallStack =>+  [RpcHandler HandlerStack] ->+  Sem EmbedTmux () ->+  UnitTest+testPluginEmbedTmux_ =+  testPluginEmbedTmux @'[] id++testEmbedTmux ::+  HasCallStack =>+  Sem EmbedTmux () ->+  UnitTest+testEmbedTmux =+  testPluginEmbedTmux_ mempty
+ lib/Ribosome/Test/Error.hs view
@@ -0,0 +1,47 @@+{-# options_haddock not-home #-}++module Ribosome.Test.Error where++import Polysemy.Test (TestError (TestError))++import Ribosome.Host.Data.Report (Reportable, mapReport, reportMessages)+import Ribosome.Host.Data.RpcHandler (Handler)++-- |Resume an effect and convert its error from @'Stop' err@ to @'Error' 'TestError'@.+resumeTestError ::+  ∀ eff err r .+  Show err =>+  Members [eff !! err, Error TestError] r =>+  InterpreterFor eff r+resumeTestError =+  resumeHoistError (TestError . show)++-- |Run a 'Handler', converting the @'Stop' 'Report'@ at its head to @'Error' 'TestError'@.+testHandler ::+  Member (Error TestError) r =>+  Handler r a ->+  Sem r a+testHandler =+  stopToErrorWith (TestError . reportMessages)++-- |Run a 'Handler' in a new thread and return an action that waits for the thread to terminate when sequenced.+-- Converts the @'Stop' 'Report'@ at its head to @'Error' 'TestError'@ when it is awaited.+testHandlerAsync ::+  Members [Error TestError, Async] r =>+  Handler r a ->+  Sem r (Sem r a)+testHandlerAsync h = do+  thread <- async do+    runStop h+  pure do+    testHandler . stopEither =<< note (TestError "async handler didn't produce result") =<< await thread++-- |Interpret @'Stop' err@ to @'Error' 'TestError'@ by using @err@'s instance of 'Reportable'.+testError ::+  ∀ err r a .+  Reportable err =>+  Member (Error TestError) r =>+  Sem (Stop err : r) a ->+  Sem r a+testError =+  testHandler . mapReport . raiseUnder
+ lib/Ribosome/Test/Examples/Example1.hs view
@@ -0,0 +1,30 @@+{-# options_haddock prune, hide #-}++-- |An example for the docs.+module Ribosome.Test.Examples.Example1 where++import Polysemy.Test++import Ribosome+import Ribosome.Api+import Ribosome.Test++store ::+  Member (Rpc !! RpcError) r =>+  Args ->+  Handler r ()+store (Args msg) =+  ignoreRpcError do+    nvimSetVar "message" msg++test_direct :: UnitTest+test_direct =+  testEmbed_ do+    store "test directly"+    assertEq "test directly" =<< nvimGetVar @Text "message"++test_rpc :: UnitTest+test_rpc =+  testPlugin_ [rpcCommand "Store" Sync store] do+    nvimCommand "Store test RPC"+    assertEq "test RPC" =<< nvimGetVar @Text "message"
− lib/Ribosome/Test/Exists.hs 
@@ -1,47 +0,0 @@-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 
@@ -1,42 +0,0 @@-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 
@@ -1,74 +0,0 @@-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 
@@ -1,20 +0,0 @@-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/Log.hs view
@@ -0,0 +1,22 @@+module Ribosome.Test.Log where++import Log (Severity)++import Ribosome.Test.Data.TestConfig (TestConfig)++testLogLevelConf ::+  HasCallStack =>+  Severity ->+  (TestConfig -> a) ->+  TestConfig ->+  a+testLogLevelConf =+  undefined++testLogLevel ::+  HasCallStack =>+  Severity ->+  (TestConfig -> a) ->+  a+testLogLevel level f =+  testLogLevelConf level f def
− lib/Ribosome/Test/Orphans.hs 
@@ -1,29 +0,0 @@-{-# 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
@@ -1,50 +1,95 @@-{-# 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 Chiasma.Data.CodecError (CodecError)+import Chiasma.Effect.Codec (NativeCommandCodecE)+import Chiasma.Effect.TmuxClient (NativeTmux)+import qualified Chiasma.Test.Screenshot as Chiasma+import Chiasma.Tmux (withTmux)+import Chiasma.TmuxApi (Tmux)+import Control.Lens.Regex.Text (group, regex)+import Exon (exon)+import Hedgehog.Internal.Property (Failure)+import qualified Log+import Path (reldir)+import Polysemy.Chronos (ChronosTime)+import qualified Polysemy.Test as Test+import Polysemy.Test (Hedgehog, Test, TestError (TestError), (===))+import Prelude hiding (group)+import qualified Time+import Time (Seconds (Seconds)) -import Ribosome.Control.Monad.Ribo (MonadRibo, Nvim)-import Ribosome.Orphans ()-import Ribosome.Test.Orphans ()-import Ribosome.Test.Unit (fixture)-import Ribosome.Tmux.Run (runTmux)+import Ribosome.Host.Effect.Log (StderrLog, stderrLog)+import Ribosome.Test.Wait (assertWait) +-- |Nvim appears to add random whitespace sequences, optionally interspersed with color codes, to empty lines.+-- This remotes that noise from lines starting with `~\ESC[39m` or `\ESC[94m~\ESC[39m`.+sanitize :: Text -> Text+sanitize =+  [regex|(\x{1b}\[94m)?~((\s|\x{1b}\[94m|\x{1b}\[39m)*)$|] . group 1 .~ ""+ screenshot ::-  MonadFree TmuxThunk m =>-  MonadIO m =>-  Text ->+  Members [Tmux, Test, Error TestError, Embed IO] r =>   Bool ->+  Bool ->+  Text ->   Int ->-  m (Maybe ([Text], [Text]))-screenshot name record pane = do-  storage <- fixture "screenshots"-  Chiasma.screenshot record storage (toString name) pane+  Sem r (Maybe ([Text], [Text]))+screenshot record sane name pane = do+  storage <- Test.fixturePath [reldir|screenshots|]+  mapError TestError (Chiasma.screenshotSanitized (if sane then sanitize else id) record storage name pane)  assertScreenshot ::-  AssertM m =>-  MonadIO m =>-  MonadRibo m =>-  MonadDeepError e TmuxError m =>-  MonadMask m =>-  Nvim m =>-  Text ->+  HasCallStack =>+  Members [NativeTmux, NativeCommandCodecE, Stop CodecError] r =>+  Members [Hedgehog IO, Test, Error TestError, Error Failure, ChronosTime, Race, Embed IO] r =>   Bool ->+  Text ->   Int ->-  m ()-assertScreenshot name record pane =-  runTmux (screenshot name record pane) >>= check+  Sem r ()+assertScreenshot sane name pane =+  withFrozenCallStack $ withTmux $ restop do+    assertWait (screenshot False sane name pane) (traverse_ check)   where-    check (Just (current, existing)) =-      gassertEqual existing current-    check Nothing =-      return ()+    check (current, existing) =+      existing === current++updateScreeshot ::+  HasCallStack =>+  Members [NativeTmux, NativeCommandCodecE, Stop CodecError] r =>+  Members [Hedgehog IO, Test, Error TestError, Error Failure, ChronosTime, StderrLog, Race, Embed IO] r =>+  Bool ->+  Text ->+  Int ->+  Sem r ()+updateScreeshot sane name pane =+  withTmux $ restop do+    stderrLog (Log.info [exon|Waiting for one second before storing new screenshot for '#{name}'|])+    Time.sleep (Seconds 1)+    void (screenshot sane True name pane)++awaitScreenshot' ::+  HasCallStack =>+  Members [NativeTmux, NativeCommandCodecE, Stop CodecError] r =>+  Members [Hedgehog IO, Test, Error TestError, Error Failure, ChronosTime, StderrLog, Race, Embed IO] r =>+  Bool ->+  Bool ->+  Text ->+  Int ->+  Sem r ()+awaitScreenshot' = \case+  True ->+    updateScreeshot+  False ->+    withFrozenCallStack assertScreenshot++awaitScreenshot ::+  HasCallStack =>+  Members [NativeTmux, NativeCommandCodecE, Stop CodecError] r =>+  Members [Hedgehog IO, Test, Error TestError, Error Failure, ChronosTime, StderrLog, Race, Embed IO] r =>+  Bool ->+  Text ->+  Int ->+  Sem r ()+awaitScreenshot record =+  withFrozenCallStack do+    awaitScreenshot' record True
+ lib/Ribosome/Test/SocketTmux.hs view
@@ -0,0 +1,172 @@+-- |Socket tmux tests start a tmux server, then run a regular Neovim session in a pane and connect to Neovim over a+-- socket.+module Ribosome.Test.SocketTmux where++import Chiasma.Command.Pane (sendKeys)+import Chiasma.Data.CodecError (CodecError)+import Chiasma.Data.SendKeysParams (Key (Lit))+import Chiasma.Effect.Codec (NativeCommandCodecE)+import Chiasma.Effect.TmuxApi (Tmux)+import Chiasma.Effect.TmuxClient (NativeTmux)+import Chiasma.Tmux (withTmux)+import Exon (exon)+import Hedgehog.Internal.Property (Failure)+import Path (Abs, File, Path, reldir, relfile, (</>))+import Path.IO (doesPathExist)+import Polysemy.Chronos (ChronosTime)+import qualified Polysemy.Test as Test+import Polysemy.Test (Hedgehog, Test, UnitTest, assert)++import Ribosome.Host.Data.NvimSocket (NvimSocket (NvimSocket))+import Ribosome.Host.Data.RpcHandler (RpcHandler)+import Ribosome.Host.Interpreter.Handlers (withHandlers)+import Ribosome.Host.Path (pathText)+import Ribosome.Socket (SocketHandlerEffects, interpretPluginSocket)+import Ribosome.Test.Data.TestConfig (TmuxTestConfig)+import Ribosome.Test.Embed (TestEffects, testPluginEmbed)+import Ribosome.Test.TmuxCommon (TmuxStack, runTmuxNvim)+import Ribosome.Test.Wait (assertWait)+import Ribosome.Data.CustomConfig (CustomConfig (CustomConfig))++-- |The stack of internal effects for socket tmux tests.+type TmuxHandlerStack =+  SocketHandlerEffects ++ Reader (CustomConfig ()) : Reader NvimSocket : TmuxStack++-- |The socket tmux test stack with additional effects.+type SocketTmuxWith r =+  TestEffects ++ r ++ TmuxHandlerStack++-- |The socket tmux test stack with no additional effects.+type SocketTmux =+  SocketTmuxWith '[]++nvimCmdline :: Path Abs File -> Text+nvimCmdline socket =+  [exon|nvim --listen #{pathText socket} -n -u NONE -i NONE --clean|]++-- |Create a socket for Neovim to listen on and run a 'Reader' with it.+withSocketTmuxNvim ::+  Members [Test, Hedgehog IO, ChronosTime, Error Failure, Race, Embed IO] r =>+  Members [NativeTmux, NativeCommandCodecE, Stop CodecError] r =>+  InterpreterFor (Reader NvimSocket) r+withSocketTmuxNvim sem = do+  dir <- Test.tempDir [reldir|tmux-test|]+  let socket = dir </> [relfile|nvim-socket|]+  withTmux do+    restop @CodecError @Tmux $ sendKeys 0 [Lit (nvimCmdline socket)]+  assertWait (pure socket) (assert <=< doesPathExist)+  runReader (NvimSocket socket) sem++-- |Run the tmux test stack.+runSocketTmuxTestConf ::+  HasCallStack =>+  TmuxTestConfig ->+  Sem TmuxHandlerStack () ->+  UnitTest+runSocketTmuxTestConf conf =+  runTmuxNvim conf .+  withSocketTmuxNvim .+  runReader (CustomConfig ()) .+  interpretPluginSocket++-- |Run the tmux test stack, using a pty to host tmux.+runSocketTmuxTest ::+  HasCallStack =>+  Sem TmuxHandlerStack () ->+  UnitTest+runSocketTmuxTest =+  runSocketTmuxTestConf def++-- |Run the tmux test stack, using a terminal to tmux tmux.+runSocketTmuxGuiTest ::+  HasCallStack =>+  Sem TmuxHandlerStack () ->+  UnitTest+runSocketTmuxGuiTest =+  runSocketTmuxTestConf (def & #tmux . #gui .~ True)++-- |Run a plugin test against a Neovim process running in a fresh tmux session, connected over a socket.+testPluginSocketTmuxConf ::+  ∀ r .+  HasCallStack =>+  Members TmuxHandlerStack (r ++ TmuxHandlerStack) =>+  -- |Regular test config combined with tmux config+  TmuxTestConfig ->+  -- |Interpreter for custom effects+  InterpretersFor r TmuxHandlerStack ->+  -- |RPC handlers+  [RpcHandler (r ++ TmuxHandlerStack)] ->+  Sem (SocketTmuxWith r) () ->+  UnitTest+testPluginSocketTmuxConf conf effs handlers =+  runSocketTmuxTestConf conf .+  effs .+  withHandlers handlers .+  testPluginEmbed++-- |Run a plugin test against a Neovim process running in a fresh tmux session, connected over a socket.+testPluginSocketTmux ::+  ∀ r .+  HasCallStack =>+  Members TmuxHandlerStack (r ++ TmuxHandlerStack) =>+  -- |Interpreter for custom effects+  InterpretersFor r TmuxHandlerStack ->+  -- |RPC handlers+  [RpcHandler (r ++ TmuxHandlerStack)] ->+  Sem (SocketTmuxWith r) () ->+  UnitTest+testPluginSocketTmux =+  testPluginSocketTmuxConf @r def++-- |Run a plugin test against a Neovim process running in a fresh tmux session, connected over a socket.+testHandlersSocketTmux ::+  HasCallStack =>+  -- |RPC handlers+  [RpcHandler TmuxHandlerStack] ->+  Sem SocketTmux () ->+  UnitTest+testHandlersSocketTmux =+  testPluginSocketTmux @'[] id++-- |Run a plugin test against a Neovim process running in a fresh tmux session, connected over a socket.+testSocketTmux ::+  HasCallStack =>+  Sem SocketTmux () ->+  UnitTest+testSocketTmux =+  testHandlersSocketTmux mempty++-- |Run a plugin test against a Neovim process running in a fresh tmux session displayed in a terminal, connected over a+-- socket.+testPluginSocketTmuxGui ::+  ∀ r .+  HasCallStack =>+  Members TmuxHandlerStack (r ++ TmuxHandlerStack) =>+  -- |Interpreter for custom effects+  InterpretersFor r TmuxHandlerStack ->+  -- |RPC handlers+  [RpcHandler (r ++ TmuxHandlerStack)] ->+  Sem (SocketTmuxWith r) () ->+  UnitTest+testPluginSocketTmuxGui =+  testPluginSocketTmuxConf @r (def & #tmux . #gui .~ True)++-- |Run a plugin test against a Neovim process running in a fresh tmux session displayed in a terminal, connected over a+-- socket.+testHandlersSocketTmuxGui ::+  HasCallStack =>+  -- |RPC handlers+  [RpcHandler TmuxHandlerStack] ->+  Sem SocketTmux () ->+  UnitTest+testHandlersSocketTmuxGui =+  testPluginSocketTmuxGui @'[] id++-- |Run a plugin test against a Neovim process running in a fresh tmux session displayed in a terminal, connected over a+-- socket.+testSocketTmuxGui ::+  HasCallStack =>+  Sem SocketTmux () ->+  UnitTest+testSocketTmuxGui =+  testHandlersSocketTmuxGui mempty
− lib/Ribosome/Test/Tmux.hs 
@@ -1,180 +0,0 @@-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/TmuxCommon.hs view
@@ -0,0 +1,63 @@+module Ribosome.Test.TmuxCommon where++import Chiasma.Data.CodecError (CodecError)+import Chiasma.Data.RenderError (RenderError)+import Chiasma.Data.TmuxError (TmuxError)+import Chiasma.Effect.TmuxClient (NativeTmux)+import qualified Chiasma.Test.Data.TmuxTestConfig as Chiasma+import Chiasma.Test.Tmux (TestTmuxEffects, withSystemTempDir, withTestTmux)+import Polysemy.Test (UnitTest)++import Ribosome.Data.PluginName (PluginName)+import Ribosome.Host.Data.BootError (BootError (BootError))+import Ribosome.Host.Test.Run (TestStack)+import Ribosome.Test.Data.TestConfig (TmuxTestConfig (TmuxTestConfig))+import Ribosome.Test.Embed (runTestConf)++type TmuxErrors =+  [+    Stop CodecError,+    Error CodecError,+    Stop RenderError,+    Error RenderError,+    Stop TmuxError,+    Error TmuxError,+    Error Text+  ]++type TmuxBaseStack =+  TestTmuxEffects ++ TmuxErrors++type TmuxStack =+  NativeTmux : TmuxBaseStack ++ Reader PluginName : TestStack++interpretTmuxErrors ::+  Member (Error BootError) r =>+  InterpretersFor TmuxErrors r+interpretTmuxErrors =+  mapError BootError .+  mapError @TmuxError (BootError . show) .+  stopToError .+  mapError @RenderError (BootError . show) .+  stopToError .+  mapError @CodecError (BootError . show) .+  stopToError++withTmuxTest ::+  Members TestStack r =>+  Chiasma.TmuxTestConfig ->+  InterpretersFor TmuxBaseStack r+withTmuxTest conf =+  interpretTmuxErrors .+  withSystemTempDir .+  withTestTmux conf++runTmuxNvim ::+  HasCallStack =>+  TmuxTestConfig ->+  Sem TmuxStack () ->+  UnitTest+runTmuxNvim (TmuxTestConfig conf tmuxConf) =+  runTestConf conf .+  withTmuxTest tmuxConf .+  restop @TmuxError @NativeTmux
lib/Ribosome/Test/Ui.hs view
@@ -1,38 +1,40 @@-{-# OPTIONS_GHC -F -pgmF htfpp #-}-+-- |Assertions for Neovim UI elements module Ribosome.Test.Ui where -import Test.Framework+import Polysemy.Test (Hedgehog, assertEq, (===))  import Ribosome.Api.Window (currentCursor, cursor)-import Ribosome.Control.Monad.Ribo (NvimE)-import Ribosome.Nvim.Api.Data (Window)-import Ribosome.Nvim.Api.IO (nvimListWins)+import Ribosome.Host.Api.Data (Window)+import Ribosome.Host.Api.Effect (nvimListWins)+import Ribosome.Host.Effect.Rpc (Rpc) +-- |Assert the number of windows. windowCountIs ::-  NvimE e m =>-  AssertM m =>+  Monad m =>+  Members [Rpc, Hedgehog m] r =>   Int ->-  m ()+  Sem r () windowCountIs count = do   wins <- nvimListWins-  gassertEqual count (length wins)+  count === length wins +-- |Assert the cursor position in a window. cursorIs ::-  NvimE e m =>-  AssertM m =>+  Monad m =>+  Members [Rpc, Hedgehog m] r =>   Int ->   Int ->   Window ->-  m ()+  Sem r () cursorIs line col =-  gassertEqual (line, col) <=< cursor+  assertEq (line, col) <=< cursor +-- |Assert the cursor position in the current window. currentCursorIs ::-  NvimE e m =>-  AssertM m =>+  Monad m =>+  Members [Rpc, Hedgehog m] r =>   Int ->   Int ->-  m ()+  Sem r () currentCursorIs line col =-  gassertEqual (line, col) =<< currentCursor+  assertEq (line, col) =<< currentCursor
− lib/Ribosome/Test/Unit.hs 
@@ -1,76 +0,0 @@-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
+ lib/Ribosome/Test/Wait.hs view
@@ -0,0 +1,46 @@+module Ribosome.Test.Wait where++import Hedgehog.Internal.Property (Failure, failWith, liftTest, mkTest)+import qualified Conc+import Conc (interpretAtomic)+import Polysemy.Test (Hedgehog, liftH)+import qualified Polysemy.Time as Time+import Polysemy.Time (MilliSeconds (MilliSeconds), Seconds (Seconds))++assertWaitFor ::+  Monad m =>+  HasCallStack =>+  Members [Hedgehog m, Time t d, Race, Error Failure, Embed IO] r =>+  TimeUnit t1 =>+  TimeUnit t2 =>+  t1 ->+  t2 ->+  Sem r a ->+  (a -> Sem r b) ->+  Sem r b+assertWaitFor timeout interval acquire test =+  withFrozenCallStack do+    interpretAtomic Nothing do+      Conc.timeout_ timeoutError timeout spin+  where+    spin = do+      a <- raise acquire+      catch (raise (test a)) \ e -> do+        atomicPut (Just e)+        Time.sleep interval+        spin+    timeoutError =+      atomicGet >>= liftH . \case+        Just e -> liftTest (mkTest (Left e, mempty))+        Nothing -> failWith Nothing "timed out before an assertion was made"++assertWait ::+  Monad m =>+  HasCallStack =>+  Members [Hedgehog m, Time t d, Race, Error Failure, Embed IO] r =>+  Sem r a ->+  (a -> Sem r b) ->+  Sem r b+assertWait acquire test =+  withFrozenCallStack do+    assertWaitFor (Seconds 3) (MilliSeconds 100) acquire test
ribosome-test.cabal view
@@ -1,75 +1,214 @@-cabal-version: 1.12-name: ribosome-test-version: 0.3.0.1-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+cabal-version: 2.2 -source-repository head-    type: git-    location: https://github.com/tek/ribosome-hs+-- This file has been generated from package.yaml by hpack version 0.34.6.+--+-- see: https://github.com/sol/hpack +name:           ribosome-test+version:        0.9.9.9+synopsis:       Test tools for Ribosome+description:    See https://hackage.haskell.org/package/ribosome-test/docs/Ribosome-Test.html+category:       Neovim+author:         Torsten Schmits+maintainer:     hackage@tryp.io+copyright:      2022 Torsten Schmits+license:        BSD-2-Clause-Patent+license-file:   LICENSE+build-type:     Simple+ 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.3.0.1 && <0.4,-        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+  exposed-modules:+      Ribosome.Handler+      Ribosome.Test+      Ribosome.Test.Data.TestConfig+      Ribosome.Test.Embed+      Ribosome.Test.EmbedTmux+      Ribosome.Test.Error+      Ribosome.Test.Examples.Example1+      Ribosome.Test.Log+      Ribosome.Test.Screenshot+      Ribosome.Test.SocketTmux+      Ribosome.Test.TmuxCommon+      Ribosome.Test.Ui+      Ribosome.Test.Wait+  hs-source-dirs:+      lib+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+      StandaloneKindSignatures+      OverloadedLabels+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin+  build-depends:+      base >=4.12 && <5+    , chiasma+    , chiasma-test+    , exon+    , hedgehog+    , lens-regex-pcre+    , path+    , path-io+    , polysemy+    , polysemy-chronos+    , polysemy-plugin+    , polysemy-test+    , prelate >=0.1+    , ribosome+    , ribosome-host+    , ribosome-host-test+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: Haskell2010++test-suite ribosome-test-unit+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Ribosome.Test.EmbedTmuxTest+      Ribosome.Test.ReportTest+      Ribosome.Test.SocketTmuxTest+      Ribosome.Test.SyntaxTest+      Skip+  hs-source-dirs:+      test+  default-extensions:+      AllowAmbiguousTypes+      ApplicativeDo+      BangPatterns+      BinaryLiterals+      BlockArguments+      ConstraintKinds+      DataKinds+      DefaultSignatures+      DeriveAnyClass+      DeriveDataTypeable+      DeriveFoldable+      DeriveFunctor+      DeriveGeneric+      DeriveLift+      DeriveTraversable+      DerivingStrategies+      DerivingVia+      DisambiguateRecordFields+      DoAndIfThenElse+      DuplicateRecordFields+      EmptyCase+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      InstanceSigs+      KindSignatures+      LambdaCase+      LiberalTypeSynonyms+      MultiParamTypeClasses+      MultiWayIf+      NamedFieldPuns+      OverloadedLabels+      OverloadedLists+      OverloadedStrings+      PackageImports+      PartialTypeSignatures+      PatternGuards+      PatternSynonyms+      PolyKinds+      QuantifiedConstraints+      QuasiQuotes+      RankNTypes+      RecordWildCards+      RecursiveDo+      RoleAnnotations+      ScopedTypeVariables+      StandaloneDeriving+      TemplateHaskell+      TupleSections+      TypeApplications+      TypeFamilies+      TypeFamilyDependencies+      TypeOperators+      TypeSynonymInstances+      UndecidableInstances+      UnicodeSyntax+      ViewPatterns+      StandaloneKindSignatures+      OverloadedLabels+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wmissing-deriving-strategies -Widentities -Wunused-packages -fplugin=Polysemy.Plugin -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.12 && <5+    , polysemy+    , polysemy-plugin+    , polysemy-test+    , prelate >=0.1+    , ribosome+    , ribosome-host+    , ribosome-test+    , tasty+  mixins:+      base hiding (Prelude)+    , prelate (Prelate as Prelude)+    , prelate hiding (Prelate)+  default-language: Haskell2010
+ test/Main.hs view
@@ -0,0 +1,22 @@+module Main where++import Polysemy.Test (unitTest)+import Ribosome.Test.EmbedTmuxTest (test_embedTmux)+import Ribosome.Test.ReportTest (test_report)+import Ribosome.Test.SocketTmuxTest (test_socketTmux)+import Ribosome.Test.SyntaxTest (test_syntax)+import Skip (skipUnlessX)+import Test.Tasty (TestTree, defaultMain, testGroup)++tests :: TestTree+tests =+  testGroup "ribosome" [+    unitTest "socket tmux" (skipUnlessX test_socketTmux),+    unitTest "embed tmux" (skipUnlessX test_embedTmux),+    unitTest "syntax" (skipUnlessX test_syntax),+    unitTest "report" (skipUnlessX test_report)+  ]++main :: IO ()+main =+  defaultMain tests
+ test/Ribosome/Test/EmbedTmuxTest.hs view
@@ -0,0 +1,12 @@+module Ribosome.Test.EmbedTmuxTest where++import Polysemy.Test (UnitTest, assert)++import Ribosome.Host.Api.Effect (nvimGetVar, nvimSetVar)+import Ribosome.Test.EmbedTmux (testEmbedTmux)++test_embedTmux :: UnitTest+test_embedTmux =+  testEmbedTmux do+    nvimSetVar "test" True+    assert =<< nvimGetVar "test"
+ test/Ribosome/Test/ReportTest.hs view
@@ -0,0 +1,37 @@+module Ribosome.Test.ReportTest where++import qualified Log+import Log (Severity (Error, Info))+import Polysemy.Test (UnitTest)++import Ribosome.Host.Api.Effect (nvimCommand, nvimInput)+import Ribosome.Host.Data.Execution (Execution (Sync))+import Ribosome.Host.Data.Report (Report (Report))+import Ribosome.Host.Data.RpcHandler (Handler)+import Ribosome.Host.Handler (rpcFunction)+import qualified Ribosome.Report as Report+import Ribosome.Test.Screenshot (awaitScreenshot)+import Ribosome.Test.SocketTmux (testHandlersSocketTmux)++stopInfo :: Handler r ()+stopInfo =+  stop (Report "report an info Stop by echoing" [] Info)++stopError :: Handler r ()+stopError =+  stop (Report "report an error Stop by responding" [] Error)++test_report :: UnitTest+test_report =+  testHandlersSocketTmux [rpcFunction "StopInfo" Sync stopInfo, rpcFunction "StopError" Sync stopError] do+    nvimCommand "mode"+    Log.debug "don't report Log.debug message"+    awaitScreenshot False "report-1" 0+    Log.info "report Log.info message"+    awaitScreenshot False "report-2" 0+    Report.warn "report Report.warn message" []+    awaitScreenshot False "report-3" 0+    nvimInput ":call StopInfo()<cr>"+    awaitScreenshot False "report-4" 0+    nvimInput ":call StopError()<cr>"+    awaitScreenshot False "report-5" 0
+ test/Ribosome/Test/SocketTmuxTest.hs view
@@ -0,0 +1,12 @@+module Ribosome.Test.SocketTmuxTest where++import Polysemy.Test (UnitTest, assert)++import Ribosome.Host.Api.Effect (nvimGetVar, nvimSetVar)+import Ribosome.Test.SocketTmux (testSocketTmux)++test_socketTmux :: UnitTest+test_socketTmux =+  testSocketTmux do+    nvimSetVar "test" True+    assert =<< nvimGetVar "test"
+ test/Ribosome/Test/SyntaxTest.hs view
@@ -0,0 +1,22 @@+module Ribosome.Test.SyntaxTest where++import Polysemy.Test (UnitTest)++import Ribosome.Api.Buffer (setCurrentBufferContent)+import Ribosome.Api.Syntax (executeSyntax)+import Ribosome.Syntax (Syntax (Syntax), syntaxHighlight, syntaxMatch)+import Ribosome.Test.Screenshot (awaitScreenshot)+import Ribosome.Test.SocketTmux (testSocketTmux)++syntax :: Syntax+syntax =+  Syntax [syntaxMatch "TestColons" "::"] [+    syntaxHighlight "TestColons" [("cterm", "reverse"), ("ctermfg", "1"), ("gui", "reverse"), ("guifg", "#dc322f")]+  ] []++test_syntax :: UnitTest+test_syntax =+  testSocketTmux do+    setCurrentBufferContent ["function :: String -> Int", "function _ = 5"]+    _ <- executeSyntax syntax+    awaitScreenshot False "syntax" 0
+ test/Skip.hs view
@@ -0,0 +1,11 @@+module Skip where++import qualified Data.Text.IO as Text+import Polysemy.Test (UnitTest)+import System.Environment (lookupEnv)++skipUnlessX :: UnitTest -> UnitTest+skipUnlessX test = do+  liftIO (lookupEnv "DISPLAY") >>= \case+    Just _ -> test+    Nothing -> liftIO (Text.putStrLn "Skipping test due to lack of display")