io-streams 1.0.1.0 → 1.0.2.0

raw patch · 11 files changed

+633/−27 lines, 11 filesdep +processdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: process

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• io-streams.cabal +21/−1
• src/System/IO/Streams.hs +2/−0
• src/System/IO/Streams/Combinators.hs +43/−1
• src/System/IO/Streams/Handle.hs +74/−4
• src/System/IO/Streams/Internal.hs +155/−13
• src/System/IO/Streams/Process.hs +86/−0
• test/System/IO/Streams/Tests/Combinators.hs +14/−0
• test/System/IO/Streams/Tests/Handle.hs +129/−8
• test/System/IO/Streams/Tests/Internal.hs +14/−0
• test/System/IO/Streams/Tests/Process.hs +93/−0
• test/TestSuite.hs +2/−0

@@ -1,5 +1,5 @@ Name:                io-streams-Version:             1.0.1.0+Version:             1.0.2.0 License:             BSD3 License-file:        LICENSE Category:            Data, Network, IO-Streams@@ -76,8 +76,17 @@   .     * support for parsing from streams using @attoparsec@.   .+    * support for spawning processes and communicating with them using streams.+  .   /ChangeLog/   .+    [@1.0.2.0@] Added "System.IO.Streams.Process" (support for communicating+                with system processes using streams), added new functions to+                "System.IO.Streams.Handle" for converting @io-streams@ types to+                'System.IO.Handle's. (Now you can pass streams from this+                library to places that expect Handles and everything will+                work.)+  .     [@1.0.1.0@] Added 'System.IO.Streams.Combinators.ignoreEof'.   .     [@1.0.0.1@] Fixed some haddock markup.@@ -106,6 +115,7 @@                      System.IO.Streams.File,                      System.IO.Streams.List,                      System.IO.Streams.Network,+                     System.IO.Streams.Process,                      System.IO.Streams.Text,                      System.IO.Streams.Vector,                      System.IO.Streams.Zlib,@@ -121,6 +131,7 @@                      bytestring    >= 0.9   && <0.11,                      network       >= 2.4   && <2.5,                      primitive     >= 0.2   && <0.6,+                     process       >= 1     && <1.2,                      text          >= 0.10  && <0.12,                      time          >= 1.2   && <1.5,                      transformers  >= 0.2   && <0.4,@@ -134,6 +145,7 @@     BangPatterns,     CPP,     DeriveDataTypeable,+    FlexibleInstances,     GeneralizedNewtypeDeriving,     MultiParamTypeClasses,     OverloadedStrings,@@ -157,6 +169,7 @@                      System.IO.Streams.Tests.Internal,                      System.IO.Streams.Tests.List,                      System.IO.Streams.Tests.Network,+                     System.IO.Streams.Tests.Process,                      System.IO.Streams.Tests.Text,                      System.IO.Streams.Tests.Vector,                      System.IO.Streams.Tests.Zlib,@@ -172,6 +185,7 @@                      System.IO.Streams.File,                      System.IO.Streams.List,                      System.IO.Streams.Network,+                     System.IO.Streams.Process,                      System.IO.Streams.Text,                      System.IO.Streams.Vector,                      System.IO.Streams.Zlib,@@ -184,6 +198,10 @@                      -fno-warn-unused-do-bind   ghc-prof-options:  -prof -auto-all +  if !os(windows)+    cpp-options: -DENABLE_PROCESS_TESTS++   Build-depends:     base          >= 4     && <5,                      attoparsec    >= 0.10  && <0.11,                      blaze-builder >= 0.3.1 && <0.4,@@ -194,6 +212,7 @@                      mtl           >= 2     && <3,                      network       >= 2.4   && <2.5,                      primitive     >= 0.2   && <0.5,+                     process       >= 1     && <1.2,                      text          >= 0.10  && <0.12,                      time          >= 1.2   && <1.5,                      transformers  >= 0.2   && <0.4,@@ -214,6 +233,7 @@     BangPatterns,     CPP,     DeriveDataTypeable,+    FlexibleInstances,     GeneralizedNewtypeDeriving,     MultiParamTypeClasses,     OverloadedStrings,

