{-# LANGUAGE OverloadedStrings #-}
module Bricoleur.Commands.Test (runTest) where
import Bricoleur.Config
import Bricoleur.Opts
import Bricoleur.Utils
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
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