summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2022-12-01 22:20:44 +0100
committerRoman Smrž <roman.smrz@seznam.cz>2022-12-04 21:43:49 +0100
commitf71befe4fd893dfce7d126763cacd9069ad728c4 (patch)
treebf5132a5bf985594b600d529302041bf0e1b29b3 /src
parent879946ea2a61cb76354b5c70d2dea0d8cce7cb13 (diff)
Config file lookup and parsing
Diffstat (limited to 'src')
-rw-r--r--src/Config.hs65
-rw-r--r--src/Main.hs21
2 files changed, 83 insertions, 3 deletions
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