    {-# 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
      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
        -- 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 <- 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)