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

module System.IO.Streams.Tests.Process (tests) where

------------------------------------------------------------------------------
import           Control.Concurrent
import           Control.Exception
import           Control.Monad                  (liftM, void)
import           Data.ByteString.Char8          (ByteString)
import qualified Data.ByteString.Char8          as S
import qualified System.IO.Streams              as Streams
import           System.Timeout
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit                     hiding (Test)
------------------------------------------------------------------------------

tests :: [Test]
#ifndef ENABLE_PROCESS_TESTS
tests = []
#else
tests = [ testInteractiveCommand
        , testInteractiveProcess
        ]


------------------------------------------------------------------------------
testInteractiveCommand :: Test
testInteractiveCommand = testCase "process/interactiveCommand" $ do
    (out, err) <- Streams.runInteractiveCommand "cat" >>= run [expected]
    assertEqual "interactiveCommand" expected out
    assertEqual "interactiveCommand" "" err

  where
    expected = "testing 1-2-3"


------------------------------------------------------------------------------
testInteractiveProcess :: Test
testInteractiveProcess = testCase "process/interactiveProcess" $ do
    (out, err) <- Streams.runInteractiveProcess "/usr/bin/tr" ["a-z", "A-Z"]
                                                Nothing Nothing
                      >>= run [inputdata]
    assertEqual "interactiveProcess" expected out
    assertEqual "interactiveProcess" "" err

  where
    inputdata = "testing 1-2-3"
    expected = "TESTING 1-2-3"


------------------------------------------------------------------------------
run :: [ByteString]
    -> (Streams.OutputStream ByteString,
        Streams.InputStream S.ByteString,
        Streams.InputStream S.ByteString,
        Streams.ProcessHandle)
     -> IO (S.ByteString, S.ByteString)
run input (stdin, stdout, stderr, processHandle) = tout 5000000 $ do
    me   <- myThreadId
    outM <- newEmptyMVar
    errM <- newEmptyMVar
    bracket (mkThreads me outM errM) killThreads $ go outM errM

  where
    tout t m = timeout t m >>= maybe (error "timeout") return

    barfTo me (e :: SomeException) = throwTo me e

    killMe restore me m =
        void (try (restore m) >>= either (barfTo me) return)

    mkThreads me outM errM = mask $ \restore -> do
        tid1 <- forkIO $ killMe restore me $ snarf stdout outM
        tid2 <- forkIO $ killMe restore me $ snarf stderr errM
        return (tid1, tid2)

    killThreads (t1, t2) = do
        mapM_ killThread [t1, t2]
        Streams.waitForProcess processHandle

    go outM errM _ = do
        Streams.fromList input >>= Streams.connectTo stdin
        out <- takeMVar outM
        err <- takeMVar errM
        return (out, err)

    snarf is mv = liftM S.concat (Streams.toList is) >>= putMVar mv

-- ENABLE_PROCESS_TESTS
#endif