io-streams 1.1.2.2 → 1.1.3.0
raw patch · 4 files changed
+92/−14 lines, 4 filesdep ~network
Dependency ranges changed: network
Files
- io-streams.cabal +14/−4
- src/System/IO/Streams/ByteString.hs +30/−5
- test/System/IO/Streams/Tests/ByteString.hs +44/−1
- test/System/IO/Streams/Tests/Network.hs +4/−4
io-streams.cabal view
@@ -1,5 +1,5 @@ Name: io-streams-Version: 1.1.2.2+Version: 1.1.3.0 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams@@ -81,6 +81,12 @@ . /ChangeLog/ .+ [@1.1.3.0@] Added @System.IO.Streams.ByteString.takeExactly@. Widened+ @network@ dependency to include 2.3. Added a+ @NoInteractiveTests@ flag to selectively disable some tests for+ environments where spawning interactive processes is+ impossible.+ . [@1.1.2.2@] Allowed newest versions of the @process@, @test-framework@, and @text@ libraries. .@@ -126,6 +132,10 @@ Extra-Source-Files: CONTRIBUTORS README.md +Flag NoInteractiveTests+ Description: Do not run interactive tests+ Default: False+ ------------------------------------------------------------------------------ Library hs-source-dirs: src@@ -162,7 +172,7 @@ attoparsec >= 0.10 && <0.11, blaze-builder >= 0.3.1 && <0.4, bytestring >= 0.9 && <0.11,- network >= 2.4 && <2.5,+ network >= 2.3 && <2.5, primitive >= 0.2 && <0.6, process >= 1 && <1.3, text >= 0.10 && <1.1,@@ -234,7 +244,7 @@ -fno-warn-unused-do-bind ghc-prof-options: -prof -auto-all - if !os(windows)+ if !os(windows) && !flag(NoInteractiveTests) cpp-options: -DENABLE_PROCESS_TESTS @@ -246,7 +256,7 @@ directory >= 1.1 && <2, filepath >= 1.2 && <2, mtl >= 2 && <3,- network >= 2.4 && <2.5,+ network >= 2.3 && <2.5, primitive >= 0.2 && <0.6, process >= 1 && <1.3, text >= 0.10 && <1.1,
src/System/IO/Streams/ByteString.hs view
@@ -29,6 +29,7 @@ , giveBytes , giveExactly , takeBytes+ , takeExactly , throwIfConsumesMoreThan , throwIfProducesMoreThan @@ -215,7 +216,29 @@ takeBytes :: Int64 -- ^ maximum number of bytes to read -> InputStream ByteString -- ^ input stream to wrap -> IO (InputStream ByteString)-takeBytes k0 src = do+takeBytes k0 = takeBytes' k0 (return Nothing)+{-# INLINE takeBytes #-}+++------------------------------------------------------------------------------+-- | Like @Streams.'takeBytes'@, but throws 'ReadTooShortException' when+-- there aren't enough bytes present on the source.+takeExactly :: Int64 -- ^ number of bytes to read+ -> InputStream ByteString -- ^ input stream to wrap+ -> IO (InputStream ByteString)+takeExactly k0 = takeBytes' k0 (throwIO $ ReadTooShortException k0)+{-# INLINE takeExactly #-}+++------------------------------------------------------------------------------+-- Helper for the two above.+takeBytes' :: Int64+ -> IO (Maybe ByteString)+ -- ^ What to do if the input ends before having consumed the+ -- right amount of bytes.+ -> InputStream ByteString+ -> IO (InputStream ByteString)+takeBytes' k0 h src = do kref <- newIORef k0 return $! InputStream (prod kref) (pb kref) where@@ -223,7 +246,7 @@ k <- readIORef kref if k <= 0 then return Nothing- else read src >>= maybe (return Nothing) (chunk k)+ else read src >>= maybe h (chunk k) where chunk k s = do let l = fromIntegral $ S.length s@@ -239,6 +262,7 @@ pb kref s = do modifyRef kref (+ (fromIntegral $ S.length s)) unRead s src+{-# INLINE takeBytes' #-} ------------------------------------------------------------------------------@@ -404,8 +428,9 @@ --------------------------------------------------------------------------------- | Thrown by 'readExactly' when not enough bytes were available on the input.-data ReadTooShortException = ReadTooShortException Int deriving (Typeable)+-- | Thrown by 'readExactly' and 'takeExactly' when not enough bytes were+-- available on the input.+data ReadTooShortException = ReadTooShortException Int64 deriving (Typeable) instance Show ReadTooShortException where show (ReadTooShortException x) = "Short read, expected " ++ show x@@ -501,7 +526,7 @@ go !dl 0 = return $! S.concat $! dl [] go !dl k = read input >>=- maybe (throwIO $ ReadTooShortException n)+ maybe (throwIO $ ReadTooShortException (fromIntegral n)) (\s -> do let l = S.length s if l >= k
test/System/IO/Streams/Tests/ByteString.hs view
@@ -43,6 +43,9 @@ , testTakeBytes2 , testTakeBytes3 , testTakeBytes4+ , testTakeExactly+ , testTakeExactly2+ , testTakeExactly3 , testThrowIfProducesMoreThan , testThrowIfProducesMoreThan2 , testThrowIfProducesMoreThan3@@ -142,7 +145,6 @@ assertEqual "take2" b y ) - ------------------------------------------------------------------------------ testTakeBytes2 :: Test testTakeBytes2 = testProperty "bytestring/takeBytes2" $@@ -189,6 +191,47 @@ mb <- timeout 100000 $ toList is assertBool "takeBytes4" $ isJust mb ++------------------------------------------------------------------------------+testTakeExactly :: Test+testTakeExactly = testProperty "bytestring/takeExactly" $+ monadicIO $+ forAllM arbitrary prop+ where+ prop :: L.ByteString -> PropertyM IO ()+ prop l = pre (L.length l > 5) >> liftQ (do+ let (a,b) = L.splitAt 4 l++ is <- fromList (L.toChunks l)+ is' <- takeExactly 4 is++ x <- liftM L.fromChunks $ toList is'+ y <- liftM L.fromChunks $ toList is++ assertEqual "take1" a x+ assertEqual "take2" b y+ )++------------------------------------------------------------------------------+testTakeExactly2 :: Test+testTakeExactly2 = testProperty "bytestring/takeExactly2" $+ monadicIO $+ forAllM arbitrary prop+ where+ prop :: L.ByteString -> PropertyM IO ()+ prop l = pre (L.length l < 10) >> liftQ (do+ is <- fromList (L.toChunks l)+ is' <- takeExactly 10 is++ expectExceptionH $ toList is'+ )++------------------------------------------------------------------------------+testTakeExactly3 :: Test+testTakeExactly3 = testCase "bytestring/takeExactly3" $ do+ is <- fromList ["one", "two"]+ is' <- takeExactly 7 is+ expectExceptionH $ toList is' ------------------------------------------------------------------------------ testThrowIfProducesMoreThan :: Test
test/System/IO/Streams/Tests/Network.hs view
@@ -44,18 +44,18 @@ Streams.fromList ["", "ok"] >>= Streams.connectTo os N.shutdown sock N.ShutdownSend Streams.toList is >>= putMVar resultMVar- N.close sock+ N.sClose sock server mvar = do sock <- N.socket N.AF_INET N.Stream N.defaultProtocol addr <- N.inet_addr "127.0.0.1" let saddr = N.SockAddrInet N.aNY_PORT addr- N.bind sock saddr+ N.bindSocket sock saddr N.listen sock 5 port <- N.socketPort sock putMVar mvar port (csock, _) <- N.accept sock (is, os) <- Streams.socketToStreams csock Streams.toList is >>= flip Streams.writeList os- N.close csock- N.close sock+ N.sClose csock+ N.sClose sock