module Control.Distributed.Task.TaskSpawning.ExecutionUtil (
withEnv,
withTempBLFile,
withTempBLCFile,
withTempFile,
ignoreIOExceptions,
expectSilentSuccess,
expectSuccess,
createTempFilePath,
serializeTaskInput,
deserializeTaskInput,
parseResultStrict,
executeExternal,
measureDuration,
readStdTillEOF
) where
import Control.Exception.Base (bracket, catch)
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy.Char8 as BLC
import qualified Data.ByteString.Lazy as BL
import Data.List (intersperse)
import Data.Time.Clock (diffUTCTime, NominalDiffTime, getCurrentTime)
import System.Directory (removeFile)
import System.Environment (lookupEnv, setEnv, unsetEnv)
import System.Exit (ExitCode(..))
import System.FilePath ()
import System.IO.Error (catchIOError, isEOFError)
import System.IO.Temp (withSystemTempFile)
import System.Process (readProcessWithExitCode)
import Control.Distributed.Task.Types.TaskTypes (TaskInput, TaskResult)
import Control.Distributed.Task.Util.ErrorHandling
import Control.Distributed.Task.Util.Logging
withEnv :: String -> String -> IO a -> IO a
withEnv key value action = do
old <- lookupEnv key
setEnv key value
res <- action
maybe (unsetEnv key) (\o -> setEnv key o) old
return res
withTempBLFile :: FilePath -> BL.ByteString -> (FilePath -> IO result) -> IO result
withTempBLFile = withTempFile BL.writeFile
withTempBLCFile :: FilePath -> BLC.ByteString -> (FilePath -> IO result) -> IO result
withTempBLCFile = withTempFile BLC.writeFile
withTempFile :: (FilePath -> dataType -> IO ()) -> FilePath -> dataType -> (FilePath -> IO result) -> IO result
withTempFile writer filePathTemplate fileContent =
bracket
(do
filePath <- createTempFilePath filePathTemplate
writer filePath fileContent
return filePath)
(\filePath -> ignoreIOExceptions $ removeFile filePath)
ignoreIOExceptions :: IO () -> IO ()
ignoreIOExceptions io = io `catchIOError` (\_ -> return ())
expectSilentSuccess :: (ExitCode, String, String) -> IO ()
expectSilentSuccess executionOutput = expectSuccess executionOutput >>= \res -> case res of
"" -> return ()
_ -> error $ "no output expected, but got: " ++ res
expectSuccess :: (ExitCode, String, String) -> IO String
expectSuccess (ExitSuccess, result, []) = return result
expectSuccess (code, out, err) = error $ "command exited with unexpected status: "++show code++", output:\n"++out++"\nstderr:\n"++err
createTempFilePath :: String -> IO FilePath
createTempFilePath template = do
withSystemTempFile template (\ f _ -> return f)
serializeTaskInput :: TaskInput -> BLC.ByteString
serializeTaskInput = BLC.pack . show
deserializeTaskInput :: BLC.ByteString -> IO TaskInput
deserializeTaskInput s = withErrorAction logError "Could not read input data" $ return $ read $ BLC.unpack s
parseResultStrict :: BLC.ByteString -> IO TaskResult
parseResultStrict s = withErrorPrefix ("Cannot parse result: "++ (BLC.unpack s)) $ return $! (BLC.lines s :: TaskResult)
executeExternal :: FilePath -> [String] -> IO String
executeExternal executable args = do
logInfo $ "executing: " ++ executable ++ " " ++ (filter (/='\n') $ concat $ intersperse " " args)
result <- withErrorAction logError ("Could not run [" ++ (show executable) ++ "] successfully: ") (readProcessWithExitCode executable args "")
expectSuccess result
measureDuration :: IO a -> IO (a, NominalDiffTime)
measureDuration action = do
before <- getCurrentTime
res <- action
after <- getCurrentTime
return (res, diffUTCTime after before)
readStdTillEOF :: IO TaskInput
readStdTillEOF = do
l <- readLnUnlessEOF
case l of
Nothing -> return []
(Just line) -> do
rest <- readStdTillEOF
return (line:rest)
where
readLnUnlessEOF :: IO (Maybe BL.ByteString)
readLnUnlessEOF = (BC.getLine >>= return . Just . BLC.fromStrict) `catch` eofHandler
where
eofHandler :: IOError -> IO (Maybe BL.ByteString)
eofHandler e = if isEOFError e then return Nothing else ioError e