Ticket #5773: PGListener.hs

File PGListener.hs, 1.3 KB (added by lpsmith, 2 years ago)
Line 
1{-# LANGUAGE OverloadedStrings #-}
2
3import           Control.Concurrent
4import           Control.Exception (bracket)
5import qualified Database.PostgreSQL.LibPQ as PQ  -- from postgresql-libpq
6import           Control.Concurrent
7
8withConn connstr = bracket (PQ.connectdb connstr) (PQ.finish)
9
10connstr = "dbname=postgres"
11
12main = withConn connstr $ \conn -> do 
13  stat <- PQ.status conn
14  case stat of
15    PQ.ConnectionOk -> return ()
16    _ -> fail (show stat)
17
18  Just res <- PQ.exec conn "LISTEN test_channel"
19  stat <- PQ.resultStatus res
20  case stat of
21    PQ.CommandOk -> return ()
22    _ -> fail (show stat)
23
24  monitor conn
25
26monitor conn = st_wait
27  where
28    st_wait = do
29      mfd <- PQ.socket conn
30      case mfd of
31        Just fd -> do
32          threadWaitRead fd
33          _bool <- PQ.consumeInput conn
34          st_notices
35        Nothing -> putStrLn "exiting..." 
36
37    st_notices = do
38      x <- PQ.notifies conn
39      case x of
40        Nothing -> st_wait
41        Just notify -> do
42          putStr ("notifyRelname:  ")
43          print  (PQ.notifyRelname  notify)
44          putStr ("notifyBePid:    ")
45          print  (PQ.notifyBePid    notify)
46          putStr ("notifyExtra:    ")
47          print  (PQ.notifyExtra    notify)
48          putStrLn ""
49          st_notices