diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2025-06-01 20:49:29 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2025-06-02 21:51:28 +0200 |
commit | 23a5528e2b5a6008b3572a172e5f1671a13d28b8 (patch) | |
tree | 9a15f9b903cdc016c24a4d9ef0e38b5da005e70f /src/Run.hs | |
parent | b698fa819723635ddbdde15e592c3b7acc018024 (diff) |
Test script execution based on config file
Diffstat (limited to 'src/Run.hs')
-rw-r--r-- | src/Run.hs | 26 |
1 files changed, 24 insertions, 2 deletions
@@ -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) |