summaryrefslogtreecommitdiff
path: root/src/Run.hs
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2025-06-01 20:49:29 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2025-06-02 21:51:28 +0200
commit23a5528e2b5a6008b3572a172e5f1671a13d28b8 (patch)
tree9a15f9b903cdc016c24a4d9ef0e38b5da005e70f /src/Run.hs
parentb698fa819723635ddbdde15e592c3b7acc018024 (diff)
Test script execution based on config file
Diffstat (limited to 'src/Run.hs')
-rw-r--r--src/Run.hs26
1 files changed, 24 insertions, 2 deletions
diff --git a/src/Run.hs b/src/Run.hs
index 8088f23..200ae8e 100644
--- a/src/Run.hs
+++ b/src/Run.hs
@@ -1,6 +1,7 @@
module Run (
module Run.Monad,
runTest,
+ loadModules,
evalGlobalDefs,
) where
@@ -12,12 +13,14 @@ import Control.Monad.Except
import Control.Monad.Fix
import Control.Monad.Reader
+import Data.Bifunctor
import Data.Map qualified as M
import Data.Maybe
-import Data.Set qualified as S
import Data.Scientific
+import Data.Set qualified as S
import Data.Text (Text)
-import qualified Data.Text as T
+import Data.Text qualified as T
+import Text.Megaparsec (errorBundlePretty, showErrorComponent)
import System.Directory
import System.Exit
@@ -30,13 +33,16 @@ import GDB
import Network
import Network.Ip
import Output
+import Parser
import Process
import Run.Monad
import Script.Expr
+import Script.Module
import Script.Shell
import Test
import Test.Builtins
+
runTest :: Output -> TestOptions -> GlobalDefs -> Test -> IO Bool
runTest out opts gdefs test = do
let testDir = optTestDir opts
@@ -111,6 +117,22 @@ runTest out opts gdefs test = do
return False
+loadModules :: [ FilePath ] -> IO ( [ Module ], GlobalDefs )
+loadModules files = do
+ ( modules, allModules ) <- parseTestFiles files >>= \case
+ Right res -> do
+ return res
+ Left err -> do
+ case err of
+ ImportModuleError bundle ->
+ putStr (errorBundlePretty bundle)
+ _ -> do
+ putStrLn (showErrorComponent err)
+ exitFailure
+ let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules
+ return ( modules, globalDefs )
+
+
evalGlobalDefs :: [ (( ModuleName, VarName ), SomeExpr ) ] -> GlobalDefs
evalGlobalDefs exprs = fix $ \gdefs ->
builtins `M.union` M.fromList (map (fmap (evalSomeWith gdefs)) exprs)