7b32518 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Fix getNotification for Windows by using threadDelay

I had to make 'errfd' one big line, since string gaps and CPP don't get along.

commit7b32518ce32a21eb5fa781d7661def17d3507c35 authorJoey Adams <joeyadams3.14159@gmail.com> dateTue 4 Jun 2013, 22:16 (13 years ago) parentc54c84e

1 file changed+17−7

compare with master

unifiedsplit

src/Database/PostgreSQL/Simple/Notification.hs+17−7

src/Database/PostgreSQL/Simple/Notification.hs+17−7

@@ -1,4 +1,6 @@

1−{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE NamedFieldPuns #-}

3+{-# LANGUAGE RecordWildCards #-}

35-----------------------------------------------------------------------------

46-- |

@@ -22,7 +24,7 @@ module Database.PostgreSQL.Simple.Notification

2224 , getNotificationNonBlocking

2325 ) where

2426

25−import Control.Concurrent ( threadWaitRead )

27+import Control.Concurrent

2628import Control.Monad ( when )

2729import qualified Data.ByteString as B

2830import Database.PostgreSQL.Simple.Internal

@@ -36,8 +38,7 @@ data Notification = Notification

3638 }

3739

3840errfd :: String

39−errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \

40− \failed to fetch file descriptor"

41+errfd = "Database.PostgreSQL.Simple.Notification.getNotification: failed to fetch file descriptor"

4142

4243convertNotice :: PQ.Notify -> Notification

4344convertNotice PQ.Notify{..}

@@ -49,9 +50,9 @@ convertNotice PQ.Notify{..}

4950-- 'getNotification' blocks until one arrives.

5051

5152getNotification :: Connection -> IO Notification

52−getNotification = loop False

53+getNotification conn = loop False

5354 where

54− loop doConsume conn = do

55+ loop doConsume = do

5556 res <- withConnection conn $ \c -> do

5657 when doConsume (PQ.consumeInput c >> return ())

5758 mmsg <- PQ.notifies c

@@ -64,7 +65,16 @@ getNotification = loop False

6465 Just msg -> return (Right msg)

6566 -- FIXME? what happens if the connection is closed/reset right here?

6667 case res of

67− Left fd -> threadWaitRead fd >> loop True conn

68+#if defined(mingw32_HOST_OS)

69+ -- threadWaitRead doesn't work for sockets on Windows, so just poll

70+ -- for input every second (PQconsumeInput is non-blocking).

71+ --

72+ -- We could call select(), but FFI calls can't be interrupted with

73+ -- async exceptions, whereas threadDelay can.

74+ Left _fd -> threadDelay 1000000 >> loop True

75+#else

76+ Left fd -> threadWaitRead fd >> loop True

77+#endif

6878 Right msg -> return $! convertNotice msg

6979

7080-- | Non-blocking variant of 'getNotification'. Returns a single notification,