From 4381eca45b925a09e2b011da6aa944d314f4ec8e Mon Sep 17 00:00:00 2001 From: Brendan Hay Date: Sat, 12 Mar 2016 10:14:26 +0100 Subject: [PATCH] Ensuring PSUBSCRIBE messages are passed to the supplied pubSub callback --- src/Database/Redis/IO/Client.hs | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/src/Database/Redis/IO/Client.hs b/src/Database/Redis/IO/Client.hs index cc02d87..4efb5a4 100644 --- a/src/Database/Redis/IO/Client.hs +++ b/src/Database/Redis/IO/Client.hs @@ -159,10 +159,14 @@ pipelined a = liftClient $ withConnection (flip (eval getLazy) a) transactional :: MonadClient m => Redis IO a -> m a transactional a = liftClient $ withConnection (flip (eval getTransaction) a) --- | Execute the given publish\/subscribe commands. The first parameter is --- the callback function which will be invoked with channel and message +-- | Execute the given publish\/subscribe commands. +-- The first parameter is the callback function which will be invoked with +-- a possible pattern (if @PSUBSCRIBE@ was used), channel, and message, -- once messages arrive. -pubSub :: MonadClient m => (ByteString -> ByteString -> PubSub IO ()) -> PubSub IO () -> m () +pubSub :: MonadClient m + => (Maybe ByteString -> ByteString -> ByteString -> PubSub IO ()) + -> PubSub IO () + -> m () pubSub f a = liftClient $ withConnection (loop a) where loop :: PubSub IO () -> Connection -> IO ((), [IO ()]) @@ -187,9 +191,11 @@ pubSub f a = liftClient $ withConnection (loop a) responses h = do m <- readPushMessage <$> C.receive h case m of - Right (Message ch ms) -> return (Just $ f ch ms) + Right (Message ch ms) -> return (Just $ f Nothing ch ms) + Right (PMessage pat ch ms) -> return (Just $ f (Just pat) ch ms) Right (UnsubscribeMessage _ 0) -> return Nothing - Right _ -> responses h + Right UnsubscribeMessage {} -> responses h + Right SubscribeMessage {} -> responses h Left e -> throwIO e eval :: (forall a. Connection -> Resp -> (Resp -> Result a) -> IO (a, IO ())) -- GitLab