diff options
| -rw-r--r-- | erebos-tester.cabal | 6 | ||||
| -rw-r--r-- | src/Config.hs | 65 | ||||
| -rw-r--r-- | src/Main.hs | 21 |
3 files changed, 88 insertions, 4 deletions
diff --git a/erebos-tester.cabal b/erebos-tester.cabal index f7152f5..f869075 100644 --- a/erebos-tester.cabal +++ b/erebos-tester.cabal @@ -33,7 +33,8 @@ executable erebos-tester executable erebos-tester-core ghc-options: -Wall -threaded main-is: Main.hs - other-modules: GDB + other-modules: Config + GDB Network Output Parser @@ -57,10 +58,13 @@ executable erebos-tester-core TypeFamilies TypeOperators build-depends: base >=4.13 && <5, + bytestring >=0.10 && <0.11, containers ^>=0.6.2.1, directory ^>=1.3.6.0, filepath ^>=1.4.2.1, generic-deriving >=1.14 && <1.15, + Glob >=0.10 && <0.11, + HsYAML >=0.2 && <0.3, lens >=5.0 && <5.2, megaparsec >=9.0 && <10, mtl ^>=2.2.2, diff --git a/src/Config.hs b/src/Config.hs new file mode 100644 index 0000000..3c0545a --- /dev/null +++ b/src/Config.hs @@ -0,0 +1,65 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Config ( + Config(..), + findConfig, + parseConfig, +) where + +import Control.Monad.Combinators + +import Data.ByteString.Lazy qualified as BS +import Data.Text qualified as T +import Data.YAML + +import System.Directory +import System.Exit +import System.FilePath +import System.FilePath.Glob + +data Config = Config + { configTool :: Maybe FilePath + , configTests :: [Pattern] + } + deriving (Show) + +instance Semigroup Config where + a <> b = Config + { configTool = maybe (configTool b) Just (configTool a) + , configTests = configTests a ++ configTests b + } + +instance Monoid Config where + mempty = Config + { configTool = Nothing + , configTests = [] + } + +instance FromYAML Config where + parseYAML = withMap "Config" $ \m -> Config + <$> (fmap T.unpack <$> m .:? "tool") + <*> (map (compile . T.unpack) <$> foldr1 (<|>) + [ fmap (:[]) (m .: "tests") -- single pattern + , m .:? "tests" .!= [] -- list of patterns + ] + ) + +findConfig :: IO (Maybe FilePath) +findConfig = go "." + where + name = "erebos-tester.yaml" + go path = do + doesFileExist (path </> name) >>= \case + True -> return $ Just $ path </> name + False -> doesDirectoryExist (path </> "..") >>= \case + True -> go (path </> "..") + False -> return Nothing + +parseConfig :: FilePath -> IO Config +parseConfig path = do + contents <- BS.readFile path + case decode1 contents of + Left (pos, err) -> do + putStr $ prettyPosWithSource pos contents err + exitFailure + Right conf -> return conf diff --git a/src/Main.hs b/src/Main.hs index 2cb8cd9..286e09c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -23,11 +23,13 @@ import System.Directory import System.Environment import System.Exit import System.FilePath +import System.FilePath.Glob import System.IO.Error import System.Posix.Process import System.Posix.Signals import System.Process +import Config import GDB import Network import Output @@ -426,14 +428,27 @@ options = main :: IO () main = do - envtool <- fromMaybe (error "No test tool defined") <$> lookupEnv "EREBOS_TEST_TOOL" + configPath <- findConfig + config <- mapM parseConfig configPath + let baseDir = maybe "." dropFileName configPath + + envtool <- lookupEnv "EREBOS_TEST_TOOL" >>= \mbtool -> + return $ fromMaybe (error "No test tool defined") $ mbtool `mplus` (return . (baseDir </>) =<< configTool =<< config) + args <- getArgs - (opts, files) <- case getOpt Permute options args of + (opts, ofiles) <- case getOpt Permute options args of (o, files, []) -> return (foldl (flip id) defaultOptions { optDefaultTool = envtool } o, files) (_, _, errs) -> ioError (userError (concat errs ++ usageInfo header options)) where header = "Usage: erebos-tester [OPTION...]" - optDefaultTool opts `seq` return () + getPermissions (head $ words $ optDefaultTool opts) >>= \perms -> do + when (not $ executable perms) $ do + fail $ optDefaultTool opts <> " is not executable" + + files <- if not (null ofiles) + then return ofiles + else concat <$> mapM (flip globDir1 baseDir) (maybe [] configTests config) + when (null files) $ fail $ "No test files" out <- startOutput $ optVerbose opts ok <- allM (runTest out opts) . concat =<< mapM parseTestFile files |