module Reanimate.Misc
( requireExecutable,
runCmd,
runCmd_,
runCmdLazy,
withTempDir,
withTempFile,
renameOrCopyFile,
getReanimateCacheDirectory,
)
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
( XdgDirectory (XdgCache),
copyFile,
createDirectoryIfMissing,
findExecutable,
getXdgDirectory,
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
getReanimateCacheDirectory :: IO FilePath
getReanimateCacheDirectory = do
root <- getXdgDirectory XdgCache "reanimate"
let path = root </> show cacheVersion
createDirectoryIfMissing True path
return path
where
cacheVersion :: Int
cacheVersion = 0