{-# LANGUAGE CPP, OverloadedStrings, RecordWildCards, FlexibleContexts #-}

module Database.Redis.ManualCommands where

import Prelude hiding (min, max)
import Data.ByteString (ByteString, empty, append)
import qualified Data.ByteString.Char8 as Char8
import qualified Data.ByteString as BS
import Data.Maybe (maybeToList, catMaybes)
#if __GLASGOW_HASKELL__ < 808
import Data.Semigroup ((<>))
#endif
import Database.Redis.Core
import Database.Redis.Protocol
import Database.Redis.Types
import qualified Database.Redis.Cluster.Command as CMD


objectRefcount
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> m (f Integer)
objectRefcount :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
objectRefcount ByteString
key = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"OBJECT", ByteString
"refcount", forall a. RedisArg a => a -> ByteString
encode ByteString
key]

objectIdletime
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> m (f Integer)
objectIdletime :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
objectIdletime ByteString
key = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"OBJECT", ByteString
"idletime", forall a. RedisArg a => a -> ByteString
encode ByteString
key]

objectEncoding
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> m (f ByteString)
objectEncoding :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f ByteString)
objectEncoding ByteString
key = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"OBJECT", ByteString
"encoding", forall a. RedisArg a => a -> ByteString
encode ByteString
key]

linsertBefore
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> ByteString -- ^ pivot
    -> ByteString -- ^ value
    -> m (f Integer)
linsertBefore :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
linsertBefore ByteString
key ByteString
pivot ByteString
value =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"LINSERT", forall a. RedisArg a => a -> ByteString
encode ByteString
key, ByteString
"BEFORE", forall a. RedisArg a => a -> ByteString
encode ByteString
pivot, forall a. RedisArg a => a -> ByteString
encode ByteString
value]

linsertAfter
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> ByteString -- ^ pivot
    -> ByteString -- ^ value
    -> m (f Integer)
linsertAfter :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
linsertAfter ByteString
key ByteString
pivot ByteString
value =
        forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"LINSERT", forall a. RedisArg a => a -> ByteString
encode ByteString
key, ByteString
"AFTER", forall a. RedisArg a => a -> ByteString
encode ByteString
pivot, forall a. RedisArg a => a -> ByteString
encode ByteString
value]

getType
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> m (f RedisType)
getType :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f RedisType)
getType ByteString
key = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"TYPE", forall a. RedisArg a => a -> ByteString
encode ByteString
key]

-- |A single entry from the slowlog.
data Slowlog = Slowlog
    { Slowlog -> Integer
slowlogId        :: Integer
      -- ^ A unique progressive identifier for every slow log entry.
    , Slowlog -> Integer
slowlogTimestamp :: Integer
      -- ^ The unix timestamp at which the logged command was processed.
    , Slowlog -> Integer
slowlogMicros    :: Integer
      -- ^ The amount of time needed for its execution, in microseconds.
    , Slowlog -> [ByteString]
slowlogCmd       :: [ByteString]
      -- ^ The command and it's arguments.
    , Slowlog -> Maybe ByteString
slowlogClientIpAndPort :: Maybe ByteString
    , Slowlog -> Maybe ByteString
slowlogClientName :: Maybe ByteString
    } deriving (Int -> Slowlog -> ShowS
[Slowlog] -> ShowS
Slowlog -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Slowlog] -> ShowS
$cshowList :: [Slowlog] -> ShowS
show :: Slowlog -> String
$cshow :: Slowlog -> String
showsPrec :: Int -> Slowlog -> ShowS
$cshowsPrec :: Int -> Slowlog -> ShowS
Show, Slowlog -> Slowlog -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Slowlog -> Slowlog -> Bool
$c/= :: Slowlog -> Slowlog -> Bool
== :: Slowlog -> Slowlog -> Bool
$c== :: Slowlog -> Slowlog -> Bool
Eq)

instance RedisResult Slowlog where
    decode :: Reply -> Either Reply Slowlog
decode (MultiBulk (Just [Reply
logId,Reply
timestamp,Reply
micros,Reply
cmd])) = do
        Integer
slowlogId        <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
logId
        Integer
slowlogTimestamp <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
timestamp
        Integer
slowlogMicros    <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
micros
        [ByteString]
slowlogCmd       <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
cmd
        let slowlogClientIpAndPort :: Maybe a
slowlogClientIpAndPort = forall a. Maybe a
Nothing
            slowlogClientName :: Maybe a
slowlogClientName = forall a. Maybe a
Nothing
        forall (m :: * -> *) a. Monad m => a -> m a
return Slowlog{Integer
[ByteString]
forall a. Maybe a
slowlogClientName :: forall a. Maybe a
slowlogClientIpAndPort :: forall a. Maybe a
slowlogCmd :: [ByteString]
slowlogMicros :: Integer
slowlogTimestamp :: Integer
slowlogId :: Integer
slowlogClientName :: Maybe ByteString
slowlogClientIpAndPort :: Maybe ByteString
slowlogCmd :: [ByteString]
slowlogMicros :: Integer
slowlogTimestamp :: Integer
slowlogId :: Integer
..}
    decode (MultiBulk (Just [Reply
logId,Reply
timestamp,Reply
micros,Reply
cmd,Reply
ip,Reply
cname])) = do
        Integer
slowlogId        <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
logId
        Integer
slowlogTimestamp <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
timestamp
        Integer
slowlogMicros    <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
micros
        [ByteString]
slowlogCmd       <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
cmd
        Maybe ByteString
slowlogClientIpAndPort <- forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RedisResult a => Reply -> Either Reply a
decode Reply
ip
        Maybe ByteString
slowlogClientName <- forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. RedisResult a => Reply -> Either Reply a
decode Reply
cname
        forall (m :: * -> *) a. Monad m => a -> m a
return Slowlog{Integer
[ByteString]
Maybe ByteString
slowlogClientName :: Maybe ByteString
slowlogClientIpAndPort :: Maybe ByteString
slowlogCmd :: [ByteString]
slowlogMicros :: Integer
slowlogTimestamp :: Integer
slowlogId :: Integer
slowlogClientName :: Maybe ByteString
slowlogClientIpAndPort :: Maybe ByteString
slowlogCmd :: [ByteString]
slowlogMicros :: Integer
slowlogTimestamp :: Integer
slowlogId :: Integer
..}
    decode Reply
r = forall a b. a -> Either a b
Left Reply
r

slowlogGet
    :: (RedisCtx m f)
    => Integer -- ^ cnt
    -> m (f [Slowlog])
slowlogGet :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Integer -> m (f [Slowlog])
slowlogGet Integer
n = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SLOWLOG", ByteString
"GET", forall a. RedisArg a => a -> ByteString
encode Integer
n]

slowlogLen :: (RedisCtx m f) => m (f Integer)
slowlogLen :: forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Integer)
slowlogLen = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SLOWLOG", ByteString
"LEN"]

slowlogReset :: (RedisCtx m f) => m (f Status)
slowlogReset :: forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Status)
slowlogReset = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SLOWLOG", ByteString
"RESET"]

zrange
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ start
    -> Integer -- ^ stop
    -> m (f [ByteString])
zrange :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [ByteString])
zrange ByteString
key Integer
start Integer
stop =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZRANGE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
start, forall a. RedisArg a => a -> ByteString
encode Integer
stop]

zrangeWithscores
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ start
    -> Integer -- ^ stop
    -> m (f [(ByteString, Double)])
zrangeWithscores :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrangeWithscores ByteString
key Integer
start Integer
stop =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZRANGE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
start, forall a. RedisArg a => a -> ByteString
encode Integer
stop, ByteString
"WITHSCORES"]

zrevrange
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ start
    -> Integer -- ^ stop
    -> m (f [ByteString])
zrevrange :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [ByteString])
zrevrange ByteString
key Integer
start Integer
stop =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZREVRANGE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
start, forall a. RedisArg a => a -> ByteString
encode Integer
stop]

zrevrangeWithscores
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ start
    -> Integer -- ^ stop
    -> m (f [(ByteString, Double)])
zrevrangeWithscores :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrevrangeWithscores ByteString
key Integer
start Integer
stop =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZREVRANGE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
start, forall a. RedisArg a => a -> ByteString
encode Integer
stop
                ,ByteString
"WITHSCORES"]

zrangebyscore
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Double -- ^ min
    -> Double -- ^ max
    -> m (f [ByteString])
zrangebyscore :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Double -> Double -> m (f [ByteString])
zrangebyscore ByteString
key Double
min Double
max =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZRANGEBYSCORE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Double
min, forall a. RedisArg a => a -> ByteString
encode Double
max]

zrangebyscoreWithscores
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Double -- ^ min
    -> Double -- ^ max
    -> m (f [(ByteString, Double)])
zrangebyscoreWithscores :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Double -> Double -> m (f [(ByteString, Double)])
zrangebyscoreWithscores ByteString
key Double
min Double
max =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZRANGEBYSCORE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Double
min, forall a. RedisArg a => a -> ByteString
encode Double
max
                ,ByteString
"WITHSCORES"]

zrangebyscoreLimit
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Double -- ^ min
    -> Double -- ^ max
    -> Integer -- ^ offset
    -> Integer -- ^ count
    -> m (f [ByteString])
zrangebyscoreLimit :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double -> Double -> Integer -> Integer -> m (f [ByteString])
zrangebyscoreLimit ByteString
key Double
min Double
max Integer
offset Integer
count =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZRANGEBYSCORE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Double
min, forall a. RedisArg a => a -> ByteString
encode Double
max
                ,ByteString
"LIMIT", forall a. RedisArg a => a -> ByteString
encode Integer
offset, forall a. RedisArg a => a -> ByteString
encode Integer
count]

zrangebyscoreWithscoresLimit
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Double -- ^ min
    -> Double -- ^ max
    -> Integer -- ^ offset
    -> Integer -- ^ count
    -> m (f [(ByteString, Double)])
zrangebyscoreWithscoresLimit :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrangebyscoreWithscoresLimit ByteString
key Double
min Double
max Integer
offset Integer
count =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZRANGEBYSCORE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Double
min, forall a. RedisArg a => a -> ByteString
encode Double
max
                ,ByteString
"WITHSCORES",ByteString
"LIMIT", forall a. RedisArg a => a -> ByteString
encode Integer
offset, forall a. RedisArg a => a -> ByteString
encode Integer
count]

zrevrangebyscore
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Double -- ^ max
    -> Double -- ^ min
    -> m (f [ByteString])
zrevrangebyscore :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Double -> Double -> m (f [ByteString])
zrevrangebyscore ByteString
key Double
min Double
max =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZREVRANGEBYSCORE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Double
min, forall a. RedisArg a => a -> ByteString
encode Double
max]

zrevrangebyscoreWithscores
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Double -- ^ max
    -> Double -- ^ min
    -> m (f [(ByteString, Double)])
zrevrangebyscoreWithscores :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Double -> Double -> m (f [(ByteString, Double)])
zrevrangebyscoreWithscores ByteString
key Double
min Double
max =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZREVRANGEBYSCORE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Double
min, forall a. RedisArg a => a -> ByteString
encode Double
max
                ,ByteString
"WITHSCORES"]

zrevrangebyscoreLimit
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Double -- ^ max
    -> Double -- ^ min
    -> Integer -- ^ offset
    -> Integer -- ^ count
    -> m (f [ByteString])
zrevrangebyscoreLimit :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double -> Double -> Integer -> Integer -> m (f [ByteString])
zrevrangebyscoreLimit ByteString
key Double
min Double
max Integer
offset Integer
count =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZREVRANGEBYSCORE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Double
min, forall a. RedisArg a => a -> ByteString
encode Double
max
                ,ByteString
"LIMIT", forall a. RedisArg a => a -> ByteString
encode Integer
offset, forall a. RedisArg a => a -> ByteString
encode Integer
count]

zrevrangebyscoreWithscoresLimit
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Double -- ^ max
    -> Double -- ^ min
    -> Integer -- ^ offset
    -> Integer -- ^ count
    -> m (f [(ByteString, Double)])
zrevrangebyscoreWithscoresLimit :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrevrangebyscoreWithscoresLimit ByteString
key Double
min Double
max Integer
offset Integer
count =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZREVRANGEBYSCORE", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode Double
min, forall a. RedisArg a => a -> ByteString
encode Double
max
                ,ByteString
"WITHSCORES",ByteString
"LIMIT", forall a. RedisArg a => a -> ByteString
encode Integer
offset, forall a. RedisArg a => a -> ByteString
encode Integer
count]

-- |Options for the 'sort' command.
data SortOpts = SortOpts
    { SortOpts -> Maybe ByteString
sortBy     :: Maybe ByteString
    , SortOpts -> (Integer, Integer)
sortLimit  :: (Integer,Integer)
    , SortOpts -> [ByteString]
sortGet    :: [ByteString]
    , SortOpts -> SortOrder
sortOrder  :: SortOrder
    , SortOpts -> Bool
sortAlpha  :: Bool
    } deriving (Int -> SortOpts -> ShowS
[SortOpts] -> ShowS
SortOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortOpts] -> ShowS
$cshowList :: [SortOpts] -> ShowS
show :: SortOpts -> String
$cshow :: SortOpts -> String
showsPrec :: Int -> SortOpts -> ShowS
$cshowsPrec :: Int -> SortOpts -> ShowS
Show, SortOpts -> SortOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortOpts -> SortOpts -> Bool
$c/= :: SortOpts -> SortOpts -> Bool
== :: SortOpts -> SortOpts -> Bool
$c== :: SortOpts -> SortOpts -> Bool
Eq)

