-- | Shared runner for the @exitcode-stdio@ integration suites: runs named
-- specs against fresh contexts, selecting them by command-line name.
module NanoUI.Testing.Runner
  ( runTests
  ) where

import Control.Monad (forM_, when)
import Data.IORef (IORef, modifyIORef', newIORef, readIORef)
import NanoUI.Testing (Context)
import System.Environment (getArgs)
import System.IO (hFlush, stdout)

-- | Run the given specs. Each entry is a test name, a context maker, and the
-- test body (which receives the context and a shared failure counter). Names
-- passed as program arguments select which tests run; with no arguments
-- everything runs. A test counts as failed when it incremented the counter.
runTests :: [(String, IO Context, Context -> IORef Int -> IO ())] -> IO ()
runTests :: [(String, IO Context, Context -> IORef Int -> IO ())] -> IO ()
runTests [(String, IO Context, Context -> IORef Int -> IO ())]
specs = do
  args <- IO [String]
getArgs
  let
    wantAll = [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args
    want String
name = Bool
wantAll Bool -> Bool -> Bool
|| String
name String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
args
    names = [String
name | (String
name, IO Context
_, Context -> IORef Int -> IO ()
_) <- [(String, IO Context, Context -> IORef Int -> IO ())]
specs]
    unknown = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
names) [String]
args
  when (not (null unknown)) $
    fail ("Unknown test names: " ++ unwords unknown)
  failed <- newIORef (0 :: Int)
  failedTests <- newIORef (0 :: Int)
  forM_ specs $ \(String
name, IO Context
mkCtx, Context -> IORef Int -> IO ()
run) ->
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
want String
name) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      String -> IO ()
putStrLn (String
"RUN: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
      Handle -> IO ()
hFlush Handle
stdout
      before <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
failed
      ctx <- mkCtx
      run ctx failed
      after <- readIORef failed
      when (after > before) $ do
        modifyIORef' failedTests (+ 1)
        putStrLn ("FAIL: " ++ name)
  n <- readIORef failedTests
  if n == 0
    then putStrLn "All tests passed."
    else do
      putStrLn $ show n ++ " test(s) failed."
      fail "tests failed"