module Database.Redis.Hash
    ( hashSet, hashSetB
    , hashGet, hashGetB
    , hashMultiGet
    , hashMultiSet
    , hashIncrementBy
    , hashExists
    , hashDelete
    , hashLength
    , hashKeys
    , hashValues
    , hashGetAll
    ) where


import           System.IO

import           Database.Redis.Internal


------------------------------------------------------------------------------
-- | Calls @HSET@ with 'String' arguments
hashSet :: Handle
        -> String  -- ^ key
        -> String  -- ^ field
        -> String  -- ^ value
        -> IO (Maybe RedisReply)
hashSet h key field value = request h $ map toUTF8 ["HSET", key, field, value]


------------------------------------------------------------------------------
-- | Calls @HSET@ with 'ByteString' arguments
hashSetB :: Handle
         -> ByteString  -- ^ key
         -> ByteString  -- ^ field
         -> ByteString  -- ^ value
         -> IO (Maybe RedisReply)
hashSetB h key field value = request h [toUTF8 "HSET", key, field, value]


------------------------------------------------------------------------------
-- | Calls @HGET@ with 'ByteString' arguments
hashGet :: Handle
        -> String  -- ^ key
        -> String  -- ^ field
        -> IO (Maybe RedisReply)
hashGet h key field = request h $ map toUTF8 ["HSET", key, field]


-- | Calls @HGET@ with 'ByteString' arguments
hashGetB :: Handle
         -> ByteString  -- ^ key
         -> ByteString  -- ^ field
         -> IO (Maybe RedisReply)
hashGetB h key field = request h [toUTF8 "HSET", key, field]


------------------------------------------------------------------------------
-- |  Calls @HMGET@ <http://code.google.com/p/redis/wiki/HmgetCommand>  with a
-- list of 'String's
hashMultiGet :: Handle
             -> String                -- ^ key
             -> [String]              -- ^ fields
             -> IO (Maybe RedisReply)
hashMultiGet h k hs = request h $ map toUTF8 $ "HMGET":k:hs


------------------------------------------------------------------------------
-- | Calls  @HMSET@ <http://code.google.com/p/redis/wiki/HmsetCommand>  with a
-- list of tuples (key, value)
hashMultiSet :: Handle
             -> String                -- ^ key
             -> [(String, String)]    -- ^ key/value pairs to set
             -> IO (Maybe RedisReply)
hashMultiSet h k kvs = request h $ map toUTF8 $ "HMSET":k:(pairsToList kvs)


------------------------------------------------------------------------------
-- | Calls @HINCRBY@ with 'String' and 'Int' arguments
hashIncrementBy :: Handle
                -> String   -- ^ key
                -> String   -- ^ field
                -> Int      -- ^ field
                -> IO (Maybe RedisReply)
hashIncrementBy h key field i =
    request h $ map toUTF8 ["HINCRBY", key, field, show i]


------------------------------------------------------------------------------
-- | Calls @HEXISTS@ (<http://code.google.com/p/redis/wiki/HexistsCommand>)
-- with 'String' arguments
hashExists :: Handle
          -> String                -- ^ key
          -> String                -- ^ field
          -> IO (Maybe RedisReply)
hashExists h key field = request h $ map toUTF8 ["HEXISTS", key, field]


------------------------------------------------------------------------------
-- | Calls @HDEL@ (<http://code.google.com/p/redis/wiki/HdelCommand>)
-- with 'String' arguments
hashDelete :: Handle
           -> String                -- ^ key
           -> String                -- ^ field
           -> IO (Maybe RedisReply)
hashDelete h key field = request h $ map toUTF8 ["HDEL", key, field]


------------------------------------------------------------------------------
-- | Calls @HLEN@ (<http://code.google.com/p/redis/wiki/HlenCommand>)
-- with 'String' arguments
hashLength :: Handle
           -> String                -- ^ key
           -> String                -- ^ field
           -> IO (Maybe RedisReply)
hashLength h key field = request h $ map toUTF8 ["HLEN", key, field]


------------------------------------------------------------------------------
-- | Calls @HKEYS@ (<http://code.google.com/p/redis/wiki/HkeysCommand>)
-- with a 'String' argument. N.B. despite its name, it returns fields.
hashKeys :: Handle
         -> String                -- ^ key
         -> IO (Maybe RedisReply)
hashKeys h k = request h $ map toUTF8 ["HKEYS", k]


------------------------------------------------------------------------------
-- | Calls @HVALS@ (<http://code.google.com/p/redis/wiki/HvalsCommand>)
-- with a 'String' argument.
hashValues :: Handle
           -> String                -- ^ key
           -> IO (Maybe RedisReply)
hashValues h k = request h $ map toUTF8 ["HVALS", k]


------------------------------------------------------------------------------
-- | Calls @HGETALL@ (<http://code.google.com/p/redis/wiki/HgetallCommand>)
-- with a 'String' argument.
hashGetAll :: Handle
           -> String                -- ^ key
           -> IO (Maybe RedisReply)
hashGetAll h k = request h $ map toUTF8 ["HGETALL", k]