-- |Redis default 'SortOpts'. Equivalent to omitting all optional parameters.
--
-- @
-- SortOpts
--     { sortBy    = Nothing -- omit the BY option
--     , sortLimit = (0,-1)  -- return entire collection
--     , sortGet   = []      -- omit the GET option
--     , sortOrder = Asc     -- sort in ascending order
--     , sortAlpha = False   -- sort numerically, not lexicographically
--     }
-- @
--
defaultSortOpts :: SortOpts
defaultSortOpts :: SortOpts
defaultSortOpts = SortOpts
    { sortBy :: Maybe ByteString
sortBy    = forall a. Maybe a
Nothing
    , sortLimit :: (Integer, Integer)
sortLimit = (Integer
0,-Integer
1)
    , sortGet :: [ByteString]
sortGet   = []
    , sortOrder :: SortOrder
sortOrder = SortOrder
Asc
    , sortAlpha :: Bool
sortAlpha = Bool
False
    }

data SortOrder = Asc | Desc deriving (Int -> SortOrder -> ShowS
[SortOrder] -> ShowS
SortOrder -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SortOrder] -> ShowS
$cshowList :: [SortOrder] -> ShowS
show :: SortOrder -> String
$cshow :: SortOrder -> String
showsPrec :: Int -> SortOrder -> ShowS
$cshowsPrec :: Int -> SortOrder -> ShowS
Show, SortOrder -> SortOrder -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SortOrder -> SortOrder -> Bool
$c/= :: SortOrder -> SortOrder -> Bool
== :: SortOrder -> SortOrder -> Bool
$c== :: SortOrder -> SortOrder -> Bool
Eq)

sortStore
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> ByteString -- ^ destination
    -> SortOpts
    -> m (f Integer)
sortStore :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> SortOpts -> m (f Integer)
sortStore ByteString
key ByteString
dest = forall a (m :: * -> *) (f :: * -> *).
(RedisResult a, RedisCtx m f) =>
ByteString -> Maybe ByteString -> SortOpts -> m (f a)
sortInternal ByteString
key (forall a. a -> Maybe a
Just ByteString
dest)

sort
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> SortOpts
    -> m (f [ByteString])
sort :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> SortOpts -> m (f [ByteString])
sort ByteString
key = forall a (m :: * -> *) (f :: * -> *).
(RedisResult a, RedisCtx m f) =>
ByteString -> Maybe ByteString -> SortOpts -> m (f a)
sortInternal ByteString
key forall a. Maybe a
Nothing

sortInternal
    :: (RedisResult a, RedisCtx m f)
    => ByteString -- ^ key
    -> Maybe ByteString -- ^ destination
    -> SortOpts
    -> m (f a)
sortInternal :: forall a (m :: * -> *) (f :: * -> *).
(RedisResult a, RedisCtx m f) =>
ByteString -> Maybe ByteString -> SortOpts -> m (f a)
sortInternal ByteString
key Maybe ByteString
destination SortOpts{Bool
[ByteString]
Maybe ByteString
(Integer, Integer)
SortOrder
sortAlpha :: Bool
sortOrder :: SortOrder
sortGet :: [ByteString]
sortLimit :: (Integer, Integer)
sortBy :: Maybe ByteString
sortAlpha :: SortOpts -> Bool
sortOrder :: SortOpts -> SortOrder
sortGet :: SortOpts -> [ByteString]
sortLimit :: SortOpts -> (Integer, Integer)
sortBy :: SortOpts -> Maybe ByteString
..} = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ByteString
"SORT", forall a. RedisArg a => a -> ByteString
encode ByteString
key], [ByteString]
by, [ByteString]
limit, [ByteString]
get, [ByteString]
order, [ByteString]
alpha, [ByteString]
store]
  where
    by :: [ByteString]
by    = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
pattern -> [ByteString
"BY", ByteString
pattern]) Maybe ByteString
sortBy
    limit :: [ByteString]
limit = let (Integer
off,Integer
cnt) = (Integer, Integer)
sortLimit in [ByteString
"LIMIT", forall a. RedisArg a => a -> ByteString
encode Integer
off, forall a. RedisArg a => a -> ByteString
encode Integer
cnt]
    get :: [ByteString]
get   = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\ByteString
pattern -> [ByteString
"GET", ByteString
pattern]) [ByteString]
sortGet
    order :: [ByteString]
order = case SortOrder
sortOrder of SortOrder
Desc -> [ByteString
"DESC"]; SortOrder
Asc -> [ByteString
"ASC"]
    alpha :: [ByteString]
alpha = [ByteString
"ALPHA" | Bool
sortAlpha]
    store :: [ByteString]
store = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
dest -> [ByteString
"STORE", ByteString
dest]) Maybe ByteString
destination


data Aggregate = Sum | Min | Max deriving (Int -> Aggregate -> ShowS
[Aggregate] -> ShowS
Aggregate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Aggregate] -> ShowS
$cshowList :: [Aggregate] -> ShowS
show :: Aggregate -> String
$cshow :: Aggregate -> String
showsPrec :: Int -> Aggregate -> ShowS
$cshowsPrec :: Int -> Aggregate -> ShowS
Show,Aggregate -> Aggregate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aggregate -> Aggregate -> Bool
$c/= :: Aggregate -> Aggregate -> Bool
== :: Aggregate -> Aggregate -> Bool
$c== :: Aggregate -> Aggregate -> Bool
Eq)

zunionstore
    :: (RedisCtx m f)
    => ByteString -- ^ destination
    -> [ByteString] -- ^ keys
    -> Aggregate
    -> m (f Integer)
zunionstore :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> Aggregate -> m (f Integer)
zunionstore ByteString
dest [ByteString]
keys =
    forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal ByteString
"ZUNIONSTORE" ByteString
dest [ByteString]
keys []

zunionstoreWeights
    :: (RedisCtx m f)
    => ByteString -- ^ destination
    -> [(ByteString,Double)] -- ^ weighted keys
    -> Aggregate
    -> m (f Integer)
zunionstoreWeights :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, Double)] -> Aggregate -> m (f Integer)
zunionstoreWeights ByteString
dest [(ByteString, Double)]
kws =
    let ([ByteString]
keys,[Double]
weights) = forall a b. [(a, b)] -> ([a], [b])
unzip [(ByteString, Double)]
kws
    in forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal ByteString
"ZUNIONSTORE" ByteString
dest [ByteString]
keys [Double]
weights

zinterstore
    :: (RedisCtx m f)
    => ByteString -- ^ destination
    -> [ByteString] -- ^ keys
    -> Aggregate
    -> m (f Integer)
zinterstore :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> Aggregate -> m (f Integer)
zinterstore ByteString
dest [ByteString]
keys =
    forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal ByteString
"ZINTERSTORE" ByteString
dest [ByteString]
keys []

zinterstoreWeights
    :: (RedisCtx m f)
    => ByteString -- ^ destination
    -> [(ByteString,Double)] -- ^ weighted keys
    -> Aggregate
    -> m (f Integer)
zinterstoreWeights :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, Double)] -> Aggregate -> m (f Integer)
zinterstoreWeights ByteString
dest [(ByteString, Double)]
kws =
    let ([ByteString]
keys,[Double]
weights) = forall a b. [(a, b)] -> ([a], [b])
unzip [(ByteString, Double)]
kws
    in forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal ByteString
"ZINTERSTORE" ByteString
dest [ByteString]
keys [Double]
weights

zstoreInternal
    :: (RedisCtx m f)
    => ByteString -- ^ cmd
    -> ByteString -- ^ destination
    -> [ByteString] -- ^ keys
    -> [Double] -- ^ weights
    -> Aggregate
    -> m (f Integer)
zstoreInternal :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal ByteString
cmd ByteString
dest [ByteString]
keys [Double]
weights Aggregate
aggregate = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ByteString
cmd, ByteString
dest, forall a. RedisArg a => a -> ByteString
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
keys], [ByteString]
keys
           , if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
weights then [] else ByteString
"WEIGHTS" forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall a. RedisArg a => a -> ByteString
encode [Double]
weights
           , [ByteString
"AGGREGATE", ByteString
aggregate']
           ]
  where
    aggregate' :: ByteString
aggregate' = case Aggregate
aggregate of
        Aggregate
Sum -> ByteString
"SUM"
        Aggregate
Min -> ByteString
"MIN"
        Aggregate
Max -> ByteString
"MAX"

eval
    :: (RedisCtx m f, RedisResult a)
    => ByteString -- ^ script
    -> [ByteString] -- ^ keys
    -> [ByteString] -- ^ args
    -> m (f a)
eval :: forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
ByteString -> [ByteString] -> [ByteString] -> m (f a)
eval ByteString
script [ByteString]
keys [ByteString]
args =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"EVAL", ByteString
script, forall a. RedisArg a => a -> ByteString
encode Integer
numkeys] forall a. [a] -> [a] -> [a]
++ [ByteString]
keys forall a. [a] -> [a] -> [a]
++ [ByteString]
args
  where
    numkeys :: Integer
numkeys = forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
keys)

-- | Works like 'eval', but sends the SHA1 hash of the script instead of the script itself.
-- Fails if the server does not recognise the hash, in which case, 'eval' should be used instead.
evalsha
    :: (RedisCtx m f, RedisResult a)
    => ByteString -- ^ base16-encoded sha1 hash of the script
    -> [ByteString] -- ^ keys
    -> [ByteString] -- ^ args
    -> m (f a)
evalsha :: forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
ByteString -> [ByteString] -> [ByteString] -> m (f a)
evalsha ByteString
script [ByteString]
keys [ByteString]
args =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"EVALSHA", ByteString
script, forall a. RedisArg a => a -> ByteString
encode Integer
numkeys] forall a. [a] -> [a] -> [a]
++ [ByteString]
keys forall a. [a] -> [a] -> [a]
++ [ByteString]
args
  where
    numkeys :: Integer
numkeys = forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
keys)

bitcount
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> m (f Integer)
bitcount :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
bitcount ByteString
key = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"BITCOUNT", ByteString
key]

bitcountRange
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ start
    -> Integer -- ^ end
    -> m (f Integer)
bitcountRange :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f Integer)
bitcountRange ByteString
key Integer
start Integer
end =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"BITCOUNT", ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
start, forall a. RedisArg a => a -> ByteString
encode Integer
end]

bitopAnd
    :: (RedisCtx m f)
    => ByteString -- ^ destkey
    -> [ByteString] -- ^ srckeys
    -> m (f Integer)
bitopAnd :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitopAnd ByteString
dst [ByteString]
srcs = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop ByteString
"AND" (ByteString
dstforall a. a -> [a] -> [a]
:[ByteString]
srcs)

bitopOr
    :: (RedisCtx m f)
    => ByteString -- ^ destkey
    -> [ByteString] -- ^ srckeys
    -> m (f Integer)
bitopOr :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitopOr ByteString
dst [ByteString]
srcs = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop ByteString
"OR" (ByteString
dstforall a. a -> [a] -> [a]
:[ByteString]
srcs)

bitopXor
    :: (RedisCtx m f)
    => ByteString -- ^ destkey
    -> [ByteString] -- ^ srckeys
    -> m (f Integer)
bitopXor :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitopXor ByteString
dst [ByteString]
srcs = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop ByteString
"XOR" (ByteString
dstforall a. a -> [a] -> [a]
:[ByteString]
srcs)

bitopNot
    :: (RedisCtx m f)
    => ByteString -- ^ destkey
    -> ByteString -- ^ srckey
    -> m (f Integer)
bitopNot :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Integer)
bitopNot ByteString
dst ByteString
src = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop ByteString
"NOT" [ByteString
dst, ByteString
src]

bitop
    :: (RedisCtx m f)
    => ByteString -- ^ operation
    -> [ByteString] -- ^ keys
    -> m (f Integer)
bitop :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop ByteString
op [ByteString]
ks = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ ByteString
"BITOP" forall a. a -> [a] -> [a]
: ByteString
op forall a. a -> [a] -> [a]
: [ByteString]
ks

-- setRange
--   ::
-- setRange = sendRequest (["SET"] ++ [encode key] ++ [encode value] ++ )

migrate
    :: (RedisCtx m f)
    => ByteString -- ^ host
    -> ByteString -- ^ port
    -> ByteString -- ^ key
    -> Integer -- ^ destinationDb
    -> Integer -- ^ timeout
    -> m (f Status)
migrate :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString -> ByteString -> Integer -> Integer -> m (f Status)
migrate ByteString
host ByteString
port ByteString
key Integer
destinationDb Integer
timeout =
  forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"MIGRATE", ByteString
host, ByteString
port, ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
destinationDb, forall a. RedisArg a => a -> ByteString
encode Integer
timeout]


-- |Options for the 'migrate' command.
data MigrateOpts = MigrateOpts
    { MigrateOpts -> Bool
migrateCopy    :: Bool
    , MigrateOpts -> Bool
migrateReplace :: Bool
    } deriving (Int -> MigrateOpts -> ShowS
[MigrateOpts] -> ShowS
MigrateOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MigrateOpts] -> ShowS
$cshowList :: [MigrateOpts] -> ShowS
show :: MigrateOpts -> String
$cshow :: MigrateOpts -> String
showsPrec :: Int -> MigrateOpts -> ShowS
$cshowsPrec :: Int -> MigrateOpts -> ShowS
Show, MigrateOpts -> MigrateOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MigrateOpts -> MigrateOpts -> Bool
$c/= :: MigrateOpts -> MigrateOpts -> Bool
== :: MigrateOpts -> MigrateOpts -> Bool
$c== :: MigrateOpts -> MigrateOpts -> Bool
Eq)

-- |Redis default 'MigrateOpts'. Equivalent to omitting all optional parameters.
--
-- @
-- MigrateOpts
--     { migrateCopy    = False -- remove the key from the local instance
--     , migrateReplace = False -- don't replace existing key on the remote instance
--     }
-- @
--
defaultMigrateOpts :: MigrateOpts
defaultMigrateOpts :: MigrateOpts
defaultMigrateOpts = MigrateOpts
    { migrateCopy :: Bool
migrateCopy    = Bool
False
    , migrateReplace :: Bool
migrateReplace = Bool
False
    }

