From 4f9a8d5554d0c5ad36264f82c5c7efc9afc5529c Mon Sep 17 00:00:00 2001
From: Marcellus Siegburg <marcellus.siegburg@uni-due.de>
Date: Mon, 13 May 2024 10:20:17 +0200
Subject: [PATCH] do not use unsafePerformIO

---
 raw/embedded/src/TestHarness.hs |  6 ++----
 src/Haskell/Template/Task.hs    | 24 +++++++++++++-----------
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/raw/embedded/src/TestHarness.hs b/raw/embedded/src/TestHarness.hs
index 6f0f995..7214e05 100644
--- a/raw/embedded/src/TestHarness.hs
+++ b/raw/embedded/src/TestHarness.hs
@@ -40,17 +40,15 @@ import Data.List                        (elem, intercalate, notElem, null)
 import Language.Haskell.Exts
   (Decl (..), Exp (..), Match (..) , Module (..), Name (..), ParseResult (..), Pat (..),
    Rhs (..), SrcSpanInfo, classifyExtension, parseFileContentsWithExts)
-import System.IO.Unsafe                 (unsafePerformIO) -- We need to run the tests inside the interpreter
 import System.Random                    (randomRIO)
 import Test.HUnit.Base
   (Node (Label), Test, Counts (Counts), errors, failures, path, performTest)
 import Test.HUnit.Text                  (showPath)
 
 {-| Function called by the interpreter, getting the tests to run as the argument. -}
-run :: HU.Testable t => [t] -> (HU.Counts, ShowS)
+run :: HU.Testable t => [t] -> IO (HU.Counts, ShowS)
 run testables =
-  unsafePerformIO $
-    catches
+  catches
     (foldM performTestUnlessError (Counts 0 0 0 0, id) testables)
     [Handler $ \(e :: ErrorCall)        -> pairWith e,
      Handler $ \(e :: PatternMatchFail) -> pairWith e,
diff --git a/src/Haskell/Template/Task.hs b/src/Haskell/Template/Task.hs
index 65e63d0..8801369 100644
--- a/src/Haskell/Template/Task.hs
+++ b/src/Haskell/Template/Task.hs
@@ -534,18 +534,20 @@ Please inform a tutor about this issue providing your solution and this message.
 deriving instance Typeable Counts
 
 handleCounts
-  :: Monad m
+  :: MonadIO m
   => (Doc -> m ())
   -> (Doc -> m ())
-  -> (Counts, String -> String)
+  -> IO (Counts, String -> String)
   -> m ()
-handleCounts reject inform result = case result of
-  (Counts {errors=a,failures=0} ,f) | a /= 0 -> do
-    inform "Some error occurred before fully testing the solution:"
-    reject (string (f ""))
-    -- e.g. quickcheck timeout errors
-  (Counts {errors=0, failures=0},_) -> return ()
-  (_                            ,f) -> reject (string (f ""))
+handleCounts reject inform runResult = do
+  result <- liftIO runResult
+  case result of
+    (Counts {errors=x, failures=0}, f) | x /= 0 -> do
+      inform "Some error occurred before fully testing the solution:"
+      reject (string (f ""))
+      -- e.g. quickcheck timeout errors
+    (Counts {errors=0, failures=0}, _) -> pure ()
+    (_                            , f) -> reject (string (f ""))
 
 checkResult
   :: Monad m
@@ -595,10 +597,10 @@ interpreter
   => FilePath
   -> SolutionConfig
   -> [String]
-  -> m (Counts, ShowS)
+  -> m (IO (Counts, ShowS))
 interpreter dirname config modules = do
   prepareInterpreter dirname config modules
-  interpret "TestHarness.run Test.test" (as :: (Counts, ShowS))
+  interpret "TestHarness.run Test.test" (as :: IO (Counts, ShowS))
 
 compiler :: MonadInterpreter m => FilePath -> SolutionConfig -> [String] -> m Bool
 compiler dirname config modules = do