From ea8109cef731b2c876b9effa759763bf59d878aa Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Wed, 14 Jan 2026 19:11:16 +0100
Subject: Mark ignored output lines

Changelog: Mark flushed or ignored output lines
---
 src/Process.hs | 28 +++++++++++++++++++---------
 1 file changed, 19 insertions(+), 9 deletions(-)

(limited to 'src/Process.hs')

diff --git a/src/Process.hs b/src/Process.hs
index 7d09b61..3cf0938 100644
--- a/src/Process.hs
+++ b/src/Process.hs
@@ -23,6 +23,7 @@ import Control.Monad.Except
 import Control.Monad.Reader
 
 import Data.Function
+import Data.List
 import Data.Maybe
 import Data.Scientific
 import Data.Text (Text)
@@ -115,10 +116,14 @@ startProcessIOLoops process@Process {..} hout herr = do
 
     void $ forkTest $ lineReadingLoop process hout $ \line -> do
         outProc OutputChildStdout process line
-        liftIO $ atomically $ do
+        ignored <- liftIO $ atomically $ do
             ignores <- map snd . snd <$> readTVar procIgnore
-            when (not $ any (matches line) ignores) $ do
+            let ignored = any (matches line) ignores
+            when (not ignored) $ do
                 modifyTVar procOutput (++ [ line ])
+            return ignored
+        when ignored $ do
+            outProc OutputIgnored process line
 
     void $ forkTest $ lineReadingLoop process herr $ \line -> do
         case procName of
@@ -218,18 +223,23 @@ instance ObjectType TestRun IgnoreProcessOutput where
     textObjectValue _ (IgnoreProcessOutput _ _) = "<IgnoreProcessOutput>"
 
     createObject oid ( process@Process {..}, regex ) = do
-        liftIO $ atomically $ do
-            flushProcessOutput process regex
+        ( obj, flushed ) <- liftIO $ atomically $ do
+            flushed <- flushProcessOutput process regex
             ( iid, list ) <- readTVar procIgnore
             writeTVar procIgnore ( iid + 1, ( iid, regex ) : list )
-            return $ Object oid $ IgnoreProcessOutput process iid
+            return ( Object oid $ IgnoreProcessOutput process iid, flushed )
+        mapM_ (outProc OutputIgnored process) flushed
+        return obj
 
     destroyObject Object { objImpl = IgnoreProcessOutput Process {..} iid } = do
         liftIO $ atomically $ do
             writeTVar procIgnore . fmap (filter ((iid /=) . fst)) =<< readTVar procIgnore
 
-flushProcessOutput :: Process -> Maybe Regex -> STM ()
+flushProcessOutput :: Process -> Maybe Regex -> STM [ Text ]
 flushProcessOutput p mbre = do
-    writeTVar (procOutput p) =<< case mbre of
-        Nothing -> return []
-        Just re -> filter (either error isNothing . regexMatch re) <$> readTVar (procOutput p)
+    current <- readTVar (procOutput p)
+    let ( ignore, keep ) = case mbre of
+            Nothing -> ( current, [] )
+            Just re -> partition (either error isJust . regexMatch re) current
+    writeTVar (procOutput p) keep
+    return ignore
-- 
cgit v1.2.3