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

---
 erebos-tester.cabal |  6 ++++-
 src/Config.hs       | 65 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/Main.hs         | 21 ++++++++++++++---
 3 files changed, 88 insertions(+), 4 deletions(-)
 create mode 100644 src/Config.hs

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