diff --git a/io-streams.cabal b/io-streams.cabal --- a/io-streams.cabal +++ b/io-streams.cabal @@ -1,5 +1,5 @@ Name: io-streams -Version: 1.5.2.0 +Version: 1.5.2.1 License: BSD3 License-file: LICENSE Category: Data, Network, IO-Streams @@ -9,7 +9,7 @@ Synopsis: Simple, composable, and easy-to-use stream I/O Tested-With: GHC==7.4.2, GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.3, GHC==8.6.3, - GHC==8.8.3, GHC==8.10.1 + GHC==8.8.3, GHC==8.10.1, GHC==9.0.1 Bug-Reports: https://github.com/snapframework/io-streams/issues Description: @@ -129,8 +129,7 @@ Build-depends: base >= 4 && <5, attoparsec >= 0.10 && <0.14, - bytestring >= 0.9 && <0.11, - bytestring-builder >= 0.10 && <0.11, + bytestring >= 0.9 && <0.12, primitive >= 0.2 && <0.8, process >= 1.1 && <1.7, text >= 0.10 && <1.3, @@ -138,6 +137,9 @@ transformers >= 0.2 && <0.6, vector >= 0.7 && <0.13 + if !impl(ghc >= 7.8) + Build-depends: bytestring-builder >= 0.10 && <0.11 + if impl(ghc >= 7.2) other-extensions: Trustworthy @@ -230,7 +232,6 @@ Build-depends: base, attoparsec, bytestring, - bytestring-builder, deepseq >= 1.2 && <1.5, directory >= 1.1 && <2, filepath >= 1.2 && <2, @@ -247,6 +248,9 @@ test-framework >= 0.6 && <0.9, test-framework-hunit >= 0.2.7 && <0.4, test-framework-quickcheck2 >= 0.2.12.1 && <0.4 + + if !impl(ghc >= 7.8) + Build-depends: bytestring-builder if impl(ghc >= 7.2) other-extensions: Trustworthy diff --git a/src/System/IO/Streams/Internal.hs b/src/System/IO/Streams/Internal.hs --- a/src/System/IO/Streams/Internal.hs +++ b/src/System/IO/Streams/Internal.hs @@ -442,37 +442,50 @@ ------------------------------------------------------------------------------ +#if MIN_VERSION_base(4,15,0) +ignoreOffset :: (a -> ptr -> n -> ioint) -> a -> ptr -> off -> n -> ioint +ignoreOffset f a ptr _ n = f a ptr n +#else +ignoreOffset :: a -> a +ignoreOffset = id +#endif +{-# INLINE ignoreOffset #-} + +------------------------------------------------------------------------------ +-- | The offset argument is ignored if present. 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 + read = ignoreOffset $ \is ptr n -> + let f s = S.unsafeUseAsCStringLen s $ \(cstr, l) -> do let c = min n l copyBytes ptr (castPtr cstr) c return $! c + in read is >>= maybe (return 0) f - readNonBlocking _ _ _ = unsupported - write _ _ _ = unsupported - writeNonBlocking _ _ _ = unsupported + readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported + write = ignoreOffset $ \_ _ _ -> unsupported + writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------ +-- | The offset argument is ignored if present. 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 + read = ignoreOffset $ \_ _ _ -> unsupported + readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported + write = ignoreOffset $ \os ptr n -> S.packCStringLen (castPtr ptr, n) >>= + flip write os . Just + writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------ -- | Internal convenience synonym for a pair of input\/output streams. type StreamPair a = SP (InputStream a) (OutputStream a) +-- | The offset argument is ignored if present. 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 + read (SP is _) = H.read is + readNonBlocking = ignoreOffset $ \_ _ _ -> unsupported + write (SP _ os) = H.write os + writeNonBlocking = ignoreOffset $ \_ _ _ -> unsupported ------------------------------------------------------------------------------ diff --git a/test/System/IO/Streams/Tests/Handle.hs b/test/System/IO/Streams/Tests/Handle.hs --- a/test/System/IO/Streams/Tests/Handle.hs +++ b/test/System/IO/Streams/Tests/Handle.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module System.IO.Streams.Tests.Handle (tests) where @@ -148,13 +149,13 @@ 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 $ withZeroOffset H.write is undefined undefined + expectExceptionH $ withZeroOffset 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 $ withZeroOffset H.read os undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking os undefined undefined expectExceptionH $ H.fillReadBuffer0 is undefined expectExceptionH $ H.fillReadBuffer0 os undefined @@ -168,17 +169,17 @@ 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 + expectExceptionH $ withZeroOffset H.readNonBlocking is undefined undefined + expectExceptionH $ withZeroOffset H.readNonBlocking os undefined undefined + expectExceptionH $ withZeroOffset H.readNonBlocking sp undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking is undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking os undefined undefined + expectExceptionH $ withZeroOffset H.writeNonBlocking sp undefined undefined S.useAsCStringLen "foo" $ \(cstr, l) -> do - H.write os (castPtr cstr) l + withZeroOffset H.write os (castPtr cstr) l liftM S.concat getList >>= assertEqual "H.write 1" "foo" - H.write sp (castPtr cstr) l + withZeroOffset 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 @@ -189,10 +190,18 @@ allocaBytes 3 $ \buf -> do - l <- H.read is buf 3 + l <- withZeroOffset 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 + l' <- withZeroOffset 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 + expectExceptionH $ withZeroOffset H.read os buf 3 + where +#if MIN_VERSION_base(4,15,0) + withZeroOffset :: Num off => (a -> ptr -> off -> n -> ioint) -> a -> ptr -> n -> ioint + withZeroOffset f a ptr n = f a ptr 0 n +#else + withZeroOffset :: a -> a + withZeroOffset = id +#endif