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

       -- ** 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,
       zrank,

       -- ** 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)
import Database.Redis.ByteStringClass

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 ()
shutdown = getRedis >>= liftIO . R.shutdown

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

exec :: (WithRedis m, BS s) => m (R.Reply s)
exec = getRedis >>= liftIO . R.exec

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

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

exists :: (WithRedis m, BS s) => s -> m (R.Reply Int)
exists key = getRedis >>= liftIO . flip R.exists key

del :: (WithRedis m, BS s) => s -> m (R.Reply Int)
del key = getRedis >>= liftIO . flip R.del key

getType :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2)
getType key = getRedis >>= liftIO . flip R.getType key

keys :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2)
keys pattern = getRedis >>= liftIO . flip R.keys pattern

randomKey :: (WithRedis m, BS s) => m (R.Reply s)
randomKey = getRedis >>= liftIO . R.randomKey

rename :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply ())
rename from to = do r <- getRedis
                    liftIO $ R.rename r from to

renameNx :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
renameNx from to = do r <- getRedis
                      liftIO $ R.renameNx r from to

dbsize :: WithRedis m => m (R.Reply Int)
dbsize = getRedis >>= liftIO . R.dbsize

expire :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int)
expire key seconds = do r <- getRedis
                        liftIO $ R.expire r key seconds

expireAt :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int)
expireAt key timestamp = do r <- getRedis
                            liftIO $ R.expireAt r key timestamp

ttl :: (WithRedis m, BS s) => s -> m (R.Reply Int)
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, BS s) => s -> Int -> m (R.Reply Int)
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, BS s) => m (R.Reply s)
info = getRedis >>= liftIO . R.info

set :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply ())
set key val = do r <- getRedis
                 liftIO $ R.set r key val

setNx :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
setNx key val = do r <- getRedis
                   liftIO $ R.setNx r key val

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

mSetNx :: (WithRedis m, BS s1, BS s2) => [(s1, s2)] -> m (R.Reply Int)
mSetNx ks = getRedis >>= liftIO . flip R.mSetNx ks

get :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2)
get key = getRedis >>= liftIO . flip R.get key

getSet :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> m (R.Reply s3)
getSet key val = do r <- getRedis
                    liftIO $ R.getSet r key val

mGet :: (WithRedis m, BS s1, BS s2) => [s1] -> m (R.Reply s2)
mGet keys = getRedis >>= liftIO . flip R.mGet keys

incr :: (WithRedis m, BS s) => s -> m (R.Reply Int)
incr key = getRedis >>= liftIO . flip R.incr key

incrBy :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int)
incrBy key n = do r <- getRedis
                  liftIO $ R.incrBy r key n

decr :: (WithRedis m, BS s) => s -> m (R.Reply Int)
decr key = getRedis >>= liftIO . flip R.decr key

decrBy :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int)
decrBy key n = do r <- getRedis
                  liftIO $ R.decrBy r key n

append :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
append key str = do r <- getRedis
                    liftIO $ R.append r key str

substr :: (WithRedis m, BS s1, BS s2) => s1 -> (Int, Int) -> m (R.Reply s2)
substr key range = do r <- getRedis
                      liftIO $ R.substr r key range

rpush :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
rpush key val = do r <- getRedis
                   liftIO $ R.rpush r key val

lpush :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
lpush key val = do r <- getRedis
                   liftIO $ R.lpush r key val

llen :: (WithRedis m, BS s) => s -> m (R.Reply Int)
llen key = getRedis >>= liftIO . flip R.llen key

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

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

lindex :: (WithRedis m, BS s1, BS s2) => s1 -> Int -> m (R.Reply s2)
lindex key index = do r <- getRedis
                      liftIO $ R.lindex r key index

lset :: (WithRedis m, BS s1, BS s2) => s1 -> Int -> s2 -> m (R.Reply ())
lset key index val = do r <- getRedis
                        liftIO $ R.lset r key index val

