{-# LANGUAGE CPP #-}
-- | Need to prevent output to the terminal, a file, or stderr? Need to capture it and use it for
-- your own means? Now you can, with 'silence' and 'capture'.

module System.IO.Silently (
  silence,
  hSilence,
  capture,
  capture_,
  hCapture,
  hCapture_,
) where

import Prelude

#if __GLASGOW_HASKELL__ >= 612
import GHC.IO.Handle (hDuplicate, hDuplicateTo)
#else
import GHC.Handle (hDuplicate, hDuplicateTo)
#endif

import System.IO
import qualified Control.Exception as E
import Control.DeepSeq
import System.Directory (removeFile,getTemporaryDirectory)

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

-- | Run an IO action while preventing all output to stdout.
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]

-- | Run an IO action while preventing all output to the given handles.
hSilence :: [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 -> do
    FilePath
tmpDir <- IO FilePath
getTempOrCurrentDirectory
    IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
tmpDir FilePath
"silence")
                               (FilePath, Handle) -> IO ()
cleanup
                               (Handle -> IO a
prepareAndRun (Handle -> IO a)
-> ((FilePath, Handle) -> Handle) -> (FilePath, Handle) -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Handle) -> Handle
forall a b. (a, b) -> b
snd)

 where
  cleanup :: (FilePath, Handle) -> IO ()
cleanup (FilePath
tmpFile,Handle
tmpHandle) = do
    Handle -> IO ()
hClose Handle
tmpHandle
    FilePath -> IO ()
removeFile FilePath
tmpFile
  prepareAndRun :: Handle -> IO a
prepareAndRun Handle
tmpHandle = [Handle] -> IO a
go [Handle]
handles
    where
      go :: [Handle] -> IO a
go [] = IO a
action
      go [Handle]
hs = ([Handle] -> IO a) -> Handle -> [Handle] -> IO a
forall a. ([Handle] -> IO a) -> Handle -> [Handle] -> IO a
goBracket [Handle] -> IO a
go Handle
tmpHandle [Handle]
hs


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 (m :: * -> *) a. Monad m => a -> m a
return FilePath
".")
  where
    -- NOTE: We can not use `catchIOError` from "System.IO.Error", it is only
    -- available in base >= 4.4.
    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

-- | Run an IO action while preventing and capturing all output to stdout.
-- This will, as a side effect, create and delete a temp file in the temp directory or current directory if there is no temp directory.
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]

-- | Like `capture`, but discards the result of given action.
capture_ :: IO a -> IO String
capture_ :: forall a. IO a -> IO FilePath
capture_ = ((FilePath, a) -> FilePath) -> IO (FilePath, a) -> IO FilePath
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

-- | Like `hCapture`, but discards the result of given action.
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 (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

-- | Run an IO action while preventing and capturing all output to the given handles.
-- This will, as a side effect, create and delete a temp file in the temp directory or current directory if there is no temp directory.
hCapture :: [Handle] -> IO a -> IO (String, a)
hCapture :: forall a. [Handle] -> IO a -> IO (FilePath, a)
hCapture [Handle]
handles IO a
action = do
  FilePath
tmpDir <- IO FilePath
getTempOrCurrentDirectory
  IO (FilePath, Handle)
-> ((FilePath, Handle) -> IO ())
-> ((FilePath, Handle) -> IO (FilePath, a))
-> IO (FilePath, a)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (FilePath -> FilePath -> IO (FilePath, Handle)
openTempFile FilePath
tmpDir FilePath
"capture")
                             (FilePath, Handle) -> IO ()
cleanup
                             (Handle -> IO (FilePath, a)
prepareAndRun (Handle -> IO (FilePath, a))
-> ((FilePath, Handle) -> Handle)
-> (FilePath, Handle)
-> IO (FilePath, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Handle) -> Handle
forall a b. (a, b) -> b
snd)
 where
  cleanup :: (FilePath, Handle) -> IO ()
cleanup (FilePath
tmpFile,Handle
tmpHandle) = do
    Handle -> IO ()
hClose Handle
tmpHandle
    FilePath -> IO ()
removeFile FilePath
tmpFile
  prepareAndRun :: Handle -> IO (FilePath, a)
prepareAndRun Handle
tmpHandle = [Handle] -> IO (FilePath, a)
go [Handle]
handles
    where
      go :: [Handle] -> IO (FilePath, a)
go [] = do
              a
a <- IO a
action
              (Handle -> IO ()) -> [Handle] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Handle -> IO ()
hFlush [Handle]
handles
              Handle -> SeekMode -> Integer -> IO ()
hSeek Handle
tmpHandle SeekMode
AbsoluteSeek Integer
0
              FilePath
str <- Handle -> IO FilePath
hGetContents Handle
tmpHandle
              FilePath
str FilePath -> IO (FilePath, a) -> IO (FilePath, a)
forall a b. NFData a => a -> b -> b
`deepseq` (FilePath, a) -> IO (FilePath, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
str,a
a)
      go [Handle]
hs = ([Handle] -> IO (FilePath, a))
-> Handle -> [Handle] -> IO (FilePath, a)
forall a. ([Handle] -> IO a) -> Handle -> [Handle] -> IO a
goBracket [Handle] -> IO (FilePath, a)
go Handle
tmpHandle [Handle]
hs

goBracket :: ([Handle] -> IO a) -> Handle -> [Handle] -> IO a
goBracket :: forall a. ([Handle] -> IO a) -> Handle -> [Handle] -> IO a
goBracket [Handle] -> IO a
go Handle
tmpHandle (Handle
h:[Handle]
hs) = do
  BufferMode
buffering <- Handle -> IO BufferMode
hGetBuffering Handle
h
  let redirect :: IO Handle
redirect = do
        Handle
old <- Handle -> IO Handle
hDuplicate Handle
h
        Handle -> Handle -> IO ()
hDuplicateTo Handle
tmpHandle Handle
h
        Handle -> IO Handle
forall (m :: * -> *) a. Monad m => a -> m a
return Handle
old
      restore :: Handle -> IO ()
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
  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 IO Handle
redirect Handle -> IO ()
restore (\Handle
_ -> [Handle] -> IO a
go [Handle]
hs)