Flush command

Changelog: Add 'flush' command

3 files changed, 27 insertions, 0 deletions

diff --git a/src/Parser/Statement.hs b/src/Parser/Statement.hs
index e58779b..732f417 100644
--- a/src/Parser/Statement.hs
+++ b/src/Parser/Statement.hs
@@ -106,6 +106,13 @@ instance ParamType a => ParamType [a] where
     paramDefault _ = return []
     paramFromSomeExpr _ se@(SomeExpr e) = cast e <|> ((:[]) <$> paramFromSomeExpr @a Proxy se)
 
+instance ParamType a => ParamType (Maybe a) where
+    type ParamRep (Maybe a) = Maybe (ParamRep a)
+    parseParam _ = Just <$> parseParam @a Proxy
+    showParamType _ = showParamType @a Proxy
+    paramDefault _ = return Nothing
+    paramFromSomeExpr _ se = Just <$> paramFromSomeExpr @a Proxy se
+
 instance (ParamType a, ParamType b) => ParamType (Either a b) where
     type ParamRep (Either a b) = Either (ParamRep a) (ParamRep b)
     parseParam _ = try (Left <$> parseParam @a Proxy) <|> (Right <$> parseParam @b Proxy)
@@ -289,6 +296,11 @@ testExpect = command "expect" $ Expect
     <*> param "capture"
     <*> innerBlock
 
+testFlush :: TestParser [TestStep]
+testFlush = command "flush" $ Flush
+    <$> paramOrContext "from"
+    <*> param ""
+
 testGuard :: TestParser [TestStep]
 testGuard = command "guard" $ Guard
     <$> cmdLine
@@ -344,6 +356,7 @@ testStep = choice
     , testSpawn
     , testSend
     , testExpect
+    , testFlush
     , testGuard
     , testDisconnectNode
     , testDisconnectNodes
diff --git a/src/Run.hs b/src/Run.hs
index 04fa9ee..a40641b 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -10,6 +10,7 @@ import Control.Monad
 import Control.Monad.Except
 import Control.Monad.Reader
 
+import Data.Either
 import Data.Map qualified as M
 import Data.Maybe
 import Data.Set qualified as S
@@ -151,6 +152,10 @@ evalSteps = mapM_ $ \case
         p <- eval pname
         expect line p expr captures $ evalSteps inner
 
+    Flush pname expr -> do
+        p <- eval pname
+        flush p expr
+
     Guard line expr -> do
         testStepGuard line expr
 
@@ -304,6 +309,14 @@ expect (SourceLine sline) p expr tvars inner = do
 
          Nothing -> exprFailed (T.pack "expect") (SourceLine sline) (Just $ procName p) expr
 
+flush :: Process -> Maybe (Expr Regex) -> TestRun ()
+flush p mbexpr = do
+    mbre <- sequence $ fmap eval mbexpr
+    atomicallyTest $ do
+        writeTVar (procOutput p) =<< case mbre of
+            Nothing -> return []
+            Just re -> filter (isLeft . regexMatch re) <$> readTVar (procOutput p)
+
 testStepGuard :: SourceLine -> Expr Bool -> TestRun ()
 testStepGuard sline expr = do
     x <- eval expr
diff --git a/src/Test.hs b/src/Test.hs
index e336858..d080cae 100644
--- a/src/Test.hs
+++ b/src/Test.hs
@@ -42,6 +42,7 @@ data TestStep = forall a. ExprType a => Let SourceLine (TypedVarName a) (Expr a)
               | Spawn (TypedVarName Process) (Either (Expr Network) (Expr Node)) [TestStep]
               | Send (Expr Process) (Expr Text)
               | Expect SourceLine (Expr Process) (Expr Regex) [TypedVarName Text] [TestStep]
+              | Flush (Expr Process) (Maybe (Expr Regex))
               | Guard SourceLine (Expr Bool)
               | DisconnectNode (Expr Node) [TestStep]
               | DisconnectNodes (Expr Network) [TestStep]