From 31608670fe91a11b5a51b7a0b627ba4ade56eaa1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 27 Apr 2025 10:30:41 +0200
Subject: Return error from parseTestFile

---
 src/TestMode.hs | 37 ++++++++++++++++++++++++++++++-------
 1 file changed, 30 insertions(+), 7 deletions(-)

(limited to 'src/TestMode.hs')

diff --git a/src/TestMode.hs b/src/TestMode.hs
index 90ccdae..ab938e6 100644
--- a/src/TestMode.hs
+++ b/src/TestMode.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 module TestMode (
     testMode,
 ) where
@@ -14,6 +16,9 @@ import Data.Text.IO qualified as T
 
 import System.IO.Error
 
+import Text.Megaparsec.Error
+import Text.Megaparsec.Pos
+
 import Output
 import Parser
 import Run
@@ -86,13 +91,31 @@ commands =
 cmdLoad :: Command
 cmdLoad = do
     [ path ] <- asks tmiParams
-    ( modules, allModules ) <- liftIO $ parseTestFiles [ T.unpack path ]
-    let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules
-    modify $ \s -> s
-        { tmsModules = modules
-        , tmsGlobals = globalDefs
-        }
-    cmdOut "load-done"
+    liftIO (parseTestFiles [ T.unpack path ]) >>= \case
+        Right ( modules, allModules ) -> do
+            let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules
+            modify $ \s -> s
+                { tmsModules = modules
+                , tmsGlobals = globalDefs
+                }
+            cmdOut "load-done"
+
+        Left (ModuleNotFound moduleName) -> do
+            cmdOut $ "load-failed module-not-found" <> textModuleName moduleName
+        Left (FileNotFound notFoundPath) -> do
+            cmdOut $ "load-failed file-not-found " <> T.pack notFoundPath
+        Left (ImportModuleError bundle) -> do
+#if MIN_VERSION_megaparsec(9,7,0)
+            mapM_ (cmdOut . T.pack) $ lines $ errorBundlePrettyWith showParseError bundle
+#endif
+            cmdOut $ "load-failed parse-error"
+  where
+    showParseError _ SourcePos {..} _ = concat
+        [ "parse-error"
+        , " ", sourceName
+        , ":", show $ unPos sourceLine
+        , ":", show $ unPos sourceColumn
+        ]
 
 cmdRun :: Command
 cmdRun = do
-- 
cgit v1.2.3