{- | Capture process-wide standard output while suppressing action exceptions.

Module: System.CaptureStdout
License: BSD-3-Clause
Credits: Merijn Verstraaten
-}
module System.CaptureStdout (captureStdout) where

import Control.Exception (SomeException, bracket, try)
import Data.Text
import Data.Text.IO (hGetContents)
import GHC.IO.Handle (hDuplicate, hDuplicateTo)
import System.IO (Handle, SeekMode (..), hFlush, hSeek, stdout)
import System.IO.Temp (withSystemTempFile)

-- | Capture output using a temporary file. Concurrent captures are not isolated.
captureStdout :: String -> IO () -> IO Text
captureStdout :: String -> IO () -> IO Text
captureStdout String
tmp IO ()
act = String -> (String -> Handle -> IO Text) -> IO Text
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
String -> (String -> Handle -> m a) -> m a
withSystemTempFile String
tmp ((String -> Handle -> IO Text) -> IO Text)
-> (String -> Handle -> IO Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ \String
_ Handle
hnd -> do
    let redirect :: IO Handle
        redirect :: IO Handle
redirect = do
            Handle -> IO ()
hFlush Handle
stdout
            Handle -> IO Handle
hDuplicate Handle
stdout IO Handle -> IO () -> IO Handle
forall a b. IO a -> IO b -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Handle -> Handle -> IO ()
hDuplicateTo Handle
hnd Handle
stdout

        undo :: Handle -> IO ()
        undo :: Handle -> IO ()
undo Handle
h = Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Handle -> IO ()
hDuplicateTo Handle
h Handle
stdout

    _ <- IO Handle
-> (Handle -> IO ())
-> (Handle -> IO (Either SomeException ()))
-> IO (Either SomeException ())
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Handle
redirect Handle -> IO ()
undo ((Handle -> IO (Either SomeException ()))
 -> IO (Either SomeException ()))
-> (Handle -> IO (Either SomeException ()))
-> IO (Either SomeException ())
forall a b. (a -> b) -> a -> b
$ \Handle
_ -> IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try IO ()
act :: IO (Either SomeException ())

    hSeek hnd AbsoluteSeek 0
    hGetContents hnd