+
+-- | 'hGetBufNonBlocking' @hdl buf count@ reads data from the handle @hdl@
+-- into the buffer @buf@ until either EOF is reached, or
+-- @count@ 8-bit bytes have been read, or there is no more data available
+-- to read immediately.
+--
+-- 'hGetBufNonBlocking' is identical to 'hGetBuf', except that it will
+-- never block waiting for data to become available, instead it returns
+-- only whatever data is available. To wait for data to arrive before
+-- calling 'hGetBufNonBlocking', use 'hWaitForInput'.
+--
+-- If the handle is a pipe or socket, and the writing end
+-- is closed, 'hGetBufNonBlocking' will behave as if EOF was reached.
+--
+hGetBufNonBlocking :: Handle -> Ptr a -> Int -> IO Int
+hGetBufNonBlocking h ptr count
+ | count == 0 = return 0
+ | count < 0 = illegalBufferSize h "hGetBufNonBlocking" count
+ | otherwise =
+ wantReadableHandle "hGetBufNonBlocking" h $
+ \ handle_@Handle__{ haFD=fd, haBuffer=ref, haIsStream=is_stream } -> do
+ bufReadNonBlocking fd ref is_stream ptr 0 count
+
+bufReadNonBlocking fd ref is_stream ptr so_far count =
+ seq fd $ seq so_far $ seq count $ do -- strictness hack
+ buf@Buffer{ bufBuf=raw, bufWPtr=w, bufRPtr=r, bufSize=sz } <- readIORef ref
+ if bufferEmpty buf
+ then if count > sz -- large read?
+ then do rest <- readChunkNonBlocking fd is_stream ptr count
+ return (so_far + rest)
+ else do buf' <- fillReadBufferWithoutBlocking fd is_stream buf
+ case buf' of { Buffer{ bufWPtr=w } ->
+ if (w == 0)
+ then return so_far
+ else do writeIORef ref buf'
+ bufReadNonBlocking fd ref is_stream ptr
+ so_far (min count w)
+ -- NOTE: new count is 'min count w'
+ -- so we will just copy the contents of the
+ -- buffer in the recursive call, and not
+ -- loop again.
+ }
+ else do
+ let avail = w - r
+ if (count == avail)
+ then do
+ memcpy_ptr_baoff ptr raw r (fromIntegral count)
+ writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
+ return (so_far + count)
+ else do
+ if (count < avail)
+ then do
+ memcpy_ptr_baoff ptr raw r (fromIntegral count)
+ writeIORef ref buf{ bufRPtr = r + count }
+ return (so_far + count)
+ else do
+
+ memcpy_ptr_baoff ptr raw r (fromIntegral avail)
+ writeIORef ref buf{ bufWPtr=0, bufRPtr=0 }
+ let remaining = count - avail
+ so_far' = so_far + avail
+ ptr' = ptr `plusPtr` avail
+
+ -- we haven't attempted to read anything yet if we get to here.
+ if remaining < sz
+ then bufReadNonBlocking fd ref is_stream ptr' so_far' remaining
+ else do
+
+ rest <- readChunkNonBlocking fd is_stream ptr' remaining
+ return (so_far' + rest)
+
+
+readChunkNonBlocking :: FD -> Bool -> Ptr a -> Int -> IO Int
+readChunkNonBlocking fd is_stream ptr bytes = do
+#ifndef mingw32_HOST_OS
+ ssize <- c_read (fromIntegral fd) (castPtr ptr) (fromIntegral bytes)
+ let r = fromIntegral ssize :: Int
+ if (r == -1)
+ then do errno <- getErrno
+ if (errno == eAGAIN || errno == eWOULDBLOCK)
+ then return 0
+ else throwErrno "readChunk"
+ else return r
+#else
+ (ssize, rc) <- asyncRead fd (fromIntegral $ fromEnum is_stream)
+ (fromIntegral bytes) ptr
+ let r = fromIntegral ssize :: Int
+ if r == (-1)
+ then ioError (errnoToIOError "hGetBufNonBlocking" (Errno (fromIntegral rc)) Nothing Nothing)
+ else return r
+#endif
+