Repository : ssh://darcs.haskell.org//srv/darcs/packages/bytestring On branch : master
http://hackage.haskell.org/trac/ghc/changeset/8b1bab6a6dde77c8af150c57bcd25cf758f87e1f >--------------------------------------------------------------- commit 8b1bab6a6dde77c8af150c57bcd25cf758f87e1f Author: Duncan Coutts <[email protected]> Date: Mon May 16 11:58:11 2011 +0000 Add hPutNonBlocking Based originally on a patch by David Fox <[email protected]> Fixes ghc ticket #1070. Also update the documentation for hGetNonBlocking >--------------------------------------------------------------- Data/ByteString.hs | 31 +++++++++++++++++++++++++++---- Data/ByteString/Char8.hs | 3 ++- Data/ByteString/Lazy.hs | 25 ++++++++++++++++++++++++- Data/ByteString/Lazy/Char8.hs | 3 ++- 4 files changed, 55 insertions(+), 7 deletions(-) diff --git a/Data/ByteString.hs b/Data/ByteString.hs index dabde59..0c124d5 100644 --- a/Data/ByteString.hs +++ b/Data/ByteString.hs @@ -197,6 +197,7 @@ module Data.ByteString ( hGetSome, -- :: Handle -> Int -> IO ByteString hGetNonBlocking, -- :: Handle -> Int -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () + hPutNonBlocking, -- :: Handle -> ByteString -> IO ByteString hPutStr, -- :: Handle -> ByteString -> IO () hPutStrLn, -- :: Handle -> ByteString -> IO () @@ -256,7 +257,7 @@ import System.IO (hIsEOF) #if defined(__GLASGOW_HASKELL__) -import System.IO (hGetBufNonBlocking) +import System.IO (hGetBufNonBlocking, hPutBufNonBlocking) #if MIN_VERSION_base(4,3,0) import System.IO (hGetBufSome) @@ -1901,6 +1902,24 @@ hPut :: Handle -> ByteString -> IO () hPut _ (PS _ _ 0) = return () hPut h (PS ps s l) = withForeignPtr ps $ \p-> hPutBuf h (p `plusPtr` s) l +-- | Similar to 'hPut' except that it will never block. Instead it returns +-- any tail that did not get written. This tail may be 'empty' in the case that +-- the whole string was written, or the whole original string if nothing was +-- written. Partial writes are also possible. +-- +-- Note: on Windows and with Haskell implementation other than GHC, this +-- function does not work correctly; it behaves identically to 'hPut'. +-- +#if defined(__GLASGOW_HASKELL__) +hPutNonBlocking :: Handle -> ByteString -> IO ByteString +hPutNonBlocking h bs@(PS ps s l) = do + bytesWritten <- withForeignPtr ps $ \p-> hPutBufNonBlocking h (p `plusPtr` s) l + return $! drop bytesWritten bs +#else +hPutNonBlocking :: Handle -> B.ByteString -> IO Int +hPutNonBlocking h bs = hPut h bs >> return empty +#endif + -- | A synonym for @hPut@, for compatibility hPutStr :: Handle -> ByteString -> IO () hPutStr = hPut @@ -1939,9 +1958,13 @@ hGet h i | i == 0 = return empty | otherwise = illegalBufferSize h "hGet" i --- | hGetNonBlocking is identical to 'hGet', except that it will never --- block waiting for data to become available. If there is no data --- available to be read, 'hGetNonBlocking' returns 'null'. +-- | hGetNonBlocking is similar to 'hGet', except that it will never block +-- waiting for data to become available, instead it returns only whatever data +-- is available. If there is no data available to be read, 'hGetNonBlocking' +-- returns 'empty'. +-- +-- Note: on Windows and with Haskell implementation other than GHC, this +-- function does not work correctly; it behaves identically to 'hGet'. -- hGetNonBlocking :: Handle -> Int -> IO ByteString #if defined(__GLASGOW_HASKELL__) diff --git a/Data/ByteString/Char8.hs b/Data/ByteString/Char8.hs index 33cd880..5cb34f0 100644 --- a/Data/ByteString/Char8.hs +++ b/Data/ByteString/Char8.hs @@ -208,6 +208,7 @@ module Data.ByteString.Char8 ( hGet, -- :: Handle -> Int -> IO ByteString hGetNonBlocking, -- :: Handle -> Int -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () + hPutNonBlocking, -- :: Handle -> ByteString -> IO ByteString hPutStr, -- :: Handle -> ByteString -> IO () hPutStrLn, -- :: Handle -> ByteString -> IO () @@ -238,7 +239,7 @@ import Data.ByteString (empty,null,length,tail,init,append ,getLine, getContents, putStr, putStrLn, interact ,hGetContents, hGet, hPut, hPutStr, hPutStrLn - ,hGetLine, hGetNonBlocking + ,hGetLine, hGetNonBlocking, hPutNonBlocking ,packCString,packCStringLen ,useAsCString,useAsCStringLen ) diff --git a/Data/ByteString/Lazy.hs b/Data/ByteString/Lazy.hs index 11973f3..9820e33 100644 --- a/Data/ByteString/Lazy.hs +++ b/Data/ByteString/Lazy.hs @@ -190,6 +190,7 @@ module Data.ByteString.Lazy ( hGet, -- :: Handle -> Int -> IO ByteString hGetNonBlocking, -- :: Handle -> Int -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () + hPutNonBlocking, -- :: Handle -> ByteString -> IO ByteString hPutStr, -- :: Handle -> ByteString -> IO () ) where @@ -1249,7 +1250,12 @@ hGet = hGetN defaultChunkSize -- | hGetNonBlocking is similar to 'hGet', except that it will never block -- waiting for data to become available, instead it returns only whatever data --- is available. +-- is available. If there is no data available to be read, 'hGetNonBlocking' +-- returns 'empty'. +-- +-- Note: on Windows and with Haskell implementation other than GHC, this +-- function does not work correctly; it behaves identically to 'hGet'. +-- #if defined(__GLASGOW_HASKELL__) hGetNonBlocking :: Handle -> Int -> IO ByteString hGetNonBlocking = hGetNonBlockingN defaultChunkSize @@ -1285,6 +1291,23 @@ getContents = hGetContents stdin hPut :: Handle -> ByteString -> IO () hPut h cs = foldrChunks (\c rest -> S.hPut h c >> rest) (return ()) cs +-- | Similar to 'hPut' except that it will never block. Instead it returns +-- any tail that did not get written. This tail may be 'empty' in the case that +-- the whole string was written, or the whole original string if nothing was +-- written. Partial writes are also possible. +-- +-- Note: on Windows and with Haskell implementation other than GHC, this +-- function does not work correctly; it behaves identically to 'hPut'. +-- +hPutNonBlocking :: Handle -> ByteString -> IO ByteString +hPutNonBlocking _ Empty = return Empty +hPutNonBlocking h bs@(Chunk c cs) = do + c' <- S.hPutNonBlocking h c + case S.length c' of + l' | l' == S.length c -> hPutNonBlocking h cs + 0 -> return bs + _ -> return (Chunk c' cs) + -- | A synonym for @hPut@, for compatibility -- hPutStr :: Handle -> ByteString -> IO () diff --git a/Data/ByteString/Lazy/Char8.hs b/Data/ByteString/Lazy/Char8.hs index 6ba6cdd..f34678f 100644 --- a/Data/ByteString/Lazy/Char8.hs +++ b/Data/ByteString/Lazy/Char8.hs @@ -172,6 +172,7 @@ module Data.ByteString.Lazy.Char8 ( hGet, -- :: Handle -> Int64 -> IO ByteString hGetNonBlocking, -- :: Handle -> Int64 -> IO ByteString hPut, -- :: Handle -> ByteString -> IO () + hPutNonBlocking, -- :: Handle -> ByteString -> IO ByteString ) where @@ -181,7 +182,7 @@ import Data.ByteString.Lazy ,empty,null,length,tail,init,append,reverse,transpose,cycle ,concat,take,drop,splitAt,intercalate,isPrefixOf,group,inits,tails,copy ,hGetContents, hGet, hPut, getContents - ,hGetNonBlocking + ,hGetNonBlocking, hPutNonBlocking ,putStr, putStrLn, interact) -- Functions we need to wrap. _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