migrateMultiple
    :: (RedisCtx m f)
    => ByteString   -- ^ host
    -> ByteString   -- ^ port
    -> Integer      -- ^ destinationDb
    -> Integer      -- ^ timeout
    -> MigrateOpts
    -> [ByteString] -- ^ keys
    -> m (f Status)
migrateMultiple :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> Integer
-> Integer
-> MigrateOpts
-> [ByteString]
-> m (f Status)
migrateMultiple ByteString
host ByteString
port Integer
destinationDb Integer
timeout MigrateOpts{Bool
migrateReplace :: Bool
migrateCopy :: Bool
migrateReplace :: MigrateOpts -> Bool
migrateCopy :: MigrateOpts -> Bool
..} [ByteString]
keys =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ByteString
"MIGRATE", ByteString
host, ByteString
port, ByteString
empty, forall a. RedisArg a => a -> ByteString
encode Integer
destinationDb, forall a. RedisArg a => a -> ByteString
encode Integer
timeout],
            [ByteString]
copy, [ByteString]
replace, [ByteString]
keys]
  where
    copy :: [ByteString]
copy = [ByteString
"COPY" | Bool
migrateCopy]
    replace :: [ByteString]
replace = [ByteString
"REPLACE" | Bool
migrateReplace]


restore
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ timeToLive
    -> ByteString -- ^ serializedValue
    -> m (f Status)
restore :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> ByteString -> m (f Status)
restore ByteString
key Integer
timeToLive ByteString
serializedValue =
  forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"RESTORE", ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
timeToLive, ByteString
serializedValue]


restoreReplace
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ timeToLive
    -> ByteString -- ^ serializedValue
    -> m (f Status)
restoreReplace :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> ByteString -> m (f Status)
restoreReplace ByteString
key Integer
timeToLive ByteString
serializedValue =
  forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"RESTORE", ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
timeToLive, ByteString
serializedValue, ByteString
"REPLACE"]


set
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> ByteString -- ^ value
    -> m (f Status)
set :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
set ByteString
key ByteString
value = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SET", ByteString
key, ByteString
value]


data Condition = Nx | Xx deriving (Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Condition] -> ShowS
$cshowList :: [Condition] -> ShowS
show :: Condition -> String
$cshow :: Condition -> String
showsPrec :: Int -> Condition -> ShowS
$cshowsPrec :: Int -> Condition -> ShowS
Show, Condition -> Condition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Condition -> Condition -> Bool
$c/= :: Condition -> Condition -> Bool
== :: Condition -> Condition -> Bool
$c== :: Condition -> Condition -> Bool
Eq)


instance RedisArg Condition where
  encode :: Condition -> ByteString
encode Condition
Nx = ByteString
"NX"
  encode Condition
Xx = ByteString
"XX"


data SetOpts = SetOpts
  { SetOpts -> Maybe Integer
setSeconds      :: Maybe Integer
  , SetOpts -> Maybe Integer
setMilliseconds :: Maybe Integer
  , SetOpts -> Maybe Condition
setCondition    :: Maybe Condition
  } deriving (Int -> SetOpts -> ShowS
[SetOpts] -> ShowS
SetOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetOpts] -> ShowS
$cshowList :: [SetOpts] -> ShowS
show :: SetOpts -> String
$cshow :: SetOpts -> String
showsPrec :: Int -> SetOpts -> ShowS
$cshowsPrec :: Int -> SetOpts -> ShowS
Show, SetOpts -> SetOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetOpts -> SetOpts -> Bool
$c/= :: SetOpts -> SetOpts -> Bool
== :: SetOpts -> SetOpts -> Bool
$c== :: SetOpts -> SetOpts -> Bool
Eq)


setOpts
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> ByteString -- ^ value
    -> SetOpts
    -> m (f Status)
setOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> SetOpts -> m (f Status)
setOpts ByteString
key ByteString
value SetOpts{Maybe Integer
Maybe Condition
setCondition :: Maybe Condition
setMilliseconds :: Maybe Integer
setSeconds :: Maybe Integer
setCondition :: SetOpts -> Maybe Condition
setMilliseconds :: SetOpts -> Maybe Integer
setSeconds :: SetOpts -> Maybe Integer
..} =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ByteString
"SET", ByteString
key, ByteString
value], [ByteString]
ex, [ByteString]
px, [ByteString]
condition]
  where
    ex :: [ByteString]
ex = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
s -> [ByteString
"EX", forall a. RedisArg a => a -> ByteString
encode Integer
s]) Maybe Integer
setSeconds
    px :: [ByteString]
px = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
s -> [ByteString
"PX", forall a. RedisArg a => a -> ByteString
encode Integer
s]) Maybe Integer
setMilliseconds
    condition :: [ByteString]
condition = forall a b. (a -> b) -> [a] -> [b]
map forall a. RedisArg a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe Condition
setCondition


data DebugMode = Yes | Sync | No deriving (Int -> DebugMode -> ShowS
[DebugMode] -> ShowS
DebugMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DebugMode] -> ShowS
$cshowList :: [DebugMode] -> ShowS
show :: DebugMode -> String
$cshow :: DebugMode -> String
showsPrec :: Int -> DebugMode -> ShowS
$cshowsPrec :: Int -> DebugMode -> ShowS
Show, DebugMode -> DebugMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DebugMode -> DebugMode -> Bool
$c/= :: DebugMode -> DebugMode -> Bool
== :: DebugMode -> DebugMode -> Bool
$c== :: DebugMode -> DebugMode -> Bool
Eq)


instance RedisArg DebugMode where
  encode :: DebugMode -> ByteString
encode DebugMode
Yes = ByteString
"YES"
  encode DebugMode
Sync = ByteString
"SYNC"
  encode DebugMode
No = ByteString
"NO"


scriptDebug
    :: (RedisCtx m f)
    => DebugMode
    -> m (f Bool)
scriptDebug :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
DebugMode -> m (f Bool)
scriptDebug DebugMode
mode =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SCRIPT DEBUG", forall a. RedisArg a => a -> ByteString
encode DebugMode
mode]


zadd
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> [(Double,ByteString)] -- ^ scoreMember
    -> m (f Integer)
zadd :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
zadd ByteString
key [(Double, ByteString)]
scoreMembers =
  forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> ZaddOpts -> m (f Integer)
zaddOpts ByteString
key [(Double, ByteString)]
scoreMembers ZaddOpts
defaultZaddOpts


data ZaddOpts = ZaddOpts
  { ZaddOpts -> Maybe Condition
zaddCondition :: Maybe Condition
  , ZaddOpts -> Bool
zaddChange    :: Bool
  , ZaddOpts -> Bool
zaddIncrement :: Bool
  } deriving (Int -> ZaddOpts -> ShowS
[ZaddOpts] -> ShowS
ZaddOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ZaddOpts] -> ShowS
$cshowList :: [ZaddOpts] -> ShowS
show :: ZaddOpts -> String
$cshow :: ZaddOpts -> String
showsPrec :: Int -> ZaddOpts -> ShowS
$cshowsPrec :: Int -> ZaddOpts -> ShowS
Show, ZaddOpts -> ZaddOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ZaddOpts -> ZaddOpts -> Bool
$c/= :: ZaddOpts -> ZaddOpts -> Bool
== :: ZaddOpts -> ZaddOpts -> Bool
$c== :: ZaddOpts -> ZaddOpts -> Bool
Eq)


-- |Redis default 'ZaddOpts'. Equivalent to omitting all optional parameters.
--
-- @
-- ZaddOpts
--     { zaddCondition = Nothing -- omit NX and XX options
--     , zaddChange    = False   -- don't modify the return value from the number of new elements added, to the total number of elements changed
--     , zaddIncrement = False   -- don't add like ZINCRBY
--     }
-- @
--
defaultZaddOpts :: ZaddOpts
defaultZaddOpts :: ZaddOpts
defaultZaddOpts = ZaddOpts
  { zaddCondition :: Maybe Condition
zaddCondition = forall a. Maybe a
Nothing
  , zaddChange :: Bool
zaddChange    = Bool
False
  , zaddIncrement :: Bool
zaddIncrement = Bool
False
  }


zaddOpts
    :: (RedisCtx m f)
    => ByteString            -- ^ key
    -> [(Double,ByteString)] -- ^ scoreMember
    -> ZaddOpts              -- ^ options
    -> m (f Integer)
zaddOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> ZaddOpts -> m (f Integer)
zaddOpts ByteString
key [(Double, ByteString)]
scoreMembers ZaddOpts{Bool
Maybe Condition
zaddIncrement :: Bool
zaddChange :: Bool
zaddCondition :: Maybe Condition
zaddIncrement :: ZaddOpts -> Bool
zaddChange :: ZaddOpts -> Bool
zaddCondition :: ZaddOpts -> Maybe Condition
..} =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ByteString
"ZADD", ByteString
key], [ByteString]
condition, [ByteString]
change, [ByteString]
increment, [ByteString]
scores]
  where
    scores :: [ByteString]
scores = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Double
x,ByteString
y) -> [forall a. RedisArg a => a -> ByteString
encode Double
x,forall a. RedisArg a => a -> ByteString
encode ByteString
y]) [(Double, ByteString)]
scoreMembers
    condition :: [ByteString]
condition = forall a b. (a -> b) -> [a] -> [b]
map forall a. RedisArg a => a -> ByteString
encode forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> [a]
maybeToList Maybe Condition
zaddCondition
    change :: [ByteString]
change = [ByteString
"CH" | Bool
zaddChange]
    increment :: [ByteString]
increment = [ByteString
"INCR" | Bool
zaddIncrement]


data ReplyMode = On | Off | Skip deriving (Int -> ReplyMode -> ShowS
[ReplyMode] -> ShowS
ReplyMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReplyMode] -> ShowS
$cshowList :: [ReplyMode] -> ShowS
show :: ReplyMode -> String
$cshow :: ReplyMode -> String
showsPrec :: Int -> ReplyMode -> ShowS
$cshowsPrec :: Int -> ReplyMode -> ShowS
Show, ReplyMode -> ReplyMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReplyMode -> ReplyMode -> Bool
$c/= :: ReplyMode -> ReplyMode -> Bool
== :: ReplyMode -> ReplyMode -> Bool
$c== :: ReplyMode -> ReplyMode -> Bool
Eq)


instance RedisArg ReplyMode where
  encode :: ReplyMode -> ByteString
encode ReplyMode
On = ByteString
"ON"
  encode ReplyMode
Off = ByteString
"OFF"
  encode ReplyMode
Skip = ByteString
"SKIP"


clientReply
    :: (RedisCtx m f)
    => ReplyMode
    -> m (f Bool)
clientReply :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ReplyMode -> m (f Bool)
clientReply ReplyMode
mode =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"CLIENT REPLY", forall a. RedisArg a => a -> ByteString
encode ReplyMode
mode]


srandmember
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> m (f (Maybe ByteString))
srandmember :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
srandmember ByteString
key = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SRANDMEMBER", ByteString
key]


srandmemberN
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ count
    -> m (f [ByteString])
srandmemberN :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f [ByteString])
srandmemberN ByteString
key Integer
count = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SRANDMEMBER", ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
count]


spop
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> m (f (Maybe ByteString))
spop :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
spop ByteString
key = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SPOP", ByteString
key]


spopN
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Integer -- ^ count
    -> m (f [ByteString])
spopN :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f [ByteString])
spopN ByteString
key Integer
count = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SPOP", ByteString
key, forall a. RedisArg a => a -> ByteString
encode Integer
count]


info
    :: (RedisCtx m f)
    => m (f ByteString)
info :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
m (f ByteString)
info = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"INFO"]


infoSection
    :: (RedisCtx m f)
    => ByteString -- ^ section
    -> m (f ByteString)
infoSection :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f ByteString)
infoSection ByteString
section = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"INFO", ByteString
section]


exists
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> m (f Bool)
exists :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Bool)
exists ByteString
key = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"EXISTS", ByteString
key]

newtype Cursor = Cursor ByteString deriving (Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cursor] -> ShowS
$cshowList :: [Cursor] -> ShowS
show :: Cursor -> String
$cshow :: Cursor -> String
showsPrec :: Int -> Cursor -> ShowS
$cshowsPrec :: Int -> Cursor -> ShowS
Show, Cursor -> Cursor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c== :: Cursor -> Cursor -> Bool
Eq)


instance RedisArg Cursor where
  encode :: Cursor -> ByteString
encode (Cursor ByteString
c) = forall a. RedisArg a => a -> ByteString
encode ByteString
c


instance RedisResult Cursor where
  decode :: Reply -> Either Reply Cursor
decode (Bulk (Just ByteString
s)) = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString -> Cursor
Cursor ByteString
s
  decode Reply
r               = forall a b. a -> Either a b
Left Reply
r


cursor0 :: Cursor
cursor0 :: Cursor
cursor0 = ByteString -> Cursor
Cursor ByteString
"0"


scan
    :: (RedisCtx m f)
    => Cursor
    -> m (f (Cursor, [ByteString])) -- ^ next cursor and values
scan :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Cursor -> m (f (Cursor, [ByteString]))
scan Cursor
cursor = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
scanOpts Cursor
cursor ScanOpts
defaultScanOpts


data ScanOpts = ScanOpts
  { ScanOpts -> Maybe ByteString
scanMatch :: Maybe ByteString
  , ScanOpts -> Maybe Integer
scanCount :: Maybe Integer
  } deriving (Int -> ScanOpts -> ShowS
[ScanOpts] -> ShowS
ScanOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScanOpts] -> ShowS
$cshowList :: [ScanOpts] -> ShowS
show :: ScanOpts -> String
$cshow :: ScanOpts -> String
showsPrec :: Int -> ScanOpts -> ShowS
$cshowsPrec :: Int -> ScanOpts -> ShowS
Show, ScanOpts -> ScanOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScanOpts -> ScanOpts -> Bool
$c/= :: ScanOpts -> ScanOpts -> Bool
== :: ScanOpts -> ScanOpts -> Bool
$c== :: ScanOpts -> ScanOpts -> Bool
Eq)


