{-
-- | This module interacts with the list structure in Redis. All the functions
-- take  either  'String' or  'ByteString'  arguments,  but send  'ByteString'
-- 'request's regardless.
-}

module Database.Redis.List
    ( listRightPush, listRightPushB
    , listLeftPush, listLeftPushB
    , listLength, listLengthB
    , listRange, listRangeB
    , listIndex, listIndexB
    , listRemove, listRemoveB
    , listTrim
    , listSet
    , listHeadPop
    , listTailPop
    , listBlockHeadPop
    , listBlockTailPop
    , listRPopLPush
    ) where


import           System.IO

import           Database.Redis.Internal


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


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


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


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


------------------------------------------------------------------------------
-- | Calls @LLEN@ with a 'String' argument
listLength :: Handle
           -> String  -- ^ key
           -> IO (Maybe RedisReply)
listLength h key = request h $ map toUTF8 ["LLEN", key]


-- | Calls @LLEN@ with a 'ByteString' argument
listLengthB :: Handle
            -> ByteString  -- ^ key
            -> IO (Maybe RedisReply)
listLengthB h key = request h [toUTF8 "LLEN", key]


------------------------------------------------------------------------------
-- | Calls @LRANGE@ with a 'String' argument
listRange :: Handle
           -> String   -- ^ key
           -> Int      -- ^ start
           -> Int      -- ^ end
           -> IO (Maybe RedisReply)
listRange h key start end =
    request h $ map toUTF8 ["LRANGE", key, show start, show end]


-- | Calls @LRANGE@ with a 'ByteString' argument
listRangeB :: Handle
           -> ByteString  -- ^ key
           -> Int         -- ^ start
           -> Int         -- ^ end
           -> IO (Maybe RedisReply)
listRangeB h key start end =
    request h [toUTF8 "LRANGE", key, toUTF8 $ show start, toUTF8 $ show end]


------------------------------------------------------------------------------
-- | LTRIM
listTrim :: Handle
           -> String   -- ^ key
           -> Int      -- ^ start
           -> Int      -- ^ end
           -> IO (Maybe RedisReply)
listTrim h key start end =
    request h $ map toUTF8 ["LTRIM", key, show start, show end]


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


-- | Calls @LINDEX@ with 'ByteString' and 'Int' arguments
listIndexB :: Handle
           -> ByteString    -- ^ key
           -> Int           -- ^ index
           -> IO (Maybe RedisReply)
listIndexB h key index =
    request h [toUTF8 "LINDEX", key, toUTF8 $ show index]


------------------------------------------------------------------------------
-- LSET
listSet :: Handle
          -> String   -- ^ key
          -> Int      -- ^ index
          -> String   -- ^ value
          -> IO (Maybe RedisReply)
listSet h key index value =
    request h $ map toUTF8 ["LSET", key, show index, value]


------------------------------------------------------------------------------
-- | Calls @LREM@ with 'String' and 'Int' arguments.  This command deletes
-- values matching the @value@ parameter. A negative 'Int' argument deletes
-- starting at the tail and moving towards the head (or from right to left,
-- after the push commands). A positive argument deletes from left to right.
-- Zero deletes all the elements.  Returns the number of elements deleted
-- (which should match the number) or 0 on failure.
listRemove :: Handle
           -> String   -- ^ key
           -> Int      -- ^ the number of items to delete (sign is direction)
           -> String   -- ^ value
           -> IO (Maybe RedisReply)
listRemove h key num value =
    request h $ map toUTF8 ["LREM", key, show num, value]


-- | Calls @LREM@ with 'ByteString' and 'Int' arguments.
listRemoveB :: Handle
            -> ByteString   -- ^ key
            -> Int          -- ^ the number of items to delete (sign is direction)
            -> ByteString   -- ^ value
            -> IO (Maybe RedisReply)
listRemoveB h key num value =
    request h [toUTF8 "LREM", key, toUTF8 $ show num, value]


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


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


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


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


-- | RPOPLPUSH
listRPopLPush :: Handle
                 -> String   -- ^ source key
                 -> String   -- ^ destination key
                 -> IO (Maybe RedisReply)
listRPopLPush h source destination =
    request h $ map toUTF8 ["RPOPLPUSH", source, destination]