[commit: bytestring] master: Add hPutNonBlocking (8b1bab6)
Ian Lynagh
igloo at earth.li
Sun Jun 19 18:38:58 CEST 2011
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 <duncan at community.haskell.org>
Date: Mon May 16 11:58:11 2011 +0000
Add hPutNonBlocking
Based originally on a patch by David Fox <david.fox at linspire.com>
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.
More information about the Cvs-libraries
mailing list