-- |Redis default 'ScanOpts'. Equivalent to omitting all optional parameters.
--
-- @
-- ScanOpts
--     { scanMatch = Nothing -- don't match any pattern
--     , scanCount = Nothing -- don't set any requirements on number elements returned (works like value @COUNT 10@)
--     }
-- @
--
defaultScanOpts :: ScanOpts
defaultScanOpts :: ScanOpts
defaultScanOpts = ScanOpts
  { scanMatch :: Maybe ByteString
scanMatch = forall a. Maybe a
Nothing
  , scanCount :: Maybe Integer
scanCount = forall a. Maybe a
Nothing
  }


scanOpts
    :: (RedisCtx m f)
    => Cursor
    -> ScanOpts
    -> m (f (Cursor, [ByteString])) -- ^ next cursor and values
scanOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
scanOpts Cursor
cursor ScanOpts
opts = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString] -> ScanOpts -> [ByteString]
addScanOpts [ByteString
"SCAN", forall a. RedisArg a => a -> ByteString
encode Cursor
cursor] ScanOpts
opts


addScanOpts
    :: [ByteString] -- ^ main part of scan command
    -> ScanOpts
    -> [ByteString]
addScanOpts :: [ByteString] -> ScanOpts -> [ByteString]
addScanOpts [ByteString]
cmd ScanOpts{Maybe Integer
Maybe ByteString
scanCount :: Maybe Integer
scanMatch :: Maybe ByteString
scanCount :: ScanOpts -> Maybe Integer
scanMatch :: ScanOpts -> Maybe ByteString
..} =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ByteString]
cmd, [ByteString]
match, [ByteString]
count]
  where
    prepend :: a -> a -> [a]
prepend a
x a
y = [a
x, a
y]
    match :: [ByteString]
match       = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall {a}. a -> a -> [a]
prepend ByteString
"MATCH") Maybe ByteString
scanMatch
    count :: [ByteString]
count       = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((forall {a}. a -> a -> [a]
prepend ByteString
"COUNT")forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a. RedisArg a => a -> ByteString
encode) Maybe Integer
scanCount

sscan
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Cursor
    -> m (f (Cursor, [ByteString])) -- ^ next cursor and values
sscan :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Cursor -> m (f (Cursor, [ByteString]))
sscan ByteString
key Cursor
cursor = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
sscanOpts ByteString
key Cursor
cursor ScanOpts
defaultScanOpts


sscanOpts
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Cursor
    -> ScanOpts
    -> m (f (Cursor, [ByteString])) -- ^ next cursor and values
sscanOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
sscanOpts ByteString
key Cursor
cursor ScanOpts
opts = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString] -> ScanOpts -> [ByteString]
addScanOpts [ByteString
"SSCAN", ByteString
key, forall a. RedisArg a => a -> ByteString
encode Cursor
cursor] ScanOpts
opts


hscan
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Cursor
    -> m (f (Cursor, [(ByteString, ByteString)])) -- ^ next cursor and values
hscan :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Cursor -> m (f (Cursor, [(ByteString, ByteString)]))
hscan ByteString
key Cursor
cursor = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Cursor -> ScanOpts -> m (f (Cursor, [(ByteString, ByteString)]))
hscanOpts ByteString
key Cursor
cursor ScanOpts
defaultScanOpts


hscanOpts
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Cursor
    -> ScanOpts
    -> m (f (Cursor, [(ByteString, ByteString)])) -- ^ next cursor and values
hscanOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Cursor -> ScanOpts -> m (f (Cursor, [(ByteString, ByteString)]))
hscanOpts ByteString
key Cursor
cursor ScanOpts
opts = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString] -> ScanOpts -> [ByteString]
addScanOpts [ByteString
"HSCAN", ByteString
key, forall a. RedisArg a => a -> ByteString
encode Cursor
cursor] ScanOpts
opts


zscan
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Cursor
    -> m (f (Cursor, [(ByteString, Double)])) -- ^ next cursor and values
zscan :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Cursor -> m (f (Cursor, [(ByteString, Double)]))
zscan ByteString
key Cursor
cursor = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Cursor -> ScanOpts -> m (f (Cursor, [(ByteString, Double)]))
zscanOpts ByteString
key Cursor
cursor ScanOpts
defaultScanOpts


zscanOpts
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> Cursor
    -> ScanOpts
    -> m (f (Cursor, [(ByteString, Double)])) -- ^ next cursor and values
zscanOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Cursor -> ScanOpts -> m (f (Cursor, [(ByteString, Double)]))
zscanOpts ByteString
key Cursor
cursor ScanOpts
opts = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString] -> ScanOpts -> [ByteString]
addScanOpts [ByteString
"ZSCAN", ByteString
key, forall a. RedisArg a => a -> ByteString
encode Cursor
cursor] ScanOpts
opts

data RangeLex a = Incl a | Excl a | Minr | Maxr

instance RedisArg a => RedisArg (RangeLex a) where
  encode :: RangeLex a -> ByteString
encode (Incl a
bs) = ByteString
"[" ByteString -> ByteString -> ByteString
`append` forall a. RedisArg a => a -> ByteString
encode a
bs
  encode (Excl a
bs) = ByteString
"(" ByteString -> ByteString -> ByteString
`append` forall a. RedisArg a => a -> ByteString
encode a
bs
  encode RangeLex a
Minr      = ByteString
"-"
  encode RangeLex a
Maxr      = ByteString
"+"

zrangebylex::(RedisCtx m f) =>
    ByteString             -- ^ key
    -> RangeLex ByteString -- ^ min
    -> RangeLex ByteString -- ^ max
    -> m (f [ByteString])
zrangebylex :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> RangeLex ByteString -> RangeLex ByteString -> m (f [ByteString])
zrangebylex ByteString
key RangeLex ByteString
min RangeLex ByteString
max =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZRANGEBYLEX", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode RangeLex ByteString
min, forall a. RedisArg a => a -> ByteString
encode RangeLex ByteString
max]

zrangebylexLimit
    ::(RedisCtx m f)
    => ByteString -- ^ key
    -> RangeLex ByteString -- ^ min
    -> RangeLex ByteString -- ^ max
    -> Integer             -- ^ offset
    -> Integer             -- ^ count
    -> m (f [ByteString])
zrangebylexLimit :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> RangeLex ByteString
-> RangeLex ByteString
-> Integer
-> Integer
-> m (f [ByteString])
zrangebylexLimit ByteString
key RangeLex ByteString
min RangeLex ByteString
max Integer
offset Integer
count  =
    forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"ZRANGEBYLEX", forall a. RedisArg a => a -> ByteString
encode ByteString
key, forall a. RedisArg a => a -> ByteString
encode RangeLex ByteString
min, forall a. RedisArg a => a -> ByteString
encode RangeLex ByteString
max,
                 ByteString
"LIMIT", forall a. RedisArg a => a -> ByteString
encode Integer
offset, forall a. RedisArg a => a -> ByteString
encode Integer
count]

data TrimOpts = NoArgs | Maxlen Integer | ApproxMaxlen Integer

xaddOpts
    :: (RedisCtx m f)
    => ByteString -- ^ key
    -> ByteString -- ^ id
    -> [(ByteString, ByteString)] -- ^ (field, value)
    -> TrimOpts
    -> m (f ByteString)
xaddOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> TrimOpts
-> m (f ByteString)
xaddOpts ByteString
key ByteString
entryId [(ByteString, ByteString)]
fieldValues TrimOpts
opts = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    [ByteString
"XADD", ByteString
key] forall a. [a] -> [a] -> [a]
++ [ByteString]
optArgs forall a. [a] -> [a] -> [a]
++ [ByteString
entryId] forall a. [a] -> [a] -> [a]
++ [ByteString]
fieldArgs
    where
        fieldArgs :: [ByteString]
fieldArgs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(ByteString
x,ByteString
y) -> [ByteString
x,ByteString
y]) [(ByteString, ByteString)]
fieldValues
        optArgs :: [ByteString]
optArgs = case TrimOpts
opts of
            TrimOpts
NoArgs -> []
            Maxlen Integer
max -> [ByteString
"MAXLEN", forall a. RedisArg a => a -> ByteString
encode Integer
max]
            ApproxMaxlen Integer
max -> [ByteString
"MAXLEN", ByteString
"~", forall a. RedisArg a => a -> ByteString
encode Integer
max]

xadd
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ id
    -> [(ByteString, ByteString)] -- ^ (field, value)
    -> m (f ByteString)
xadd :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString -> [(ByteString, ByteString)] -> m (f ByteString)
xadd ByteString
key ByteString
entryId [(ByteString, ByteString)]
fieldValues = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> TrimOpts
-> m (f ByteString)
xaddOpts ByteString
key ByteString
entryId [(ByteString, ByteString)]
fieldValues TrimOpts
NoArgs

data StreamsRecord = StreamsRecord
    { StreamsRecord -> ByteString
recordId :: ByteString
    , StreamsRecord -> [(ByteString, ByteString)]
keyValues :: [(ByteString, ByteString)]
    } deriving (Int -> StreamsRecord -> ShowS
[StreamsRecord] -> ShowS
StreamsRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StreamsRecord] -> ShowS
$cshowList :: [StreamsRecord] -> ShowS
show :: StreamsRecord -> String
$cshow :: StreamsRecord -> String
showsPrec :: Int -> StreamsRecord -> ShowS
$cshowsPrec :: Int -> StreamsRecord -> ShowS
Show, StreamsRecord -> StreamsRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StreamsRecord -> StreamsRecord -> Bool
$c/= :: StreamsRecord -> StreamsRecord -> Bool
== :: StreamsRecord -> StreamsRecord -> Bool
$c== :: StreamsRecord -> StreamsRecord -> Bool
Eq)

instance RedisResult StreamsRecord where
    decode :: Reply -> Either Reply StreamsRecord
decode (MultiBulk (Just [Bulk (Just ByteString
recordId), MultiBulk (Just [Reply]
rawKeyValues)])) = do
        [ByteString]
keyValuesList <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. RedisResult a => Reply -> Either Reply a
decode [Reply]
rawKeyValues
        let keyValues :: [(ByteString, ByteString)]
keyValues = [ByteString] -> [(ByteString, ByteString)]
decodeKeyValues [ByteString]
keyValuesList
        forall (m :: * -> *) a. Monad m => a -> m a
return StreamsRecord{[(ByteString, ByteString)]
ByteString
keyValues :: [(ByteString, ByteString)]
recordId :: ByteString
keyValues :: [(ByteString, ByteString)]
recordId :: ByteString
..}
        where
            decodeKeyValues :: [ByteString] -> [(ByteString, ByteString)]
            decodeKeyValues :: [ByteString] -> [(ByteString, ByteString)]
decodeKeyValues [ByteString]
bs = forall a b. (a -> b) -> [a] -> [b]
map (\[ByteString
x,ByteString
y] -> (ByteString
x,ByteString
y)) forall a b. (a -> b) -> a -> b
$ forall {a}. [a] -> [[a]]
chunksOfTwo [ByteString]
bs
            chunksOfTwo :: [a] -> [[a]]
chunksOfTwo (a
x:a
y:[a]
rest) = [a
x,a
y]forall a. a -> [a] -> [a]
:[a] -> [[a]]
chunksOfTwo [a]
rest
            chunksOfTwo [a]
_ = []
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a

data XReadOpts = XReadOpts
    { XReadOpts -> Maybe Integer
block :: Maybe Integer
    , XReadOpts -> Maybe Integer
recordCount :: Maybe Integer
    } deriving (Int -> XReadOpts -> ShowS
[XReadOpts] -> ShowS
XReadOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XReadOpts] -> ShowS
$cshowList :: [XReadOpts] -> ShowS
show :: XReadOpts -> String
$cshow :: XReadOpts -> String
showsPrec :: Int -> XReadOpts -> ShowS
$cshowsPrec :: Int -> XReadOpts -> ShowS
Show, XReadOpts -> XReadOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XReadOpts -> XReadOpts -> Bool
$c/= :: XReadOpts -> XReadOpts -> Bool
== :: XReadOpts -> XReadOpts -> Bool
$c== :: XReadOpts -> XReadOpts -> Bool
Eq)

-- |Redis default 'XReadOpts'. Equivalent to omitting all optional parameters.
--
-- @
-- XReadOpts
--     { block = Nothing -- Don't block waiting for more records
--     , recordCount    = Nothing   -- no record count
--     }
-- @
--
defaultXreadOpts :: XReadOpts
defaultXreadOpts :: XReadOpts
defaultXreadOpts = XReadOpts { block :: Maybe Integer
block = forall a. Maybe a
Nothing, recordCount :: Maybe Integer
recordCount = forall a. Maybe a
Nothing }

data XReadResponse = XReadResponse
    { XReadResponse -> ByteString
stream :: ByteString
    , XReadResponse -> [StreamsRecord]
records :: [StreamsRecord]
    } deriving (Int -> XReadResponse -> ShowS
[XReadResponse] -> ShowS
XReadResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XReadResponse] -> ShowS
$cshowList :: [XReadResponse] -> ShowS
show :: XReadResponse -> String
$cshow :: XReadResponse -> String
showsPrec :: Int -> XReadResponse -> ShowS
$cshowsPrec :: Int -> XReadResponse -> ShowS
Show, XReadResponse -> XReadResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XReadResponse -> XReadResponse -> Bool
$c/= :: XReadResponse -> XReadResponse -> Bool
== :: XReadResponse -> XReadResponse -> Bool
$c== :: XReadResponse -> XReadResponse -> Bool
Eq)