lrem :: (WithRedis m, BS s1, BS s2) => s1 -> Int -> s2 -> m (R.Reply Int)
lrem key count value = do r <- getRedis
                          liftIO $ R.lrem r key count value

lpop :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2)
lpop key = getRedis >>= liftIO . flip R.lpop key

rpop :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2)
rpop key = getRedis >>= liftIO . flip R.rpop key

rpoplpush :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> m (R.Reply s3)
rpoplpush src dst = do r <- getRedis
                       liftIO $ R.rpoplpush r src dst

blpop :: (WithRedis m, BS s1, BS s2) => [s1] -> Int -> m (R.Reply s2)
blpop keys timeout = do r <- getRedis
                        liftIO $ R.blpop r keys timeout

brpop :: (WithRedis m, BS s1, BS s2) => [s1] -> Int -> m (R.Reply s2)
brpop keys timeout = do r <- getRedis
                        liftIO $ R.brpop r keys timeout

sadd :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
sadd key val = do r <- getRedis
                  liftIO $ R.sadd r key val

srem :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
srem key val = do r <- getRedis
                  liftIO $ R.srem r key val

spop :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2)
spop key = getRedis >>= liftIO . flip R.spop key

smove :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> s3 -> m (R.Reply Int)
smove src dst member = do r <- getRedis
                          liftIO $ R.smove r src dst member

scard :: (WithRedis m, BS s) => s -> m (R.Reply Int)
scard key = getRedis >>= liftIO . flip R.scard key

sismember :: (WithRedis m, BS s) => s -> m (R.Reply Int)
sismember key = getRedis >>= liftIO . flip R.sismember key

smembers :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2)
smembers key = getRedis >>= liftIO . flip R.smembers key

srandmember :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2)
srandmember key = getRedis >>= liftIO . flip R.srandmember key

sinter :: (WithRedis m, BS s1, BS s2) => [s1] -> m (R.Reply s2)
sinter key = getRedis >>= liftIO . flip R.sinter key

sinterStore :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply ())
sinterStore dst keys = do r <- getRedis
                          liftIO $ R.sinterStore r dst keys

sunion :: (WithRedis m, BS s1, BS s2) => [s1] -> m (R.Reply s2)
sunion keys = getRedis >>= liftIO . flip R.sunion keys

sunionStore :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply ())
sunionStore dst keys = do r <- getRedis
                          liftIO $ R.sunionStore r dst keys

sdiff :: (WithRedis m, BS s1, BS s2) => [s1] -> m (R.Reply s2)
sdiff keys = getRedis >>= liftIO . flip R.sdiff keys

sdiffStore :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply ())
sdiffStore dst keys = do r <- getRedis
                         liftIO $ R.sdiffStore r dst keys

zadd :: (WithRedis m, BS s1, BS s2) => s1 -> Double -> s2 -> m (R.Reply Int)
zadd key score member = do r <- getRedis
                           liftIO $ R.zadd r key score member

zrem :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
zrem key member = do r <- getRedis
                     liftIO $ R.zrem r key member

zincrBy :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> Double -> s2 -> m (R.Reply s3)
zincrBy key score member = do r <- getRedis
                              liftIO $ R.zincrBy r key score member

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

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

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

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

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

zcard :: (WithRedis m, BS s) => s -> m (R.Reply Int)
zcard key = getRedis >>= liftIO . flip R.zcard key

zscore :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> m (R.Reply s3)
zscore key member = do r <- getRedis
                       liftIO $ R.zscore r key member

zrank :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)
zrank key member = do r <- getRedis
                      liftIO $ R.zrank r key member

sort :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> R.SortOptions s2 -> m (R.Reply s3)
sort key opt = do r <- getRedis
                  liftIO $ R.sort r key opt

listRelated :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> (Int, Int) -> m (R.Reply s3)
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 Int)
lastsave = getRedis >>= liftIO . R.lastsave

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