module System.IO.Extra(
module System.IO,
captureOutput,
withBuffering,
readFileEncoding, readFileUTF8, readFileBinary,
readFile', readFileEncoding', readFileUTF8', readFileBinary',
writeFileEncoding, writeFileUTF8, writeFileBinary,
withTempFile, withTempDir, newTempFile, newTempDir,
) where
import System.IO
import Control.Concurrent.Extra
import Control.Exception.Extra as E
import GHC.IO.Handle(hDuplicate,hDuplicateTo)
import System.Directory.Extra
import System.IO.Error
import System.IO.Unsafe
import System.FilePath
import Data.Char
import Data.Time.Clock
import Data.Tuple.Extra
import Data.IORef
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 file 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 a -> IO (String, a)
captureOutput act = withTempFile $ \file -> do
withFile file ReadWriteMode $ \h -> do
res <- clone stdout h $ clone stderr h $ do
hClose h
act
out <- readFile' file
return (out, res)
where
clone out h act = do
buf <- hGetBuffering out
out2 <- hDuplicate out
hDuplicateTo h out
act `finally` do
hDuplicateTo out2 out
hClose out2
hSetBuffering out buf
withBuffering :: Handle -> BufferMode -> IO a -> IO a
withBuffering h m act = bracket (hGetBuffering h) (hSetBuffering h) $ const $ do
hSetBuffering h m
act
tempRef :: IORef Int
tempRef = unsafePerformIO $ do
rand :: Integer <- fmap (read . reverse . filter isDigit . show . utctDayTime) getCurrentTime
newIORef $ fromIntegral rand
tempUnique :: IO Int
tempUnique = atomicModifyIORef tempRef $ succ &&& succ
newTempFile :: IO (FilePath, IO ())
newTempFile = do
file <- create
del <- once $ ignore $ removeFile file
return (file, del)
where
create = do
tmpdir <- getTemporaryDirectory
val <- tempUnique
(file, h) <- retryBool (\(_ :: IOError) -> True) 5 $ openTempFile tmpdir $ "extra-file-" ++ show val ++ "-"
hClose h
return file
withTempFile :: (FilePath -> IO a) -> IO a
withTempFile act = do
(file, del) <- newTempFile
act file `finally` del
newTempDir :: IO (FilePath, IO ())
newTempDir = do
tmpdir <- getTemporaryDirectory
dir <- retryBool (\(_ :: IOError) -> True) 5 $ create tmpdir
del <- once $ ignore $ removeDirectoryRecursive dir
return (dir, del)
where
create tmpdir = do
v <- tempUnique
let dir = tmpdir </> "extra-dir-" ++ show v
catchBool isAlreadyExistsError
(createDirectoryPrivate dir >> return dir) $
\e -> create tmpdir
withTempDir :: (FilePath -> IO a) -> IO a
withTempDir act = do
(dir,del) <- newTempDir
act dir `finally` del