instance RedisResult XReadResponse where
    decode :: Reply -> Either Reply XReadResponse
decode (MultiBulk (Just [Bulk (Just ByteString
stream), MultiBulk (Just [Reply]
rawRecords)])) = do
        [StreamsRecord]
records <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. RedisResult a => Reply -> Either Reply a
decode [Reply]
rawRecords
        forall (m :: * -> *) a. Monad m => a -> m a
return XReadResponse{[StreamsRecord]
ByteString
records :: [StreamsRecord]
stream :: ByteString
records :: [StreamsRecord]
stream :: ByteString
..}
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a

xreadOpts
    :: (RedisCtx m f)
    => [(ByteString, ByteString)] -- ^ (stream, id) pairs
    -> XReadOpts -- ^ Options
    -> m (f (Maybe [XReadResponse]))
xreadOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[(ByteString, ByteString)]
-> XReadOpts -> m (f (Maybe [XReadResponse]))
xreadOpts [(ByteString, ByteString)]
streamsAndIds XReadOpts
opts = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    [ByteString
"XREAD"] forall a. [a] -> [a] -> [a]
++ ([(ByteString, ByteString)] -> XReadOpts -> [ByteString]
internalXreadArgs [(ByteString, ByteString)]
streamsAndIds XReadOpts
opts)

internalXreadArgs :: [(ByteString, ByteString)] -> XReadOpts -> [ByteString]
internalXreadArgs :: [(ByteString, ByteString)] -> XReadOpts -> [ByteString]
internalXreadArgs [(ByteString, ByteString)]
streamsAndIds XReadOpts{Maybe Integer
recordCount :: Maybe Integer
block :: Maybe Integer
recordCount :: XReadOpts -> Maybe Integer
block :: XReadOpts -> Maybe Integer
..} =
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ByteString]
blockArgs, [ByteString]
countArgs, [ByteString
"STREAMS"], [ByteString]
streams, [ByteString]
recordIds]
    where
        blockArgs :: [ByteString]
blockArgs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
blockMillis -> [ByteString
"BLOCK", forall a. RedisArg a => a -> ByteString
encode Integer
blockMillis]) Maybe Integer
block
        countArgs :: [ByteString]
countArgs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
countRecords -> [ByteString
"COUNT", forall a. RedisArg a => a -> ByteString
encode Integer
countRecords]) Maybe Integer
recordCount
        streams :: [ByteString]
streams = forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
stream, ByteString
_) -> ByteString
stream) [(ByteString, ByteString)]
streamsAndIds
        recordIds :: [ByteString]
recordIds = forall a b. (a -> b) -> [a] -> [b]
map (\(ByteString
_, ByteString
recordId) -> ByteString
recordId) [(ByteString, ByteString)]
streamsAndIds


xread
    :: (RedisCtx m f)
    => [(ByteString, ByteString)] -- ^ (stream, id) pairs
    -> m( f (Maybe [XReadResponse]))
xread :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[(ByteString, ByteString)] -> m (f (Maybe [XReadResponse]))
xread [(ByteString, ByteString)]
streamsAndIds = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[(ByteString, ByteString)]
-> XReadOpts -> m (f (Maybe [XReadResponse]))
xreadOpts [(ByteString, ByteString)]
streamsAndIds XReadOpts
defaultXreadOpts

xreadGroupOpts
    :: (RedisCtx m f)
    => ByteString -- ^ group name
    -> ByteString -- ^ consumer name
    -> [(ByteString, ByteString)] -- ^ (stream, id) pairs
    -> XReadOpts -- ^ Options
    -> m (f (Maybe [XReadResponse]))
xreadGroupOpts :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> XReadOpts
-> m (f (Maybe [XReadResponse]))
xreadGroupOpts ByteString
groupName ByteString
consumerName [(ByteString, ByteString)]
streamsAndIds XReadOpts
opts = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    [ByteString
"XREADGROUP", ByteString
"GROUP", ByteString
groupName, ByteString
consumerName] forall a. [a] -> [a] -> [a]
++ ([(ByteString, ByteString)] -> XReadOpts -> [ByteString]
internalXreadArgs [(ByteString, ByteString)]
streamsAndIds XReadOpts
opts)

xreadGroup
    :: (RedisCtx m f)
    => ByteString -- ^ group name
    -> ByteString -- ^ consumer name
    -> [(ByteString, ByteString)] -- ^ (stream, id) pairs
    -> m (f (Maybe [XReadResponse]))
xreadGroup :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> m (f (Maybe [XReadResponse]))
xreadGroup ByteString
groupName ByteString
consumerName [(ByteString, ByteString)]
streamsAndIds = forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> XReadOpts
-> m (f (Maybe [XReadResponse]))
xreadGroupOpts ByteString
groupName ByteString
consumerName [(ByteString, ByteString)]
streamsAndIds XReadOpts
defaultXreadOpts

xgroupCreate
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group name
    -> ByteString -- ^ start ID
    -> m (f Status)
xgroupCreate :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Status)
xgroupCreate ByteString
stream ByteString
groupName ByteString
startId = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"XGROUP", ByteString
"CREATE", ByteString
stream, ByteString
groupName, ByteString
startId]

xgroupSetId
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group
    -> ByteString -- ^ id
    -> m (f Status)
xgroupSetId :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Status)
xgroupSetId ByteString
stream ByteString
group ByteString
messageId = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"XGROUP", ByteString
"SETID", ByteString
stream, ByteString
group, ByteString
messageId]

xgroupDelConsumer
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group
    -> ByteString -- ^ consumer
    -> m (f Integer)
xgroupDelConsumer :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
xgroupDelConsumer ByteString
stream ByteString
group ByteString
consumer = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"XGROUP", ByteString
"DELCONSUMER", ByteString
stream, ByteString
group, ByteString
consumer]

xgroupDestroy
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group
    -> m (f Bool)
xgroupDestroy :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Bool)
xgroupDestroy ByteString
stream ByteString
group = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"XGROUP", ByteString
"DESTROY", ByteString
stream, ByteString
group]

xack
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group name
    -> [ByteString] -- ^ message IDs
    -> m (f Integer)
xack :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> [ByteString] -> m (f Integer)
xack ByteString
stream ByteString
groupName [ByteString]
messageIds = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"XACK", ByteString
stream, ByteString
groupName] forall a. [a] -> [a] -> [a]
++ [ByteString]
messageIds

xrange
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ start
    -> ByteString -- ^ end
    -> Maybe Integer -- ^ COUNT
    -> m (f [StreamsRecord])
xrange :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> ByteString
-> Maybe Integer
-> m (f [StreamsRecord])
xrange ByteString
stream ByteString
start ByteString
end Maybe Integer
count = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"XRANGE", ByteString
stream, ByteString
start, ByteString
end] forall a. [a] -> [a] -> [a]
++ [ByteString]
countArgs
    where countArgs :: [ByteString]
countArgs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
c -> [ByteString
"COUNT", forall a. RedisArg a => a -> ByteString
encode Integer
c]) Maybe Integer
count

xrevRange
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ end
    -> ByteString -- ^ start
    -> Maybe Integer -- ^ COUNT
    -> m (f [StreamsRecord])
xrevRange :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> ByteString
-> Maybe Integer
-> m (f [StreamsRecord])
xrevRange ByteString
stream ByteString
end ByteString
start Maybe Integer
count = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"XREVRANGE", ByteString
stream, ByteString
end, ByteString
start] forall a. [a] -> [a] -> [a]
++ [ByteString]
countArgs
    where countArgs :: [ByteString]
countArgs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\Integer
c -> [ByteString
"COUNT", forall a. RedisArg a => a -> ByteString
encode Integer
c]) Maybe Integer
count

xlen
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> m (f Integer)
xlen :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
xlen ByteString
stream = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"XLEN", ByteString
stream]

data XPendingSummaryResponse = XPendingSummaryResponse
    { XPendingSummaryResponse -> Integer
numPendingMessages :: Integer
    , XPendingSummaryResponse -> ByteString
smallestPendingMessageId :: ByteString
    , XPendingSummaryResponse -> ByteString
largestPendingMessageId :: ByteString
    , XPendingSummaryResponse -> [(ByteString, Integer)]
numPendingMessagesByconsumer :: [(ByteString, Integer)]
    } deriving (Int -> XPendingSummaryResponse -> ShowS
[XPendingSummaryResponse] -> ShowS
XPendingSummaryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPendingSummaryResponse] -> ShowS
$cshowList :: [XPendingSummaryResponse] -> ShowS
show :: XPendingSummaryResponse -> String
$cshow :: XPendingSummaryResponse -> String
showsPrec :: Int -> XPendingSummaryResponse -> ShowS
$cshowsPrec :: Int -> XPendingSummaryResponse -> ShowS
Show, XPendingSummaryResponse -> XPendingSummaryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPendingSummaryResponse -> XPendingSummaryResponse -> Bool
$c/= :: XPendingSummaryResponse -> XPendingSummaryResponse -> Bool
== :: XPendingSummaryResponse -> XPendingSummaryResponse -> Bool
$c== :: XPendingSummaryResponse -> XPendingSummaryResponse -> Bool
Eq)

instance RedisResult XPendingSummaryResponse where
    decode :: Reply -> Either Reply XPendingSummaryResponse
decode (MultiBulk (Just [
        Integer Integer
numPendingMessages,
        Bulk (Just ByteString
smallestPendingMessageId),
        Bulk (Just ByteString
largestPendingMessageId),
        MultiBulk (Just [MultiBulk (Just [Reply]
rawGroupsAndCounts)])])) = do
            let groupsAndCounts :: [(Reply, Reply)]
groupsAndCounts = forall {b}. [b] -> [(b, b)]
chunksOfTwo [Reply]
rawGroupsAndCounts
            [(ByteString, Integer)]
numPendingMessagesByconsumer <- [(Reply, Reply)] -> Either Reply [(ByteString, Integer)]
decodeGroupsAndCounts [(Reply, Reply)]
groupsAndCounts
            forall (m :: * -> *) a. Monad m => a -> m a
return XPendingSummaryResponse{Integer
[(ByteString, Integer)]
ByteString
numPendingMessagesByconsumer :: [(ByteString, Integer)]
largestPendingMessageId :: ByteString
smallestPendingMessageId :: ByteString
numPendingMessages :: Integer
numPendingMessagesByconsumer :: [(ByteString, Integer)]
largestPendingMessageId :: ByteString
smallestPendingMessageId :: ByteString
numPendingMessages :: Integer
..}
            where
                decodeGroupsAndCounts :: [(Reply, Reply)] -> Either Reply [(ByteString, Integer)]
                decodeGroupsAndCounts :: [(Reply, Reply)] -> Either Reply [(ByteString, Integer)]
decodeGroupsAndCounts [(Reply, Reply)]
bs = forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Reply, Reply) -> Either Reply (ByteString, Integer)
decodeGroupCount [(Reply, Reply)]
bs
                decodeGroupCount :: (Reply, Reply) -> Either Reply (ByteString, Integer)
                decodeGroupCount :: (Reply, Reply) -> Either Reply (ByteString, Integer)
decodeGroupCount (Reply
x, Reply
y) = do
                    ByteString
decodedX <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
x
                    Integer
decodedY <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
y
                    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
decodedX, Integer
decodedY)
                chunksOfTwo :: [b] -> [(b, b)]
chunksOfTwo (b
x:b
y:[b]
rest) = (b
x,b
y)forall a. a -> [a] -> [a]
:[b] -> [(b, b)]
chunksOfTwo [b]
rest
                chunksOfTwo [b]
_ = []
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a

xpendingSummary
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group
    -> Maybe ByteString -- ^ consumer
    -> m (f XPendingSummaryResponse)
xpendingSummary :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString -> Maybe ByteString -> m (f XPendingSummaryResponse)
xpendingSummary ByteString
stream ByteString
group Maybe ByteString
consumer = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"XPENDING", ByteString
stream, ByteString
group] forall a. [a] -> [a] -> [a]
++ [ByteString]
consumerArg
    where consumerArg :: [ByteString]
consumerArg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
c -> [ByteString
c]) Maybe ByteString
consumer

data XPendingDetailRecord = XPendingDetailRecord
    { XPendingDetailRecord -> ByteString
messageId :: ByteString
    , XPendingDetailRecord -> ByteString
consumer :: ByteString
    , XPendingDetailRecord -> Integer
millisSinceLastDelivered :: Integer
    , XPendingDetailRecord -> Integer
numTimesDelivered :: Integer
    } deriving (Int -> XPendingDetailRecord -> ShowS
[XPendingDetailRecord] -> ShowS
XPendingDetailRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XPendingDetailRecord] -> ShowS
$cshowList :: [XPendingDetailRecord] -> ShowS
show :: XPendingDetailRecord -> String
$cshow :: XPendingDetailRecord -> String
showsPrec :: Int -> XPendingDetailRecord -> ShowS
$cshowsPrec :: Int -> XPendingDetailRecord -> ShowS
Show, XPendingDetailRecord -> XPendingDetailRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XPendingDetailRecord -> XPendingDetailRecord -> Bool
$c/= :: XPendingDetailRecord -> XPendingDetailRecord -> Bool
== :: XPendingDetailRecord -> XPendingDetailRecord -> Bool
$c== :: XPendingDetailRecord -> XPendingDetailRecord -> Bool
Eq)

instance RedisResult XPendingDetailRecord where
    decode :: Reply -> Either Reply XPendingDetailRecord
