{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
module Test.Tasty.Tmux
(
testTmux
, testTmux'
, withTmuxSession
, withTmuxSession'
, TestCase
, HasTmuxSession(..)
, TmuxSession
, sendKeys
, sendLiteralKeys
, sendLine
, tmuxSendKeys
, TmuxKeysMode(..)
, setEnvVarInSession
, capture
, snapshot
, Capture
, captureBytes
, captureString
, waitForCondition
, Condition(..)
, defaultRetries
, defaultBackoff
, assertCondition
, assertSubstring
, assertRegex
, assertConditionS
, assertSubstringS
, assertRegexS
, AnsiAttrParam
, AnsiFGParam
, AnsiBGParam
, buildAnsiRegex
, put
) where
import Control.Concurrent (threadDelay)
import Control.Exception (catch, IOException)
import Control.Monad (void)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (MonadIO, MonadReader, asks, runReaderT)
import Control.Monad.State (MonadState, get, put, runStateT)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as L
import Data.Char (isAscii, isAlphaNum)
import Data.Functor.Const (Const(..))
import Data.List (intercalate)
import Data.Semigroup ((<>))
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
import System.IO (hPutStrLn, stderr)
import System.Process.Typed
( proc, runProcess_, readProcessInterleaved_, ProcessConfig )
import Text.Regex.Posix ((=~))
import Test.Tasty (TestTree, TestName, testGroup, withResource)
import Test.Tasty.HUnit (assertBool, testCaseSteps)
data Condition
= Unconditional
| Substring B.ByteString
| Regex B.ByteString
| Not Condition
deriving (Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show)
newtype Capture = Capture { Capture -> ByteString
_captureBytes :: B.ByteString }
captureString :: Capture -> String
captureString :: Capture -> String
captureString = Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode forall b c a. (b -> c) -> (a -> b) -> a -> c
. Capture -> ByteString
_captureBytes
captureBytes :: Capture -> B.ByteString
captureBytes :: Capture -> ByteString
captureBytes = Capture -> ByteString
_captureBytes
type TestCase a = IO a -> Int -> TestTree
type TmuxSession = String
class HasTmuxSession a where
tmuxSession :: Functor f => (TmuxSession -> f TmuxSession) -> a -> f a
instance HasTmuxSession TmuxSession where
tmuxSession :: forall (f :: * -> *).
Functor f =>
(String -> f String) -> String -> f String
tmuxSession = forall a. a -> a
id
view :: MonadReader s m => ((a -> Const a a) -> s -> Const a s) -> m a
view :: forall s (m :: * -> *) a.
MonadReader s m =>
((a -> Const a a) -> s -> Const a s) -> m a
view (a -> Const a a) -> s -> Const a s
l = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall {k} a (b :: k). Const a b -> a
getConst forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Const a a) -> s -> Const a s
l forall {k} a (b :: k). a -> Const a b
Const)
testTmux
:: IO a
-> (a -> IO ())
-> [TestCase a]
-> TestTree
testTmux :: forall a. IO a -> (a -> IO ()) -> [TestCase a] -> TestTree
testTmux IO a
pre a -> IO ()
post [TestCase a]
tests =
forall a. IO a -> (a -> IO ()) -> (IO a -> TestTree) -> TestTree
withResource IO String
frameworkPre forall {p}. p -> IO ()
frameworkPost forall a b. (a -> b) -> a -> b
$ \IO String
ioKeepalive ->
forall a. IO a -> (a -> IO ()) -> (IO a -> TestTree) -> TestTree
withResource (IO String
ioKeepalive forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> IO a
pre) a -> IO ()
post forall a b. (a -> b) -> a -> b
$ \IO a
env ->
String -> [TestTree] -> TestTree
testGroup String
"user acceptance tests" forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (forall a b. (a -> b) -> a -> b
$ IO a
env) [TestCase a]
tests [Int
0..]
where
keepaliveSessionName :: String
keepaliveSessionName = String
"keepalive"
frameworkPre :: IO String
frameworkPre = String -> IO String
setUpTmuxSession String
keepaliveSessionName
frameworkPost :: p -> IO ()
frameworkPost p
_ = String -> IO ()
cleanUpTmuxSession String
keepaliveSessionName
testTmux' :: [TestCase ()] -> TestTree
testTmux' :: [TestCase ()] -> TestTree
testTmux' = forall a. IO a -> (a -> IO ()) -> [TestCase a] -> TestTree
testTmux (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
type AnsiAttrParam = String
type AnsiFGParam = String
type AnsiBGParam = String
buildAnsiRegex :: [AnsiAttrParam] -> [AnsiFGParam] -> [AnsiBGParam] -> B.ByteString
buildAnsiRegex :: [String] -> [String] -> [String] -> ByteString
buildAnsiRegex [String]
attrs [String]
fgs [String]
bgs =
let
withSemis :: [String] -> String
withSemis = forall a. [a] -> [[a]] -> [a]
intercalate String
";"
wrap :: [String] -> String
wrap [] = String
""
wrap [String]
xs = String
"\ESC\\[" forall a. Semigroup a => a -> a -> a
<> [String] -> String
withSemis [String]
xs forall a. Semigroup a => a -> a -> a
<> String
"m"
tmux24 :: String
tmux24 = [String] -> String
wrap ([String]
attrs forall a. Semigroup a => a -> a -> a
<> [String]
fgs forall a. Semigroup a => a -> a -> a
<> [String]
bgs)
tmux25 :: String
tmux25 = [String] -> String
wrap [String]
attrs forall a. Semigroup a => a -> a -> a
<> [String] -> String
wrap [String]
fgs forall a. Semigroup a => a -> a -> a
<> [String] -> String
wrap [String]
bgs
choice :: String -> ShowS
choice String
"" String
"" = String
""
choice String
"" String
r = String
r
choice String
l String
"" = String
l
choice String
l String
r = String
"(" forall a. Semigroup a => a -> a -> a
<> String
l forall a. Semigroup a => a -> a -> a
<> String
"|" forall a. Semigroup a => a -> a -> a
<> String
r forall a. Semigroup a => a -> a -> a
<> String
")"
in
String -> ByteString
B.pack forall a b. (a -> b) -> a -> b
$ String -> ShowS
choice String
tmux24 String
tmux25
setEnvVarInSession
:: (HasTmuxSession a, MonadReader a m, MonadIO m)
=> String -> String -> m ()
setEnvVarInSession :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
String -> String -> m ()
setEnvVarInSession String
name String
value =
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
String -> Condition -> m Capture
sendLine (String
"export " forall a. Semigroup a => a -> a -> a
<> String
name forall a. Semigroup a => a -> a -> a
<> String
"=" forall a. Semigroup a => a -> a -> a
<> String
value) Condition
Unconditional
sendKeys
:: (HasTmuxSession a, MonadReader a m, MonadIO m)
=> String -> Condition -> m Capture
sendKeys :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
String -> Condition -> m Capture
sendKeys String
keys Condition
expect = do
forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
TmuxKeysMode -> String -> m ()
tmuxSendKeys TmuxKeysMode
InterpretKeys String
keys
forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
Condition -> Int -> Int -> m Capture
waitForCondition Condition
expect Int
defaultRetries Int
defaultBackoff
sendLiteralKeys
:: (HasTmuxSession a, MonadReader a m, MonadIO m)
=> String -> Condition -> m Capture
sendLiteralKeys :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
String -> Condition -> m Capture
sendLiteralKeys String
keys Condition
cond = do
forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
TmuxKeysMode -> String -> m ()
tmuxSendKeys TmuxKeysMode
LiteralKeys String
keys
forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
Condition -> Int -> Int -> m Capture
waitForCondition Condition
cond Int
defaultRetries Int
defaultBackoff
sendLine
:: (HasTmuxSession a, MonadReader a m, MonadIO m)
=> String -> Condition -> m Capture
sendLine :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
String -> Condition -> m Capture
sendLine String
s Condition
cond = do
forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
String -> Condition -> m Capture
sendLiteralKeys String
s Condition
Unconditional
forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
String -> Condition -> m Capture
sendKeys String
"Enter" Condition
cond
data TmuxKeysMode = LiteralKeys | InterpretKeys
deriving (TmuxKeysMode -> TmuxKeysMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TmuxKeysMode -> TmuxKeysMode -> Bool
$c/= :: TmuxKeysMode -> TmuxKeysMode -> Bool
== :: TmuxKeysMode -> TmuxKeysMode -> Bool
$c== :: TmuxKeysMode -> TmuxKeysMode -> Bool
Eq)
tmuxSendKeys
:: (HasTmuxSession a, MonadReader a m, MonadIO m)
=> TmuxKeysMode -> String -> m ()
tmuxSendKeys :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
TmuxKeysMode -> String -> m ()
tmuxSendKeys TmuxKeysMode
mode String
keys = forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m) =>
TmuxKeysMode -> String -> m (ProcessConfig () () ())
tmuxSendKeysProc TmuxKeysMode
mode String
keys forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_
tmuxSendKeysProc
:: (HasTmuxSession a, MonadReader a m)
=> TmuxKeysMode -> String -> m (ProcessConfig () () ())
tmuxSendKeysProc :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m) =>
TmuxKeysMode -> String -> m (ProcessConfig () () ())
tmuxSendKeysProc TmuxKeysMode
mode String
keys = forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m) =>
String -> [String] -> m (ProcessConfig () () ())
tmuxSessionProc String
"send-keys" ([String
"-l" | TmuxKeysMode
mode forall a. Eq a => a -> a -> Bool
== TmuxKeysMode
LiteralKeys] forall a. Semigroup a => a -> a -> a
<> [String
keys])
tmuxSessionProc
:: (HasTmuxSession a, MonadReader a m)
=> String -> [String] -> m (ProcessConfig () () ())
tmuxSessionProc :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m) =>
String -> [String] -> m (ProcessConfig () () ())
tmuxSessionProc String
cmd [String]
args = do
String
sessionName <- forall s (m :: * -> *) a.
MonadReader s m =>
((a -> Const a a) -> s -> Const a s) -> m a
view forall a (f :: * -> *).
(HasTmuxSession a, Functor f) =>
(String -> f String) -> a -> f a
tmuxSession
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
proc String
"tmux" (String
cmd forall a. a -> [a] -> [a]
: String
"-t" forall a. a -> [a] -> [a]
: String
sessionName forall a. a -> [a] -> [a]
: [String]
args)
waitForCondition
:: (HasTmuxSession a, MonadReader a m, MonadIO m)
=> Condition
-> Int
-> Int
-> m Capture
waitForCondition :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
Condition -> Int -> Int -> m Capture
waitForCondition Condition
cond Int
n Int
backOff = do
Capture
cap <- forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
m Capture
capture
case Condition -> ByteString -> Bool
checkCondition Condition
cond (Capture -> ByteString
captureBytes Capture
cap) of
Bool
True -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Capture
cap
Bool
_ | Int
n forall a. Ord a => a -> a -> Bool
> Int
0 -> do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO ()
threadDelay Int
backOff
forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
Condition -> Int -> Int -> m Capture
waitForCondition Condition
cond (Int
n forall a. Num a => a -> a -> a
- Int
1) (Int
backOff forall a. Num a => a -> a -> a
* Int
4)
| Bool
otherwise -> Capture
cap forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (m :: * -> *). MonadIO m => Condition -> Capture -> m ()
assertCondition Condition
cond Capture
cap
checkCondition :: Condition -> B.ByteString -> Bool
checkCondition :: Condition -> ByteString -> Bool
checkCondition Condition
Unconditional = forall a b. a -> b -> a
const Bool
True
checkCondition (Substring ByteString
s) = (ByteString
s ByteString -> ByteString -> Bool
`B.isInfixOf`)
checkCondition (Regex ByteString
re) = (forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
RegexContext Regex source1 target) =>
source1 -> source -> target
=~ ByteString
re)
checkCondition (Not Condition
cond) = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Condition -> ByteString -> Bool
checkCondition Condition
cond
assertCondition :: (MonadIO m) => Condition -> Capture -> m ()
assertCondition :: forall (m :: * -> *). MonadIO m => Condition -> Capture -> m ()
assertCondition Condition
cond Capture
cap =
let s :: String
s = Capture -> String
captureString Capture
cap
in forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> Bool -> IO ()
assertBool
( String
"Condition not met: '" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Condition
cond
forall a. Semigroup a => a -> a -> a
<> String
"'. Last capture:\n\n " forall a. Semigroup a => a -> a -> a
<> String
s forall a. Semigroup a => a -> a -> a
<> String
"\n\n"
forall a. Semigroup a => a -> a -> a
<> String
" raw: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show String
s )
(Condition -> ByteString -> Bool
checkCondition Condition
cond (Capture -> ByteString
captureBytes Capture
cap))
assertSubstring :: (MonadIO m) => B.ByteString -> Capture -> m ()
assertSubstring :: forall (m :: * -> *). MonadIO m => ByteString -> Capture -> m ()
assertSubstring = forall (m :: * -> *). MonadIO m => Condition -> Capture -> m ()
assertCondition forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Condition
Substring
assertRegex :: (MonadIO m) => B.ByteString -> Capture -> m ()
assertRegex :: forall (m :: * -> *). MonadIO m => ByteString -> Capture -> m ()
assertRegex = forall (m :: * -> *). MonadIO m => Condition -> Capture -> m ()
assertCondition forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Condition
Regex
assertConditionS :: (MonadIO m, MonadState Capture m) => Condition -> m ()
assertConditionS :: forall (m :: * -> *).
(MonadIO m, MonadState Capture m) =>
Condition -> m ()
assertConditionS Condition
cond = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadIO m => Condition -> Capture -> m ()
assertCondition Condition
cond
assertSubstringS :: (MonadIO m, MonadState Capture m) => B.ByteString -> m ()
assertSubstringS :: forall (m :: * -> *).
(MonadIO m, MonadState Capture m) =>
ByteString -> m ()
assertSubstringS ByteString
s = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadIO m => ByteString -> Capture -> m ()
assertSubstring ByteString
s
assertRegexS :: (MonadIO m, MonadState Capture m) => B.ByteString -> m ()
assertRegexS :: forall (m :: * -> *).
(MonadIO m, MonadState Capture m) =>
ByteString -> m ()
assertRegexS ByteString
s = forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *). MonadIO m => ByteString -> Capture -> m ()
assertRegex ByteString
s
defaultRetries :: Int
defaultRetries :: Int
defaultRetries = Int
5
withTmuxSession
:: (HasTmuxSession testEnv)
=> (sharedEnv -> TmuxSession -> IO testEnv)
-> (testEnv -> IO ())
-> TestName
-> ( forall m. (MonadReader testEnv m, MonadState Capture m, MonadIO m)
=> (String -> m ()) -> m a
)
-> TestCase sharedEnv
withTmuxSession :: forall testEnv sharedEnv a.
HasTmuxSession testEnv =>
(sharedEnv -> String -> IO testEnv)
-> (testEnv -> IO ())
-> String
-> (forall (m :: * -> *).
(MonadReader testEnv m, MonadState Capture m, MonadIO m) =>
(String -> m ()) -> m a)
-> TestCase sharedEnv
withTmuxSession sharedEnv -> String -> IO testEnv
pre testEnv -> IO ()
post String
desc forall (m :: * -> *).
(MonadReader testEnv m, MonadState Capture m, MonadIO m) =>
(String -> m ()) -> m a
f IO sharedEnv
getGEnv Int
i =
forall a. IO a -> (a -> IO ()) -> (IO a -> TestTree) -> TestTree
withResource
(IO sharedEnv
getGEnv forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \sharedEnv
gEnv -> IO String
frameworkPre forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= sharedEnv -> String -> IO testEnv
pre sharedEnv
gEnv)
(\testEnv
env -> testEnv -> IO ()
post testEnv
env forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> IO ()
cleanUpTmuxSession (forall s (m :: * -> *) a.
MonadReader s m =>
((a -> Const a a) -> s -> Const a s) -> m a
view forall a (f :: * -> *).
(HasTmuxSession a, Functor f) =>
(String -> f String) -> a -> f a
tmuxSession testEnv
env))
forall a b. (a -> b) -> a -> b
$ \IO testEnv
env -> String -> ((String -> IO ()) -> IO ()) -> TestTree
testCaseSteps String
desc forall a b. (a -> b) -> a -> b
$
\String -> IO ()
step -> IO testEnv
env forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT (forall (m :: * -> *).
(MonadReader testEnv m, MonadState Capture m, MonadIO m) =>
(String -> m ()) -> m a
f (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
step)) forall {a}. a
initCap)
where
initCap :: a
initCap = forall a. HasCallStack => String -> a
error String
"no Capture; use 'snapshot' first"
frameworkPre :: IO String
frameworkPre =
let
sessionName :: String
sessionName = forall a. [a] -> [[a]] -> [a]
intercalate String
"-" (String
"tasty-tmux" forall a. a -> [a] -> [a]
: forall a. Show a => a -> String
show Int
i forall a. a -> [a] -> [a]
: [String]
descWords)
descWords :: [String]
descWords = String -> [String]
words forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (\Char
c -> Char -> Bool
isAscii Char
c Bool -> Bool -> Bool
&& (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
' ')) String
desc
in
String -> IO String
setUpTmuxSession String
sessionName
withTmuxSession'
:: TestName
-> ( forall m. (MonadReader TmuxSession m, MonadState Capture m, MonadIO m)
=> (String -> m ()) -> m a
)
-> TestCase sharedEnv
withTmuxSession' :: forall a sharedEnv.
String
-> (forall (m :: * -> *).
(MonadReader String m, MonadState Capture m, MonadIO m) =>
(String -> m ()) -> m a)
-> TestCase sharedEnv
withTmuxSession' = forall testEnv sharedEnv a.
HasTmuxSession testEnv =>
(sharedEnv -> String -> IO testEnv)
-> (testEnv -> IO ())
-> String
-> (forall (m :: * -> *).
(MonadReader testEnv m, MonadState Capture m, MonadIO m) =>
(String -> m ()) -> m a)
-> TestCase sharedEnv
withTmuxSession (forall a b. a -> b -> a
const forall (f :: * -> *) a. Applicative f => a -> f a
pure) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
capture :: (HasTmuxSession a, MonadReader a m, MonadIO m) => m Capture
capture :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
m Capture
capture = ByteString -> Capture
Capture forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
L.toStrict
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m) =>
String -> [String] -> m (ProcessConfig () () ())
tmuxSessionProc String
"capture-pane"
[ String
"-e"
, String
"-p"
, String
"-J"
]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) stdin stdoutIgnored stderrIgnored.
MonadIO m =>
ProcessConfig stdin stdoutIgnored stderrIgnored -> m ByteString
readProcessInterleaved_)
snapshot :: (HasTmuxSession a, MonadReader a m, MonadState Capture m, MonadIO m) => m ()
snapshot :: forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadState Capture m,
MonadIO m) =>
m ()
snapshot = forall a (m :: * -> *).
(HasTmuxSession a, MonadReader a m, MonadIO m) =>
m Capture
capture forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall s (m :: * -> *). MonadState s m => s -> m ()
put
defaultBackoff :: Int
defaultBackoff :: Int
defaultBackoff = Int
20 forall a. Num a => a -> a -> a
* Int
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
3 :: Int)
setUpTmuxSession :: TmuxSession -> IO TmuxSession
setUpTmuxSession :: String -> IO String
setUpTmuxSession String
sessionname = String
sessionname forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
(forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
proc
String
"tmux"
[ String
"new-session"
, String
"-x"
, String
"80"
, String
"-y"
, String
"24"
, String
"-d"
, String
"-s"
, String
sessionname
, String
"-n"
, String
"tasty-tmux"])
(\IOException
e ->
do let err :: String
err = forall a. Show a => a -> String
show (IOException
e :: IOException)
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"\nException during setUp: " forall a. Semigroup a => a -> a -> a
<> String
err)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
cleanUpTmuxSession :: String -> IO ()
cleanUpTmuxSession :: String -> IO ()
cleanUpTmuxSession String
sessionname =
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch
(forall (m :: * -> *) stdin stdout stderr.
MonadIO m =>
ProcessConfig stdin stdout stderr -> m ()
runProcess_ forall a b. (a -> b) -> a -> b
$ String -> [String] -> ProcessConfig () () ()
proc String
"tmux" [String
"kill-session", String
"-t", String
sessionname])
(\IOException
e ->
do let err :: String
err = forall a. Show a => a -> String
show (IOException
e :: IOException)
Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"\nException when killing session: " forall a. Semigroup a => a -> a -> a
<> String
err)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())