@@ -66,6 +66,7 @@  , module System.IO.Streams.File  , module System.IO.Streams.List  , module System.IO.Streams.Network+ , module System.IO.Streams.Process  , module System.IO.Streams.Text  , module System.IO.Streams.Vector  , module System.IO.Streams.Zlib@@ -84,6 +85,7 @@ import           System.IO.Streams.Handle import           System.IO.Streams.List import           System.IO.Streams.Network+import           System.IO.Streams.Process import           System.IO.Streams.Text import           System.IO.Streams.Vector import           System.IO.Streams.Zlib

@@ -47,6 +47,8 @@  , intersperse  , skipToEof  , ignoreEof+ , atEndOfInput+ , atEndOfOutput  ) where  ------------------------------------------------------------------------------@@ -770,10 +772,50 @@ -- | Wraps an 'OutputStream', ignoring any end-of-stream 'Nothing' values -- written to the returned stream. ----- Since: 1.0.1.0+-- /Since: 1.0.1.0/ -- ignoreEof :: OutputStream a -> IO (OutputStream a) ignoreEof s = makeOutputStream f   where     f Nothing  = return $! ()     f x        = write x s+++------------------------------------------------------------------------------+-- | Wraps an 'InputStream', running the specified action when the stream+-- yields end-of-file.+--+-- /Since: 1.0.2.0/+--+atEndOfInput :: IO b -> InputStream a -> IO (InputStream a)+atEndOfInput m is = sourceToStream source+  where+    eof = do+        let !x = SP eofSrc Nothing+        void m+        return x++    eofSrc = Source {+               produce  = eof+             , pushback = pb+             }+    pb s = unRead s is >> return source+    source = Source {+               produce  = read is >>= maybe eof chunk+             , pushback = pb+             }+      where+        chunk s = return $! SP source (Just s)+++------------------------------------------------------------------------------+-- | Wraps an 'OutputStream', running the specified action when the stream+-- receives end-of-file.+--+-- /Since: 1.0.2.0/+--+atEndOfOutput :: IO b -> OutputStream a -> IO (OutputStream a)+atEndOfOutput m os = makeOutputStream f+  where+    f Nothing = write Nothing os >> void m+    f x       = write x os

