From 8f62c1ad5045564d8fd5ddafea877efc2d7fc803 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sat, 17 Oct 2026 20:40:33 +0200
Subject: Replace user error with custom error data type

---
 src/Error.hs   | 26 ++++++++++++++++++++++++++
 src/Main.hs    |  9 +++++----
 src/Network.hs |  4 +++-
 src/Run.hs     |  7 ++++---
 4 files changed, 38 insertions(+), 8 deletions(-)
 create mode 100644 src/Error.hs

(limited to 'src')

diff --git a/src/Error.hs b/src/Error.hs
new file mode 100644
index 0000000..5226912
--- /dev/null
+++ b/src/Error.hs
@@ -0,0 +1,26 @@
+module Error (
+    TesterError(..),
+    throwOtherError
+) where
+
+import Control.Exception
+import Control.Monad.Except
+import Control.Monad.IO.Class
+
+import Data.Text (Text)
+import Data.Text qualified as T
+
+
+data TesterError
+    = OtherTesterError Text
+
+instance Show TesterError where
+    show = displayException
+
+instance Exception TesterError where
+    displayException = \case
+        OtherTesterError err -> T.unpack err
+
+
+throwOtherError :: (MonadIO m, MonadError IOException m) => Text -> m a
+throwOtherError = liftIO . throwIO . OtherTesterError
diff --git a/src/Main.hs b/src/Main.hs
index aada687..8e89f7c 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -20,6 +20,7 @@ import System.Posix.Terminal
 import System.Posix.Types
 
 import Config
+import Error
 import JUnit
 import Output
 import Parser.Core
@@ -180,14 +181,14 @@ main = do
                 -> case conftool of
                     ToolPath cpath -> return $ ToolPath $ baseDir </> cpath
                     ToolCabal ccabal -> return $ ToolCabal ccabal
-            | otherwise -> fail "no test tool defined"
+            | otherwise -> throwOtherError "no test tool defined"
 
     case defaultTool of
         ToolPath tpath -> case words tpath of
             (path : _) -> getPermissions path >>= \perms -> do
                 when (not $ executable perms) $ do
-                    fail $ "‘" <> path <> "’ is not executable"
-            _ -> fail $ "invalid tool argument: ‘" <> tpath <> "’"
+                    throwOtherError $ "‘" <> T.pack path <> "’ is not executable"
+            _ -> throwOtherError $ "invalid tool argument: ‘" <> T.pack tpath <> "’"
         ToolCabal _ -> return ()
 
     files <- if not (null ofiles)
@@ -197,7 +198,7 @@ main = do
                 (path, _)        -> (path, Nothing)
         else map (, Nothing) <$> maybe (return []) (getConfigTestFiles) config
 
-    when (null files) $ fail $ "No test files"
+    when (null files) $ throwOtherError $ "no test files"
 
     useColor <- case optColor opts of
         Just use -> return use
diff --git a/src/Network.hs b/src/Network.hs
index b48a233..a06dc9b 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -29,6 +29,8 @@ import Network.Ip
 import Script.Expr
 import Script.Expr.Class
 
+import Error
+
 {-
 NETWORK STRUCTURE
 =================
@@ -193,7 +195,7 @@ newNode nodeNetwork vname = atomicallyWithIO $ do
 
     postpone $ do
         exists <- doesPathExist nodeDir
-        when exists $ ioError $ userError $ nodeDir ++ " exists"
+        when exists $ throwOtherError $ "node directory ‘" <> T.pack nodeDir <> "’ already exists"
         createDirectoryIfMissing True nodeDir
 
     let node = Node {..}
diff --git a/src/Run.hs b/src/Run.hs
index 53a0275..33c4109 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -44,6 +44,7 @@ import System.Posix.Signals
 import System.Process
 
 import Config
+import Error
 import GDB
 import Network
 import Network.Ip
@@ -117,7 +118,7 @@ runTest out opts gdefs test = do
     when (optForce opts) $ removeDirectoryRecursive testDir `catchIOError` \e ->
         if isDoesNotExistError e then return () else ioError e
     exists <- doesPathExist testDir
-    when exists $ ioError $ userError $ testDir ++ " exists"
+    when exists $ throwOtherError $ "test directory ‘" <> T.pack testDir <> "’ already exists"
     createDirectoryIfMissing True testDir
 
     failedVar <- newTVarIO Nothing
@@ -136,12 +137,12 @@ runTest out opts gdefs test = do
                             let path = takeWhile (/= '\n') cabalOut
                             return $ T.unpack $ T.unwords (T.pack path : args)
                         _ -> do
-                            ioError $ userError $ "failed to find ‘" <> T.unpack name <> "’ executable path using cabal"
+                            throwOtherError $ "failed to find ‘" <> name <> "’ executable path using cabal"
                 | otherwise
                 -> return $ T.unpack arg
     defaultTool <- case optDefaultTool opts of
         Just tool -> evalTool tool
-        Nothing -> ioError $ userError "No test tool defined"
+        Nothing -> throwOtherError "no test tool defined"
     procTools <- mapM (sequence . fmap evalTool) $ optProcTools opts
 
     mgdb <- if optGDB opts
-- 
cgit v1.2.3