module Reanimate.Misc
( requireExecutable
, runCmd
, runCmd_
, runCmdLazy
, withTempDir
, withTempFile
, renameOrCopyFile
) where
import Control.Concurrent
import Control.Exception (catch, evaluate, finally, throw)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Foreign.C.Error
import GHC.IO.Exception
import System.Directory (copyFile, findExecutable, removeFile,
renameFile)
import System.FilePath ((<.>))
import System.IO (hClose, hGetContents, hIsEOF, hPutStr,
stderr)
import System.IO.Temp (withSystemTempDirectory,
withSystemTempFile)
import System.Process (readProcessWithExitCode,
runInteractiveProcess, showCommandForUser,
terminateProcess, waitForProcess)
requireExecutable :: String -> IO FilePath
requireExecutable exec = do
mbPath <- findExecutable exec
case mbPath of
Nothing -> error $ "Couldn't find executable: " ++ exec
Just path -> return path
runCmd :: FilePath -> [String] -> IO ()
runCmd exec args = do
ret <- runCmd_ exec args
case ret of
Left err -> error $ showCommandForUser exec args ++ ":\n" ++ err
Right{} -> return ()
runCmd_ :: FilePath -> [String] -> IO (Either String String)
runCmd_ exec args = do
(ret, stdout, errMsg) <- readProcessWithExitCode exec args ""
_ <- evaluate (length stdout + length errMsg)
case ret of
ExitSuccess -> return (Right stdout)
ExitFailure err | False ->
return
$ Left
$ "Failed to run: "
++ showCommandForUser exec args
++ "\n"
++ "Error code: "
++ show err
++ "\n"
++ "stderr: "
++ errMsg
ExitFailure{} | null errMsg ->
return $ Left stdout
ExitFailure{} -> return $ Left errMsg
runCmdLazy
:: FilePath -> [String] -> (IO (Either String T.Text) -> IO a) -> IO a
runCmdLazy exec args handler = do
(inp, out, err, pid) <- runInteractiveProcess exec args Nothing Nothing
hClose inp
errOutput <- hGetContents err
_ <- forkIO $ hPutStr stderr errOutput
let fetch = do
eof <- hIsEOF out
if eof
then do
_ <- evaluate (length errOutput)
ret <- waitForProcess pid
case ret of
ExitSuccess -> return (Left "")
ExitFailure{} -> return (Left errOutput)
else do
line <- T.hGetLine out
return (Right line)
handler fetch `finally` do
terminateProcess pid
_ <- waitForProcess pid
return ()
renameOrCopyFile :: FilePath -> FilePath -> IO ()
renameOrCopyFile src dst = renameFile src dst `catch` exdev
where
exdev e = if fmap Errno (ioe_errno e) == Just eXDEV
then copyFile src dst >> removeFile src
else throw e
withTempDir :: (FilePath -> IO a) -> IO a
withTempDir = withSystemTempDirectory "reanimate"
withTempFile :: String -> (FilePath -> IO a) -> IO a
withTempFile ext action =
withSystemTempFile ("reanimate" <.> ext) $ \path hd ->
hClose hd >> action path