module System.IO.Extra(
module System.IO,
readFileEncoding, readFileUTF8, readFileBinary,
readFile', readFileEncoding', readFileUTF8', readFileBinary',
writeFileEncoding, writeFileUTF8, writeFileBinary,
withTempFile, withTempDir,
captureOutput,
withBuffering,
) where
import System.IO
import Control.Exception.Extra as E
import GHC.IO.Handle(hDuplicate,hDuplicateTo)
import System.Directory
import System.IO.Error
import System.FilePath
import Data.Char
import Data.Time.Clock
#ifndef mingw32_HOST_OS
import qualified System.Posix
#endif
readFileEncoding :: TextEncoding -> FilePath -> IO String
readFileEncoding enc file = do
h <- openFile file ReadMode
hSetEncoding h enc
hGetContents h
readFileUTF8 :: FilePath -> IO String
readFileUTF8 = readFileEncoding utf8
readFileBinary :: FilePath -> IO String
readFileBinary file = do
h <- openBinaryFile file ReadMode
hGetContents h
readFile' :: FilePath -> IO String
readFile' file = withFile file ReadMode $ \h -> do
s <- hGetContents h
evaluate $ length s
return s
readFileEncoding' :: TextEncoding -> FilePath -> IO String
readFileEncoding' e file = withFile file ReadMode $ \h -> do
hSetEncoding h e
s <- hGetContents h
evaluate $ length s
return s
readFileUTF8' :: FilePath -> IO String
readFileUTF8' = readFileEncoding' utf8
readFileBinary' :: FilePath -> IO String
readFileBinary' file = withBinaryFile file ReadMode $ \h -> do
s <- hGetContents h
evaluate $ length s
return s
writeFileEncoding :: TextEncoding -> FilePath -> String -> IO ()
writeFileEncoding enc file x = withFile x WriteMode $ \h -> do
hSetEncoding h enc
hPutStr h x
writeFileUTF8 :: FilePath -> String -> IO ()
writeFileUTF8 = writeFileEncoding utf8
writeFileBinary :: FilePath -> String -> IO ()
writeFileBinary file x = withBinaryFile file WriteMode $ \h -> hPutStr h x
captureOutput :: IO () -> IO String
captureOutput act = withTempFile $ \file -> do
h <- openFile file ReadWriteMode
bout <- hGetBuffering stdout
berr <- hGetBuffering stderr
sto <- hDuplicate stdout
ste <- hDuplicate stderr
hDuplicateTo h stdout
hDuplicateTo h stderr
hClose h
act
hDuplicateTo sto stdout
hDuplicateTo ste stderr
hSetBuffering stdout bout
hSetBuffering stderr berr
readFile' file
withBuffering :: Handle -> BufferMode -> IO a -> IO a
withBuffering h m act = bracket (hGetBuffering h) (hSetBuffering h) $ const $ do
hSetBuffering h m
act
withTempFile :: (FilePath -> IO a) -> IO a
withTempFile act = do
tmpdir <- getTemporaryDirectory
bracket
(openTempFile tmpdir "extra")
(\(file, h) -> ignore $ removeFile file)
(\(file, h) -> hClose h >> act file)
withTempDir :: (FilePath -> IO a) -> IO a
withTempDir act = do
tmpdir <- getTemporaryDirectory
bracket
(createTempDirectory tmpdir "extra")
(ignore . removeDirectoryRecursive)
act
createTempDirectory :: FilePath -> String -> IO FilePath
createTempDirectory dir prefix = do
rand :: Integer <- fmap (read . take 20 . filter isDigit . show . utctDayTime) getCurrentTime
findTempName rand
where
findTempName x = do
let dirpath = dir </> prefix ++ show x
catchBool isAlreadyExistsError
(mkPrivateDir dirpath >> return dirpath) $
\e -> findTempName (x+1)
mkPrivateDir :: String -> IO ()
#ifdef mingw32_HOST_OS
mkPrivateDir s = createDirectory s
#else
mkPrivateDir s = System.Posix.createDirectory s 0o700
#endif