module Database.PostgreSQL.Simple.Notification
( Notification(..)
, getNotification
, getNotificationNonBlocking
) where
import Control.Concurrent ( threadWaitRead )
import Control.Monad ( when )
import qualified Data.ByteString as B
import Database.PostgreSQL.Simple.Internal
import qualified Database.PostgreSQL.LibPQ as PQ
import System.Posix.Types ( CPid )
data Notification = Notification
{ notificationPid :: !CPid
, notificationChannel :: !B.ByteString
, notificationData :: !B.ByteString
}
errfd :: String
errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \
\failed to fetch file descriptor"
convertNotice :: PQ.Notify -> Notification
convertNotice PQ.Notify{..}
= Notification { notificationPid = notifyBePid
, notificationChannel = notifyRelname
, notificationData = notifyExtra }
getNotification :: Connection -> IO Notification
getNotification = loop False
where
loop doConsume conn = do
res <- withConnection conn $ \c -> do
when doConsume (PQ.consumeInput c >> return ())
mmsg <- PQ.notifies c
case mmsg of
Nothing -> do
mfd <- PQ.socket c
case mfd of
Nothing -> fail errfd
Just fd -> return (Left fd)
Just msg -> return (Right msg)
case res of
Left fd -> threadWaitRead fd >> loop True conn
Right msg -> return $! convertNotice msg
getNotificationNonBlocking :: Connection -> IO (Maybe Notification)
getNotificationNonBlocking conn =
withConnection conn $ \c -> do
mmsg <- PQ.notifies c
case mmsg of
Just msg -> return $! Just $! convertNotice msg
Nothing -> do
_ <- PQ.consumeInput c
mmsg' <- PQ.notifies c
case mmsg' of
Just msg -> return $! Just $! convertNotice msg
Nothing -> return Nothing