{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | 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

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

-- | 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 :: 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


-- Provide a tempfile for the given action and remove it afterwards.
withTempFile :: String -> (Handle -> IO a) -> IO a
withTempFile :: forall a. FilePath -> (Handle -> IO a) -> IO a
withTempFile FilePath
tmpName Handle -> IO a
action = 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
tmpName)
            (FilePath, Handle) -> IO ()
cleanup
            (Handle -> IO a
action (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, 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
    -- 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 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

-- | 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 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

-- | 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 :: 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
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
str, a
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
  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 a. a -> IO a
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)