git.iko.soy/typeable/postgresql-simple
on master help sign in
Add Listen/Notify support
18ca588Leon P Smith
postgresql-simple.cabal+5−4
compare with master
unifiedsplit
@@ -22,12 +22,13 @@ Library
22 -- Modules exported by the library.
22 -- Modules exported by the library.
23 Exposed-modules:
23 Exposed-modules:
24 Database.PostgreSQL.Simple
24 Database.PostgreSQL.Simple
25+ Database.PostgreSQL.Simple.BuiltinTypes
26+ Database.PostgreSQL.Simple.Field
27+ Database.PostgreSQL.Simple.Notification
25 Database.PostgreSQL.Simple.Param
28 Database.PostgreSQL.Simple.Param
26− Database.PostgreSQL.Simple.QueryParams
27 Database.PostgreSQL.Simple.Result
29 Database.PostgreSQL.Simple.Result
28− Database.PostgreSQL.Simple.Field
30+ Database.PostgreSQL.Simple.QueryParams
29 Database.PostgreSQL.Simple.QueryResults
31 Database.PostgreSQL.Simple.QueryResults
30− Database.PostgreSQL.Simple.BuiltinTypes
31 Database.PostgreSQL.Simple.Types
32 Database.PostgreSQL.Simple.Types
32 Other-modules:
33 Other-modules:
33 Database.PostgreSQL.Simple.Implementation
34 Database.PostgreSQL.Simple.Implementation
@@ -45,7 +46,7 @@ Library
45 old-locale,
46 old-locale,
46 text >= 0.11.0.2,
47 text >= 0.11.0.2,
47 time,
48 time,
48− transformers >= 0.2.0.0
49+ transformers
49 -- Modules not exported by this package.
50 -- Modules not exported by this package.
50 -- Other-modules:
51 -- Other-modules:
51
52
src/Database/PostgreSQL/Simple/Notification.hsnew file+78
@@ -0,0 +1,78 @@
1+{-# LANGUAGE RecordWildCards, NamedFieldPuns #-}
2+
3+-----------------------------------------------------------------------------
4+-- |
5+-- Module : Database.HDBC.PostgreSQL.Notification
6+-- Copyright : (c) 2011 Leon P Smith
7+-- License : BSD3
8+--
9+-- Maintainer : leon@melding-monads.com
10+-- Stability : experimental
11+--
12+-----------------------------------------------------------------------------
13+
14+module Database.PostgreSQL.Simple.Notification
15+ ( Notification(..)
16+ , getNotification
17+ ) where
18+
19+import Control.Concurrent ( threadWaitRead )
20+import Control.Concurrent.MVar ( takeMVar, putMVar )
21+import qualified Data.ByteString as B
22+import Database.PostgreSQL.Simple.Implementation
23+import qualified Database.PostgreSQL.LibPQ as PQ
24+import System.Posix.Types ( CPid )
25+
26+data Notification = Notification
27+ { notificationPid :: CPid
28+ , notificationChannel :: B.ByteString
29+ , notificationData :: B.ByteString
30+ }
31+
32+errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \
33+ \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)
48+
49+getNotification :: Connection -> IO Notification
50+getNotification conn = do
51+ c <- lockConn conn
52+ loop conn c
53+ 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+ loop conn c = do
61+ mmsg <- PQ.notifies c
62+ case mmsg of
63+ Nothing -> do
64+ mfd <- PQ.socket c
65+ unlockConn conn c
66+ case mfd of
67+ Nothing -> fail errfd
68+ Just fd -> do
69+ threadWaitRead fd
70+ c <- lockConn conn
71+ _ <- PQ.consumeInput c
72+ -- FIXME? error handling
73+ loop conn c
74+ Just PQ.Notify{..} -> do
75+ unlockConn conn c
76+ return Notification { notificationPid = notifyBePid
77+ , notificationChannel = notifyRelname
78+ , notificationData = notifyExtra }