module Database.Redis.Redis (
Redis(..),
Reply(..),
Interval(..),
IsInterval(..),
SortOptions(..),
sortDefaults,
fromRInline, fromRBulk, fromRMulti, fromRMultiBulk,
fromRInt, fromROk, noError, takeAll,
localhost, defaultPort,
connect, disconnect, isConnected,
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,
set, setNx, mSet, mSetNx,
get, getSet, mGet,
incr, incrBy, decr,
decrBy, append, substr,
rpush, lpush, llen, lrange, ltrim,
lindex, lset, lrem, lpop, rpop,
rpoplpush, blpop, brpop,
sadd, srem, spop, smove, scard, sismember,
smembers, srandmember, sinter, sinterStore,
sunion, sunionStore, sdiff, sdiffStore,
zadd, zrem, zincrBy, zrange,
zrevrange, zrangebyscore, zcount,
zremrangebyscore, zcard, zscore,
zrank,
sort, listRelated,
save, bgsave, lastsave, bgrewriteaof
)
where
import Prelude hiding (putStrLn)
import qualified Network.Socket as S
import qualified System.IO as IO
import System.IO.UTF8 (putStrLn)
import qualified Data.ByteString as B
import Data.ByteString (ByteString)
import Data.ByteString.Char8 ()
import qualified Data.ByteString.UTF8 as U
import Data.Maybe (fromJust)
import Data.List (intersperse)
import Database.Redis.ByteStringClass
tracebs bs = putStrLn (U.toString bs)
data Redis = Redis { server :: (String, String),
handle :: IO.Handle
}
deriving (Show, Eq)
data Command = CInline ByteString
| CMInline [ByteString]
| CBulk [ByteString] ByteString
| CMBulk [ByteString]
data BS s => Reply s = RTimeout
| ROk
| RPong
| RQueued
| RError String
| RInline s
| RInt Int
| RBulk (Maybe s)
| RMulti (Maybe [Reply s])
deriving Eq
showbs :: BS s => s -> String
showbs = U.toString . toBS
instance BS s => Show (Reply s) where
show RTimeout = "RTimeout"
show ROk = "ROk"
show RPong = "RPong"
show RQueued = "RQueued"
show (RError msg) = "RError: " ++ msg
show (RInline s) = "RInline (" ++ (showbs s) ++ ")"
show (RInt a) = "RInt " ++ show a
show (RBulk (Just s)) = "RBulk " ++ showbs s
show (RBulk Nothing) = "RBulk Nothing"
show (RMulti (Just rs)) = "RMulti [" ++ join rs ++ "]"
where join = concat . intersperse ", " . map show
show (RMulti Nothing) = "[]"
fromRInline :: (Monad m, BS s) => Reply s -> m s
fromRInline reply = case reply of
RError msg -> error msg
RInline s -> return s
_ -> error $ "wrong reply, RInline expected: " ++ (show reply)
fromRBulk :: (Monad m, BS s) => Reply s -> m (Maybe s)
fromRBulk reply = case reply of
RError msg -> error msg
RBulk s -> return s
_ -> error $ "wrong reply, RBulk expected: " ++ (show reply)
fromRMulti :: (Monad m, BS s) => Reply s -> m (Maybe [Reply s])
fromRMulti reply = case reply of
RError msg -> error msg
RMulti ss -> return ss
_ -> error $ "wrong reply, RMulti expected: " ++ (show reply)
fromRMultiBulk :: (Monad m, BS s) => Reply s -> m (Maybe [Maybe s])
fromRMultiBulk reply = fromRMulti reply >>= return . (>>= sequence . map fromRBulk)
fromRInt :: (Monad m, BS s) => Reply s -> m Int
fromRInt reply = case reply of
RError msg -> error msg
RInt n -> return n
_ -> error $ "wrong reply, RInt expected: " ++ (show reply)
fromROk :: (Monad m, BS s) => Reply s -> m ()
fromROk reply = case reply of
RError msg -> error msg
ROk -> return ()
_ -> error $ "wrong reply, ROk expected: " ++ (show reply)
noError :: (Monad m, BS s) => Reply s -> m ()
noError reply = case reply of
RError msg -> error msg
_ -> return ()
urn = U.fromString "\r\n"
uspace = U.fromString " "
uminus = U.fromString "-"
uplus = U.fromString "+"
ucolon = U.fromString ":"
ubucks = U.fromString "$"
uasterisk = U.fromString "*"
hPutRn h = B.hPut h urn
defaultPort :: String
defaultPort = "6379"
localhost :: String
localhost = "localhost"
takeAll :: (Int, Int)
takeAll = (0, 1)
connect :: String -> String -> IO Redis
connect hostname port =
do serveraddr <- head `fmap` S.getAddrInfo Nothing (Just hostname) (Just port)
s <- S.socket (S.addrFamily serveraddr) S.Stream S.defaultProtocol
S.setSocketOption s S.KeepAlive 1
S.connect s (S.addrAddress serveraddr)
h <- S.socketToHandle s IO.ReadWriteMode
IO.hSetBuffering h (IO.BlockBuffering Nothing)
return $ Redis (hostname, port) h
disconnect :: Redis -> IO ()
disconnect = IO.hClose . handle
isConnected :: Redis -> IO Bool
isConnected = IO.hIsOpen . handle
send :: IO.Handle -> [ByteString] -> IO ()
send h [] = return ()
send h (bs:ls) = B.hPut h bs >> B.hPut h uspace >> send h ls
sendCommand :: Redis -> Command -> IO ()
sendCommand r (CInline bs) = let h = handle r
in B.hPut h bs >> hPutRn h >> IO.hFlush h
sendCommand r (CMInline ls) = let h = handle r
in send h ls >> hPutRn h >> IO.hFlush h
sendCommand r (CBulk lcmd bs) = let h = handle r
size = U.fromString $ show $ B.length bs
in do send h lcmd
B.hPut h uspace
B.hPut h size
hPutRn h
B.hPut h bs
hPutRn h
IO.hFlush h
sendCommand r (CMBulk strings) = let h = handle r
sendls [] = return ()
sendls (bs:ls) = let size = U.fromString . show . B.length
in do B.hPut h ubucks
B.hPut h $ size bs
hPutRn h
B.hPut h bs
hPutRn h
sendls ls
in do B.hPut h uasterisk
B.hPut h $ U.fromString $ show $ length strings
hPutRn h
sendls strings
IO.hFlush h
recv :: BS s => Redis -> IO (Reply s)
recv r = do first <- trim `fmap` B.hGetLine h
case U.uncons first of
Just ('-', rest) -> recv_err rest
Just ('+', rest) -> recv_inline rest
Just (':', rest) -> recv_int rest
Just ('$', rest) -> recv_bulk rest
Just ('*', rest) -> recv_multi rest
where
h = handle r
trim = B.takeWhile (\c -> c /= 13 && c /= 10)
recv_err rest = return $ RError $ U.toString rest
recv_inline rest = return $ case rest of
"OK" -> ROk
"PONG" -> RPong
"QUEUED" -> RQueued
_ -> RInline $ fromBS rest
recv_int rest = let reply = read (U.toString rest) :: Int
in return $ RInt reply
recv_bulk rest = let size = read (U.toString rest) :: Int
in do body <- recv_bulk_body size
return $ RBulk (fromBS `fmap` body)
recv_bulk_body (1) = return Nothing
recv_bulk_body size = do body <- B.hGet h (size + 2)
let reply = B.take size body
return $ Just reply
recv_multi rest = let cnt = read (U.toString rest) :: Int
in do bulks <- recv_multi_n cnt
return $ RMulti bulks
recv_multi_n (1) = return Nothing
recv_multi_n 0 = return $ Just []
recv_multi_n n = do this <- recv r
tail <- fromJust `fmap` recv_multi_n (n1)
return $ Just (this : tail)
ping :: Redis -> IO (Reply ())
ping r = sendCommand r (CInline "PING") >> recv r
auth :: BS s =>
Redis
-> s
-> IO (Reply ())
auth r pwd = sendCommand r (CMInline ["AUTH", toBS pwd] ) >> recv r
quit :: Redis -> IO ()
quit r = sendCommand r (CInline "QUIT") >> disconnect r
shutdown :: Redis -> IO ()
shutdown r = sendCommand r (CInline "SHUTDOWN") >> disconnect r
multi :: Redis -> IO (Reply ())
multi r = sendCommand r (CInline "MULTI") >> recv r
exec :: BS s => Redis -> IO (Reply s)
exec r = sendCommand r (CInline "EXEC") >> recv r
discard :: Redis -> IO (Reply ())
discard r = sendCommand r (CInline "DISCARD") >> recv r
run_multi :: (BS s) =>
Redis
-> [IO (Reply ())]
-> IO (Reply s)
run_multi r cs = let cs' = map (>>= noError) cs
in do multi r
sequence_ cs'
exec r
exists :: BS s =>
Redis
-> s
-> IO (Reply Int)
exists r key = sendCommand r (CMBulk ["EXISTS", toBS key]) >> recv r
del :: BS s =>
Redis
-> s
-> IO (Reply Int)
del r key = sendCommand r (CMBulk ["DEL", toBS key]) >> recv r
getType :: (BS s1, BS s2) =>
Redis
-> s1
-> IO (Reply s2)
getType r key = sendCommand r (CMBulk ["TYPE", toBS key]) >> recv r
keys :: (BS s1, BS s2) =>
Redis
-> s1
-> IO (Reply s2)
keys r pattern = sendCommand r (CMInline ["KEYS", toBS pattern]) >> recv r
randomKey :: BS s => Redis -> IO (Reply s)
randomKey r = sendCommand r (CInline "RANDOMKEY") >> recv r
rename :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply ())
rename r from to = sendCommand r (CMBulk ["RENAME", toBS from, toBS to]) >> recv r
renameNx :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
renameNx r from to = sendCommand r (CMBulk ["RENAMENX", toBS from, toBS to]) >> recv r
dbsize :: Redis -> IO (Reply Int)
dbsize r = sendCommand r (CInline "DBSIZE") >> recv r
expire :: BS s =>
Redis
-> s
-> Int
-> IO (Reply Int)
expire r key seconds = sendCommand r (CMBulk ["EXPIRE", toBS key, toBS seconds]) >> recv r
expireAt :: BS s =>
Redis
-> s
-> Int
-> IO (Reply Int)
expireAt r key timestamp = sendCommand r (CMBulk ["EXPIRE", toBS key, toBS timestamp]) >> recv r
ttl :: BS s =>
Redis
-> s
-> IO (Reply Int)
ttl r key = sendCommand r (CMBulk ["TTL", toBS key]) >> recv r
select :: Redis
-> Int
-> IO (Reply ())
select r db = sendCommand r (CMInline ["SELECT", toBS db]) >> recv r
move :: BS s =>
Redis
-> s
-> Int
-> IO (Reply Int)
move r key db = sendCommand r (CMBulk ["MOVE", toBS key, toBS db]) >> recv r
flushDb :: Redis -> IO (Reply ())
flushDb r = sendCommand r (CInline "FLUSHDB") >> recv r
flushAll :: Redis -> IO (Reply ())
flushAll r = sendCommand r (CInline "FLUSHALL") >> recv r
info :: BS s => Redis -> IO (Reply s)
info r = sendCommand r (CInline "INFO") >> recv r
set :: (BS s1, BS s2) => Redis
-> s1
-> s2
-> IO (Reply ())
set r key val = sendCommand r (CMBulk ["SET", toBS key, toBS val]) >> recv r
setNx :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
setNx r key val = sendCommand r (CMBulk ["SETNX", toBS key, toBS val]) >> recv r
mSet :: (BS s1, BS s2) =>
Redis
-> [(s1, s2)]
-> IO (Reply ())
mSet r ks = let interlace' [] ls = ls
interlace' ((a, b):rest) ls = interlace' rest (toBS a : toBS b : ls)
interlace ls = interlace' ls []
in sendCommand r (CMBulk ("MSET" : interlace ks)) >> recv r
mSetNx :: (BS s1, BS s2) =>
Redis
-> [(s1, s2)]
-> IO (Reply Int)
mSetNx r ks = let interlace' [] ls = ls
interlace' ((a, b):rest) ls = interlace' rest (toBS a : toBS b : ls)
interlace ls = interlace' ls []
in sendCommand r (CMBulk ("MSETNX" : interlace ks)) >> recv r
get :: (BS s1, BS s2) =>
Redis
-> s1
-> IO (Reply s2)
get r key = sendCommand r (CMBulk ["GET", toBS key]) >> recv r
getSet :: (BS s1, BS s2, BS s3) =>
Redis
-> s1
-> s2
-> IO (Reply s3)
getSet r key val = sendCommand r (CMBulk ["GETSET", toBS key, toBS val]) >> recv r
mGet :: (BS s1, BS s2) =>
Redis
-> [s1]
-> IO (Reply s2)
mGet r keys = sendCommand r (CMBulk ("MGET" : map toBS keys)) >> recv r
incr :: BS s =>
Redis
-> s
-> IO (Reply Int)
incr r key = sendCommand r (CMBulk ["INCR", toBS key]) >> recv r
incrBy :: BS s =>
Redis
-> s
-> Int
-> IO (Reply Int)
incrBy r key n = sendCommand r (CMBulk ["INCRBY", toBS key, toBS n]) >> recv r
decr :: BS s =>
Redis
-> s
-> IO (Reply Int)
decr r key = sendCommand r (CMBulk ["DECR", toBS key]) >> recv r
decrBy :: BS s =>
Redis
-> s
-> Int
-> IO (Reply Int)
decrBy r key n = sendCommand r (CMBulk ["DECRBY", toBS key, toBS n]) >> recv r
append :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
append r key str = sendCommand r (CMBulk ["APPEND", toBS key, toBS str]) >> recv r
substr :: (BS s1, BS s2) =>
Redis
-> s1
-> (Int, Int)
-> IO (Reply s2)
substr r key (from, to) = sendCommand r (CMBulk ["SUBSTR", toBS key, toBS from, toBS to]) >> recv r
rpush :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
rpush r key val = sendCommand r (CMBulk ["RPUSH", toBS key, toBS val]) >> recv r
lpush :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
lpush r key val = sendCommand r (CMBulk ["LPUSH", toBS key, toBS val]) >> recv r
llen :: BS s =>
Redis
-> s
-> IO (Reply Int)
llen r key = sendCommand r (CMBulk ["LLEN", toBS key]) >> recv r
lrange :: (BS s1, BS s2) =>
Redis
-> s1
-> (Int, Int)
-> IO (Reply s2)
lrange r key (from, to) = sendCommand r (CMBulk ["LRANGE", toBS key, toBS from, toBS to]) >> recv r
ltrim :: BS s =>
Redis
-> s
-> (Int, Int)
-> IO (Reply ())
ltrim r key (from, to) = sendCommand r (CMBulk ["LTRIM", toBS key, toBS from, toBS to]) >> recv r
lindex :: (BS s1, BS s2) =>
Redis
-> s1
-> Int
-> IO (Reply s2)
lindex r key index = sendCommand r (CMBulk ["LINDEX", toBS key, toBS index]) >> recv r
lset :: (BS s1, BS s2) =>
Redis
-> s1
-> Int
-> s2
-> IO (Reply ())
lset r key index val = sendCommand r (CMBulk ["LSET", toBS key, toBS index, toBS val]) >> recv r
lrem :: (BS s1, BS s2) =>
Redis
-> s1
-> Int
-> s2
-> IO (Reply Int)
lrem r key count value = sendCommand r (CMBulk ["LREM", toBS key, toBS count, toBS value]) >> recv r
lpop :: (BS s1, BS s2) =>
Redis
-> s1
-> IO (Reply s2)
lpop r key = sendCommand r (CMBulk ["LPOP", toBS key]) >> recv r
rpop :: (BS s1, BS s2) =>
Redis
-> s1
-> IO (Reply s2)
rpop r key = sendCommand r (CMBulk ["RPOP", toBS key]) >> recv r
rpoplpush :: (BS s1, BS s2, BS s3) =>
Redis
-> s1
-> s2
-> IO (Reply s3)
rpoplpush r src dst = sendCommand r (CMBulk ["RPOPLPUSH", toBS src, toBS dst]) >> recv r
blpop :: (BS s1, BS s2) =>
Redis
-> [s1]
-> Int
-> IO (Reply s2)
blpop r keys timeout = sendCommand r (CMBulk (("BLPOP" : map toBS keys) ++ [toBS timeout])) >> recv r
brpop :: (BS s1, BS s2) =>
Redis
-> [s1]
-> Int
-> IO (Reply s2)
brpop r keys timeout = sendCommand r (CMBulk (("BRPOP" : map toBS keys) ++ [toBS timeout])) >> recv r
sadd :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
sadd r key val = sendCommand r (CMBulk ["SADD", toBS key, toBS val]) >> recv r
srem :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
srem r key val = sendCommand r (CMBulk ["SREM", toBS key, toBS val]) >> recv r
spop :: (BS s1, BS s2) =>
Redis
-> s1
-> IO (Reply s2)
spop r key = sendCommand r (CMBulk ["SPOP", toBS key]) >> recv r
smove :: (BS s1, BS s2, BS s3) =>
Redis
-> s1
-> s2
-> s3
-> IO (Reply Int)
smove r src dst member = sendCommand r (CMBulk ["SMOVE", toBS src, toBS dst, toBS member]) >> recv r
scard :: BS s =>
Redis
-> s
-> IO (Reply Int)
scard r key = sendCommand r (CMBulk ["SCARD", toBS key]) >> recv r
sismember :: BS s =>
Redis
-> s
-> IO (Reply Int)
sismember r key = sendCommand r (CMBulk ["SISMEMBER", toBS key]) >> recv r
smembers :: (BS s1, BS s2) =>
Redis
-> s1
-> IO (Reply s2)
smembers r key = sendCommand r (CMBulk ["SMEMBERS", toBS key]) >> recv r
srandmember :: (BS s1, BS s2) =>
Redis
-> s1
-> IO (Reply s2)
srandmember r key = sendCommand r (CMBulk ["SRANDMEMBER", toBS key]) >> recv r
sinter :: (BS s1, BS s2) =>
Redis
-> [s1]
-> IO (Reply s2)
sinter r keys = sendCommand r (CMBulk ("SINTER" : map toBS keys)) >> recv r
sinterStore :: (BS s1, BS s2) =>
Redis
-> s1
-> [s2]
-> IO (Reply ())
sinterStore r dst keys = sendCommand r (CMBulk ("SINTERSTORE" : toBS dst : map toBS keys)) >> recv r
sunion :: (BS s1, BS s2) =>
Redis
-> [s1]
-> IO (Reply s2)
sunion r keys = sendCommand r (CMBulk ("SUNION" : map toBS keys)) >> recv r
sunionStore :: (BS s1, BS s2) =>
Redis
-> s1
-> [s2]
-> IO (Reply ())
sunionStore r dst keys = sendCommand r (CMBulk ("SUNIONSTORE" : toBS dst : map toBS keys)) >> recv r
sdiff :: (BS s1, BS s2) =>
Redis
-> [s1]
-> IO (Reply s2)
sdiff r keys = sendCommand r (CMBulk ("SDIFF" : map toBS keys)) >> recv r
sdiffStore :: (BS s1, BS s2) =>
Redis
-> s1
-> [s2]
-> IO (Reply ())
sdiffStore r dst keys = sendCommand r (CMBulk ("SDIFFSTORE" : toBS dst : map toBS keys)) >> recv r
zadd :: (BS s1, BS s2) =>
Redis
-> s1
-> Double
-> s2
-> IO (Reply Int)
zadd r key score member = sendCommand r (CMBulk ["ZADD", toBS key, toBS score, toBS member]) >> recv r
zrem :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
zrem r key member = sendCommand r (CMBulk ["ZREM", toBS key, toBS member]) >> recv r
zincrBy :: (BS s1, BS s2, BS s3) =>
Redis
-> s1
-> Double
-> s2
-> IO (Reply s3)
zincrBy r key increment member = sendCommand r (CMBulk ["ZINCRBY", toBS key, toBS increment, toBS member]) >> recv r
zrange :: (BS s1, BS s2) =>
Redis
-> s1
-> (Int, Int)
-> Bool
-> IO (Reply s2)
zrange r key limit withscores = let cmd' = ["ZRANGE", toBS key, toBS $ fst limit, toBS $ snd limit]
cmd | withscores = cmd' ++ ["WITHSCORES"]
| otherwise = cmd'
in sendCommand r (CMBulk cmd) >> recv r
zrevrange :: (BS s1, BS s2) =>
Redis
-> s1
-> (Int, Int)
-> Bool
-> IO (Reply s2)
zrevrange r key limit withscores = let cmd' = ["ZREVRANGE", toBS key, toBS $ fst limit, toBS $ snd limit]
cmd | withscores = cmd' ++ ["WITHSCORES"]
| otherwise = cmd'
in sendCommand r (CMBulk cmd) >> recv r
data Interval a = Closed a a
| Open a a
| LeftOpen a a
| RightOpen a a
deriving Show
class IsInterval i a | i -> a where
toInterval :: i -> Interval a
instance IsInterval (Interval a) a where
toInterval = id
instance IsInterval (a, a) a where
toInterval (a, b) = Open a b
instance IsInterval [a] a where
toInterval (a : b : []) = Closed a b
toInterval _ = error "Interval cast error"
from (Closed a _) = show a
from (Open a _) = '(' : (show a)
from (LeftOpen a _) = '(' : (show a)
from (RightOpen a _) = show a
to (Closed _ a) = show a
to (Open _ a) = '(' : (show a)
to (LeftOpen _ a) = show a
to (RightOpen _ a) = '(' : (show a)
zrangebyscore :: (IsInterval i Double, BS s1, BS s2) =>
Redis
-> s1
-> i
-> Bool
-> IO (Reply s2)
zrangebyscore r key i withscores = let cmd' = i' `seq` ["ZRANGEBYSCORE", toBS key, toBS (from i'), toBS (to i')]
cmd | withscores = cmd' ++ ["WITHSCORES"]
| otherwise = cmd'
i' = toInterval i
in cmd `seq` sendCommand r (CMBulk cmd) >> recv r
zcount :: (IsInterval i Double, BS s) =>
Redis
-> s
-> i
-> IO (Reply Int)
zcount r key i = let cmd = i' `seq` ["ZCOUNT", toBS key, toBS (from i'), toBS (to i')]
i' = toInterval i
in cmd `seq` sendCommand r (CMBulk cmd) >> recv r
zremrangebyscore :: BS s =>
Redis
-> s
-> (Double, Double)
-> IO (Reply Int)
zremrangebyscore r key (from, to) = sendCommand r (CMBulk ["ZREMRANGEBYSCORE", toBS key, toBS from, toBS to]) >> recv r
zcard :: BS s =>
Redis
-> s
-> IO (Reply Int)
zcard r key = sendCommand r (CMBulk ["ZCARD", toBS key]) >> recv r
zscore :: (BS s1, BS s2, BS s3) =>
Redis
-> s1
-> s2
-> IO (Reply s3)
zscore r key member = sendCommand r (CMBulk ["ZSCORE", toBS key, toBS member]) >> recv r
zrank :: (BS s1, BS s2) =>
Redis
-> s1
-> s2
-> IO (Reply Int)
zrank r key member = sendCommand r (CMBulk ["ZRANK", toBS key, toBS member]) >> recv r
data BS s => SortOptions s = SortOptions { desc :: Bool,
limit :: (Int, Int),
alpha :: Bool,
sort_by :: s,
get_obj :: [s],
store :: s
}
sortDefaults :: SortOptions ByteString
sortDefaults = SortOptions { desc = False,
limit = takeAll,
alpha = False,
sort_by = "",
get_obj = [],
store = "" }
sort :: (BS s1, BS s2, BS s3) =>
Redis
-> s1
-> SortOptions s2
-> IO (Reply s3)
sort r key opt = let opt_s = buildOptions opt
buildOptions :: BS s => SortOptions s -> [ByteString]
buildOptions opt = let desc_s
| desc opt = ["DESC"]
| otherwise = []
limit_s
| (limit opt) == (0, 0) = []
| otherwise = ["LIMIT", (toBS $ fst $ limit opt), (toBS $ snd $ limit opt)]
alpha_s
| alpha opt = ["ALPHA"]
| otherwise = []
sort_by_s
| B.null $ toBS (sort_by opt) = []
| otherwise = ["BY",(toBS $ sort_by opt)]
get_obj_s
| null $ get_obj opt = []
| otherwise = "GET" : map toBS (get_obj opt)
store_s
| B.null $ toBS (store opt) = []
| otherwise = ["STORE", toBS $ store opt]
in concat [sort_by_s, limit_s, get_obj_s, desc_s, alpha_s, store_s]
in sendCommand r (CMBulk ("SORT" : toBS key : opt_s)) >> recv r
listRelated :: (BS s1, BS s2, BS s3) =>
Redis
-> s1
-> s2
-> (Int, Int)
-> IO (Reply s3)
listRelated r related key l = let opts = sortDefaults { sort_by = "x",
get_obj = [toBS related],
limit = l }
in sort r key opts
save :: Redis -> IO (Reply ())
save r = sendCommand r (CInline "SAVE") >> recv r
bgsave :: Redis -> IO (Reply ())
bgsave r = sendCommand r (CInline "BGSAVE") >> recv r
lastsave :: Redis -> IO (Reply Int)
lastsave r = sendCommand r (CInline "LASTSAVE") >> recv r
bgrewriteaof :: Redis -> IO (Reply ())
bgrewriteaof r = sendCommand r (CInline "BGREWRITEAOF") >> recv r