{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}

-- | Main Redis API and protocol implementation
module Database.Redis.Redis (
       -- * Types ans Constructors
       Redis(..),
       Reply(..),
       Interval(..),
       IsInterval(..),
       SortOptions(..),
       sortDefaults,
       fromRInline, fromRBulk, fromRMulti, fromRMultiBulk,
       fromRInt, fromROk, noError, takeAll,

       -- * Database connection
       localhost, 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 qualified Network.Socket as S
import qualified System.IO as IO
import qualified Data.ByteString as B
import qualified Data.ByteString.UTF8 as U
import Data.Maybe (fromJust)

-- | Redis connection descriptor
data Redis = Redis { server   :: (String, String), -- ^ hostname and port pair
                     handle :: IO.Handle           -- ^ real network connection
                   }
                deriving (Show, Eq)

-- | Redis command variants
data Command = CInline String
             | CMInline [String]
             | CBulk [String] String
             | CMBulk [String]

-- | Redis reply variants
data Reply = RTimeout               -- ^ Timeout. Currently unused
           | ROk                    -- ^ \"Ok\" reply
           | RPong                  -- ^ Reply for the ping command
           | RQueued                -- ^ Used inside multi-exec block
           | RError String          -- ^ Some kind of server-side error
           | RInline String         -- ^ Simple oneline reply
           | RInt Int               -- ^ Integer reply
           | RBulk (Maybe String)   -- ^ Multiline reply
           | RMulti (Maybe [Reply]) -- ^ Complex reply. It may consists of various type of replys
             deriving (Show, Eq)

-- | Unwraps RInline reply.
--
-- Throws an exception when called with something different from RInline
fromRInline :: (Monad m) => Reply -> m String
fromRInline reply = case reply of
                      RError msg -> error msg
                      RInline s  -> return s
                      _          -> error $ "wrong reply, RInline expected: " ++ (show reply)

-- | Unwraps RBulk reply.
--
-- Throws an exception when called with something different from RBulk
fromRBulk :: (Monad m) => Reply -> m (Maybe String)
fromRBulk reply = case reply of
                    RError msg -> error msg
                    RBulk s    -> return s
                    _          -> error $ "wrong reply, RBulk expected: " ++ (show reply)

-- | Unwraps RMulti reply
--
-- Throws an exception when called with something different from RMulti
fromRMulti :: (Monad m) => Reply -> m (Maybe [Reply])
fromRMulti reply = case reply of
                     RError msg -> error msg
                     RMulti ss  -> return ss
                     _          -> error $ "wrong reply, RMulti expected: " ++ (show reply)

-- | Unwraps RMulti reply filled with RBulk
--
-- Throws an exception when called with something different from RMulti
fromRMultiBulk :: (Monad m) => Reply -> m (Maybe [Maybe String])
fromRMultiBulk reply = fromRMulti reply >>= return . (>>= sequence . map fromRBulk)

-- | Unwraps RInt reply
--
-- Throws an exception when called with something different from RInt
fromRInt :: (Monad m) => Reply -> m Int
fromRInt reply = case reply of
                   RError msg -> error msg
                   RInt n     -> return n
                   _          -> error $ "wrong reply, RInt expected: " ++ (show reply)

-- | Unwraps ROk reply
--
-- Throws an exception when called with something different from ROk
fromROk :: (Monad m) => Reply -> m ()
fromROk reply = case reply of
                   RError msg -> error msg
                   ROk        -> return ()
                   _          -> error $ "wrong reply, ROk expected: " ++ (show reply)

-- | Unwraps every non-error reply
--
-- Throws an exception when called with something different from RMulti
noError :: (Monad m) => Reply -> 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

-- | default Redis port
defaultPort :: String
defaultPort = "6379"
-- | just a localhost
localhost :: String
localhost = "localhost"

-- | a (0, -1) range - takes all element from a list in lrange, zrange
-- and so on
takeAll :: (Int, Int)
takeAll = (0, -1)

-- | Conects to Redis server and returns connection descriptor
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

-- | Close connection
disconnect :: Redis -> IO ()
disconnect = IO.hClose . handle

-- | Returns True when connection handler is opened
isConnected :: Redis -> IO Bool
isConnected = IO.hIsOpen . handle

{- ================ Private =============== -}
send :: IO.Handle -> [String] -> IO ()
send h [] = return ()
send h (s:ls) = let bs = U.fromString s
                in B.hPut h bs >> B.hPut h uspace >> send h ls

sendCommand :: Redis -> Command -> IO ()
sendCommand r (CInline s) = let h = handle r
                                bs = U.fromString s
                            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 s) = let h = handle r
                                   bs = U.fromString s
                                   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 (l:ls) = let bs = U.fromString l
                                                         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 :: Redis -> IO Reply