@@ -1,7 +1,8 @@-{-# LANGUAGE CPP         #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE FlexibleInstances #-}  #if __GLASGOW_HASKELL__ >= 702-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Trustworthy       #-} #endif  -- | Input and output streams for file 'Handle's.@@ -9,6 +10,11 @@  ( -- * Handle conversions    handleToInputStream  , handleToOutputStream+ , inputStreamToHandle+ , outputStreamToHandle+ , streamPairToHandle++   -- * Standard system handles  , stdin  , stdout  , stderr@@ -16,12 +22,13 @@  import           Data.ByteString            (ByteString) import qualified Data.ByteString            as S+import qualified GHC.IO.Handle              as H import           System.IO                  (Handle, hFlush) import qualified System.IO                  as IO import           System.IO.Unsafe           (unsafePerformIO) ------------------------------------------------------------------------------ import           System.IO.Streams.Internal (InputStream, OutputStream,-                                             lockingInputStream,+                                             SP (..), lockingInputStream,                                              lockingOutputStream,                                              makeInputStream,                                              makeOutputStream)@@ -34,6 +41,10 @@  ------------------------------------------------------------------------------ -- | Converts a read-only handle into an 'InputStream' of strict 'ByteString's.+--+-- Note that the wrapped handle is /not/ closed when it yields end-of-stream;+-- you can use 'System.IO.Streams.Combinators.atEndOfInput' to close the handle+-- if you would like this behaviour. handleToInputStream :: Handle -> IO (InputStream ByteString) handleToInputStream h = makeInputStream f   where@@ -44,13 +55,72 @@  ------------------------------------------------------------------------------ -- | Converts a writable handle into an 'OutputStream' of strict 'ByteString's.+--+-- Note that the wrapped handle is /not/ closed when it receives end-of-stream;+-- you can use 'System.IO.Streams.Combinators.atEndOfOutput' to close the+-- handle if you would like this behaviour. handleToOutputStream :: Handle -> IO (OutputStream ByteString) handleToOutputStream h = makeOutputStream f   where-    f Nothing  = return $! ()+    f Nothing  = hFlush h     f (Just x) = if S.null x                    then hFlush h                    else S.hPut h x+++------------------------------------------------------------------------------+-- | Converts an 'InputStream' over bytestrings to a read-only 'Handle'. Note+-- that the generated handle is opened unbuffered in binary mode (i.e. no+-- newline translation is performed).+--+-- Note: the 'InputStream' passed into this function is wrapped in+-- 'lockingInputStream' to make it thread-safe.+--+-- /Since: 1.0.2.0./+inputStreamToHandle :: InputStream ByteString -> IO Handle+inputStreamToHandle is0 = do+    is <- lockingInputStream is0+    h <- H.mkDuplexHandle is "*input-stream*" Nothing $! H.noNewlineTranslation+    H.hSetBuffering h H.NoBuffering+    return h+++------------------------------------------------------------------------------+-- | Converts an 'OutputStream' over bytestrings to a write-only 'Handle'. Note+-- that the 'Handle' will be opened in non-buffering mode; if you buffer the+-- 'OutputStream' using the 'Handle' buffering then @io-streams@ will copy the+-- 'Handle' buffer when sending 'ByteString' values to the output, which might+-- not be what you want. When the output buffer, if used, is flushed, an empty+-- string is written to the output, as is conventional throughout the+-- @io-streams@ library for 'ByteString' output buffers.+--+-- Note: the 'OutputStream' passed into this function is wrapped in+-- 'lockingOutputStream' to make it thread-safe.+--+-- /Since: 1.0.2.0./+outputStreamToHandle :: OutputStream ByteString -> IO Handle+outputStreamToHandle os0 = do+    os <- lockingOutputStream os0+    h <- H.mkDuplexHandle os "*output-stream*" Nothing $! H.noNewlineTranslation+    H.hSetBuffering h H.NoBuffering+    return $! h+++------------------------------------------------------------------------------+-- | Converts a pair of 'InputStream' and 'OutputStream' over bytestrings to a+-- read-write 'Handle'.+--+-- Note: the streams passed into this function are wrapped in+-- locking primitives to make them thread-safe.+--+-- /Since: 1.0.2.0./+streamPairToHandle :: InputStream ByteString -> OutputStream ByteString -> IO Handle+streamPairToHandle is0 os0 = do+    is <- lockingInputStream is0+    os <- lockingOutputStream os0+    h <- H.mkDuplexHandle (SP is os) "*stream*" Nothing $! H.noNewlineTranslation+    H.hSetBuffering h H.NoBuffering+    return $! h   ------------------------------------------------------------------------------

@@ -4,6 +4,8 @@ -- Library users should use the interface provided by "System.IO.Streams"  {-# LANGUAGE BangPatterns               #-}+{-# LANGUAGE DeriveDataTypeable         #-}+{-# LANGUAGE FlexibleInstances          #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings          #-} @@ -12,6 +14,7 @@     SP(..)   , Source(..)   , Sink(..)+  , StreamPair      -- * About pushback     -- $pushback@@ -73,19 +76,33 @@   ) where  -------------------------------------------------------------------------------import           Control.Applicative    (Applicative (..))-import           Control.Concurrent     (newMVar, withMVar)-import           Control.Monad          (liftM, (>=>))-import           Control.Monad.IO.Class (MonadIO (..))-import           Data.IORef             (IORef, newIORef, readIORef,-                                         writeIORef)-import           Data.Monoid            (Monoid (..))-import           Prelude                hiding (read)+import           Control.Applicative      (Applicative (..))+import           Control.Concurrent       (newMVar, withMVar)+import           Control.Exception        (throwIO)+import           Control.Monad            (liftM, (>=>))+import           Control.Monad.IO.Class   (MonadIO (..))+import           Data.ByteString.Char8    (ByteString)+import qualified Data.ByteString.Char8    as S+import qualified Data.ByteString.Internal as S+import qualified Data.ByteString.Unsafe   as S+import           Data.IORef               (IORef, newIORef, readIORef,+                                           writeIORef)+import           Data.Monoid              (Monoid (..))+import           Data.Typeable            (Typeable)+import           Data.Word                (Word8)+import           Foreign.Marshal.Utils    (copyBytes)+import           Foreign.Ptr              (castPtr)+import qualified GHC.IO.Buffer            as H+import qualified GHC.IO.BufferedIO        as H+import qualified GHC.IO.Device            as H+import           GHC.IO.Exception         (unsupportedOperation)+import           Prelude                  hiding (read)   ------------------------------------------------------------------------------ -- | A strict pair type. data SP a b = SP !a !b+  deriving (Typeable)  ------------------------------------------------------------------------------ -- | A 'Source' generates values of type @c@ in the 'IO' monad.@@ -110,7 +127,7 @@ data Source c = Source {       produce  :: IO (SP (Source c) (Maybe c))     , pushback :: c -> IO (Source c)-    }+    } deriving (Typeable)   ------------------------------------------------------------------------------@@ -143,7 +160,7 @@ -- 'Generator'. newtype Generator r a = Generator {       unG :: IO (Either (SP r (Generator r a)) a)-    }+    } deriving (Typeable)   ------------------------------------------------------------------------------@@ -222,7 +239,7 @@ ------------------------------------------------------------------------------ newtype Consumer c a = Consumer {       unC :: IO (Either (Maybe c -> Consumer c a) a)-    }+    } deriving (Typeable)   ------------------------------------------------------------------------------@@ -294,7 +311,7 @@ -- 'Sink's. data Sink c = Sink {       consume :: Maybe c -> IO (Sink c)-    }+    } deriving (Typeable)   ------------------------------------------------------------------------------@@ -432,7 +449,7 @@ -- @'unRead' c stream >> 'read' stream === 'return' ('Just' c)@ -- newtype InputStream  c = IS (IORef (Source c))-+  deriving (Typeable)  ------------------------------------------------------------------------------ -- | An 'OutputStream' consumes values of type @c@ in the 'IO' monad.@@ -448,6 +465,7 @@ -- this library will simply discard the extra input.) -- newtype OutputStream c = OS (IORef (Sink   c))+  deriving (Typeable)   ------------------------------------------------------------------------------@@ -722,3 +740,127 @@ -- @ -- Streams.'unRead' c stream >> Streams.'read' stream === 'return' ('Just' c) -- @+++++                 --------------------------------------------+                 -- Typeclass instances for Handle support --+                 --------------------------------------------++------------------------------------------------------------------------------+bUFSIZ :: Int+bUFSIZ = 32752+++------------------------------------------------------------------------------+unsupported :: IO a+unsupported = throwIO unsupportedOperation+++------------------------------------------------------------------------------+bufferToBS :: H.Buffer Word8 -> ByteString+bufferToBS buf = S.copy $! S.fromForeignPtr raw l sz+  where+    raw  = H.bufRaw buf+    l    = H.bufL buf+    r    = H.bufR buf+    sz   = r - l+++------------------------------------------------------------------------------+instance H.RawIO (InputStream ByteString) where+    read is ptr n = read is >>= maybe (return 0) f+      where+        f s = S.unsafeUseAsCStringLen s $ \(cstr, l) -> do+                  let c = min n l+                  copyBytes ptr (castPtr cstr) c+                  return $! c++    readNonBlocking  _ _ _ = unsupported+    write            _ _ _ = unsupported+    writeNonBlocking _ _ _ = unsupported+++------------------------------------------------------------------------------+instance H.RawIO (OutputStream ByteString) where+    read _ _ _             = unsupported+    readNonBlocking _ _ _  = unsupported+    write os ptr n         = S.packCStringLen (castPtr ptr, n) >>=+                             flip write os . Just+    writeNonBlocking _ _ _ = unsupported+++------------------------------------------------------------------------------+-- | Internal convenience synonym for a pair of input\/output streams.+type StreamPair a = SP (InputStream a) (OutputStream a)++instance H.RawIO (StreamPair ByteString) where+    read (SP is _) ptr n   = H.read is ptr n+    readNonBlocking  _ _ _ = unsupported+    write (SP _ os) ptr n  = H.write os ptr n+    writeNonBlocking _ _ _ = unsupported+++------------------------------------------------------------------------------+instance H.BufferedIO (OutputStream ByteString) where+    newBuffer !_ bs            = H.newByteBuffer bUFSIZ bs+    fillReadBuffer !_ _        = unsupported+    fillReadBuffer0 !_ _       = unsupported++    flushWriteBuffer !os !buf  = do+        write (Just $! bufferToBS buf) os+        emptyWriteBuffer buf++    flushWriteBuffer0 !os !buf = do+        let s = bufferToBS buf+        let l = S.length s+        write (Just s) os+        buf' <- emptyWriteBuffer buf+        return $! (l, buf')+++------------------------------------------------------------------------------+instance H.BufferedIO (InputStream ByteString) where+    newBuffer !_ !bs        = H.newByteBuffer bUFSIZ bs+    fillReadBuffer !is !buf = H.readBuf is buf+    fillReadBuffer0 _ _    = unsupported+    flushWriteBuffer _ _   = unsupported+    flushWriteBuffer0 _ _  = unsupported+++------------------------------------------------------------------------------+instance H.BufferedIO (StreamPair ByteString) where+    newBuffer !_ bs              = H.newByteBuffer bUFSIZ bs+    fillReadBuffer (SP is _)     = H.fillReadBuffer is+    fillReadBuffer0 _ _          = unsupported+    flushWriteBuffer (SP _ !os)  = H.flushWriteBuffer os+    flushWriteBuffer0 (SP _ !os) = H.flushWriteBuffer0 os+++------------------------------------------------------------------------------+instance H.IODevice (OutputStream ByteString) where+  ready _ _ _ = return True+  close       = write Nothing+  devType _   = return H.Stream+++------------------------------------------------------------------------------+instance H.IODevice (InputStream ByteString) where+  ready _ _ _ = return True+  close _     = return $! ()+  devType _   = return H.Stream+++------------------------------------------------------------------------------+instance H.IODevice (StreamPair ByteString) where+  ready _ _ _     = return True+  close (SP _ os) = write Nothing os+  devType _       = return H.Stream+++------------------------------------------------------------------------------+emptyWriteBuffer :: H.Buffer Word8+                 -> IO (H.Buffer Word8)+emptyWriteBuffer buf+    = return buf { H.bufL=0, H.bufR=0, H.bufState = H.WriteBuffer }

@@ -0,0 +1,86 @@+-- | A module adapting the functions from "System.Process" to work with+-- @io-streams@.+module System.IO.Streams.Process+  ( module System.Process+  , runInteractiveCommand+  , runInteractiveProcess+  ) where++------------------------------------------------------------------------------+import           Data.ByteString.Char8         (ByteString)+import           System.IO                     (hClose)+import qualified System.IO.Streams.Combinators as Streams+import qualified System.IO.Streams.Handle      as Streams+import           System.IO.Streams.Internal    (InputStream, OutputStream)+import qualified System.IO.Streams.Internal    as Streams+import           System.Process                hiding (env,+                                                runInteractiveCommand,+                                                runInteractiveProcess,+                                                runProcess)+import qualified System.Process                as P+------------------------------------------------------------------------------+++------------------------------------------------------------------------------+-- | Runs a command using the shell, and returns streams that may be used to+-- communicate with the process via its stdin, stdout, and stderr respectively.+--+-- The streams returned by this command are guarded by locks and are therefore+-- safe to use in multithreaded code.+--+-- /Since: 1.0.2.0/+--+runInteractiveCommand :: String+                      -> IO (OutputStream ByteString,+                             InputStream ByteString,+                             InputStream ByteString,+                             ProcessHandle)+runInteractiveCommand scmd = do+    (hin, hout, herr, ph) <- P.runInteractiveCommand scmd+    sIn  <- Streams.handleToOutputStream hin >>=+            Streams.atEndOfOutput (hClose hin) >>=+            Streams.lockingOutputStream+    sOut <- Streams.handleToInputStream hout >>=+            Streams.atEndOfInput (hClose hout) >>=+            Streams.lockingInputStream+    sErr <- Streams.handleToInputStream herr >>=+            Streams.atEndOfInput (hClose herr) >>=+            Streams.lockingInputStream+    return (sIn, sOut, sErr, ph)+++------------------------------------------------------------------------------+-- | Runs a raw command, and returns streams that may be used to communicate+-- with the process via its @stdin@, @stdout@ and @stderr@ respectively.+--+-- For example, to start a process and feed a string to its stdin:+--+-- > (inp,out,err,pid) <- runInteractiveProcess "..."+-- > forkIO (Streams.write (Just str) inp)+--+-- The streams returned by this command are guarded by locks and are therefore+-- safe to use in multithreaded code.+--+-- /Since: 1.0.2.0/+--+runInteractiveProcess+    :: FilePath                 -- ^ Filename of the executable (see 'proc' for details)+    -> [String]                 -- ^ Arguments to pass to the executable+    -> Maybe FilePath           -- ^ Optional path to the working directory+    -> Maybe [(String,String)]  -- ^ Optional environment (otherwise inherit)+    -> IO (OutputStream ByteString,+           InputStream ByteString,+           InputStream ByteString,+           ProcessHandle)+runInteractiveProcess cmd args wd env = do+    (hin, hout, herr, ph) <- P.runInteractiveProcess cmd args wd env+    sIn  <- Streams.handleToOutputStream hin >>=+            Streams.atEndOfOutput (hClose hin) >>=+            Streams.lockingOutputStream+    sOut <- Streams.handleToInputStream hout >>=+            Streams.atEndOfInput (hClose hout) >>=+            Streams.lockingInputStream+    sErr <- Streams.handleToInputStream herr >>=+            Streams.atEndOfInput (hClose herr) >>=+            Streams.lockingInputStream+    return (sIn, sOut, sErr, ph)

@@ -57,6 +57,7 @@         , testGive         , testIgnore         , testIgnoreEof+        , testAtEnd         ]  @@ -415,3 +416,16 @@   where     f ref _ Nothing    = modifyIORef ref (+1)     f _ chunk (Just x) = modifyIORef chunk (++ [x])+++------------------------------------------------------------------------------+testAtEnd :: Test+testAtEnd = testCase "combinators/atEndOfInput" $ do+    boolRef <- newIORef False+    is <- fromList [1,2,3::Int] >>= atEndOfInput (writeIORef boolRef True)+    unRead 0 is+    toList is >>= assertEqual "list" [0,1,2,3]+    readIORef boolRef >>= assertBool "ran"+    toList is >>= assertEqual "list 2" []+    unRead 0 is+    toList is >>= assertEqual "list 3" [0]

@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns      #-} {-# LANGUAGE OverloadedStrings #-}  module System.IO.Streams.Tests.Handle (tests) where@@ -7,12 +8,20 @@ import           Control.Monad                  hiding (mapM) import qualified Data.ByteString.Char8          as S import           Data.List+import           Foreign.Marshal.Alloc          (allocaBytes)+import           Foreign.Marshal.Utils          (copyBytes)+import           Foreign.Ptr                    (castPtr)+import qualified GHC.IO.Buffer                  as HB+import qualified GHC.IO.BufferedIO              as H+import qualified GHC.IO.Device                  as H import           Prelude                        hiding (mapM, read) import           System.Directory import           System.FilePath import           System.IO                      hiding (stderr, stdin, stdout) import qualified System.IO                      as IO-import           System.IO.Streams              hiding (intersperse)+import           System.IO.Streams              (OutputStream)+import qualified System.IO.Streams              as Streams+import qualified System.IO.Streams.Internal     as Streams import           Test.Framework import           Test.Framework.Providers.HUnit import           Test.HUnit                     hiding (Test)@@ -21,7 +30,13 @@  tests :: [Test] tests = [ testHandle-        , testStdHandles ]+        , testStdHandles+        , testInputStreamToHandle+        , testOutputStreamToHandle+        , testStreamPairToHandle+        , testHandleInstances+        , testHandleBadnesses+        ]   ------------------------------------------------------------------------------@@ -36,11 +51,12 @@     tst = do         withBinaryFile fn WriteMode $ \h -> do             let l = "" : (intersperse " " ["the", "quick", "brown", "fox"])-            os <- handleToOutputStream h-            fromList l >>= connectTo os+            os <- Streams.handleToOutputStream h+            Streams.fromList l >>= Streams.connectTo os          withBinaryFile fn ReadMode $ \h -> do-            l <- liftM S.concat (handleToInputStream h >>= toList)+            l <- liftM S.concat (Streams.handleToInputStream h >>=+                                 Streams.toList)             assertEqual "testFiles" "the quick brown fox" l  @@ -49,7 +65,112 @@ testStdHandles = testCase "handle/stdHandles" $ do     hClose IO.stdin     -- Should generate exception: handle is closed.-    expectExceptionH (toList stdin)-    write (Just "") stdout-    write (Just "") stderr+    expectExceptionH (Streams.toList Streams.stdin)+    Streams.write (Just "") Streams.stdout+    Streams.write (Just "") Streams.stderr     return ()+++------------------------------------------------------------------------------+testInputStreamToHandle :: Test+testInputStreamToHandle = testCase "handle/inputStreamToHandle" $ do+    h <- Streams.fromList ["foo", "bar", "baz"] >>=+         Streams.inputStreamToHandle+    S.hGetContents h >>= assertEqual "inputStreamToHandle" "foobarbaz"+++------------------------------------------------------------------------------+testOutputStreamToHandle :: Test+testOutputStreamToHandle = testCase "handle/outputStreamToHandle" $ do+    (os, getInput) <- Streams.listOutputStream+    h <- Streams.outputStreamToHandle os+    S.hPutStrLn h "foo"+    liftM S.concat getInput >>= assertEqual "outputStreamToHandle" "foo\n"+++------------------------------------------------------------------------------+testStreamPairToHandle :: Test+testStreamPairToHandle = testCase "handle/streamPairToHandle" $ do+    is             <- Streams.fromList ["foo", "bar", "baz"]+    (os, getInput) <- Streams.listOutputStream++    h <- Streams.streamPairToHandle is os+    S.hPutStrLn h "foo"+    S.hGetContents h >>= assertEqual "input stream" "foobarbaz"+    liftM S.concat getInput >>= assertEqual "output stream" "foo\n"+++------------------------------------------------------------------------------+testHandleBadnesses :: Test+testHandleBadnesses = testCase "handle/badness" $ do+    h <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle+    _ <- S.hGetContents h+    expectExceptionH $ S.hGetContents h++    h' <- Streams.fromList ["foo", "bar", "baz"] >>= Streams.inputStreamToHandle+    expectExceptionH $ S.hPutStrLn h' "foo"++    (os, _) <- Streams.listOutputStream+    h'' <- Streams.outputStreamToHandle os+    expectExceptionH $ S.hGetContents h''++    is <- Streams.fromList ["foo"]+    h''' <- Streams.streamPairToHandle is os+    _ <- S.hGetContents h'''+    expectExceptionH $ S.hGetContents h'''+++------------------------------------------------------------------------------+testHandleInstances :: Test+testHandleInstances = testCase "handle/ghc-instances" $ do+    is            <- Streams.fromList ["foo", "bar", "baz" :: S.ByteString]+    (os, getList) <- Streams.listOutputStream+    let sp   = Streams.SP is (os :: OutputStream S.ByteString)+    expectExceptionH $ H.write is undefined undefined+    expectExceptionH $ H.writeNonBlocking is undefined undefined+    expectExceptionH $ H.flushWriteBuffer is undefined+    expectExceptionH $ H.flushWriteBuffer0 is undefined++    expectExceptionH $ H.read os undefined undefined+    expectExceptionH $ H.writeNonBlocking os undefined undefined++    expectExceptionH $ H.fillReadBuffer0 is undefined+    expectExceptionH $ H.fillReadBuffer0 os undefined+    expectExceptionH $ H.fillReadBuffer0 sp undefined++    H.ready is False 0 >>= assertEqual "ready input" True+    H.ready os False 0 >>= assertEqual "ready output" True+    H.ready sp False 0 >>= assertEqual "ready pair" True++    H.devType is >>= assertBool "devtype input"  . (== H.Stream)+    H.devType os >>= assertBool "devtype output" . (== H.Stream)+    H.devType sp >>= assertBool "devtype pair"   . (== H.Stream)++    expectExceptionH $ H.readNonBlocking is undefined undefined+    expectExceptionH $ H.readNonBlocking os undefined undefined+    expectExceptionH $ H.readNonBlocking sp undefined undefined+    expectExceptionH $ H.writeNonBlocking is undefined undefined+    expectExceptionH $ H.writeNonBlocking os undefined undefined+    expectExceptionH $ H.writeNonBlocking sp undefined undefined++    S.useAsCStringLen "foo" $ \(cstr, l) -> do+        H.write os (castPtr cstr) l+        liftM S.concat getList >>= assertEqual "H.write 1" "foo"+        H.write sp (castPtr cstr) l+        liftM S.concat getList >>= assertEqual "H.write 2" "foo"+        buf <- H.newBuffer sp HB.WriteBuffer+        HB.withBuffer buf $ \ptr -> copyBytes ptr (castPtr cstr) 3+        (l', !buf') <- H.flushWriteBuffer0 sp $ buf { HB.bufR = 3 }+        assertEqual "flushWriteBuffer0" 3 l'+        assertEqual "bufR" 0 $ HB.bufR buf'+        liftM S.concat getList >>= assertEqual "write 3" "foo"+++    allocaBytes 3 $ \buf -> do+        l <- H.read is buf 3+        assertEqual "3 byte read" 3 l+        S.packCStringLen (castPtr buf, l) >>= assertEqual "first read" "foo"+        l' <- H.read sp buf 3+        assertEqual "3 byte read #2" 3 l'+        S.packCStringLen (castPtr buf, l') >>= assertEqual "second read" "bar"+        expectExceptionH $ H.read os buf 3

@@ -16,6 +16,7 @@ ------------------------------------------------------------------------------ import           System.IO.Streams.Internal import           System.IO.Streams.List+import           System.IO.Streams.Tests.Common  tests :: [Test] tests = [ testSourceConcat@@ -28,6 +29,7 @@         , testGeneratorInstances         , testGeneratorSource         , testConsumer+        , testTrivials         ]  @@ -188,3 +190,15 @@                                  !t <- liftIO $ readIORef ref                                  liftIO $ writeIORef ref $! t + x                                  c ref)+++------------------------------------------------------------------------------+testTrivials :: Test+testTrivials = testCase "internal/trivials" $ do+    coverTypeableInstance (undefined :: InputStream Int)+    coverTypeableInstance (undefined :: OutputStream Int)+    coverTypeableInstance (undefined :: Source Int)+    coverTypeableInstance (undefined :: Sink Int)+    coverTypeableInstance (undefined :: Generator Int ())+    coverTypeableInstance (undefined :: Consumer Int ())+    coverTypeableInstance (undefined :: SP Int Int)

@@ -0,0 +1,93 @@+{-# 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

@@ -10,6 +10,7 @@ import qualified System.IO.Streams.Tests.Internal    as Internal import qualified System.IO.Streams.Tests.List        as List import qualified System.IO.Streams.Tests.Network     as Network+import qualified System.IO.Streams.Tests.Process     as Process import qualified System.IO.Streams.Tests.Text        as Text import qualified System.IO.Streams.Tests.Vector      as Vector import qualified System.IO.Streams.Tests.Zlib        as Zlib@@ -30,6 +31,7 @@             , testGroup "Tests.Internal" Internal.tests             , testGroup "Tests.List" List.tests             , testGroup "Tests.Network" Network.tests+            , testGroup "Tests.Process" Process.tests             , testGroup "Tests.Text" Text.tests             , testGroup "Tests.Vector" Vector.tests             , testGroup "Tests.Zlib" Zlib.tests