hasql-notifications 0.2.4.0 → 0.2.5.0
raw patch · 4 files changed
+25/−22 lines, 4 filesdep ~hasqldep ~hasql-pool
Dependency ranges changed: hasql, hasql-pool
Files
- app/Main.hs +1/−3
- hasql-notifications.cabal +4/−3
- src/Hasql/Notifications.hs +19/−13
- test/Hasql/NotificationsSpec.hs +1/−3
app/Main.hs view
@@ -4,8 +4,6 @@ import System.Exit (die) import Hasql.Connection-import Hasql.Connection.Setting-import Hasql.Connection.Setting.Connection import Hasql.Notifications main :: IO ()@@ -13,7 +11,7 @@ hSetBuffering stdout NoBuffering hSetBuffering stderr NoBuffering - dbOrError <- acquire [ connection $ string "postgres://localhost/db_name" ]+ dbOrError <- acquire "postgres://localhost/db_name" case dbOrError of Right db -> do let channelToListen = toPgIdentifier "sample-channel"
hasql-notifications.cabal view
@@ -1,5 +1,5 @@ name: hasql-notifications-version: 0.2.4.0+version: 0.2.5.0 synopsis: LISTEN/NOTIFY support for Hasql description: Use PostgreSQL Asynchronous notification support with your Hasql Types. homepage: https://github.com/diogob/hasql-notifications@@ -19,9 +19,9 @@ build-depends: base >= 4.7 && < 5 , bytestring >= 0.10.8.2 && < 0.13 , text >= 2 && < 2.2- , hasql-pool >= 1.3 && < 1.4+ , hasql-pool >= 1.4 && < 1.5 , postgresql-libpq >= 0.9 && < 1.0- , hasql >= 1.9 && < 1.10+ , hasql >= 1.10 && < 1.11 default-language: Haskell2010 ghc-options: -Wall@@ -48,6 +48,7 @@ , hspec , bytestring , QuickCheck+ build-tool-depends: hspec-discover:hspec-discover >=2.11.12 && <3 ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 default-extensions: OverloadedStrings
src/Hasql/Notifications.hs view
@@ -30,13 +30,14 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Database.PostgreSQL.LibPQ as PQ-import Hasql.Connection (Connection, withLibPQConnection)+import Hasql.Connection (Connection)+import qualified Hasql.Connection as Connection import qualified Hasql.Decoders as HD import qualified Hasql.Encoders as HE+import qualified Hasql.Errors as Errors import Hasql.Pool (Pool, UsageError, use)-import Hasql.Session (run, sql, statement)-import qualified Hasql.Session as S-import qualified Hasql.Statement as HST+import qualified Hasql.Session as Session+import qualified Hasql.Statement as Statement -- | A wrapped text that represents a properly escaped and quoted PostgreSQL identifier newtype PgIdentifier = PgIdentifier Text deriving (Show)@@ -71,9 +72,9 @@ Text -> IO (Either UsageError ()) notifyPool pool channel mesg =- use pool (statement (channel, mesg) callStatement)+ use pool (Session.statement (channel, mesg) callStatement) where- callStatement = HST.Statement ("SELECT pg_notify" <> "($1, $2)") encoder HD.noResult False+ callStatement = Statement.unpreparable "SELECT pg_notify($1, $2)" encoder HD.noResult encoder = contramap fst (HE.param $ HE.nonNullable HE.text) <> contramap snd (HE.param $ HE.nonNullable HE.text) -- | Given a Hasql Connection, a channel and a message sends a notify command to the database@@ -84,9 +85,10 @@ PgIdentifier -> -- | Payload to be sent with the notification Text ->- IO (Either S.SessionError ())+ IO (Either Errors.SessionError ()) notify con channel mesg =- run (sql $ T.encodeUtf8 ("NOTIFY " <> fromPgIdentifier channel <> ", '" <> mesg <> "'")) con+ Connection.use con $ Session.script $ mconcat $+ ["NOTIFY ", fromPgIdentifier channel, ", '", mesg, "'"] -- | -- Given a Hasql Connection and a channel sends a listen command to the database.@@ -120,9 +122,11 @@ PgIdentifier -> IO () listen con channel =- void $ withLibPQConnection con execListen+ void $ Connection.use con $ Session.onLibpqConnection execListen where- execListen = executeOrPanic $ T.encodeUtf8 $ "LISTEN " <> fromPgIdentifier channel+ execListen pqCon = do+ flip executeOrPanic pqCon $ T.encodeUtf8 $ "LISTEN " <> fromPgIdentifier channel+ pure (Right (), pqCon) -- | Given a Hasql Connection and a channel sends a unlisten command to the database unlisten ::@@ -132,9 +136,11 @@ PgIdentifier -> IO () unlisten con channel =- void $ withLibPQConnection con execUnlisten+ void $ Connection.use con $ Session.onLibpqConnection execUnlisten where- execUnlisten = executeOrPanic $ T.encodeUtf8 $ "UNLISTEN " <> fromPgIdentifier channel+ execUnlisten pqCon = do+ flip executeOrPanic pqCon $ T.encodeUtf8 $ "UNLISTEN " <> fromPgIdentifier channel+ pure (Right (), pqCon) executeOrPanic :: ByteString -> PQ.Connection -> IO () executeOrPanic cmd pqCon = do@@ -188,7 +194,7 @@ Connection -> IO () waitForNotifications sendNotification con =- withLibPQConnection con $ void . forever . pqFetch+ void $ Connection.use con $ Session.onLibpqConnection $ forever . pqFetch where pqFetch pqCon = do mNotification <- PQ.notifies pqCon
test/Hasql/NotificationsSpec.hs view
@@ -5,8 +5,6 @@ import Control.Monad (void) import Data.ByteString import Hasql.Connection-import Hasql.Connection.Setting-import Hasql.Connection.Setting.Connection import Hasql.Notifications import System.Exit (die) import Test.Hspec@@ -22,7 +20,7 @@ describe "send and receive notification" $ describe "when I send a notification to channel my handler is listening to" $ it "should call our notification handler" $ do- dbOrError <- acquire [ connection $ string "postgres://postgres:roottoor@localhost/hasql_notifications_test"]+ dbOrError <- acquire "postgres://postgres:roottoor@localhost/hasql_notifications_test" case dbOrError of Right db -> do let channelToListen = toPgIdentifier "test-channel"