recv r = do first <- bsToStr `fmap` B.hGetLine h
            case first of
              ('-':rest)  -> recv_err rest
              ('+':rest)  -> recv_inline rest
              (':':rest)  -> recv_int rest
              ('$':rest)  -> recv_bulk rest
              ('*':rest)  -> recv_multi rest
    where
      h = handle r
      bsToStr = (takeWhile (\c -> c /= '\r' && c /= '\n')) . U.toString

      recv_err :: String -> IO Reply
      recv_err rest = return $ RError rest

      recv_inline :: String -> IO Reply
      recv_inline rest = return $ case rest of
                                    "OK"       -> ROk
                                    "PONG"     -> RPong
                                    "QUEUED"   -> RQueued
                                    _          -> RInline rest

      recv_int :: String -> IO Reply
      recv_int rest = let reply = read rest :: Int
                      in return $ RInt reply

      recv_bulk :: String -> IO Reply
      recv_bulk rest = let size = read rest :: Int
                       in do body <- recv_bulk_body size
                             return $ RBulk body

      recv_bulk_body :: Int -> IO (Maybe String)
      recv_bulk_body (-1) = return Nothing
      recv_bulk_body size = do body <- B.hGet h (size + 2)
                               let reply = U.toString $ B.take size body
                               return $ Just reply

      recv_multi :: String -> IO Reply
      recv_multi rest = let cnt = read rest :: Int
                        in do bulks <- recv_multi_n cnt
                              return $ RMulti bulks

      recv_multi_n :: Int -> IO (Maybe [Reply])
      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 (n-1)
                          return $ Just (this : tail)

{- ============ Just commands ============= -}
-- | ping - pong
--
-- RPong returned if no errors happends
ping :: Redis -> IO Reply
ping r = sendCommand r (CInline "PING") >> recv r

-- | Password authentication
--
-- ROk returned
auth :: Redis
     -> String                  -- ^ password
     -> IO Reply
auth r pwd = sendCommand r (CMInline ["AUTH", pwd] ) >> recv r

-- | Quit and close connection
quit :: Redis -> IO ()
quit r = sendCommand r (CInline "QUIT") >> disconnect r

-- | Stop all the clients, save the DB, then quit the server
shutdown :: Redis -> IO Reply
shutdown r = sendCommand r (CInline "SHUTDOWN") >> recv r

-- | Begin the multi-exec block
--
-- ROk returned
multi :: Redis -> IO Reply
multi r = sendCommand r (CInline "MULTI") >> recv r

-- | Execute queued commands
--
-- RMulti returned - replys for all executed commands
exec :: Redis -> IO Reply
exec r = sendCommand r (CInline "EXEC") >> recv r

-- | Run commands within multi-exec block
--
-- RMulti returned - replys for all executed commands
run_multi :: Redis
          -> [IO Reply]         -- ^ IO actions to run
          -> IO Reply
run_multi r cs = let cs' = map (>>= noError) cs
                 in do multi r
                       sequence_ cs'
                       exec r

-- | Test if the key exists
--
-- (RInt 1) returned if the key exists and (RInt 0) otherwise
exists :: Redis
       -> String                -- ^ target key
       -> IO Reply
exists r key = sendCommand r (CMBulk ["EXISTS", key]) >> recv r

-- | Remove the key
--
-- (RInt 0) returned if no keys were removed or (RInt n) with removed keys count
del :: Redis
    -> String                   -- ^ target key
    -> IO Reply
del r key = sendCommand r (CMBulk ["DEL", key]) >> recv r

-- | Return the type of the value stored at key in form of a string
--
-- RInline with one of "none", "string", "list", "set", "zset" returned
getType :: Redis
        -> String               -- ^ target key
        -> IO Reply
