@@ -17,7 +17,7 @@ module Database.PostgreSQL.Simple.Notification
1717 ) where
1818
1919import Control.Concurrent ( threadWaitRead )
20−import Control.Concurrent.MVar ( takeMVar, putMVar )
20+import Control.Monad ( when )
2121import qualified Data.ByteString as B
2222import Database.PostgreSQL.Simple.Internal
2323import qualified Database.PostgreSQL.LibPQ as PQ
@@ -31,51 +31,24 @@ data Notification = Notification
3131
3232errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \
3333 \failed to fetch file descriptor"
34−errconn = "Database.PostgreSQL.Simple.Notification.getNotification: \
35− \not connected"
36−
37−lockConn :: Connection -> IO (PQ.Connection)
38−lockConn Connection{..} = do
39− mconn <- takeMVar connectionHandle
40− case mconn of
41− Nothing -> do
42− putMVar connectionHandle mconn
43− fail errconn
44− Just conn -> return conn
45−
46−unlockConn :: Connection -> PQ.Connection -> IO ()
47−unlockConn Connection{..} c = putMVar connectionHandle (Just c)
4834
4935getNotification :: Connection -> IO Notification
50−getNotification conn = do
51− c <- lockConn conn
52− loop conn c
36+getNotification = loop False
5337 where
54− -- now, I believe the only ways that this code throws an exception is:
55− -- 1. lockConn/unlockConn when we are blocked on a GC'd MVar
56− -- 2. threadWaitRead when closeFdWith gets called
57− -- 3. and if we raise it ourself
58− -- If 1 happens, then it doesn't matter if the MVar is locked or not,
59− -- and if 2 or 3 happens then the connection should be unlocked.
60− --
61− -- Note, however, that this function is not safe from asynchronous
62− -- exceptions, which probably ought to be fixed.
63− loop conn c = do
64− mmsg <- PQ.notifies c
65− case mmsg of
66− Nothing -> do
67− mfd <- PQ.socket c
68− unlockConn conn c
69− case mfd of
70− Nothing -> fail errfd
71− Just fd -> do
72− threadWaitRead fd
73− c <- lockConn conn
74− _ <- PQ.consumeInput c
75− -- FIXME? error handling
76− loop conn c
77− Just PQ.Notify{..} -> do
78− unlockConn conn c
38+ loop doConsume conn = do
39+ res <- withConnection conn $ \c -> do
40+ when doConsume (PQ.consumeInput c >> return ())
41+ mmsg <- PQ.notifies c
42+ case mmsg of
43+ Nothing -> do
44+ mfd <- PQ.socket c
45+ case mfd of
46+ Nothing -> fail errfd
47+ Just fd -> return (Left fd)
48+ Just x -> return (Right x)
49+ case res of
50+ Left fd -> threadWaitRead fd >> loop True conn
51+ Right PQ.Notify{..} -> do
7952 return Notification { notificationPid = notifyBePid
8053 , notificationChannel = notifyRelname
8154 , notificationData = notifyExtra }