{-# LANGUAGE OverloadedStrings #-} module Bricoleur.Commands.Test (runTest) where import Control.Monad (forM_) import qualified Data.ByteString.Lazy.Char8 as B import qualified GHC.IO.Exception as Exn import System.FilePath (()) import qualified System.FilePath as Sys import qualified System.Process as Sys import Bricoleur.Opts import Bricoleur.Config import Bricoleur.Utils runTest :: Config -> Options -> IO () runTest conf opts = do let root = Sys.takeDirectory (optFile opts) cDebug ("running tests for " % shown) (confDocument conf) forM_ (confSources conf) $ \ samp -> do cDebug ("- running test for " % stext) (sourceName samp) runCommand root samp runCommand :: FilePath -> Source -> IO () runCommand root src = do forM_ (sourceCommands src) $ \ln -> do let dir = root sourceDir src cDebug (" $ " % string % " (in '" % string % "')") ln dir (outH, inH) <- Sys.createPipe let process = (Sys.shell ln) { Sys.cwd = Just (root sourceDir src) , Sys.std_out = Sys.UseHandle inH , Sys.std_err = Sys.UseHandle inH } (_, _, _, p) <- Sys.createProcess process bufOutput <- B.hGetContents outH code <- Sys.waitForProcess p case code of Exn.ExitSuccess -> return () Exn.ExitFailure n -> do let idtext = map (B.append " - ") (B.lines bufOutput) cError ("\nCommand '" % string % "' exited with error (" % shown % ")") ln n mapM_ bsErrorLn idtext