getType r key = sendCommand r (CMBulk ["TYPE", key]) >> recv r

-- | Returns all the keys matching the glob-style pattern as space separated strings
--
-- RBulk returned
keys :: Redis
     -> String                  -- ^ target key
     -> IO Reply
keys r pattern = sendCommand r (CMInline ["KEYS", pattern]) >> recv r

-- | Return random key name
--
-- RInline returned
randomKey :: Redis -> IO Reply
randomKey r = sendCommand r (CInline "RANDOMKEY") >> recv r

-- | Rename the key. If key with that name exists it'll be overwritten.
--
-- ROk returned
rename :: Redis
       -> String                -- ^ source key
       -> String                -- ^ destination key
       -> IO Reply
rename r from to = sendCommand r (CMBulk ["RENAME", from, to]) >> recv r

-- | Rename the key if no keys with destination name exists.
--
-- (RInt 1) returned if key was renamed and (RInt 0) otherwise
renameNx :: Redis
         -> String              -- ^ source key
         -> String              -- ^ destination key
         -> IO Reply
renameNx r from to = sendCommand r (CMBulk ["RENAMENX", from, to]) >> recv r

-- | Get the number of keys in the currently selected database
--
-- RInt returned
dbsize :: Redis -> IO Reply
dbsize r = sendCommand r (CInline "DBSIZE") >> recv r

-- | Set an expiration timeout in seconds on the specified key.
--
-- For more information see <http://code.google.com/p/redis/wiki/ExpireCommand>
--
-- (RInt 1) returned if timeout was set and (RInt 0) otherwise
expire :: Redis
       -> String                -- ^ target key
       -> Int                   -- ^ timeout in seconds
       -> IO Reply
expire r key seconds = sendCommand r (CMBulk ["EXPIRE", key, show seconds]) >> recv r

-- | Set an expiration time in form of UNIX timestamp on the specified key
--
-- For more information see <http://code.google.com/p/redis/wiki/ExpireCommand>
--
-- (RInt 1) returned if timeout was set and (RInt 0) otherwise
expireAt :: Redis
         -> String              -- ^ target key
         -> Int                 -- ^ timeout in seconds
         -> IO Reply
expireAt r key timestamp = sendCommand r (CMBulk ["EXPIRE", key, show timestamp]) >> recv r

-- | Return the remining time to live of the key or -1 if key has no
-- associated timeout
--
-- RInt returned
ttl :: Redis
    -> String                   -- ^ target key
    -> IO Reply
ttl r key = sendCommand r (CMBulk ["TTL", key]) >> recv r

-- | Select the DB with the specified zero-based numeric index
--
-- ROk returned
select :: Redis
       -> Int                   -- ^ database number
       -> IO Reply
select r db = sendCommand r (CMInline ["SELECT", show db]) >> recv r

-- | Move the specified key from the currently selected DB to the
-- specified destination DB. If such a key is already exists in the
-- target DB no data modification performed.
--
-- (RInt 1) returned if the key was moved and (RInt 0) otherwise
move :: Redis
     -> String                  -- ^ target key
     -> Int                     -- ^ destination database number
     -> IO Reply
move r key db = sendCommand r (CMBulk ["MOVE", key, show db]) >> recv r

-- | Delete all the keys of the currently selected DB
--
-- ROk returned
flushDb :: Redis -> IO Reply
flushDb r = sendCommand r (CInline "FLUSHDB") >> recv r

-- | Delete all the keys of all the existing databases
--
-- ROk returned
flushAll :: Redis -> IO Reply
flushAll r = sendCommand r (CInline "FLUSHALL") >> recv r

-- | Returns different information and statistics about the server
--
-- for more information see <http://code.google.com/p/redis/wiki/InfoCommand>
--
-- RBulk returned
info :: Redis -> IO Reply
info r = sendCommand r (CInline "INFO") >> recv r

-- | Set the string value as value of the key
--
-- ROk returned
set :: Redis
    -> String                   -- ^ target key
    -> String                   -- ^ value
    -> IO Reply
set r key val = sendCommand r (CMBulk ["SET", key, val]) >> recv r

-- | Set the key value if key does not exists
--
-- (RInt 1) returned if key was set and (RInt 0) otherwise
setNx :: Redis
      -> String                 -- ^ target key
      -> String                 -- ^ value
      -> IO Reply
