module System.RawFilePath
( RawFilePath
, callProcess
, callProcessSilent
, readProcess
, readProcessEither
, listDirectory
, getDirectoryFiles
, getDirectoryFilesRecursive
, copyFile
, getHomeDirectory
, doesFileExist
, doesDirectoryExist
, setCurrentDirectory
, tryRemoveFile
) where
import Data.Monoid
import Control.Monad
import Control.Exception
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import System.IO
import System.IO.Error
import System.Exit (ExitCode(..))
import Foreign.Marshal.Alloc (allocaBytes)
import System.Posix.ByteString
processError :: RawFilePath -> IOError
processError cmd = mkIOError userErrorType
("calling process " <> show cmd) Nothing (Just $ show cmd)
callProcess
:: RawFilePath
-> [ByteString]
-> IO ()
callProcess cmd args = do
pid <- forkProcess $ executeFile cmd True args Nothing
getProcessStatus True False pid >>= \case
Just status -> case status of
Exited exitCode -> case exitCode of
ExitSuccess -> return ()
ExitFailure _ -> failure
_ -> failure
Nothing -> failure
where
failure = ioError (processError cmd)
callProcessSilent
:: RawFilePath
-> [ByteString]
-> IO ExitCode
callProcessSilent cmd args = do
pid <- forkProcess $ do
closeFd stdOutput
closeFd stdError
executeFile cmd True args Nothing
getProcessStatus True False pid >>= \case
Just status -> case status of
Exited exitCode -> return exitCode
_ -> failure
Nothing -> failure
where
failure = ioError (processError cmd)
getContentsAndClose :: Handle -> IO ByteString
getContentsAndClose h = B.hGetContents h <* hClose h
readProcess
:: RawFilePath
-> [ByteString]
-> IO ByteString
readProcess cmd args = do
(fd0, fd1) <- createPipe
pid <- forkProcess $ do
closeFd fd0
closeFd stdOutput
closeFd stdError
void $ dupTo fd1 stdOutput
executeFile cmd True args Nothing
closeFd fd1
(fdToHandle fd0 >>= getContentsAndClose) <*
getProcessStatus True False pid
readProcessEither
:: RawFilePath
-> [ByteString]
-> IO (Either ByteString ByteString)
readProcessEither cmd args = do
(fd0, fd1) <- createPipe
(efd0, efd1) <- createPipe
pid <- forkProcess $ do
closeFd fd0
closeFd stdOutput
void $ dupTo fd1 stdOutput
closeFd efd0
closeFd stdError
void $ dupTo efd1 stdError
executeFile cmd True args Nothing
closeFd fd1
closeFd efd1
content <- fdToHandle fd0 >>= getContentsAndClose
err <- fdToHandle efd0 >>= getContentsAndClose
getProcessStatus True False pid >>= \case
Just status -> case status of
Exited exitCode -> case exitCode of
ExitSuccess -> return $ Right content
ExitFailure _ -> return $ Left err
_ -> return $ Left err
Nothing -> return $ Left err
listDirectory
:: RawFilePath
-> IO [RawFilePath]
listDirectory dirPath = filter f <$> getDirectoryFiles dirPath
where
f p = p /= "." && p /= ".."
getDirectoryFiles
:: RawFilePath
-> IO [RawFilePath]
getDirectoryFiles dirPath = bracket open close repeatRead
where
open = openDirStream dirPath
close = closeDirStream
repeatRead stream = do
d <- readDirStream stream
if B.length d == 0 then return [] else do
rest <- repeatRead stream
return $ d : rest
getDirectoryFilesRecursive
:: RawFilePath
-> IO [RawFilePath]
getDirectoryFilesRecursive path = do
names <- map (path </>) . filter (\x -> x /= ".." && x /= ".") <$>
getDirectoryFiles path
inspectedNames <- mapM inspect names
return $ concat inspectedNames
where
inspect :: RawFilePath -> IO [RawFilePath]
inspect p = fmap isDirectory (getFileStatus p) >>= \i -> if i
then getDirectoryFilesRecursive p else return [p]
defaultFlags :: OpenFileFlags
defaultFlags = OpenFileFlags
{ append = False
, exclusive = False
, noctty = True
, nonBlock = False
, trunc = False
}
bufferSize :: Int
bufferSize = 4096
copyFile
:: RawFilePath
-> RawFilePath
-> IO ()
copyFile srcPath tgtPath = do
bracket ropen hClose $ \hi ->
bracket topen hClose $ \ho ->
allocaBytes bufferSize $ copyContents hi ho
rename tmpPath tgtPath
where
ropen = openFd srcPath ReadOnly Nothing defaultFlags >>= fdToHandle
topen = createFile tmpPath stdFileMode >>= fdToHandle
tmpPath = tgtPath <> ".copyFile.tmp"
copyContents hi ho buffer = do
count <- hGetBuf hi buffer bufferSize
when (count > 0) $ do
hPutBuf ho buffer count
copyContents hi ho buffer
tryRemoveFile :: RawFilePath -> IO ()
tryRemoveFile path = catchIOError (removeLink path) $
\e -> unless (isDoesNotExistError e) $ ioError e
getHomeDirectory :: IO RawFilePath
getHomeDirectory = getEnv "HOME" >>= maybe err return
where
err = ioError $ mkIOError doesNotExistErrorType errMsg Nothing Nothing
errMsg = "Environment variable $HOME"
doesFileExist :: RawFilePath -> IO Bool
doesFileExist path = fileExist path >>= \i -> if i
then not . isDirectory <$> getFileStatus path
else return False
doesDirectoryExist :: RawFilePath -> IO Bool
doesDirectoryExist path = fileExist path >>= \i -> if i
then isDirectory <$> getFileStatus path
else return False
setCurrentDirectory :: RawFilePath -> IO ()
setCurrentDirectory = changeWorkingDirectory
infixr 5 </>
(</>) :: RawFilePath -> RawFilePath -> RawFilePath
a </> b = mconcat [a, "/", b]