{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
module System.IO.Silently
( silence, hSilence
, capture, capture_, hCapture, hCapture_
) where
import Prelude
import qualified Control.Exception as E
import Control.DeepSeq
( deepseq )
import GHC.IO.Handle
( hDuplicate, hDuplicateTo )
import System.Directory
( getTemporaryDirectory, removeFile )
import System.IO
( Handle, IOMode(AppendMode), SeekMode(AbsoluteSeek)
, hClose, hFlush, hGetBuffering, hGetContents, hSeek, hSetBuffering
, openFile, openTempFile, stdout
)
mNullDevice :: Maybe FilePath
#ifdef WINDOWS
mNullDevice = Just "\\\\.\\NUL"
#elif UNIX
mNullDevice :: Maybe FilePath
mNullDevice = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
"/dev/null"
#else
mNullDevice = Nothing
#endif
silence :: IO a -> IO a
silence :: forall a. IO a -> IO a
silence = [Handle] -> IO a -> IO a
forall a. [Handle] -> IO a -> IO a
hSilence [Handle
stdout]
hSilence :: forall a. [Handle] -> IO a -> IO a
hSilence :: forall a. [Handle] -> IO a -> IO a
hSilence [Handle]
handles IO a
action =
case Maybe FilePath
mNullDevice of
Just FilePath
nullDevice ->
IO Handle -> (Handle -> IO ()) -> (Handle -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (FilePath -> IOMode -> IO Handle
openFile FilePath
nullDevice IOMode
AppendMode)
Handle -> IO ()
hClose
Handle -> IO a
prepareAndRun
Maybe FilePath
Nothing -> FilePath -> (Handle -> IO a) -> IO a
forall a. FilePath -> (Handle -> IO a) -> IO a
withTempFile FilePath
"silence" Handle -> IO a
prepareAndRun
where
prepareAndRun :: Handle -> IO a
prepareAndRun :: Handle -> IO a
prepareAndRun Handle
tmpHandle = [Handle] -> IO a
go [Handle]
handles
where
go :: [Handle] -> IO a
go [] = IO a
action
go (Handle
h:[Handle]
hs) = ([Handle] -> IO a) -> Handle -> Handle -> [Handle] -> IO a
forall a.
([Handle] -> IO a) -> Handle -> Handle -> [Handle] -> IO a
goBracket [Handle] -> IO a
go Handle
tmpHandle Handle
h [Handle]
hs
withTempFile :: String -> (Handle -> IO a) -> IO a
withTempFile :: forall a. FilePath -> (Handle -> IO a) -> IO a
withTempFile FilePath
tmpName Handle -> IO a
action = do
tmpDir <- IO FilePath
getTempOrCurrentDirectory
E.bracket (openTempFile tmpDir tmpName)
cleanup
(action . snd)
where
cleanup :: (FilePath, Handle) -> IO ()
cleanup :: (FilePath, Handle) -> IO ()
cleanup (FilePath
tmpFile, Handle
tmpHandle) = do
Handle -> IO ()
hClose Handle
tmpHandle
FilePath -> IO ()
removeFile FilePath
tmpFile
getTempOrCurrentDirectory :: IO String
getTempOrCurrentDirectory :: IO FilePath
getTempOrCurrentDirectory = IO FilePath
getTemporaryDirectory IO FilePath -> (IOError -> IO FilePath) -> IO FilePath
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
_ -> FilePath -> IO FilePath
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
".")
where
catchIOError :: IO a -> (IOError -> IO a) -> IO a
catchIOError :: forall a. IO a -> (IOError -> IO a) -> IO a
catchIOError = IO a -> (IOError -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
capture :: IO a -> IO (String, a)
capture :: forall a. IO a -> IO (FilePath, a)
capture = [Handle] -> IO a -> IO (FilePath, a)
forall a. [Handle] -> IO a -> IO (FilePath, a)
hCapture [Handle
stdout]
capture_ :: IO a -> IO String
capture_ :: forall a. IO a -> IO FilePath
capture_ = ((FilePath, a) -> FilePath) -> IO (FilePath, a) -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, a) -> FilePath
forall a b. (a, b) -> a
fst (IO (FilePath, a) -> IO FilePath)
-> (IO a -> IO (FilePath, a)) -> IO a -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> IO (FilePath, a)
forall a. IO a -> IO (FilePath, a)
capture
hCapture_ :: [Handle] -> IO a -> IO String
hCapture_ :: forall a. [Handle] -> IO a -> IO FilePath
hCapture_ [Handle]
handles = ((FilePath, a) -> FilePath) -> IO (FilePath, a) -> IO FilePath
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FilePath, a) -> FilePath
forall a b. (a, b) -> a
fst (IO (FilePath, a) -> IO FilePath)
-> (IO a -> IO (FilePath, a)) -> IO a -> IO FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Handle] -> IO a -> IO (FilePath, a)
forall a. [Handle] -> IO a -> IO (FilePath, a)
hCapture [Handle]
handles
hCapture :: forall a. [Handle] -> IO a -> IO (String, a)
hCapture :: forall a. [Handle] -> IO a -> IO (FilePath, a)
hCapture [Handle]
handles IO a
action = FilePath -> (Handle -> IO (FilePath, a)) -> IO (FilePath, a)
forall a. FilePath -> (Handle -> IO a) -> IO a
withTempFile FilePath
"capture" Handle -> IO (FilePath, a)
prepareAndRun
where
prepareAndRun :: Handle -> IO (String, a)
prepareAndRun :: Handle -> IO (FilePath, a)
prepareAndRun Handle
tmpHandle = [Handle] -> IO (FilePath, a)
go [Handle]
handles
where
go :: [Handle] -> IO (FilePath, a)
go [] = do
a <- IO a
action
mapM_ hFlush handles
hSeek tmpHandle AbsoluteSeek 0
str <- hGetContents tmpHandle
str `deepseq` return (str, a)
go (Handle
h:[Handle]
hs) = ([Handle] -> IO (FilePath, a))
-> Handle -> Handle -> [Handle] -> IO (FilePath, a)
forall a.
([Handle] -> IO a) -> Handle -> Handle -> [Handle] -> IO a
goBracket [Handle] -> IO (FilePath, a)
go Handle
tmpHandle Handle
h [Handle]
hs
goBracket :: ([Handle] -> IO a) -> Handle -> Handle -> [Handle] -> IO a
goBracket :: forall a.
([Handle] -> IO a) -> Handle -> Handle -> [Handle] -> IO a
goBracket [Handle] -> IO a
go Handle
tmpHandle Handle
h [Handle]
hs = do
buffering <- Handle -> IO BufferMode
hGetBuffering Handle
h
let redirect = do
old <- Handle -> IO Handle
hDuplicate Handle
h
hDuplicateTo tmpHandle h
return old
restore Handle
old = do
Handle -> Handle -> IO ()
hDuplicateTo Handle
old Handle
h
Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
buffering
Handle -> IO ()
hClose Handle
old
E.bracket redirect restore (\Handle
_ -> [Handle] -> IO a
go [Handle]
hs)