setNx r key val = sendCommand r (CMBulk ["SETNX", key, val]) >> recv r

-- | Atomically set multiple keys
--
-- ROk returned
mSet :: Redis
     -> [(String, String)]      -- ^ (key, value) pairs
     -> IO Reply
mSet r ks = let interlace' [] ls = ls
                interlace' ((a, b):rest) ls = interlace' rest (a:b:ls)
                interlace ls = interlace' ls []
            in sendCommand r (CMBulk ("MSET" : interlace ks)) >> recv r

-- | Atomically set multiple keys if none of them exists.
--
-- (RInt 1) returned if all keys was set and (RInt 0) otherwise
mSetNx :: Redis
       -> [(String, String)]    -- ^ (key, value) pairs
       -> IO Reply
mSetNx r ks = let interlace' [] ls = ls
                  interlace' ((a, b):rest) ls = interlace' rest (a:b:ls)
                  interlace ls = interlace' ls []
              in sendCommand r (CMBulk ("MSETNX" : interlace ks)) >> recv r

-- | Get the value of the specified key.
--
-- RBulk returned
get :: Redis
    -> String                   -- ^ target key
    -> IO Reply
get r key = sendCommand r (CMBulk ["GET", key]) >> recv r

-- | Atomically set this value and return the old value
--
-- RBulk returned
getSet :: Redis
       -> String                -- ^ target key
       -> String                -- ^ value
       -> IO Reply
getSet r key val = sendCommand r (CMBulk ["GETSET", key, val]) >> recv r

-- | Get the values of all specified keys
--
-- RMulti filled with RBulk replys returned
mGet :: Redis
     -> [String]                -- ^ target keys
     -> IO Reply
mGet r keys = sendCommand r (CMBulk ("MGET" : keys)) >> recv r

-- | Increment the key value by one
--
-- RInt returned with new key value
incr :: Redis
     -> String                  -- ^ target key
     -> IO Reply
incr r key = sendCommand r (CMBulk ["INCR", key]) >> recv r

-- | Increment the key value by N
--
-- RInt returned with new key value
incrBy :: Redis
       -> String                -- ^ target key
       -> Int                   -- ^ increment
       -> IO Reply
incrBy r key n = sendCommand r (CMBulk ["INCRBY", key, show n]) >> recv r

-- | Decrement the key value by one
--
-- RInt returned with new key value
decr :: Redis
     -> String                  -- ^ target key
     -> IO Reply
decr r key = sendCommand r (CMBulk ["DECR", key]) >> recv r

-- | Decrement the key value by N
--
-- RInt returned with new key value
decrBy :: Redis
       -> String                -- ^ target key
       -> Int                   -- ^ decrement
       -> IO Reply
decrBy r key n = sendCommand r (CMBulk ["DECRBY", key, show n]) >> recv r

-- | Append string to the string-typed key
--
-- RInt returned - the length of resulting string
append :: Redis
       -> String                -- ^ target key
       -> String                -- ^ value
       -> IO Reply
append r key str = sendCommand r (CMBulk ["APPEND", key, str]) >> recv r

-- | Add string value to the head of the list-type key
--
-- ROk returned or RError if key is not a list
rpush :: Redis
      -> String                 -- ^ target key
      -> String                 -- ^ value
      -> IO Reply
rpush r key val = sendCommand r (CMBulk ["RPUSH", key, val]) >> recv r

-- | Add string value to the tail of the list-type key
--
-- ROk returned or RError if key is not a list
lpush :: Redis
      -> String                 -- ^ target key
      -> String                 -- ^ value
      -> IO Reply
lpush r key val = sendCommand r (CMBulk ["LPUSH", key, val]) >> recv r

-- | Return lenght of the list. Note that for not-existing keys it
-- returns zero length.
--
-- RInt returned or RError if key is not a list
llen :: Redis
     -> String                  -- ^ target key
     -> IO Reply
llen r key = sendCommand r (CMBulk ["LLEN", key]) >> recv r

