From 20a18716e494d7d83d498cfc4bfd96fa11d6b8ce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Thu, 12 Jan 2023 22:45:48 +0100
Subject: Move process-related functions to Process module

---
 src/Run/Monad.hs | 18 ++++++++++++++++++
 1 file changed, 18 insertions(+)

(limited to 'src/Run')

diff --git a/src/Run/Monad.hs b/src/Run/Monad.hs
index 220ac46..221f6d7 100644
--- a/src/Run/Monad.hs
+++ b/src/Run/Monad.hs
@@ -4,6 +4,9 @@ module Run.Monad (
     TestState(..),
     TestOptions(..), defaultTestOptions,
     Failed(..),
+
+    finally,
+    forkTest,
 ) where
 
 import Control.Concurrent
@@ -87,3 +90,18 @@ instance MonadEval TestRun where
 
 instance MonadOutput TestRun where
     getOutput = asks $ teOutput . fst
+
+
+finally :: MonadError e m => m a -> m b -> m a
+finally act handler = do
+    x <- act `catchError` \e -> handler >> throwError e
+    void handler
+    return x
+
+forkTest :: TestRun () -> TestRun ()
+forkTest act = do
+    tenv <- ask
+    void $ liftIO $ forkIO $ do
+        runExceptT (flip runReaderT tenv $ fromTestRun act) >>= \case
+            Left e -> atomically $ writeTVar (teFailed $ fst tenv) (Just e)
+            Right () -> return ()
-- 
cgit v1.2.3