redis-0.2: Database/Redis/Monad.hs

{-
Copyright (c) 2010 Alexander Bogdanov <andorn@gmail.com>

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
-}

{-# LANGUAGE FlexibleContexts #-}

-- | Monadic wrapper for "Database.Redis.Redis"
module Database.Redis.Monad (
       -- * Types ans Constructors
       WithRedis(..),
       R.Redis(..),
       R.Reply(..),
       R.Interval(..),
       R.IsInterval(..),
       R.SortOptions(..),
       R.sortDefaults,

       R.fromRInline, R.fromRBulk, R.fromRMulti, R.fromRMultiBulk,
       R.fromRInt, R.fromROk, R.noError, R.takeAll,

       -- * Database connection
        R.localhost, R.defaultPort,
       connect, disconnect, isConnected,

       -- * Redis commands
       -- ** Generic
       ping, auth, quit, shutdown,
       multi, exec, discard, run_multi, exists,
       del, getType, keys, randomKey, rename,
       renameNx, dbsize, expire, expireAt,
       ttl, select, move, flushDb,
       flushAll, info,

       -- ** Strings
       set, setNx, mSet, mSetNx,
       get, getSet, mGet,
       incr, incrBy, decr,
       decrBy, append,

       -- ** Lists
       rpush, lpush, llen, lrange, ltrim,
       lindex, lset, lrem, lpop, rpop,
       rpoplpush, blpop, brpop,

       -- ** Sets
       sadd, srem, spop, smove, scard, sismember,
       smembers, srandmember, sinter, sinterStore,
       sunion, sunionStore, sdiff, sdiffStore,

       -- ** Sorted sets
       zadd, zrem, zincrBy, zrange,
       zrevrange, zrangebyscore, zcount,
       zremrangebyscore, zcard, zscore,

       -- ** Sorting
       sort, listRelated,

       -- ** Persistent control
       save, bgsave, lastsave, bgrewriteaof
)
where

import Control.Monad.Trans
import qualified Control.Monad.State as St
import Control.Monad.State (StateT(..))
import Control.Applicative

import qualified Database.Redis.Redis as R
import Database.Redis.Redis (IsInterval)

class MonadIO m => WithRedis m where
    getRedis :: m (R.Redis)
    setRedis :: R.Redis -> m ()

connect :: WithRedis m => String -> String -> m ()
connect host port = liftIO (R.connect host port) >>= setRedis

disconnect :: WithRedis m => m ()
disconnect = getRedis >>= liftIO . R.disconnect

isConnected :: WithRedis m => m Bool
isConnected = getRedis >>= liftIO . R.isConnected

ping :: WithRedis m => m R.Reply
ping = getRedis >>= liftIO . R.ping

auth :: WithRedis m => String -> m R.Reply
auth pwd = getRedis >>= liftIO . flip R.auth pwd

quit :: WithRedis m => m ()
quit = getRedis >>= liftIO . R.quit

shutdown :: WithRedis m => m R.Reply
shutdown = getRedis >>= liftIO . R.shutdown

multi :: WithRedis m => m R.Reply
multi = getRedis >>= liftIO . R.multi

exec :: WithRedis m => m R.Reply
exec = getRedis >>= liftIO . R.exec

discard :: WithRedis m => m R.Reply
discard = getRedis >>= liftIO . R.discard

run_multi :: WithRedis m => [m R.Reply] -> m R.Reply
run_multi cs = let cs' = map (>>= R.noError) cs
               in do multi
                     sequence_ cs'
                     exec

exists :: WithRedis m => String -> m R.Reply
exists key = getRedis >>= liftIO . flip R.exists key

del :: WithRedis m => String -> m R.Reply
del key = getRedis >>= liftIO . flip R.del key

getType :: WithRedis m => String -> m R.Reply
getType key = getRedis >>= liftIO . flip R.getType key

keys :: WithRedis m => String -> m R.Reply
keys pattern = getRedis >>= liftIO . flip R.keys pattern

randomKey :: WithRedis m => m R.Reply
randomKey = getRedis >>= liftIO . R.randomKey

rename :: WithRedis m => String -> String -> m R.Reply
rename from to = do r <- getRedis
                    liftIO $ R.rename r from to

renameNx :: WithRedis m => String -> String -> m R.Reply
renameNx from to = do r <- getRedis
                      liftIO $ R.renameNx r from to

dbsize :: WithRedis m => m R.Reply
dbsize = getRedis >>= liftIO . R.dbsize

expire :: WithRedis m => String -> Int -> m R.Reply
expire key seconds = do r <- getRedis
                        liftIO $ R.expire r key seconds

expireAt :: WithRedis m => String -> Int -> m R.Reply
expireAt key timestamp = do r <- getRedis
                            liftIO $ R.expireAt r key timestamp

ttl :: WithRedis m => String -> m R.Reply
ttl key = getRedis >>= liftIO . flip R.ttl key

select :: WithRedis m => Int -> m R.Reply
select db = getRedis >>= liftIO . flip R.select db

move :: WithRedis m => String -> Int -> m R.Reply
move key db = do r <- getRedis
                 liftIO $ R.move r key db

flushDb :: WithRedis m => m R.Reply
flushDb = getRedis >>= liftIO . R.flushDb

flushAll :: WithRedis m => m R.Reply
flushAll = getRedis >>= liftIO . R.flushAll

info :: WithRedis m => m R.Reply
info = getRedis >>= liftIO . R.info

set :: WithRedis m => String -> String -> m R.Reply
set key val = do r <- getRedis
                 liftIO $ R.set r key val

setNx :: WithRedis m => String -> String -> m R.Reply
setNx key val = do r <- getRedis
                   liftIO $ R.setNx r key val

mSet :: WithRedis m => [(String, String)] -> m R.Reply
mSet ks = getRedis >>= liftIO . flip R.mSet ks

mSetNx :: WithRedis m => [(String, String)] -> m R.Reply
mSetNx ks = getRedis >>= liftIO . flip R.mSetNx ks

get :: WithRedis m => String -> m R.Reply
get key = getRedis >>= liftIO . flip R.get key

getSet :: WithRedis m => String -> String -> m R.Reply
getSet key val = do r <- getRedis
                    liftIO $ R.getSet r key val

mGet :: WithRedis m => [String] -> m R.Reply
mGet keys = getRedis >>= liftIO . flip R.mGet keys

incr :: WithRedis m => String -> m R.Reply
incr key = getRedis >>= liftIO . flip R.incr key

incrBy :: WithRedis m => String -> Int -> m R.Reply
incrBy key n = do r <- getRedis
                  liftIO $ R.incrBy r key n

decr :: WithRedis m => String -> m R.Reply
decr key = getRedis >>= liftIO . flip R.decr key

decrBy :: WithRedis m => String -> Int -> m R.Reply
decrBy key n = do r <- getRedis
                  liftIO $ R.decrBy r key n

append :: WithRedis m => String -> String -> m R.Reply
append key str = do r <- getRedis
                    liftIO $ R.append r key str

rpush :: WithRedis m => String -> String -> m R.Reply
rpush key val = do r <- getRedis
                   liftIO $ R.rpush r key val

lpush :: WithRedis m => String -> String -> m R.Reply
lpush key val = do r <- getRedis
                   liftIO $ R.lpush r key val

llen :: WithRedis m => String -> m R.Reply
llen key = getRedis >>= liftIO . flip R.llen key

lrange :: WithRedis m => String -> (Int, Int) -> m R.Reply
lrange key limit = do r <- getRedis
                      liftIO $ R.lrange r key limit

ltrim :: WithRedis m => String -> (Int, Int) -> m R.Reply
ltrim key limit = do r <- getRedis
                     liftIO $ R.ltrim r key limit

lindex :: WithRedis m => String -> Int -> m R.Reply
lindex key index = do r <- getRedis
                      liftIO $ R.lindex r key index

lset :: WithRedis m => String -> Int -> String -> m R.Reply
lset key index val = do r <- getRedis
                        liftIO $ R.lset r key index val

lrem :: WithRedis m => String -> Int -> String -> m R.Reply
lrem key count value = do r <- getRedis
                          liftIO $ R.lrem r key count value

lpop :: WithRedis m => String -> m R.Reply
lpop key = getRedis >>= liftIO . flip R.lpop key

rpop :: WithRedis m => String -> m R.Reply
rpop key = getRedis >>= liftIO . flip R.rpop key

rpoplpush :: WithRedis m => String -> String -> m R.Reply
rpoplpush src dst = do r <- getRedis
                       liftIO $ R.rpoplpush r src dst

blpop :: WithRedis m => [String] -> Int -> m R.Reply
blpop keys timeout = do r <- getRedis
                        liftIO $ R.blpop r keys timeout

brpop :: WithRedis m => [String] -> Int -> m R.Reply
brpop keys timeout = do r <- getRedis
                        liftIO $ R.brpop r keys timeout

sadd :: WithRedis m => String -> String -> m R.Reply
sadd key val = do r <- getRedis
                  liftIO $ R.sadd r key val

srem :: WithRedis m => String -> String -> m R.Reply
srem key val = do r <- getRedis
                  liftIO $ R.srem r key val

spop :: WithRedis m => String -> m R.Reply
spop key = getRedis >>= liftIO . flip R.spop key

smove :: WithRedis m => String -> String -> String -> m R.Reply
smove src dst member = do r <- getRedis
                          liftIO $ R.smove r src dst member

scard :: WithRedis m => String -> m R.Reply
scard key = getRedis >>= liftIO . flip R.scard key

sismember :: WithRedis m => String -> m R.Reply
sismember key = getRedis >>= liftIO . flip R.sismember key

smembers :: WithRedis m => String -> m R.Reply
smembers key = getRedis >>= liftIO . flip R.smembers key

srandmember :: WithRedis m => String -> m R.Reply
srandmember key = getRedis >>= liftIO . flip R.srandmember key

sinter :: WithRedis m => [String] -> m R.Reply
sinter key = getRedis >>= liftIO . flip R.sinter key

sinterStore :: WithRedis m => String -> [String] -> m R.Reply
sinterStore dst keys = do r <- getRedis
                          liftIO $ R.sinterStore r dst keys

sunion :: WithRedis m => [String] -> m R.Reply
sunion keys = getRedis >>= liftIO . flip R.sunion keys

sunionStore :: WithRedis m => String -> [String] -> m R.Reply
sunionStore dst keys = do r <- getRedis
                          liftIO $ R.sunionStore r dst keys

sdiff :: WithRedis m => [String] -> m R.Reply
sdiff keys = getRedis >>= liftIO . flip R.sdiff keys

sdiffStore :: WithRedis m => String -> [String] -> m R.Reply
sdiffStore dst keys = do r <- getRedis
                         liftIO $ R.sdiffStore r dst keys

zadd :: WithRedis m => String -> Double -> String -> m R.Reply
zadd key score member = do r <- getRedis
                           liftIO $ R.zadd r key score member

zrem :: WithRedis m => String -> String -> m R.Reply
zrem key member = do r <- getRedis
                     liftIO $ R.zrem r key member

zincrBy :: WithRedis m => String -> Double -> String -> m R.Reply
zincrBy key score member = do r <- getRedis
                              liftIO $ R.zincrBy r key score member

zrange :: WithRedis m => String -> (Int, Int) -> Bool -> m R.Reply
zrange key limit withscores = do r <- getRedis
                                 liftIO $ R.zrange r key limit withscores

zrevrange :: WithRedis m => String -> (Int, Int) -> Bool -> m R.Reply
zrevrange key limit withscores = do r <- getRedis
                                    liftIO $ R.zrevrange r key limit withscores

zrangebyscore :: (WithRedis m, IsInterval i Double) => String -> i -> Bool -> m R.Reply
zrangebyscore key limit withscores = do r <- getRedis
                                        liftIO $ R.zrangebyscore r key limit withscores

zcount :: (WithRedis m, IsInterval i Double) => String -> i -> m R.Reply
zcount key limit = do r <- getRedis
                      liftIO $ R.zcount r key limit

zremrangebyscore :: WithRedis m => String -> (Double, Double) -> m R.Reply
zremrangebyscore key limit = do r <- getRedis
                                liftIO $ R.zremrangebyscore r key limit

zcard :: WithRedis m => String -> m R.Reply
zcard key = getRedis >>= liftIO . flip R.zcard key

zscore :: WithRedis m => String -> String -> m R.Reply
zscore key member = do r <- getRedis
                       liftIO $ R.zscore r key member

sort :: WithRedis m => String -> R.SortOptions -> m R.Reply
sort key opt = do r <- getRedis
                  liftIO $ R.sort r key opt

listRelated :: WithRedis m => String -> String -> (Int, Int) -> m R.Reply
listRelated related key l = do r <- getRedis
                               liftIO $ R.listRelated r related key l

save :: WithRedis m => m R.Reply
save = getRedis >>= liftIO . R.save

bgsave :: WithRedis m => m R.Reply
bgsave = getRedis >>= liftIO . R.bgsave

lastsave :: WithRedis m => m R.Reply
lastsave = getRedis >>= liftIO . R.lastsave

bgrewriteaof :: WithRedis m => m R.Reply
bgrewriteaof = getRedis >>= liftIO . R.bgrewriteaof