-- | Return the specified range of list elements. List indexed from 0
-- to (llen - 1). lrange returns slice including \"from\" and \"to\"
-- elements, eg. lrange 0 2 will return the first three elements of
-- the list.
--
-- Parameters \"from\" and \"to\" may also be negative. If so it will counts as
-- offset from end ot the list. eg. -1 - is the last element of the
-- list, -2 - is the second from the end and so on.
--
-- RMulti filled with RBulk returned
lrange :: Redis
       -> String                -- ^ traget key
       -> (Int, Int)            -- ^ (from, to) pair
       -> IO Reply
lrange r key (from, to) = sendCommand r (CMBulk ["LRANGE", key, show from, show to]) >> recv r

-- | Trim list so that it will contain only the specified range of elements.
--
-- ROk returned
ltrim :: Redis
      -> String                 -- ^ target key
      -> (Int, Int)             -- ^ (from, to) pair
      -> IO Reply
ltrim r key (from, to) = sendCommand r (CMBulk ["LTRIM", key, show from, show to]) >> recv r

-- | Return the specified element of the list by its index
--
-- RBulk returned
lindex :: Redis
       -> String                -- ^ target key
       -> Int                   -- ^ index
       -> IO Reply
lindex r key index = sendCommand r (CMBulk ["LINDEX", key, show index]) >> recv r

-- | Set the list's value indexed by an /index/ to the new value
--
-- ROk returned if element was set and RError if index is out of
-- range or key is not a list
lset :: Redis -> String -> Int -> String -> IO Reply
lset r key index val = sendCommand r (CMBulk ["LSET", key, show index, val]) >> recv r

-- | Remove the first /count/ occurrences of the /value/ element from the list
--
-- RInt returned - the number of elements removed
lrem :: Redis
     -> String                  -- ^ target key
     -> Int                     -- ^ occurrences
     -> String                  -- ^ value
     -> IO Reply
lrem r key count value = sendCommand r (CMBulk ["LREM", key, show count, value]) >> recv r

-- | Atomically return and remove the first element of the list
--
-- RBulk returned
lpop :: Redis
     -> String                  -- ^ target key
     -> IO Reply
lpop r key = sendCommand r (CMBulk ["LPOP", key]) >> recv r

-- | Atomically return and remove the last element of the list
--
-- RBulk returned
rpop :: Redis
     -> String                  -- ^ target key
     -> IO Reply
rpop r key = sendCommand r (CMBulk ["RPOP", key]) >> recv r

-- | Atomically return and remove the last (tail) element of the
-- source list, and push the element as the first (head) element of
-- the destination list
--
-- RBulk returned
rpoplpush :: Redis
          -> String             -- ^ source key
          -> String             -- ^ destination key
          -> IO Reply
rpoplpush r src dst = sendCommand r (CMBulk ["RPOPLPUSH", src, dst]) >> recv r

-- | Blocking lpop
--
-- For more information see <http://code.google.com/p/redis/wiki/BlpopCommand>
--
-- RMulti returned filled with key name and popped value
blpop :: Redis
      -> [String]               -- ^ keys list
      -> Int                    -- ^ timeout
      -> IO Reply
blpop r keys timeout = sendCommand r (CMBulk (("BLPOP" : keys) ++ [show timeout])) >> recv r

-- | Blocking rpop
--
-- For more information see <http://code.google.com/p/redis/wiki/BlpopCommand>
--
-- RMulti returned filled with key name and popped value
brpop :: Redis
      -> [String]               -- ^ keys list
      -> Int                    -- ^ timeout
      -> IO Reply
brpop r keys timeout = sendCommand r (CMBulk (("BRPOP" : keys) ++ [show timeout])) >> recv r

-- | Add the specified member to the set value stored at key
--
-- (RInt 1) returned if element was added and (RInt 0) if element was
-- already a member of the set
sadd :: Redis
     -> String                  -- ^ target key
     -> String                  -- ^ value
     -> IO Reply
sadd r key val = sendCommand r (CMBulk ["SADD", key, val]) >> recv r

-- | Remove the specified member from the set value stored at key
--
-- (RInt 1) returned if element was removed and (RInt 0) if element
-- is not a member of the set
srem :: Redis
     -> String                  -- ^ target key
     -> String                  -- ^ value
     -> IO Reply
srem r key val = sendCommand r (CMBulk ["SREM", key, val]) >> recv r

-- | Remove a random element from a Set returning it as return value
--
-- RBulk returned
spop :: Redis
     -> String                  -- ^ target key
     -> IO Reply
