@@ -19,6 +19,7 @@
1919module Database.PostgreSQL.Simple.Notification
2020 ( Notification(..)
2121 , getNotification
22+ , getNotificationIfAvailable
2223 ) where
2324
2425import Control.Concurrent ( threadWaitRead )
@@ -38,6 +39,11 @@ errfd :: String
3839errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \
3940 \failed to fetch file descriptor"
4041
42+convertNotice :: PQ.Notify -> Notification
43+convertNotice PQ.Notify{..}
44+ = Notification { notificationPid = notifyBePid
45+ , notificationChannel = notifyRelname
46+ , notificationData = notifyExtra }
4147
4248-- | Returns a single notification. If no notifications are available,
4349-- 'getNotification' blocks until one arrives.
@@ -55,10 +61,24 @@ getNotification = loop False
5561 case mfd of
5662 Nothing -> fail errfd
5763 Just fd -> return (Left fd)
58− Just x -> return (Right x)
64+ Just msg -> return (Right msg)
65+ -- FIXME? what happens if the connection is closed/reset right here?
5966 case res of
6067 Left fd -> threadWaitRead fd >> loop True conn
61− Right PQ.Notify{..} -> do
62− return Notification { notificationPid = notifyBePid
63− , notificationChannel = notifyRelname
64− , notificationData = notifyExtra }
68+ Right msg -> return $! convertNotice msg
69+
70+-- | Non-blocking variant of 'getNotification'. Returns a single notification,
71+-- if available. If no notifications are available, returns 'Nothing'.
72+
73+getNotificationIfAvailable :: Connection -> IO (Maybe Notification)
74+getNotificationIfAvailable conn =
75+ withConnection conn $ \c -> do
76+ mmsg <- PQ.notifies c
77+ case mmsg of
78+ Just msg -> return $! Just $! convertNotice msg
79+ Nothing -> do
80+ _ <- PQ.consumeInput c
81+ mmsg' <- PQ.notifies c
82+ case mmsg' of
83+ Just msg -> return $! Just $! convertNotice msg
84+ Nothing -> return Nothing