git.iko.soy/typeable/postgresql-simple
on master help sign in
Fix getNotification for Windows by using threadDelay
7b32518Joey Adams
src/Database/PostgreSQL/Simple/Notification.hs+17−7
compare with master
unifiedsplit
@@ -1,4 +1,6 @@
1+{-# LANGUAGE CPP #-}
1−{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
2+{-# LANGUAGE NamedFieldPuns #-}
3+{-# LANGUAGE RecordWildCards #-}
2
4
3-----------------------------------------------------------------------------
5-----------------------------------------------------------------------------
4-- |
6-- |
@@ -22,7 +24,7 @@ module Database.PostgreSQL.Simple.Notification
22 , getNotificationNonBlocking
24 , getNotificationNonBlocking
23 ) where
25 ) where
24
26
25−import Control.Concurrent ( threadWaitRead )
27+import Control.Concurrent
26import Control.Monad ( when )
28import Control.Monad ( when )
27import qualified Data.ByteString as B
29import qualified Data.ByteString as B
28import Database.PostgreSQL.Simple.Internal
30import Database.PostgreSQL.Simple.Internal
@@ -36,8 +38,7 @@ data Notification = Notification
36 }
38 }
37
39
38errfd :: String
40errfd :: String
39−errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \
41+errfd = "Database.PostgreSQL.Simple.Notification.getNotification: failed to fetch file descriptor"
40− \failed to fetch file descriptor"
41
42
42convertNotice :: PQ.Notify -> Notification
43convertNotice :: PQ.Notify -> Notification
43convertNotice PQ.Notify{..}
44convertNotice PQ.Notify{..}
@@ -49,9 +50,9 @@ convertNotice PQ.Notify{..}
49-- 'getNotification' blocks until one arrives.
50-- 'getNotification' blocks until one arrives.
50
51
51getNotification :: Connection -> IO Notification
52getNotification :: Connection -> IO Notification
52−getNotification = loop False
53+getNotification conn = loop False
53 where
54 where
54− loop doConsume conn = do
55+ loop doConsume = do
55 res <- withConnection conn $ \c -> do
56 res <- withConnection conn $ \c -> do
56 when doConsume (PQ.consumeInput c >> return ())
57 when doConsume (PQ.consumeInput c >> return ())
57 mmsg <- PQ.notifies c
58 mmsg <- PQ.notifies c
@@ -64,7 +65,16 @@ getNotification = loop False
64 Just msg -> return (Right msg)
65 Just msg -> return (Right msg)
65 -- FIXME? what happens if the connection is closed/reset right here?
66 -- FIXME? what happens if the connection is closed/reset right here?
66 case res of
67 case res of
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
67− Left fd -> threadWaitRead fd >> loop True conn
76+ Left fd -> threadWaitRead fd >> loop True
77+#endif
68 Right msg -> return $! convertNotice msg
78 Right msg -> return $! convertNotice msg
69
79
70-- | Non-blocking variant of 'getNotification'. Returns a single notification,
80-- | Non-blocking variant of 'getNotification'. Returns a single notification,