spop r key = sendCommand r (CMBulk ["SPOP", key]) >> recv r

-- | Move the specifided member from one set to another
--
-- (RInt 1) returned if element was moved and (RInt 0) if element
-- is not a member of the source set
smove :: Redis
      -> String                 -- ^ source key
      -> String                 -- ^ destination key
      -> String                 -- ^ value
      -> IO Reply
smove r src dst member = sendCommand r (CMBulk ["SMOVE", src, dst, member]) >> recv r

-- | Return the number of elements of the set. If key doesn't exists 0
-- returned.
--
-- RInt returned
scard :: Redis
      -> String                 -- ^ target key
      -> IO Reply
scard r key = sendCommand r (CMBulk ["SCARD", key]) >> recv r

-- | Test if element is member of the set. If key doesn't exists 0
-- returned.
--
-- (RInt 1) returned if element is member of the set and (RInt 0) otherwise
sismember :: Redis
          -> String             -- ^ target key
          -> IO Reply
sismember r key = sendCommand r (CMBulk ["SISMEMBER", key]) >> recv r

-- | Return all the members (elements) of the set
--
-- RMulti filled with RBulk returned
smembers :: Redis
         -> String              -- ^ target key
         -> IO Reply
smembers r key = sendCommand r (CMBulk ["SMEMBERS", key]) >> recv r

-- | Return a random element from a set
--
-- RBulk returned
srandmember :: Redis
            -> String           -- ^ target key
            -> IO Reply
srandmember r key = sendCommand r (CMBulk ["SRANDMEMBER", key]) >> recv r

-- | Return the members of a set resulting from the intersection of
-- all the specifided sets
--
-- RMulti filled with RBulk returned
sinter :: Redis
       -> [String]              -- ^ keys list
       -> IO Reply
sinter r keys = sendCommand r (CMBulk ("SINTER" : keys)) >> recv r

-- | The same as 'sinter' but instead of being returned the resulting set
-- is stored
--
-- ROk returned
sinterStore :: Redis
            -> String           -- ^ where to store resulting set
            -> [String]         -- ^ sets list
            -> IO Reply
sinterStore r dst keys = sendCommand r (CMBulk ("SINTERSTORE" : dst : keys)) >> recv r

-- | Return the members of a set resulting from the union of all the
-- specifided sets
--
-- RMulti filled with RBulk returned
sunion :: Redis
       -> [String]              -- ^ keys list
       -> IO Reply
sunion r keys = sendCommand r (CMBulk ("SUNION" : keys)) >> recv r

-- | The same as 'sunion' but instead of being returned the resulting set
-- is stored
--
-- ROk returned
sunionStore :: Redis
            -> String           -- ^ where to store resulting set
            -> [String]         -- ^ sets list
            -> IO Reply
sunionStore r dst keys = sendCommand r (CMBulk ("SUNIONSTORE" : dst : keys)) >> recv r

-- | Return the members of a set resulting from the difference between
-- the first set provided and all the successive sets
--
-- RMulti filled with RBulk returned
sdiff :: Redis
      -> [String]               -- ^ keys list
      -> IO Reply
sdiff r keys = sendCommand r (CMBulk ("SDIFF" : keys)) >> recv r

-- | The same as 'sdiff' but instead of being returned the resulting
-- set is stored
--
-- ROk returned
sdiffStore :: Redis
           -> String            -- ^ where to store resulting set
           -> [String]          -- ^ sets list
           -> IO Reply
sdiffStore r dst keys = sendCommand r (CMBulk ("SDIFFSTORE" : dst : keys)) >> recv r

-- | Add the specified member having the specifeid score to the sorted
-- set
--
-- (RInt 1) returned if new element was added and (RInt 0) if that
-- element was already a member of the sortet set and the score was
-- updated
zadd :: Redis
     -> String                  -- ^ target key
     -> Double                  -- ^ score
     -> String                  -- ^ value
     -> IO Reply
zadd r key score member = sendCommand r (CMBulk ["ZADD", key, show score, member]) >> recv r

-- | Remove the specified member from the sorted set
--
-- (RInt 1) returned if element was removed and (RInt 0) if element
-- was not a member of the sorted set
zrem :: Redis
     -> String                  -- ^ target key
     -> String                  -- ^ value
     -> IO Reply
