Your use of putStrLn is making the typechecker (correctly!) infer that your do block is intended to be in an IO context, then the call to publish requires the context to be an instance of RedisCtx, which IO is not.
Normally in a Redis context, the solution would be to lift the IO action into the Redis context using liftIO :: IO a -> m a from the MonadIO class, as in the example in the documentation:
runRedis conn $ do
set "hello" "hello"
set "world" "world"
helloworld <- multiExec $ do
hello <- get "hello"
world <- get "world"
return $ (,) <$> hello <*> world
liftIO (print helloworld)
MonadIO is the set of types in whose context you can execute IO actions.
However, in this case, it’s the other way around: the functional parameter to pubSub returns an IO action, but publish expects a RedisCtx monad.
It’s not clear to me whether pubSub allows you to make a runRedis call inside the callback, like this, although I think it should typecheck:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Database.Redis
import System.IO
main = do
conn <- connect defaultConnectInfo
runRedis conn $ do
pubSub (subscribe ["commands"]) $ \msg -> do
putStrLn $ "Message from " ++ show (msgChannel msg)
runRedis conn $ publish "results" "Result of a very interesting calculation"
return mempty
Based on skimming the docs, each runRedis call takes a connection from the connection pool, whose default size is 50; however, if there is no available connection, it blocks, so my concern is that because the docs for pubSub say it’s “single-threaded”, this could deadlock waiting for a connection that won’t be released since you’re in a “nested” runRedis call.
I think the thing I would try next is to use the more flexible pubSubForever API; in the hedis test suite there’s an example of using pubSubForever with separate threads for publishing and handling subscription events.
main = do
ctrl <- newPubSubController [("foo", msgHandler)] []
conn <- connect defaultConnectInfo
withAsync (publishThread conn) $ \_pubT -> do
withAsync (handlerThread conn ctrl) $ \_handlerT -> do
void $ hPutStrLn stderr "Press enter to subscribe to bar" >> getLine
void $ addChannels ctrl [("bar", msgHandler)] []
-- …
-- (Add/remove various subscriptions.)
-- …
publishThread uses runRedis and calls publish:
publishThread :: Connection -> IO ()
publishThread c = runRedis c $ loop (0 :: Int)
where
loop i = do
let msg = encodeUtf8 $ pack $ "Publish iteration " ++ show i
void $ publish "foo" ("foo" <> msg)
-- …
liftIO $ threadDelay $ 2*1000*1000
loop (i+1)
handlerThread uses pubSubForever:
handlerThread :: Connection -> PubSubController -> IO ()
handlerThread conn ctrl = forever $
pubSubForever conn ctrl onInitialComplete
`catch` (\(e :: SomeException) -> do
hPutStrLn stderr $ "Got error: " ++ show e
threadDelay $ 50*1000)
This is wrapped in a call to forever to resubscribe if the connection is lost, per the docs for pubSubForever:
[…] if the network connection to Redis dies, pubSubForever will throw a ConnectionLost. When such an exception is thrown, you can recall pubSubForever with the same PubSubController which will open a new connection and resubscribe to all the channels which are tracked in the PubSubController.
This test uses Control.Concurrent.Async from the async package for managing tasks, which is a good idea imo. If you want to avoid that dependency, you could use forkIO instead (with e.g. a Chan or STM TChan to send events from the handler), the only issue is that this won’t automatically notify the other threads if the forked thread terminates due to an exception, whereas Async makes some nice exception safety guarantees.
