content: module Main where
  
  import Control.Concurrent.Async (Async, async, waitBoth)
  import Control.Monad
  import Data.List
  import Data.List.Split
  import GHC.IO.Handle
  import System.IO (hPutStrLn, stdout, stderr)
  import System.Exit (exitFailure, exitSuccess)
  import System.Environment (getArgs)
  import System.Process
  import Text.Regex.Posix
  
  defaultCabalName :: String
  defaultCabalName = "cabal"
  
  isTestFailure :: String -> Bool
  isTestFailure line = line =~ "^Test suite .*: FAIL$"
  
  readLines :: Handle -> Handle -> IO [String]
  readLines hIn hOut = do
      isEOF <- hIsEOF hIn
      if isEOF
          then return []
          else do
              x <- hGetLine hIn
              hPutStrLn hOut x
              xs <- readLines hIn hOut
              return (x : xs)
  
  checkFailure :: Handle -> Handle -> IO (Async Bool)
  checkFailure hIn = async . liftM (not . any isTestFailure) . readLines hIn
  
  runCabalTest :: String -> [String] -> IO Bool
  runCabalTest cabalName args = do
      (_, out, err, _) <- runInteractiveCommand (cabalName ++ " test " ++ unwords args)
      aOutResult <- checkFailure out stdout
      aErrResult <- checkFailure err stderr
      results <- waitBoth aOutResult aErrResult
      return $ uncurry (&&) results
  
  getCabalName :: [String] -> Maybe String
  getCabalName [] = Just defaultCabalName
  getCabalName [arg] = case splitOn "=" arg of
      (_ : cabalName : _) -> Just cabalName
      _ -> Nothing
  getCabalName _ = Nothing
  
  main :: IO ()
  main = do
      cmdArgs <- getArgs
      case cmdArgs of
          ["--help"] -> usage >> exitSuccess
          ["-h"] -> usage >> exitSuccess
          options -> case mCabalName of
              Just cabalName -> do
                  result <- runCabalTest cabalName cabalTestArgs
                  if result then exitSuccess else exitFailure
              Nothing -> usage >> exitFailure
              where (runCabalTestArgs, cabalTestArgs) = partition (=~ "^--cabal-name=.*") options
                    mCabalName = getCabalName runCabalTestArgs
      where usage = putStrLn "Usage: run-cabal-test [run-cabal-test-options] [cabal-test-options]"
  