From f71befe4fd893dfce7d126763cacd9069ad728c4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Thu, 1 Dec 2022 22:20:44 +0100
Subject: Config file lookup and parsing

---
 src/Config.hs | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/Main.hs   | 21 ++++++++++++++++---
 2 files changed, 83 insertions(+), 3 deletions(-)
 create mode 100644 src/Config.hs

(limited to 'src')

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
-- 
cgit v1.2.3