zrem r key member = sendCommand r (CMBulk ["ZREM", key, member]) >> recv r

-- | If /member/ already in the sorted set adds the /increment/ to its
-- score and updates the position of the element in the sorted set
-- accordingly. If member does not exist in the sorted set it is added
-- with increment as score (that is, like if the previous score was
-- virtually zero). The new score of the member is returned.
--
-- RBulk returned
zincrBy :: Redis
        -> String               -- ^ target key
        -> Double               -- ^ increment
        -> String               -- ^ value
        -> IO Reply
zincrBy r key increment member = sendCommand r (CMBulk ["ZINCRBY", key, show increment, member]) >> recv r

-- | Return the specified elements of the sorted set. Start and end
-- are zero-based indexes. WITHSCORES paramenter indicates if it's
-- needed to return elements with its scores or not. If WITHSCORES is
-- True then the resulting list will be composed of value1, score1,
-- value2, score2 and so on.
--
-- RMulti filled with RBulk returned
zrange :: Redis
       -> String                -- ^ target key
       -> (Int, Int)            -- ^ (from, to) pair
       -> Bool                  -- ^ withscores option
       -> IO Reply
zrange r key limit withscores = let cmd' = ["ZRANGE", key, show $ fst limit, show $ snd limit]
                                    cmd | withscores = cmd' ++ ["WITHSCORES"]
                                        | otherwise  = cmd'
                                in sendCommand r (CMBulk cmd) >> recv r

-- | Return the specified elements of the sorted set at the specified
-- key. The elements are considered sorted from the highest to the
-- lowerest score
--
-- RMulti filled with RBulk returned
zrevrange :: Redis
          -> String             -- ^ target key
          -> (Int, Int)         -- ^ (from, to) pair
          -> Bool               -- ^ withscores option
          -> IO Reply
zrevrange r key limit withscores = let cmd' = ["ZREVRANGE", key, show $ fst limit, show $ snd limit]
                                       cmd | withscores = cmd' ++ ["WITHSCORES"]
                                           | otherwise  = cmd'
                                   in sendCommand r (CMBulk cmd) >> recv r

-- | Interval representation
data Interval a = Closed a a    -- ^ closed interval [a, b]
                | Open a a      -- ^ open interval (a, b)
                | LeftOpen a a  -- ^ left-open interval (a, b]
                | RightOpen a a -- ^ right-open interval [a, b)
                deriving Show

-- | Class for conversion value to 'Interval'
--
-- Definied instances is:
--
-- * the Interval itself
--
-- * pair (a,b) for open interval
--
-- * two-member list [a, b] for closed interval (throws runtime error if the list length is different)
--
class IsInterval i a | i -> a where
    toInterval :: i -> Interval a

-- | Trivial IsInterval instance
instance IsInterval (Interval a) a where
    toInterval = id

-- | Pair (a, b) converted to open interval
instance IsInterval (a, a) a where
    toInterval (a, b) = Open a b

-- | Two-element list [a, b] converted to closed interval. No static
-- checking of list length performed.
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)

-- | Return the all the elements in the sorted set with a score that
-- lays within a given interval
--
-- RMulti filled with RBulk returned
zrangebyscore :: IsInterval i Double =>
                 Redis
              -> String         -- ^ target key
              -> i              -- ^ scores interval
              -> Bool           -- ^ withscores option
              -> IO Reply
zrangebyscore r key i withscores = let cmd' = i' `seq` ["ZRANGEBYSCORE", key, from i', to i']
                                       cmd | withscores = cmd' ++ ["WITHSCORES"]
                                           | otherwise  = cmd'
                                       i' = toInterval i
                                   in cmd `seq` sendCommand r (CMBulk cmd) >> recv r

-- | Count a number of elements of the sorted set with a score that
-- lays within a given interval
--
-- RInt returned
zcount :: IsInterval i Double =>
          Redis
       -> String                -- ^ target key
       -> i                     -- ^ scores interval
       -> IO Reply
zcount r key i = let cmd = i' `seq` ["ZCOUNT", key, from i', to i']
                     i' = toInterval i
                 in cmd `seq` sendCommand r (CMBulk cmd) >> recv r