decode (MultiBulk (Just [
        Bulk (Just ByteString
messageId) ,
        Bulk (Just ByteString
consumer),
        Integer Integer
millisSinceLastDelivered,
        Integer Integer
numTimesDelivered])) = forall a b. b -> Either a b
Right XPendingDetailRecord{Integer
ByteString
numTimesDelivered :: Integer
millisSinceLastDelivered :: Integer
consumer :: ByteString
messageId :: ByteString
numTimesDelivered :: Integer
millisSinceLastDelivered :: Integer
consumer :: ByteString
messageId :: ByteString
..}
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a

xpendingDetail
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group
    -> ByteString -- ^ startId
    -> ByteString -- ^ endId
    -> Integer -- ^ count
    -> Maybe ByteString -- ^ consumer
    -> m (f [XPendingDetailRecord])
xpendingDetail :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> ByteString
-> ByteString
-> Integer
-> Maybe ByteString
-> m (f [XPendingDetailRecord])
xpendingDetail ByteString
stream ByteString
group ByteString
startId ByteString
endId Integer
count Maybe ByteString
consumer = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    [ByteString
"XPENDING", ByteString
stream, ByteString
group, ByteString
startId, ByteString
endId, forall a. RedisArg a => a -> ByteString
encode Integer
count] forall a. [a] -> [a] -> [a]
++ [ByteString]
consumerArg
    where consumerArg :: [ByteString]
consumerArg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\ByteString
c -> [ByteString
c]) Maybe ByteString
consumer

data XClaimOpts = XClaimOpts
    { XClaimOpts -> Maybe Integer
xclaimIdle :: Maybe Integer
    , XClaimOpts -> Maybe Integer
xclaimTime :: Maybe Integer
    , XClaimOpts -> Maybe Integer
xclaimRetryCount :: Maybe Integer
    , XClaimOpts -> Bool
xclaimForce :: Bool
    } deriving (Int -> XClaimOpts -> ShowS
[XClaimOpts] -> ShowS
XClaimOpts -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XClaimOpts] -> ShowS
$cshowList :: [XClaimOpts] -> ShowS
show :: XClaimOpts -> String
$cshow :: XClaimOpts -> String
showsPrec :: Int -> XClaimOpts -> ShowS
$cshowsPrec :: Int -> XClaimOpts -> ShowS
Show, XClaimOpts -> XClaimOpts -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XClaimOpts -> XClaimOpts -> Bool
$c/= :: XClaimOpts -> XClaimOpts -> Bool
== :: XClaimOpts -> XClaimOpts -> Bool
$c== :: XClaimOpts -> XClaimOpts -> Bool
Eq)

defaultXClaimOpts :: XClaimOpts
defaultXClaimOpts :: XClaimOpts
defaultXClaimOpts = XClaimOpts
    { xclaimIdle :: Maybe Integer
xclaimIdle = forall a. Maybe a
Nothing
    , xclaimTime :: Maybe Integer
xclaimTime = forall a. Maybe a
Nothing
    , xclaimRetryCount :: Maybe Integer
xclaimRetryCount = forall a. Maybe a
Nothing
    , xclaimForce :: Bool
xclaimForce = Bool
False
    }


-- |Format a request for XCLAIM.
xclaimRequest
    :: ByteString -- ^ stream
    -> ByteString -- ^ group
    -> ByteString -- ^ consumer
    -> Integer -- ^ min idle time
    -> XClaimOpts -- ^ optional arguments
    -> [ByteString] -- ^ message IDs
    -> [ByteString]
xclaimRequest :: ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> [ByteString]
xclaimRequest ByteString
stream ByteString
group ByteString
consumer Integer
minIdleTime XClaimOpts{Bool
Maybe Integer
xclaimForce :: Bool
xclaimRetryCount :: Maybe Integer
xclaimTime :: Maybe Integer
xclaimIdle :: Maybe Integer
xclaimForce :: XClaimOpts -> Bool
xclaimRetryCount :: XClaimOpts -> Maybe Integer
xclaimTime :: XClaimOpts -> Maybe Integer
xclaimIdle :: XClaimOpts -> Maybe Integer
..} [ByteString]
messageIds =
    [ByteString
"XCLAIM", ByteString
stream, ByteString
group, ByteString
consumer, forall a. RedisArg a => a -> ByteString
encode Integer
minIdleTime] forall a. [a] -> [a] -> [a]
++ ( forall a b. (a -> b) -> [a] -> [b]
map forall a. RedisArg a => a -> ByteString
encode [ByteString]
messageIds ) forall a. [a] -> [a] -> [a]
++ [ByteString]
optArgs
    where optArgs :: [ByteString]
optArgs = [ByteString]
idleArg forall a. [a] -> [a] -> [a]
++ [ByteString]
timeArg forall a. [a] -> [a] -> [a]
++ [ByteString]
retryCountArg forall a. [a] -> [a] -> [a]
++ [ByteString]
forceArg
          idleArg :: [ByteString]
idleArg = forall {a}. RedisArg a => ByteString -> Maybe a -> [ByteString]
optArg ByteString
"IDLE" Maybe Integer
xclaimIdle
          timeArg :: [ByteString]
timeArg = forall {a}. RedisArg a => ByteString -> Maybe a -> [ByteString]
optArg ByteString
"TIME" Maybe Integer
xclaimTime
          retryCountArg :: [ByteString]
retryCountArg = forall {a}. RedisArg a => ByteString -> Maybe a -> [ByteString]
optArg ByteString
"RETRYCOUNT" Maybe Integer
xclaimRetryCount
          forceArg :: [ByteString]
forceArg = if Bool
xclaimForce then [ByteString
"FORCE"] else []
          optArg :: ByteString -> Maybe a -> [ByteString]
optArg ByteString
name Maybe a
maybeArg = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\a
x -> [ByteString
name, forall a. RedisArg a => a -> ByteString
encode a
x]) Maybe a
maybeArg

xclaim
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group
    -> ByteString -- ^ consumer
    -> Integer -- ^ min idle time
    -> XClaimOpts -- ^ optional arguments
    -> [ByteString] -- ^ message IDs
    -> m (f [StreamsRecord])
xclaim :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> m (f [StreamsRecord])
xclaim ByteString
stream ByteString
group ByteString
consumer Integer
minIdleTime XClaimOpts
opts [ByteString]
messageIds = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> [ByteString]
xclaimRequest ByteString
stream ByteString
group ByteString
consumer Integer
minIdleTime XClaimOpts
opts [ByteString]
messageIds

xclaimJustIds
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group
    -> ByteString -- ^ consumer
    -> Integer -- ^ min idle time
    -> XClaimOpts -- ^ optional arguments
    -> [ByteString] -- ^ message IDs
    -> m (f [ByteString])
xclaimJustIds :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> m (f [ByteString])
xclaimJustIds ByteString
stream ByteString
group ByteString
consumer Integer
minIdleTime XClaimOpts
opts [ByteString]
messageIds = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$
    (ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> [ByteString]
xclaimRequest ByteString
stream ByteString
group ByteString
consumer Integer
minIdleTime XClaimOpts
opts [ByteString]
messageIds) forall a. [a] -> [a] -> [a]
++ [ByteString
"JUSTID"]

data XInfoConsumersResponse = XInfoConsumersResponse
    { XInfoConsumersResponse -> ByteString
xinfoConsumerName :: ByteString
    , XInfoConsumersResponse -> Integer
xinfoConsumerNumPendingMessages :: Integer
    , XInfoConsumersResponse -> Integer
xinfoConsumerIdleTime :: Integer
    } deriving (Int -> XInfoConsumersResponse -> ShowS
[XInfoConsumersResponse] -> ShowS
XInfoConsumersResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XInfoConsumersResponse] -> ShowS
$cshowList :: [XInfoConsumersResponse] -> ShowS
show :: XInfoConsumersResponse -> String
$cshow :: XInfoConsumersResponse -> String
showsPrec :: Int -> XInfoConsumersResponse -> ShowS
$cshowsPrec :: Int -> XInfoConsumersResponse -> ShowS
Show, XInfoConsumersResponse -> XInfoConsumersResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XInfoConsumersResponse -> XInfoConsumersResponse -> Bool
$c/= :: XInfoConsumersResponse -> XInfoConsumersResponse -> Bool
== :: XInfoConsumersResponse -> XInfoConsumersResponse -> Bool
$c== :: XInfoConsumersResponse -> XInfoConsumersResponse -> Bool
Eq)

instance RedisResult XInfoConsumersResponse where
    decode :: Reply -> Either Reply XInfoConsumersResponse
decode (MultiBulk (Just [
        Bulk (Just ByteString
"name"),
        Bulk (Just ByteString
xinfoConsumerName),
        Bulk (Just ByteString
"pending"),
        Integer Integer
xinfoConsumerNumPendingMessages,
        Bulk (Just ByteString
"idle"),
        Integer Integer
xinfoConsumerIdleTime])) = forall a b. b -> Either a b
Right XInfoConsumersResponse{Integer
ByteString
xinfoConsumerIdleTime :: Integer
xinfoConsumerNumPendingMessages :: Integer
xinfoConsumerName :: ByteString
xinfoConsumerIdleTime :: Integer
xinfoConsumerNumPendingMessages :: Integer
xinfoConsumerName :: ByteString
..}
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a

xinfoConsumers
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> ByteString -- ^ group
    -> m (f [XInfoConsumersResponse])
xinfoConsumers :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f [XInfoConsumersResponse])
xinfoConsumers ByteString
stream ByteString
group = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"XINFO", ByteString
"CONSUMERS", ByteString
stream, ByteString
group]

data XInfoGroupsResponse = XInfoGroupsResponse
    { XInfoGroupsResponse -> ByteString
xinfoGroupsGroupName :: ByteString
    , XInfoGroupsResponse -> Integer
xinfoGroupsNumConsumers :: Integer
    , XInfoGroupsResponse -> Integer
xinfoGroupsNumPendingMessages :: Integer
    , XInfoGroupsResponse -> ByteString
xinfoGroupsLastDeliveredMessageId :: ByteString
    } deriving (Int -> XInfoGroupsResponse -> ShowS
[XInfoGroupsResponse] -> ShowS
XInfoGroupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XInfoGroupsResponse] -> ShowS
$cshowList :: [XInfoGroupsResponse] -> ShowS
show :: XInfoGroupsResponse -> String
$cshow :: XInfoGroupsResponse -> String
showsPrec :: Int -> XInfoGroupsResponse -> ShowS
$cshowsPrec :: Int -> XInfoGroupsResponse -> ShowS
Show, XInfoGroupsResponse -> XInfoGroupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XInfoGroupsResponse -> XInfoGroupsResponse -> Bool
$c/= :: XInfoGroupsResponse -> XInfoGroupsResponse -> Bool
== :: XInfoGroupsResponse -> XInfoGroupsResponse -> Bool
$c== :: XInfoGroupsResponse -> XInfoGroupsResponse -> Bool
Eq)

instance RedisResult XInfoGroupsResponse where
    decode :: Reply -> Either Reply XInfoGroupsResponse
decode (MultiBulk (Just [
        Bulk (Just ByteString
"name"),Bulk (Just ByteString
xinfoGroupsGroupName),
        Bulk (Just ByteString
"consumers"),Integer Integer
xinfoGroupsNumConsumers,
        Bulk (Just ByteString
"pending"),Integer Integer
xinfoGroupsNumPendingMessages,
        Bulk (Just ByteString
"last-delivered-id"),Bulk (Just ByteString
xinfoGroupsLastDeliveredMessageId)])) = forall a b. b -> Either a b
Right XInfoGroupsResponse{Integer
ByteString
xinfoGroupsLastDeliveredMessageId :: ByteString
xinfoGroupsNumPendingMessages :: Integer
xinfoGroupsNumConsumers :: Integer
xinfoGroupsGroupName :: ByteString
xinfoGroupsLastDeliveredMessageId :: ByteString
xinfoGroupsNumPendingMessages :: Integer
xinfoGroupsNumConsumers :: Integer
xinfoGroupsGroupName :: ByteString
..}
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a

xinfoGroups
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> m (f [XInfoGroupsResponse])
xinfoGroups :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [XInfoGroupsResponse])
xinfoGroups ByteString
stream = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"XINFO", ByteString
"GROUPS", ByteString
stream]

data XInfoStreamResponse 
    = XInfoStreamResponse
    { XInfoStreamResponse -> Integer
xinfoStreamLength :: Integer
    , XInfoStreamResponse -> Integer
xinfoStreamRadixTreeKeys :: Integer
    , XInfoStreamResponse -> Integer
xinfoStreamRadixTreeNodes :: Integer
    , XInfoStreamResponse -> Integer
xinfoStreamNumGroups :: Integer
    , XInfoStreamResponse -> ByteString
xinfoStreamLastEntryId :: ByteString
    , XInfoStreamResponse -> StreamsRecord
xinfoStreamFirstEntry :: StreamsRecord
    , XInfoStreamResponse -> StreamsRecord
xinfoStreamLastEntry :: StreamsRecord
    } 
    | XInfoStreamEmptyResponse
    { xinfoStreamLength :: Integer
    , xinfoStreamRadixTreeKeys :: Integer
    , xinfoStreamRadixTreeNodes :: Integer
    , xinfoStreamNumGroups :: Integer
    , xinfoStreamLastEntryId :: ByteString
    }
    deriving (Int -> XInfoStreamResponse -> ShowS
[XInfoStreamResponse] -> ShowS
XInfoStreamResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [XInfoStreamResponse] -> ShowS
$cshowList :: [XInfoStreamResponse] -> ShowS
show :: XInfoStreamResponse -> String
$cshow :: XInfoStreamResponse -> String
showsPrec :: Int -> XInfoStreamResponse -> ShowS
$cshowsPrec :: Int -> XInfoStreamResponse -> ShowS
Show, XInfoStreamResponse -> XInfoStreamResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XInfoStreamResponse -> XInfoStreamResponse -> Bool
$c/= :: XInfoStreamResponse -> XInfoStreamResponse -> Bool
== :: XInfoStreamResponse -> XInfoStreamResponse -> Bool
$c== :: XInfoStreamResponse -> XInfoStreamResponse -> Bool
Eq)

