{-# 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, 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

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