diff options
| author | Andreas Klebinger <klebinger.andreas@gmx.at> | 2020-06-11 18:52:01 +0200 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2020-07-15 16:41:03 -0400 |
| commit | dcb423937a052496af73e34a315e3d15882b9f19 (patch) | |
| tree | d144bc82564f94f6673bf0c6af3fd70a681b2925 | |
| parent | d07ebe0df6df32bbffbf77ea09e39b6da2e8cbb3 (diff) | |
| download | haskell-dcb423937a052496af73e34a315e3d15882b9f19.tar.gz | |
winio: Actually return Nothing on EOF for non-blocking read
| -rw-r--r-- | libraries/base/GHC/Event/Windows.hsc | 6 | ||||
| -rw-r--r-- | libraries/base/GHC/IO/Windows/Handle.hsc | 18 |
2 files changed, 15 insertions, 9 deletions
diff --git a/libraries/base/GHC/Event/Windows.hsc b/libraries/base/GHC/Event/Windows.hsc index a041ce0409..8523abea26 100644 --- a/libraries/base/GHC/Event/Windows.hsc +++ b/libraries/base/GHC/Event/Windows.hsc @@ -53,6 +53,7 @@ module GHC.Event.Windows ( withException, ioSuccess, ioFailed, + ioFailedAny, getLastError, -- * I/O Result type @@ -827,6 +828,11 @@ ioSuccess = return . IOSuccess ioFailed :: Integral a => a -> IO (IOResult a) ioFailed = return . IOFailed . Just . fromIntegral +-- | Signal that the I/O action has failed with the given reason. +-- Polymorphic in successful result type. +ioFailedAny :: Integral a => a -> IO (IOResult b) +ioFailedAny = return . IOFailed . Just . fromIntegral + ------------------------------------------------------------------------ -- Timeouts diff --git a/libraries/base/GHC/IO/Windows/Handle.hsc b/libraries/base/GHC/IO/Windows/Handle.hsc index 3ed119858c..c7d4db6278 100644 --- a/libraries/base/GHC/IO/Windows/Handle.hsc +++ b/libraries/base/GHC/IO/Windows/Handle.hsc @@ -450,7 +450,7 @@ hwndReadNonBlocking :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int hwndReadNonBlocking hwnd ptr offset bytes = do val <- withOverlapped "hwndReadNonBlocking" (toHANDLE hwnd) offset (startCB ptr) completionCB - return $ Just $ fromIntegral $ ioValue val + return $ ioValue val where startCB inputBuf lpOverlapped = do debugIO ":: hwndReadNonBlocking" @@ -460,14 +460,14 @@ hwndReadNonBlocking hwnd ptr offset bytes return $ Mgr.CbNone ret completionCB err dwBytes - | err == #{const ERROR_SUCCESS} = Mgr.ioSuccess $ fromIntegral dwBytes - | err == #{const ERROR_HANDLE_EOF} = Mgr.ioSuccess 0 - | err == #{const STATUS_END_OF_FILE} = Mgr.ioSuccess 0 - | err == #{const ERROR_BROKEN_PIPE} = Mgr.ioSuccess 0 - | err == #{const STATUS_PIPE_BROKEN} = Mgr.ioSuccess 0 - | err == #{const ERROR_NO_MORE_ITEMS} = Mgr.ioSuccess 0 - | err == #{const ERROR_MORE_DATA} = Mgr.ioSuccess $ fromIntegral dwBytes - | otherwise = Mgr.ioFailed err + | err == #{const ERROR_SUCCESS} = Mgr.ioSuccess $ Just $! fromIntegral dwBytes + | err == #{const ERROR_HANDLE_EOF} = Mgr.ioSuccess Nothing + | err == #{const STATUS_END_OF_FILE} = Mgr.ioSuccess Nothing + | err == #{const ERROR_BROKEN_PIPE} = Mgr.ioSuccess Nothing + | err == #{const STATUS_PIPE_BROKEN} = Mgr.ioSuccess Nothing + | err == #{const ERROR_NO_MORE_ITEMS} = Mgr.ioSuccess Nothing + | err == #{const ERROR_MORE_DATA} = Mgr.ioSuccess $ Just $! fromIntegral dwBytes + | otherwise = Mgr.ioFailedAny err hwndWrite :: Io NativeHandle -> Ptr Word8 -> Word64 -> Int -> IO () hwndWrite hwnd ptr offset bytes |