diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 37 |
1 files changed, 13 insertions, 24 deletions
diff --git a/src/Main.hs b/src/Main.hs index 48f95df..b3f7a2a 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,27 +2,24 @@ module Main (main) where import Control.Monad -import Data.Bifunctor import Data.List import Data.Maybe +import Data.Text (Text) import Data.Text qualified as T import Text.Read (readMaybe) -import Text.Megaparsec (errorBundlePretty, showErrorComponent) import System.Console.GetOpt import System.Directory import System.Environment import System.Exit import System.FilePath -import System.FilePath.Glob import System.IO import System.Posix.Terminal import System.Posix.Types import Config import Output -import Parser import Process import Run import Script.Module @@ -34,6 +31,7 @@ import Version data CmdlineOptions = CmdlineOptions { optTest :: TestOptions , optRepeat :: Int + , optExclude :: [ Text ] , optVerbose :: Bool , optColor :: Maybe Bool , optShowHelp :: Bool @@ -45,6 +43,7 @@ defaultCmdlineOptions :: CmdlineOptions defaultCmdlineOptions = CmdlineOptions { optTest = defaultTestOptions , optRepeat = 1 + , optExclude = [] , optVerbose = False , optColor = Nothing , optShowHelp = False @@ -86,6 +85,9 @@ options = , Option ['r'] ["repeat"] (ReqArg (\str opts -> opts { optRepeat = read str }) "<count>") "number of times to repeat the test(s)" + , Option [ 'e' ] [ "exclude" ] + (ReqArg (\str opts -> opts { optExclude = T.pack str : optExclude opts }) "<test>") + "exclude given test from execution" , Option [] ["wait"] (NoArg $ to $ \opts -> opts { optWait = True }) "wait at the end of each test" @@ -108,9 +110,8 @@ hiddenOptions = main :: IO () main = do - configPath <- findConfig - config <- mapM parseConfig configPath - let baseDir = maybe "." dropFileName configPath + config <- mapM parseConfig =<< findConfig + let baseDir = maybe "." configDir config envtool <- lookupEnv "EREBOS_TEST_TOOL" >>= \mbtool -> return $ fromMaybe (error "No test tool defined") $ mbtool `mplus` (return . (baseDir </>) =<< configTool =<< config) @@ -119,6 +120,7 @@ main = do { optTest = defaultTestOptions { optDefaultTool = envtool , optTestDir = normalise $ baseDir </> optTestDir defaultTestOptions + , optTimeout = fromMaybe (optTimeout defaultTestOptions) $ configTimeout =<< config } } @@ -151,7 +153,7 @@ main = do exitSuccess when (optTestMode opts) $ do - testMode + testMode config exitSuccess case words $ optDefaultTool $ optTest opts of @@ -165,7 +167,7 @@ main = do case span (/= ':') ofile of (path, ':':test) -> (path, Just $ T.pack test) (path, _) -> (path, Nothing) - else map (, Nothing) . concat <$> mapM (flip globDir1 baseDir) (maybe [] configTests config) + else map (, Nothing) <$> maybe (return []) (getConfigTestFiles) config when (null files) $ fail $ "No test files" @@ -177,18 +179,8 @@ main = do | otherwise = OutputStyleQuiet out <- startOutput outputStyle useColor - ( modules, allModules ) <- parseTestFiles (map fst files) >>= \case - Right res -> do - return res - Left err -> do - case err of - ImportModuleError bundle -> - putStr (errorBundlePretty bundle) - _ -> do - putStrLn (showErrorComponent err) - exitFailure - - tests <- if null otests + ( modules, globalDefs ) <- loadModules (map fst files) + tests <- filter ((`notElem` optExclude opts) . testName) <$> if null otests then fmap concat $ forM (zip modules files) $ \( Module {..}, ( filePath, mbTestName )) -> do case mbTestName of Nothing -> return moduleTests @@ -207,9 +199,6 @@ main = do hPutStrLn stderr $ "Test ‘" <> T.unpack name <> "’ not found" exitFailure - - let globalDefs = evalGlobalDefs $ concatMap (\m -> map (first ( moduleName m, )) $ moduleDefinitions m) allModules - ok <- allM (runTest out (optTest opts) globalDefs) $ concat $ replicate (optRepeat opts) tests when (not ok) exitFailure |