redis 0.5 → 0.5.1
raw patch · 4 files changed
+92/−23 lines, 4 files
Files
- Database/Redis/Internal.hs +2/−0
- Database/Redis/Monad.hs +15/−1
- Database/Redis/Redis.hs +71/−20
- redis.cabal +4/−2
Database/Redis/Internal.hs view
@@ -70,6 +70,8 @@ data (BS s) => Message s = MSubscribe s Int | MUnsubscribe s Int+ | MPSubscribe s Int+ | MPUnsubscribe s Int | MMessage s s deriving Show
Database/Redis/Monad.hs view
@@ -41,6 +41,7 @@ -- * Database connection R.localhost, R.defaultPort, connect, disconnect, isConnected,+ getServer, getDatabase, -- * Redis commands -- ** Generic@@ -84,7 +85,8 @@ -- ** Publish/Subscribe subscribed, subscribe, unsubscribe,- publish, listen,+ psubscribe, punsubscribe, publish,+ listen, -- ** Persistent control save, bgsave, lastsave, bgrewriteaof@@ -115,6 +117,12 @@ isConnected :: WithRedis m => m Bool isConnected = getRedis >>= liftIO . R.isConnected +getServer :: WithRedis m => m (String, String)+getServer = getRedis >>= liftIO . R.getServer++getDatabase :: WithRedis m => m Int+getDatabase = getRedis >>= liftIO . R.getDatabase+ ping :: WithRedis m => m (R.Reply ()) ping = getRedis >>= liftIO . R.ping @@ -461,6 +469,12 @@ unsubscribe :: (WithRedis m, BS s1, BS s2) => [s1] -> m [R.Message s2] unsubscribe classes = getRedis >>= liftIO . flip R.unsubscribe classes++psubscribe :: (WithRedis m, BS s1, BS s2) => [s1] -> m [R.Message s2]+psubscribe classes = getRedis >>= liftIO . flip R.psubscribe classes++punsubscribe :: (WithRedis m, BS s1, BS s2) => [s1] -> m [R.Message s2]+punsubscribe classes = getRedis >>= liftIO . flip R.punsubscribe classes publish :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) publish klass msg = do r <- getRedis
Database/Redis/Redis.hs view
@@ -40,6 +40,7 @@ -- * Database connection localhost, defaultPort, connect, disconnect, isConnected,+ getServer, getDatabase, -- * Redis commands -- ** Generic@@ -83,7 +84,8 @@ -- ** Publish/Subscribe subscribed, subscribe, unsubscribe,- publish, listen,+ psubscribe, punsubscribe, publish,+ listen, -- ** Persistent control save, bgsave, lastsave, bgrewriteaof@@ -184,9 +186,11 @@ mtype <- fromRBulk $ head rm' when (isNothing mtype) $ error $ "error parsing message: " ++ (show reply) return $ case fromJust mtype of- "subscribe" -> mksub MSubscribe $ tail rm'- "unsubscribe" -> mksub MUnsubscribe $ tail rm'- "message" -> mkmsg $ tail rm'+ "subscribe" -> mksub MSubscribe $ tail rm'+ "unsubscribe" -> mksub MUnsubscribe $ tail rm'+ "psubscribe" -> mksub MPSubscribe $ tail rm'+ "punsubscribe" -> mksub MPUnsubscribe $ tail rm'+ "message" -> mkmsg $ tail rm' where mksub f [RBulk (Just k), RInt n] = f (fromBS k) n mkmsg [RBulk (Just k), RBulk (Just msg)] = MMessage (fromBS k) (fromBS msg)@@ -216,6 +220,14 @@ isConnected :: Redis -> IO Bool isConnected = withState' (IO.hIsOpen . handle) +-- | Returns connection host and port+getServer :: Redis -> IO (String, String)+getServer = withState' (return . server)++-- | Returns currently selected database+getDatabase :: Redis -> IO Int+getDatabase = withState' (return . database)+ {- ============ Just commands ============= -} -- | ping - pong --@@ -1291,51 +1303,90 @@ subscribed :: Redis -> IO Int subscribed r = withState r $ \rs -> return $ isSubscribed rs +recv_ rs ls 0 = return ls+recv_ rs ls n = do l <- recv rs+ ll <- recv_ rs ls (n - 1)+ return $ l:ll+ -- | Subscribe to channels -- -- list of Message with subscribtion information returned subscribe :: (BS s1, BS s2) => Redis- -> [s1]+ -> [s1] -- ^ channels to subscribe -> IO [Message s2] subscribe r classes = inState r $ \rs -> do sendCommand rs (CMBulk ("SUBSCRIBE" : map toBS classes)) res <- recv_ rs [] (length classes) >>= mapM parseMessage- let MSubscribe _ n = last res+ let !(MSubscribe _ n) = last res return (rs {isSubscribed = n}, res)- where recv_ rs ls 0 = return ls- recv_ rs ls n = do l <- recv rs- ll <- recv_ rs ls (n - 1)- return $ l:ll --- | Unsubscribe from channels+-- | Unsubscribe from channels. If called with an empty list then+-- unsubscribe all channels -- -- list of Message with subscribtion information returned unsubscribe :: (BS s1, BS s2) => Redis- -> [s1]+ -> [s1] -- ^ channels to unsubscribe -> IO [Message s2]+unsubscribe r [] = inState r $ \rs -> let subs = isSubscribed rs+ in if subs == 0+ then return (rs, [])+ else do sendCommand rs (CInline "UNSUBSCRIBE")+ res <- recv_ rs [] subs >>= mapM parseMessage+ let !(MUnsubscribe _ n) = last res+ return (rs {isSubscribed = n}, res)+ unsubscribe r classes = inState r $ \rs -> do sendCommand rs (CMBulk ("UNSUBSCRIBE" : map toBS classes)) res <- recv_ rs [] (length classes) >>= mapM parseMessage let !(MUnsubscribe _ n) = last res return (rs {isSubscribed = n}, res)- where recv_ rs ls 0 = return ls- recv_ rs ls n = do l <- recv rs- ll <- recv_ rs ls (n - 1)- return $ l:ll +-- | Subscribe to patterns+--+-- list of Message with subscribtion information returned+psubscribe :: (BS s1, BS s2) =>+ Redis+ -> [s1] -- ^ patterns to subscribe+ -> IO [Message s2]+psubscribe r patterns = inState r $ \rs -> do sendCommand rs (CMBulk ("PSUBSCRIBE" : map toBS patterns))+ res <- recv_ rs [] (length patterns) >>= mapM parseMessage+ let !(MPSubscribe _ n) = last res+ return (rs {isSubscribed = n}, res)++-- | Unsubscribe from patterns. If called with an empty list then+-- unsubscribe all patterns+--+-- list of Message with subscribtion information returned+punsubscribe :: (BS s1, BS s2) =>+ Redis+ -> [s1] -- ^ patterns to unsubscribe+ -> IO [Message s2]+punsubscribe r [] = inState r $ \rs -> let subs = isSubscribed rs+ in if subs == 0+ then return (rs, [])+ else do sendCommand rs (CInline "PUNSUBSCRIBE")+ res <- recv_ rs [] subs >>= mapM parseMessage+ let !(MPUnsubscribe _ n) = last res+ return (rs {isSubscribed = n}, res)++punsubscribe r patterns = inState r $ \rs -> do sendCommand rs (CMBulk ("PUNSUBSCRIBE" : map toBS patterns))+ res <- recv_ rs [] (length patterns) >>= mapM parseMessage+ let !(MPUnsubscribe _ n) = last res+ return (rs {isSubscribed = n}, res)+ -- | Publish message to target channel ----- RInt returned - a number of clients+-- RInt returned - a number of clients that recieves the message publish :: (BS s1, BS s2) => Redis- -> s1- -> s2+ -> s1 -- ^ channel+ -> s2 -- ^ message -> IO (Reply Int) publish r klass msg = withState r $ \rs -> sendCommand rs (CMBulk ["PUBLISH", toBS klass, toBS msg]) >> recv rs -- | Wait for a messages. ----- Important! Client will be blocken untill some message recieved!+-- Important! Client will be blocked untill some message recieved! -- -- Message returned listen :: BS s =>
redis.cabal view
@@ -1,5 +1,5 @@ Name: redis-Version: 0.5+Version: 0.5.1 License: MIT Maintainer: Alexander Bogdanov <andorn@gmail.com> Author: Alexander Bogdanov <andorn@gmail.com>@@ -20,7 +20,9 @@ . - new hash commands added: hmset, hmget, hincrby .- - initial support for subscribe\/unsubscribe\/publish+ - initial support for (p)subscribe\/(p)unsubscribe\/publish+ .+ - getServer and getDatabase accessors added Stability: beta Build-Type: Simple