instance RedisResult XInfoStreamResponse where
    decode :: Reply -> Either Reply XInfoStreamResponse
decode = Reply -> Either Reply XInfoStreamResponse
decodeRedis5 forall a. Semigroup a => a -> a -> a
<> Reply -> Either Reply XInfoStreamResponse
decodeRedis6
        where
            decodeRedis5 :: Reply -> Either Reply XInfoStreamResponse
decodeRedis5 (MultiBulk (Just [
                 Bulk (Just ByteString
"length"),Integer Integer
xinfoStreamLength,
                 Bulk (Just ByteString
"radix-tree-keys"),Integer Integer
xinfoStreamRadixTreeKeys,
                 Bulk (Just ByteString
"radix-tree-nodes"),Integer Integer
xinfoStreamRadixTreeNodes,
                 Bulk (Just ByteString
"groups"),Integer Integer
xinfoStreamNumGroups,
                 Bulk (Just ByteString
"last-generated-id"),Bulk (Just ByteString
xinfoStreamLastEntryId),
                 Bulk (Just ByteString
"first-entry"), Bulk Maybe ByteString
Nothing ,
                 Bulk (Just ByteString
"last-entry"), Bulk Maybe ByteString
Nothing ])) = do
                     forall (m :: * -> *) a. Monad m => a -> m a
return XInfoStreamEmptyResponse{Integer
ByteString
xinfoStreamLastEntryId :: ByteString
xinfoStreamNumGroups :: Integer
xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeKeys :: Integer
xinfoStreamLength :: Integer
xinfoStreamLastEntryId :: ByteString
xinfoStreamNumGroups :: Integer
xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeKeys :: Integer
xinfoStreamLength :: Integer
..}
            decodeRedis5 (MultiBulk (Just [
                Bulk (Just ByteString
"length"),Integer Integer
xinfoStreamLength,
                Bulk (Just ByteString
"radix-tree-keys"),Integer Integer
xinfoStreamRadixTreeKeys,
                Bulk (Just ByteString
"radix-tree-nodes"),Integer Integer
xinfoStreamRadixTreeNodes,
                Bulk (Just ByteString
"groups"),Integer Integer
xinfoStreamNumGroups,
                Bulk (Just ByteString
"last-generated-id"),Bulk (Just ByteString
xinfoStreamLastEntryId),
                Bulk (Just ByteString
"first-entry"), Reply
rawFirstEntry ,
                Bulk (Just ByteString
"last-entry"), Reply
rawLastEntry ])) = do
                    StreamsRecord
xinfoStreamFirstEntry <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
rawFirstEntry
                    StreamsRecord
xinfoStreamLastEntry <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
rawLastEntry
                    forall (m :: * -> *) a. Monad m => a -> m a
return XInfoStreamResponse{Integer
ByteString
StreamsRecord
xinfoStreamLastEntry :: StreamsRecord
xinfoStreamFirstEntry :: StreamsRecord
xinfoStreamLastEntryId :: ByteString
xinfoStreamNumGroups :: Integer
xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeKeys :: Integer
xinfoStreamLength :: Integer
xinfoStreamLastEntry :: StreamsRecord
xinfoStreamFirstEntry :: StreamsRecord
xinfoStreamLastEntryId :: ByteString
xinfoStreamNumGroups :: Integer
xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeKeys :: Integer
xinfoStreamLength :: Integer
..}
            decodeRedis5 Reply
a = forall a b. a -> Either a b
Left Reply
a

            decodeRedis6 :: Reply -> Either Reply XInfoStreamResponse
decodeRedis6 (MultiBulk (Just [
                Bulk (Just ByteString
"length"),Integer Integer
xinfoStreamLength,
                Bulk (Just ByteString
"radix-tree-keys"),Integer Integer
xinfoStreamRadixTreeKeys,
                Bulk (Just ByteString
"radix-tree-nodes"),Integer Integer
xinfoStreamRadixTreeNodes,
                Bulk (Just ByteString
"last-generated-id"),Bulk (Just ByteString
xinfoStreamLastEntryId),
                Bulk (Just ByteString
"groups"),Integer Integer
xinfoStreamNumGroups,
                Bulk (Just ByteString
"first-entry"), Bulk Maybe ByteString
Nothing ,
                Bulk (Just ByteString
"last-entry"), Bulk Maybe ByteString
Nothing ])) = do
                    forall (m :: * -> *) a. Monad m => a -> m a
return XInfoStreamEmptyResponse{Integer
ByteString
xinfoStreamNumGroups :: Integer
xinfoStreamLastEntryId :: ByteString
xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeKeys :: Integer
xinfoStreamLength :: Integer
xinfoStreamLastEntryId :: ByteString
xinfoStreamNumGroups :: Integer
xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeKeys :: Integer
xinfoStreamLength :: Integer
..}
            decodeRedis6 (MultiBulk (Just [
                Bulk (Just ByteString
"length"),Integer Integer
xinfoStreamLength,
                Bulk (Just ByteString
"radix-tree-keys"),Integer Integer
xinfoStreamRadixTreeKeys,
                Bulk (Just ByteString
"radix-tree-nodes"),Integer Integer
xinfoStreamRadixTreeNodes,
                Bulk (Just ByteString
"last-generated-id"),Bulk (Just ByteString
xinfoStreamLastEntryId),
                Bulk (Just ByteString
"groups"),Integer Integer
xinfoStreamNumGroups,
                Bulk (Just ByteString
"first-entry"), Reply
rawFirstEntry ,
                Bulk (Just ByteString
"last-entry"), Reply
rawLastEntry ])) = do
                    StreamsRecord
xinfoStreamFirstEntry <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
rawFirstEntry
                    StreamsRecord
xinfoStreamLastEntry <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
rawLastEntry
                    forall (m :: * -> *) a. Monad m => a -> m a
return XInfoStreamResponse{Integer
ByteString
StreamsRecord
xinfoStreamLastEntry :: StreamsRecord
xinfoStreamFirstEntry :: StreamsRecord
xinfoStreamNumGroups :: Integer
xinfoStreamLastEntryId :: ByteString
xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeKeys :: Integer
xinfoStreamLength :: Integer
xinfoStreamLastEntry :: StreamsRecord
xinfoStreamFirstEntry :: StreamsRecord
xinfoStreamLastEntryId :: ByteString
xinfoStreamNumGroups :: Integer
xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeKeys :: Integer
xinfoStreamLength :: Integer
..}
            decodeRedis6 Reply
a = forall a b. a -> Either a b
Left Reply
a

xinfoStream
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> m (f XInfoStreamResponse)
xinfoStream :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f XInfoStreamResponse)
xinfoStream ByteString
stream = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"XINFO", ByteString
"STREAM", ByteString
stream]

xdel
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> [ByteString] -- ^ message IDs
    -> m (f Integer)
xdel :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
xdel ByteString
stream [ByteString]
messageIds = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"XDEL", ByteString
stream] forall a. [a] -> [a] -> [a]
++ [ByteString]
messageIds

xtrim
    :: (RedisCtx m f)
    => ByteString -- ^ stream
    -> TrimOpts
    -> m (f Integer)
xtrim :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> TrimOpts -> m (f Integer)
xtrim ByteString
stream TrimOpts
opts = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"XTRIM", ByteString
stream] forall a. [a] -> [a] -> [a]
++ [ByteString]
optArgs
    where
        optArgs :: [ByteString]
optArgs = case TrimOpts
opts of
            TrimOpts
NoArgs -> []
            Maxlen Integer
max -> [ByteString
"MAXLEN", forall a. RedisArg a => a -> ByteString
encode Integer
max]
            ApproxMaxlen Integer
max -> [ByteString
"MAXLEN", ByteString
"~", forall a. RedisArg a => a -> ByteString
encode Integer
max]

inf :: RealFloat a => a
inf :: forall a. RealFloat a => a
inf = a
1 forall a. Fractional a => a -> a -> a
/ a
0

auth
    :: RedisCtx m f
    => ByteString -- ^ password
    -> m (f Status)
auth :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Status)
auth ByteString
password = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"AUTH", ByteString
password]

-- the select command. used in 'connect'.
select
    :: RedisCtx m f
    => Integer -- ^ index
    -> m (f Status)
select :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Integer -> m (f Status)
select Integer
ix = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SELECT", forall a. RedisArg a => a -> ByteString
encode Integer
ix]

-- the ping command. used in 'checkedconnect'.
ping
    :: (RedisCtx m f)
    => m (f Status)
ping :: forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Status)
ping  = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString
"PING"] )

data ClusterNodesResponse = ClusterNodesResponse
    { ClusterNodesResponse -> [ClusterNodesResponseEntry]
clusterNodesResponseEntries :: [ClusterNodesResponseEntry]
    } deriving (Int -> ClusterNodesResponse -> ShowS
[ClusterNodesResponse] -> ShowS
ClusterNodesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterNodesResponse] -> ShowS
$cshowList :: [ClusterNodesResponse] -> ShowS
show :: ClusterNodesResponse -> String
$cshow :: ClusterNodesResponse -> String
showsPrec :: Int -> ClusterNodesResponse -> ShowS
$cshowsPrec :: Int -> ClusterNodesResponse -> ShowS
Show, ClusterNodesResponse -> ClusterNodesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterNodesResponse -> ClusterNodesResponse -> Bool
$c/= :: ClusterNodesResponse -> ClusterNodesResponse -> Bool
== :: ClusterNodesResponse -> ClusterNodesResponse -> Bool
$c== :: ClusterNodesResponse -> ClusterNodesResponse -> Bool
Eq)

data ClusterNodesResponseEntry = ClusterNodesResponseEntry { ClusterNodesResponseEntry -> ByteString
clusterNodesResponseNodeId :: ByteString
    , ClusterNodesResponseEntry -> ByteString
clusterNodesResponseNodeIp :: ByteString
    , ClusterNodesResponseEntry -> Integer
clusterNodesResponseNodePort :: Integer
    , ClusterNodesResponseEntry -> [ByteString]
clusterNodesResponseNodeFlags :: [ByteString]
    , ClusterNodesResponseEntry -> Maybe ByteString
clusterNodesResponseMasterId :: Maybe ByteString
    , ClusterNodesResponseEntry -> Integer
clusterNodesResponsePingSent :: Integer
    , ClusterNodesResponseEntry -> Integer
clusterNodesResponsePongReceived :: Integer
    , ClusterNodesResponseEntry -> Integer
clusterNodesResponseConfigEpoch :: Integer
    , ClusterNodesResponseEntry -> ByteString
clusterNodesResponseLinkState :: ByteString
    , ClusterNodesResponseEntry -> [ClusterNodesResponseSlotSpec]
clusterNodesResponseSlots :: [ClusterNodesResponseSlotSpec]
    } deriving (Int -> ClusterNodesResponseEntry -> ShowS
[ClusterNodesResponseEntry] -> ShowS
ClusterNodesResponseEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterNodesResponseEntry] -> ShowS
$cshowList :: [ClusterNodesResponseEntry] -> ShowS
show :: ClusterNodesResponseEntry -> String
$cshow :: ClusterNodesResponseEntry -> String
showsPrec :: Int -> ClusterNodesResponseEntry -> ShowS
$cshowsPrec :: Int -> ClusterNodesResponseEntry -> ShowS
Show, ClusterNodesResponseEntry -> ClusterNodesResponseEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterNodesResponseEntry -> ClusterNodesResponseEntry -> Bool
$c/= :: ClusterNodesResponseEntry -> ClusterNodesResponseEntry -> Bool
== :: ClusterNodesResponseEntry -> ClusterNodesResponseEntry -> Bool
$c== :: ClusterNodesResponseEntry -> ClusterNodesResponseEntry -> Bool
Eq)

data ClusterNodesResponseSlotSpec
    = ClusterNodesResponseSingleSlot Integer
    | ClusterNodesResponseSlotRange Integer Integer
    | ClusterNodesResponseSlotImporting Integer ByteString
    | ClusterNodesResponseSlotMigrating Integer ByteString deriving (Int -> ClusterNodesResponseSlotSpec -> ShowS
[ClusterNodesResponseSlotSpec] -> ShowS
ClusterNodesResponseSlotSpec -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterNodesResponseSlotSpec] -> ShowS
$cshowList :: [ClusterNodesResponseSlotSpec] -> ShowS
show :: ClusterNodesResponseSlotSpec -> String
$cshow :: ClusterNodesResponseSlotSpec -> String
showsPrec :: Int -> ClusterNodesResponseSlotSpec -> ShowS
$cshowsPrec :: Int -> ClusterNodesResponseSlotSpec -> ShowS
Show, ClusterNodesResponseSlotSpec
-> ClusterNodesResponseSlotSpec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterNodesResponseSlotSpec
-> ClusterNodesResponseSlotSpec -> Bool
$c/= :: ClusterNodesResponseSlotSpec
-> ClusterNodesResponseSlotSpec -> Bool
== :: ClusterNodesResponseSlotSpec
-> ClusterNodesResponseSlotSpec -> Bool
$c== :: ClusterNodesResponseSlotSpec
-> ClusterNodesResponseSlotSpec -> Bool
Eq)


instance RedisResult ClusterNodesResponse where
    decode :: Reply -> Either Reply ClusterNodesResponse
decode r :: Reply
r@(Bulk (Just ByteString
bulkData)) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left Reply
r) forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ do
        [ClusterNodesResponseEntry]
