-- |  This  module  has  nothing  to do  with  Haskell  @String@s;  the  Redis
-- Command  Reference (<http://code.google.com/p/redis/wiki/CommandReference>)
-- confusingly refers  to its simple  key/value pairing as strings,  even when
-- those strings can be incremented. Unfortunately,  I can't think of a better
-- name.

module Database.Redis.String
    ( itemSet, itemSetB
    , itemSetNX
    , itemSetEX
    , itemGet, itemGetB
    , multiSet
    , multiGet
    , multiSetNX
    , increment
    , incrementBy
    , decrement
    , decrementBy
    , itemGetSet
    , itemAppend
    , substring
    ) where


import           System.IO

import           Database.Redis.Internal


------------------------------------------------------------------------------
-- | SET for @String@ arguments
-- <http://code.google.com/p/redis/wiki/SetCommand>
itemSet :: Handle
        -> String                -- ^ key to set
        -> String                -- ^ value to set
        -> IO (Maybe RedisReply)
itemSet h key value = request h $ map toUTF8 ["SET", key, value]


-- | SET for ByteString input
itemSetB :: Handle
         -> ByteString            -- ^ key to set
         -> ByteString            -- ^ value to set
         -> IO (Maybe RedisReply)
itemSetB h key value = request h [toUTF8 "SET", key, value]


------------------------------------------------------------------------------
-- | GET for a @String@ argument
-- <http://code.google.com/p/redis/wiki/GetCommand>
itemGet :: Handle
        -> String                -- ^ key of the value to return
        -> IO (Maybe RedisReply)
itemGet h key = request h $ map toUTF8 ["GET", key]


-- | GET for a 'ByteString' argument
itemGetB :: Handle
         -> ByteString            -- ^ key of the value to return
         -> IO (Maybe RedisReply)
itemGetB h key = request h [toUTF8 "GET", key]

-- GETSET
------------------------------------------------------------------------------
-- | GETSET for @String@ arguments
-- <http://code.google.com/p/redis/wiki/GetsetCommand>
itemGetSet :: Handle
           -> String                -- ^ key of the value to return
           -> String                -- ^ new value
           -> IO (Maybe RedisReply)
itemGetSet h key value = request h $ map toUTF8 ["GETSET", key, value]



------------------------------------------------------------------------------
-- MGET
multiGet :: Handle
         -> [String]              -- ^ keys from which to return a value
         -> IO (Maybe RedisReply)
multiGet h keys = request h $ map toUTF8 $ "MGET":keys


------------------------------------------------------------------------------
-- | SETNX for @String@ arguments
-- <http://code.google.com/p/redis/wiki/SetnxCommand>
itemSetNX :: Handle
          -> String                -- ^ key to set
          -> String                -- ^ value to set
          -> IO (Maybe RedisReply)
itemSetNX h key value = request h $ map toUTF8 ["SETNX", key, value]


------------------------------------------------------------------------------
-- | SETEX
itemSetEX :: Handle
          -> String                -- ^ key to set
          -> Int                   -- ^ number of seconds until expiration
          -> String                -- ^ value to set
          -> IO (Maybe RedisReply)
itemSetEX h key i value = request h $ map toUTF8 ["SETEX", key, show i, value]


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


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


------------------------------------------------------------------------------
-- | INCR
increment :: Handle
          -> String                 -- ^ key to increment
          -> IO (Maybe RedisReply)
increment h key = request h $ map toUTF8 ["INCR", key]


------------------------------------------------------------------------------
-- | INCRBY
incrementBy :: Handle
            -> String                 -- ^ key to increment
            -> Int
            -> IO (Maybe RedisReply)
incrementBy h key i = request h $ map toUTF8 ["INCRBY", key, show i]


------------------------------------------------------------------------------
-- | DECR
decrement :: Handle
          -> String                 -- ^ key to decrement
          -> IO (Maybe RedisReply)
decrement h key = request h $ map toUTF8 ["DECR", key]


------------------------------------------------------------------------------
-- DECRBY
decrementBy :: Handle
            -> String                 -- ^ key to decrement
            -> Int
            -> IO (Maybe RedisReply)
decrementBy h key i = request h $ map toUTF8 ["DECRBY", key, show i]


------------------------------------------------------------------------------
-- | APPEND for @String@ arguments
-- <http://code.google.com/p/redis/wiki/AppendCommand>
itemAppend :: Handle
           -> String                -- ^ key to append to
           -> String                -- ^ value to append
           -> IO (Maybe RedisReply)
itemAppend h key value = request h $ map toUTF8 ["APPEND", key, value]


------------------------------------------------------------------------------
-- | SUBSTR
substring :: Handle
          -> String                -- ^ key to append to
          -> Int                   -- ^ start position
          -> Int                   -- ^ end position
          -> IO (Maybe RedisReply)
substring h key start end = 
    request h $ map toUTF8 ["SUBSTRING", show key, show start, show end]