-- | Remove all the elements in the sorted set with a score that lays
-- within a given interval
--
-- RInt returned - the number of elements removed
zremrangebyscore :: Redis
                 -> String           -- ^ target key
                 -> (Double, Double) -- ^ (from, to) pair. zremrangebyscore
                                     -- currently doesn't supports
                                     -- open intervals
                 -> IO Reply
zremrangebyscore r key (from, to) = sendCommand r (CMBulk ["ZREMRANGEBYSCORE", key, show from, show to]) >> recv r

-- | Return the sorted set cardinality (number of elements)
--
-- RInt returned
zcard :: Redis
      -> String                 -- ^ target key
      -> IO Reply
zcard r key = sendCommand r (CMBulk ["ZCARD", key]) >> recv r

-- | Return the score of the specified element of the sorted set
--
-- RBulk returned
zscore :: Redis
       -> String                -- ^ target key
       -> String                -- ^ value
       -> IO Reply
zscore r key member = sendCommand r (CMBulk ["ZSCORE", key, member]) >> recv r

-- | Options data type for the 'sort' command
data SortOptions = SortOptions { desc       :: Bool, -- ^ sort with descending order
                                 limit      :: (Int, Int), -- ^ return (from, to) elements
                                 alpha      :: Bool,       -- ^ sort alphabetically
                                 sort_by    :: String,     -- ^ sort by value from this key
                                 get_obj    :: [String],   -- ^ return this keys values
                                 store      :: String      -- ^ store result to this key
                               }

-- | Default options for the 'sort' command
sortDefaults :: SortOptions
sortDefaults = SortOptions { desc = False,
                             limit = takeAll,
                             alpha = False,
                             sort_by = "",
                             get_obj = [],
                             store = "" }

-- | Sort the elements contained in the List, Set, or Sorted Set
--
-- for more information see <http://code.google.com/p/redis/wiki/SortCommand>
--
-- RMulti filled with RBulk returned
sort :: Redis
     -> String                  -- ^ target key
     -> SortOptions             -- ^ options
     -> IO Reply
sort r key opt = let opt_s = buildOptions opt
                     buildOptions opt = let desc_s
                                                | desc opt  = ["DESC"]
                                                | otherwise = []
                                            limit_s
                                                | (limit opt) == (0, 0) = []
                                                | otherwise             = ["LIMIT", (show $ fst $ limit opt), (show $ snd $ limit opt)]
                                            alpha_s
                                                | alpha opt = ["ALPHA"]
                                                | otherwise = []
                                            sort_by_s
                                                | null $ sort_by opt = []
                                                | otherwise          = ["BY",(sort_by opt)]
                                            get_obj_s
                                                | null $ get_obj opt = []
                                                | otherwise          = "GET" : get_obj opt
                                            store_s
                                                | null $ store opt = []
                                                | otherwise        = ["STORE", store opt]
                                        in concat [sort_by_s, limit_s, get_obj_s, desc_s, alpha_s, store_s]
                 in sendCommand r (CMBulk ("SORT" : key : opt_s)) >> recv r

-- | Shortcut for the 'sort' with some 'get_obj' and constant
-- 'sort_by' options
--
-- RMulti filled with RBulk returned
listRelated :: Redis
            -> String           -- ^ target key
            -> String           -- ^ key returned
            -> (Int, Int)       -- ^ range
            -> IO Reply
listRelated r related key l = let opts = sortDefaults { sort_by = "x",
                                                        get_obj = [related],
                                                        limit = l }
                              in sort r key opts

-- | Save the whole dataset on disk
--
-- ROk returned
save :: Redis -> IO Reply
save r = sendCommand r (CInline "SAVE") >> recv r

-- | Save the DB in background
--
-- ROk returned
bgsave :: Redis -> IO Reply
bgsave r = sendCommand r (CInline "BGSAVE") >> recv r

-- | Return the UNIX TIME of the last DB save executed with success
--
-- RInt returned
lastsave :: Redis -> IO Reply
lastsave r = sendCommand r (CInline "LASTSAVE") >> recv r

-- | Rewrites the Append Only File in background
--
-- ROk returned
bgrewriteaof :: Redis -> IO Reply
bgrewriteaof r = sendCommand r (CInline "BGREWRITEAOF") >> recv r