infos <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ByteString -> Maybe ClusterNodesResponseEntry
parseNodeInfo forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
Char8.lines ByteString
bulkData
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [ClusterNodesResponseEntry] -> ClusterNodesResponse
ClusterNodesResponse [ClusterNodesResponseEntry]
infos where
            parseNodeInfo :: ByteString -> Maybe ClusterNodesResponseEntry
            parseNodeInfo :: ByteString -> Maybe ClusterNodesResponseEntry
parseNodeInfo ByteString
line = case ByteString -> [ByteString]
Char8.words ByteString
line of
              (ByteString
nodeId : ByteString
hostNamePort : ByteString
flags : ByteString
masterNodeId : ByteString
pingSent : ByteString
pongRecv : ByteString
epoch : ByteString
linkState : [ByteString]
slots) ->
                case Char -> ByteString -> [ByteString]
Char8.split Char
':' ByteString
hostNamePort of
                  [ByteString
hostName, ByteString
port] -> ByteString
-> ByteString
-> Integer
-> [ByteString]
-> Maybe ByteString
-> Integer
-> Integer
-> Integer
-> ByteString
-> [ClusterNodesResponseSlotSpec]
-> ClusterNodesResponseEntry
ClusterNodesResponseEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
nodeId
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
hostName
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe Integer
readInteger ByteString
port
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> ByteString -> [ByteString]
Char8.split Char
',' ByteString
flags)
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Maybe ByteString
readMasterNodeId ByteString
masterNodeId)
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe Integer
readInteger ByteString
pingSent
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe Integer
readInteger ByteString
pongRecv
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe Integer
readInteger ByteString
epoch
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
linkState
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteString -> Maybe ClusterNodesResponseSlotSpec
readNodeSlot [ByteString]
slots)
                  [ByteString]
_ -> forall a. Maybe a
Nothing
              [ByteString]
_ -> forall a. Maybe a
Nothing
            readInteger :: ByteString -> Maybe Integer
            readInteger :: ByteString -> Maybe Integer
readInteger = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Integer, ByteString)
Char8.readInteger

            readMasterNodeId :: ByteString -> Maybe ByteString
            readMasterNodeId :: ByteString -> Maybe ByteString
readMasterNodeId ByteString
"-"    = forall a. Maybe a
Nothing
            readMasterNodeId ByteString
nodeId = forall a. a -> Maybe a
Just ByteString
nodeId

            readNodeSlot :: ByteString -> Maybe ClusterNodesResponseSlotSpec
            readNodeSlot :: ByteString -> Maybe ClusterNodesResponseSlotSpec
readNodeSlot ByteString
slotSpec = case Char
'[' Char -> ByteString -> Bool
`Char8.elem` ByteString
slotSpec of
                Bool
True -> ByteString -> Maybe ClusterNodesResponseSlotSpec
readSlotImportMigrate ByteString
slotSpec
                Bool
False -> case Char
'-' Char -> ByteString -> Bool
`Char8.elem` ByteString
slotSpec of
                    Bool
True -> ByteString -> Maybe ClusterNodesResponseSlotSpec
readSlotRange ByteString
slotSpec
                    Bool
False -> Integer -> ClusterNodesResponseSlotSpec
ClusterNodesResponseSingleSlot forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Integer
readInteger ByteString
slotSpec
            readSlotImportMigrate :: ByteString -> Maybe ClusterNodesResponseSlotSpec
            readSlotImportMigrate :: ByteString -> Maybe ClusterNodesResponseSlotSpec
readSlotImportMigrate ByteString
slotSpec = case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"->-" ByteString
slotSpec of
                (ByteString
_, ByteString
"") -> case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"-<-" ByteString
slotSpec of
                    (ByteString
_, ByteString
"") -> forall a. Maybe a
Nothing
                    (ByteString
leftPart, ByteString
rightPart) -> Integer -> ByteString -> ClusterNodesResponseSlotSpec
ClusterNodesResponseSlotImporting
                        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe Integer
readInteger forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
Char8.drop Int
1 ByteString
leftPart)
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
rightPart forall a. Num a => a -> a -> a
- Int
1) ByteString
rightPart)
                (ByteString
leftPart, ByteString
rightPart) -> Integer -> ByteString -> ClusterNodesResponseSlotSpec
ClusterNodesResponseSlotMigrating
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Maybe Integer
readInteger forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
Char8.drop Int
1 ByteString
leftPart)
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take (ByteString -> Int
BS.length ByteString
rightPart forall a. Num a => a -> a -> a
- Int
1) ByteString
rightPart)
            readSlotRange :: ByteString -> Maybe ClusterNodesResponseSlotSpec
            readSlotRange :: ByteString -> Maybe ClusterNodesResponseSlotSpec
readSlotRange ByteString
slotSpec = case ByteString -> ByteString -> (ByteString, ByteString)
BS.breakSubstring ByteString
"-" ByteString
slotSpec of
                (ByteString
_, ByteString
"") -> forall a. Maybe a
Nothing
                (ByteString
leftPart, ByteString
rightPart) -> Integer -> Integer -> ClusterNodesResponseSlotSpec
ClusterNodesResponseSlotRange
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe Integer
readInteger ByteString
leftPart
                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ByteString -> Maybe Integer
readInteger forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
1 ByteString
rightPart)

    decode Reply
r = forall a b. a -> Either a b
Left Reply
r

clusterNodes
    :: (RedisCtx m f)
    => m (f ClusterNodesResponse)
clusterNodes :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
m (f ClusterNodesResponse)
clusterNodes = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"CLUSTER", ByteString
"NODES"]

data ClusterSlotsResponse = ClusterSlotsResponse { ClusterSlotsResponse -> [ClusterSlotsResponseEntry]
clusterSlotsResponseEntries :: [ClusterSlotsResponseEntry] } deriving (Int -> ClusterSlotsResponse -> ShowS
[ClusterSlotsResponse] -> ShowS
ClusterSlotsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterSlotsResponse] -> ShowS
$cshowList :: [ClusterSlotsResponse] -> ShowS
show :: ClusterSlotsResponse -> String
$cshow :: ClusterSlotsResponse -> String
showsPrec :: Int -> ClusterSlotsResponse -> ShowS
$cshowsPrec :: Int -> ClusterSlotsResponse -> ShowS
Show)

data ClusterSlotsNode = ClusterSlotsNode
    { ClusterSlotsNode -> ByteString
clusterSlotsNodeIP :: ByteString
    , ClusterSlotsNode -> Int
clusterSlotsNodePort :: Int
    , ClusterSlotsNode -> ByteString
clusterSlotsNodeID :: ByteString
    } deriving (Int -> ClusterSlotsNode -> ShowS
[ClusterSlotsNode] -> ShowS
ClusterSlotsNode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterSlotsNode] -> ShowS
$cshowList :: [ClusterSlotsNode] -> ShowS
show :: ClusterSlotsNode -> String
$cshow :: ClusterSlotsNode -> String
showsPrec :: Int -> ClusterSlotsNode -> ShowS
$cshowsPrec :: Int -> ClusterSlotsNode -> ShowS
Show)

data ClusterSlotsResponseEntry = ClusterSlotsResponseEntry
    { ClusterSlotsResponseEntry -> Int
clusterSlotsResponseEntryStartSlot :: Int
    , ClusterSlotsResponseEntry -> Int
clusterSlotsResponseEntryEndSlot :: Int
    , ClusterSlotsResponseEntry -> ClusterSlotsNode
clusterSlotsResponseEntryMaster :: ClusterSlotsNode
    , ClusterSlotsResponseEntry -> [ClusterSlotsNode]
clusterSlotsResponseEntryReplicas :: [ClusterSlotsNode]
    } deriving (Int -> ClusterSlotsResponseEntry -> ShowS
[ClusterSlotsResponseEntry] -> ShowS
ClusterSlotsResponseEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterSlotsResponseEntry] -> ShowS
$cshowList :: [ClusterSlotsResponseEntry] -> ShowS
show :: ClusterSlotsResponseEntry -> String
$cshow :: ClusterSlotsResponseEntry -> String
showsPrec :: Int -> ClusterSlotsResponseEntry -> ShowS
$cshowsPrec :: Int -> ClusterSlotsResponseEntry -> ShowS
Show)

instance RedisResult ClusterSlotsResponse where
    decode :: Reply -> Either Reply ClusterSlotsResponse
decode (MultiBulk (Just [Reply]
bulkData)) = do
        [ClusterSlotsResponseEntry]
clusterSlotsResponseEntries <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. RedisResult a => Reply -> Either Reply a
decode [Reply]
bulkData
        forall (m :: * -> *) a. Monad m => a -> m a
return ClusterSlotsResponse{[ClusterSlotsResponseEntry]
clusterSlotsResponseEntries :: [ClusterSlotsResponseEntry]
clusterSlotsResponseEntries :: [ClusterSlotsResponseEntry]
..}
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a

instance RedisResult ClusterSlotsResponseEntry where
    decode :: Reply -> Either Reply ClusterSlotsResponseEntry
decode (MultiBulk (Just
        ((Integer Integer
startSlot):(Integer Integer
endSlot):Reply
masterData:[Reply]
replicas))) = do
            ClusterSlotsNode
clusterSlotsResponseEntryMaster <- forall a. RedisResult a => Reply -> Either Reply a
decode Reply
masterData
            [ClusterSlotsNode]
clusterSlotsResponseEntryReplicas <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a. RedisResult a => Reply -> Either Reply a
decode [Reply]
replicas
            let clusterSlotsResponseEntryStartSlot :: Int
clusterSlotsResponseEntryStartSlot = forall a. Num a => Integer -> a
fromInteger Integer
startSlot
            let clusterSlotsResponseEntryEndSlot :: Int
clusterSlotsResponseEntryEndSlot = forall a. Num a => Integer -> a
fromInteger Integer
endSlot
            forall (m :: * -> *) a. Monad m => a -> m a
return ClusterSlotsResponseEntry{Int
[ClusterSlotsNode]
ClusterSlotsNode
clusterSlotsResponseEntryEndSlot :: Int
clusterSlotsResponseEntryStartSlot :: Int
clusterSlotsResponseEntryReplicas :: [ClusterSlotsNode]
clusterSlotsResponseEntryMaster :: ClusterSlotsNode
clusterSlotsResponseEntryReplicas :: [ClusterSlotsNode]
clusterSlotsResponseEntryMaster :: ClusterSlotsNode
clusterSlotsResponseEntryEndSlot :: Int
clusterSlotsResponseEntryStartSlot :: Int
..}
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a

instance RedisResult ClusterSlotsNode where
    decode :: Reply -> Either Reply ClusterSlotsNode
decode (MultiBulk (Just ((Bulk (Just ByteString
clusterSlotsNodeIP)):(Integer Integer
port):(Bulk (Just ByteString
clusterSlotsNodeID)):[Reply]
_))) = forall a b. b -> Either a b
Right ClusterSlotsNode{Int
ByteString
clusterSlotsNodePort :: Int
clusterSlotsNodeID :: ByteString
clusterSlotsNodeIP :: ByteString
clusterSlotsNodeID :: ByteString
clusterSlotsNodePort :: Int
clusterSlotsNodeIP :: ByteString
..}
        where clusterSlotsNodePort :: Int
clusterSlotsNodePort = forall a. Num a => Integer -> a
fromInteger Integer
port
    decode Reply
a = forall a b. a -> Either a b
Left Reply
a


clusterSlots
    :: (RedisCtx m f)
    => m (f ClusterSlotsResponse)
clusterSlots :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
m (f ClusterSlotsResponse)
clusterSlots = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"CLUSTER", ByteString
"SLOTS"]

clusterSetSlotImporting
    :: (RedisCtx m f)
    => Integer
    -> ByteString
    -> m (f Status)
clusterSetSlotImporting :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Integer -> ByteString -> m (f Status)
clusterSetSlotImporting Integer
slot ByteString
sourceNodeId = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"CLUSTER", ByteString
"SETSLOT", (forall a. RedisArg a => a -> ByteString
encode Integer
slot), ByteString
"IMPORTING", ByteString
sourceNodeId]

clusterSetSlotMigrating
    :: (RedisCtx m f)
    => Integer
    -> ByteString
    -> m (f Status)
clusterSetSlotMigrating :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Integer -> ByteString -> m (f Status)
clusterSetSlotMigrating Integer
slot ByteString
destinationNodeId = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"CLUSTER", ByteString
"SETSLOT", (forall a. RedisArg a => a -> ByteString
encode Integer
slot), ByteString
"MIGRATING", ByteString
destinationNodeId]

clusterSetSlotStable
    :: (RedisCtx m f)
    => Integer
    -> m (f Status)
clusterSetSlotStable :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Integer -> m (f Status)
clusterSetSlotStable Integer
slot = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest forall a b. (a -> b) -> a -> b
$ [ByteString
"CLUSTER", ByteString
"SETSLOT", ByteString
"STABLE", (forall a. RedisArg a => a -> ByteString
encode Integer
slot)]

clusterSetSlotNode
    :: (RedisCtx m f)
    => Integer
    -> ByteString
    -> m (f Status)
clusterSetSlotNode :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Integer -> ByteString -> m (f Status)
clusterSetSlotNode Integer
slot ByteString
node = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"CLUSTER", ByteString
"SETSLOT", (forall a. RedisArg a => a -> ByteString
encode Integer
slot), ByteString
"NODE", ByteString
node]

clusterGetKeysInSlot
    :: (RedisCtx m f)
    => Integer
    -> Integer
    -> m (f [ByteString])
clusterGetKeysInSlot :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Integer -> Integer -> m (f [ByteString])
clusterGetKeysInSlot Integer
slot Integer
count = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"CLUSTER", ByteString
"GETKEYSINSLOT", (forall a. RedisArg a => a -> ByteString
encode Integer
slot), (forall a. RedisArg a => a -> ByteString
encode Integer
count)]

command :: (RedisCtx m f) => m (f [CMD.CommandInfo])
command :: forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
m (f [CommandInfo])
command = forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"COMMAND"]