never executed always true always false

    1 module Reanimate.Misc
    2   ( requireExecutable
    3   , runCmd
    4   , runCmd_
    5   , runCmdLazy
    6   , withTempDir
    7   , withTempFile
    8   , renameOrCopyFile
    9   ) where
   10 
   11 import           Control.Concurrent
   12 import           Control.Exception  (catch, evaluate, finally, throw)
   13 import qualified Data.Text          as T
   14 import qualified Data.Text.IO       as T
   15 import           Foreign.C.Error
   16 import           GHC.IO.Exception
   17 import           System.Directory   (copyFile, findExecutable, removeFile,
   18                                      renameFile)
   19 import           System.FilePath    ((<.>))
   20 import           System.IO          (hClose, hGetContents, hIsEOF, hPutStr,
   21                                      stderr)
   22 import           System.IO.Temp     (withSystemTempDirectory,
   23                                      withSystemTempFile)
   24 import           System.Process     (readProcessWithExitCode,
   25                                      runInteractiveProcess, showCommandForUser,
   26                                      terminateProcess, waitForProcess)
   27 
   28 
   29 requireExecutable :: String -> IO FilePath
   30 requireExecutable exec = do
   31   mbPath <- findExecutable exec
   32   case mbPath of
   33     Nothing   -> error $ "Couldn't find executable: " ++ exec
   34     Just path -> return path
   35 
   36 runCmd :: FilePath -> [String] -> IO ()
   37 runCmd exec args = do
   38   ret <- runCmd_ exec args
   39   case ret of
   40     Left err -> error $ showCommandForUser exec args ++ ":\n" ++ err
   41     Right{}  -> return ()
   42 
   43 runCmd_ :: FilePath -> [String] -> IO (Either String String)
   44 runCmd_ exec args = do
   45   (ret, stdout, errMsg) <- readProcessWithExitCode exec args ""
   46   _                     <- evaluate (length stdout + length errMsg)
   47   case ret of
   48     ExitSuccess -> return (Right stdout)
   49     ExitFailure err | False ->
   50       return
   51         $  Left
   52         $  "Failed to run: "
   53         ++ showCommandForUser exec args
   54         ++ "\n"
   55         ++ "Error code: "
   56         ++ show err
   57         ++ "\n"
   58         ++ "stderr: "
   59         ++ errMsg
   60     ExitFailure{} | null errMsg -> -- LaTeX prints errors to stdout. :(
   61       return $ Left stdout
   62     ExitFailure{} -> return $ Left errMsg
   63 
   64 runCmdLazy
   65   :: FilePath -> [String] -> (IO (Either String T.Text) -> IO a) -> IO a
   66 runCmdLazy exec args handler = do
   67   (inp, out, err, pid) <- runInteractiveProcess exec args Nothing Nothing
   68   hClose inp
   69   errOutput <- hGetContents err
   70   _ <- forkIO $ hPutStr stderr errOutput
   71   let fetch = do
   72         eof <- hIsEOF out
   73         if eof
   74           then do
   75             _      <- evaluate (length errOutput)
   76             ret    <- waitForProcess pid
   77             case ret of
   78               ExitSuccess   -> return (Left "")
   79               ExitFailure{} -> return (Left errOutput)
   80               {-ExitFailure errMsg -> do
   81                 return $ Left $
   82                   "Failed to run: " ++ showCommandForUser exec args ++ "\n" ++
   83                   "Error code: " ++ show errMsg ++ "\n" ++
   84                   "stderr: " ++ stderr-}
   85           else do
   86             line <- T.hGetLine out
   87             return (Right line)
   88   handler fetch `finally` do
   89     terminateProcess pid
   90     _ <- waitForProcess pid
   91     return ()
   92 
   93 -- renameFile fails if we're crossing filesystem boundaries. If this happens,
   94 -- revert back to copyFile + removeFile.
   95 renameOrCopyFile :: FilePath -> FilePath -> IO ()
   96 renameOrCopyFile src dst = renameFile src dst `catch` exdev
   97  where
   98   exdev e = if fmap Errno (ioe_errno e) == Just eXDEV
   99     then copyFile src dst >> removeFile src
  100     else throw e
  101 
  102 withTempDir :: (FilePath -> IO a) -> IO a
  103 withTempDir = withSystemTempDirectory "reanimate"
  104 
  105 withTempFile :: String -> (FilePath -> IO a) -> IO a
  106 withTempFile ext action =
  107   withSystemTempFile ("reanimate" <.> ext) $ \path hd ->
  108     hClose hd >> action path