12345678910111213141516171819202122232425262728293031323334353637383940414243444546 |
- {-# 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
|