Main.hs

{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE PartialTypeSignatures #-}

module Main where

import           Control.Exception.Safe   (MonadMask)
import qualified Control.Exception.Safe   as Exc
import           Control.Monad.IO.Class   (MonadIO)
import           Data.ByteString          (ByteString)
import qualified Data.ByteString          as BS
import           Data.Text                (Text)
import           Data.Text.Encoding       (decodeUtf8With)
import           Data.Text.Encoding.Error (lenientDecode)
import           GHC.IO.Handle            (hDuplicateTo, hDuplicate)
import           System.IO                (BufferMode (..), Handle, IOMode (..),
                                           hPutStrLn, hSetBuffering, openFile,
                                           stderr, stdout, hFlush, hClose)
import           System.IO.Temp           (withSystemTempFile)
import           Test.Hspec               (Spec, SpecWith, aroundWith, describe,
                                           hspec, it, shouldBe)

main :: IO ()
main = do
  hSetBuffering stderr NoBuffering
  hspec spec

spec :: Spec
spec = describe "foo" $ do
  withMirroredStdout $ it "bar" $ \handle -> do
    hPutStrLn stderr $! "baz"
    hFlush stderr; hFlush handle
    baz <- hGetLineText handle
    baz `shouldBe` ("baz" :: Text)

withMirroredStdout :: SpecWith Handle -> Spec
withMirroredStdout innerSpec = flip aroundWith innerSpec $ \action -> \() -> do
  withSystemTempFile "mirror" $ \_ handle -> do
    hSetBuffering handle NoBuffering
    hDuplicateTo handle stderr
    hFlush stderr; hFlush handle
    action $! handle

hGetLineText :: Handle -> IO Text
hGetLineText handle = do
  dup <- hDuplicate handle
  hFlush handle; hFlush dup
  (decodeUtf8With lenientDecode <$> BS.hGetLine handle) <* hClose dup

package.yaml

name:                streaming

dependencies:
  - base >= 4.7 && < 5
  - bytestring
  - hspec
  - safe-exceptions
  - temporary
  - text

executables:
  test:
    main:                Main.hs
    source-dirs:         executables
    ghc-options:
     - -threaded
     - -rtsopts
     - -with-rtsopts=-N