{-# LANGUAGE OverloadedStrings, RecordWildCards, FlexibleContexts #-}
module Database.Redis.ManualCommands where
import Prelude hiding (min, max)
import Data.ByteString (ByteString, empty, append)
import Data.Maybe (maybeToList)
import Database.Redis.Core
import Database.Redis.Protocol
import Database.Redis.Types
objectRefcount
:: (RedisCtx m f)
=> ByteString
-> m (f Integer)
objectRefcount :: ByteString -> m (f Integer)
objectRefcount key :: ByteString
key = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["OBJECT", "refcount", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key]
objectIdletime
:: (RedisCtx m f)
=> ByteString
-> m (f Integer)
objectIdletime :: ByteString -> m (f Integer)
objectIdletime key :: ByteString
key = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["OBJECT", "idletime", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key]
objectEncoding
:: (RedisCtx m f)
=> ByteString
-> m (f ByteString)
objectEncoding :: ByteString -> m (f ByteString)
objectEncoding key :: ByteString
key = [ByteString] -> m (f ByteString)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["OBJECT", "encoding", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key]
linsertBefore
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> m (f Integer)
linsertBefore :: ByteString -> ByteString -> ByteString -> m (f Integer)
linsertBefore key :: ByteString
key pivot :: ByteString
pivot value :: ByteString
value =
[ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["LINSERT", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, "BEFORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
pivot, ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
value]
linsertAfter
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> m (f Integer)
linsertAfter :: ByteString -> ByteString -> ByteString -> m (f Integer)
linsertAfter key :: ByteString
key pivot :: ByteString
pivot value :: ByteString
value =
[ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["LINSERT", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, "AFTER", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
pivot, ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
value]
getType
:: (RedisCtx m f)
=> ByteString
-> m (f RedisType)
getType :: ByteString -> m (f RedisType)
getType key :: ByteString
key = [ByteString] -> m (f RedisType)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["TYPE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key]
data Slowlog = Slowlog
{ Slowlog -> Integer
slowlogId :: Integer
, Slowlog -> Integer
slowlogTimestamp :: Integer
, Slowlog -> Integer
slowlogMicros :: Integer
, Slowlog -> [ByteString]
slowlogCmd :: [ByteString]
, Slowlog -> Maybe ByteString
slowlogClientIpAndPort :: Maybe ByteString
, Slowlog -> Maybe ByteString
slowlogClientName :: Maybe ByteString
} deriving (Int -> Slowlog -> ShowS
[Slowlog] -> ShowS
Slowlog -> String
(Int -> Slowlog -> ShowS)
-> (Slowlog -> String) -> ([Slowlog] -> ShowS) -> Show Slowlog
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
(Slowlog -> Slowlog -> Bool)
-> (Slowlog -> Slowlog -> Bool) -> Eq Slowlog
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 [logId :: Reply
logId,timestamp :: Reply
timestamp,micros :: Reply
micros,cmd :: Reply
cmd])) = do
Integer
slowlogId <- Reply -> Either Reply Integer
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
logId
Integer
slowlogTimestamp <- Reply -> Either Reply Integer
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
timestamp
Integer
slowlogMicros <- Reply -> Either Reply Integer
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
micros
[ByteString]
slowlogCmd <- Reply -> Either Reply [ByteString]
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
cmd
let slowlogClientIpAndPort :: Maybe a
slowlogClientIpAndPort = Maybe a
forall a. Maybe a
Nothing
slowlogClientName :: Maybe a
slowlogClientName = Maybe a
forall a. Maybe a
Nothing
Slowlog -> Either Reply Slowlog
forall (m :: * -> *) a. Monad m => a -> m a
return Slowlog :: Integer
-> Integer
-> Integer
-> [ByteString]
-> Maybe ByteString
-> Maybe ByteString
-> Slowlog
Slowlog{..}
decode (MultiBulk (Just [logId :: Reply
logId,timestamp :: Reply
timestamp,micros :: Reply
micros,cmd :: Reply
cmd,ip :: Reply
ip,cname :: Reply
cname])) = do
Integer
slowlogId <- Reply -> Either Reply Integer
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
logId
Integer
slowlogTimestamp <- Reply -> Either Reply Integer
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
timestamp
Integer
slowlogMicros <- Reply -> Either Reply Integer
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
micros
[ByteString]
slowlogCmd <- Reply -> Either Reply [ByteString]
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
cmd
Maybe ByteString
slowlogClientIpAndPort <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Either Reply ByteString -> Either Reply (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reply -> Either Reply ByteString
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
ip
Maybe ByteString
slowlogClientName <- ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> Either Reply ByteString -> Either Reply (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reply -> Either Reply ByteString
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
cname
Slowlog -> Either Reply Slowlog
forall (m :: * -> *) a. Monad m => a -> m a
return Slowlog :: Integer
-> Integer
-> Integer
-> [ByteString]
-> Maybe ByteString
-> Maybe ByteString
-> Slowlog
Slowlog{..}
decode r :: Reply
r = Reply -> Either Reply Slowlog
forall a b. a -> Either a b
Left Reply
r
slowlogGet
:: (RedisCtx m f)
=> Integer
-> m (f [Slowlog])
slowlogGet :: Integer -> m (f [Slowlog])
slowlogGet n :: Integer
n = [ByteString] -> m (f [Slowlog])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SLOWLOG", "GET", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
n]
slowlogLen :: (RedisCtx m f) => m (f Integer)
slowlogLen :: m (f Integer)
slowlogLen = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SLOWLOG", "LEN"]
slowlogReset :: (RedisCtx m f) => m (f Status)
slowlogReset :: m (f Status)
slowlogReset = [ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SLOWLOG", "RESET"]
zrange
:: (RedisCtx m f)
=> ByteString
-> Integer
-> Integer
-> m (f [ByteString])
zrange :: ByteString -> Integer -> Integer -> m (f [ByteString])
zrange key :: ByteString
key start :: Integer
start stop :: Integer
stop =
[ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZRANGE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
start, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
stop]
zrangeWithscores
:: (RedisCtx m f)
=> ByteString
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrangeWithscores :: ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrangeWithscores key :: ByteString
key start :: Integer
start stop :: Integer
stop =
[ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZRANGE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
start, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
stop, "WITHSCORES"]
zrevrange
:: (RedisCtx m f)
=> ByteString
-> Integer
-> Integer
-> m (f [ByteString])
zrevrange :: ByteString -> Integer -> Integer -> m (f [ByteString])
zrevrange key :: ByteString
key start :: Integer
start stop :: Integer
stop =
[ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZREVRANGE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
start, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
stop]
zrevrangeWithscores
:: (RedisCtx m f)
=> ByteString
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrevrangeWithscores :: ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrevrangeWithscores key :: ByteString
key start :: Integer
start stop :: Integer
stop =
[ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZREVRANGE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
start, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
stop
,"WITHSCORES"]
zrangebyscore
:: (RedisCtx m f)
=> ByteString
-> Double
-> Double
-> m (f [ByteString])
zrangebyscore :: ByteString -> Double -> Double -> m (f [ByteString])
zrangebyscore key :: ByteString
key min :: Double
min max :: Double
max =
[ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZRANGEBYSCORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
min, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
max]
zrangebyscoreWithscores
:: (RedisCtx m f)
=> ByteString
-> Double
-> Double
-> m (f [(ByteString, Double)])
zrangebyscoreWithscores :: ByteString -> Double -> Double -> m (f [(ByteString, Double)])
zrangebyscoreWithscores key :: ByteString
key min :: Double
min max :: Double
max =
[ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZRANGEBYSCORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
min, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
max
,"WITHSCORES"]
zrangebyscoreLimit
:: (RedisCtx m f)
=> ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [ByteString])
zrangebyscoreLimit :: ByteString
-> Double -> Double -> Integer -> Integer -> m (f [ByteString])
zrangebyscoreLimit key :: ByteString
key min :: Double
min max :: Double
max offset :: Integer
offset count :: Integer
count =
[ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZRANGEBYSCORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
min, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
max
,"LIMIT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
offset, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
count]
zrangebyscoreWithscoresLimit
:: (RedisCtx m f)
=> ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrangebyscoreWithscoresLimit :: ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrangebyscoreWithscoresLimit key :: ByteString
key min :: Double
min max :: Double
max offset :: Integer
offset count :: Integer
count =
[ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZRANGEBYSCORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
min, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
max
,"WITHSCORES","LIMIT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
offset, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
count]
zrevrangebyscore
:: (RedisCtx m f)
=> ByteString
-> Double
-> Double
-> m (f [ByteString])
zrevrangebyscore :: ByteString -> Double -> Double -> m (f [ByteString])
zrevrangebyscore key :: ByteString
key min :: Double
min max :: Double
max =
[ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZREVRANGEBYSCORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
min, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
max]
zrevrangebyscoreWithscores
:: (RedisCtx m f)
=> ByteString
-> Double
-> Double
-> m (f [(ByteString, Double)])
zrevrangebyscoreWithscores :: ByteString -> Double -> Double -> m (f [(ByteString, Double)])
zrevrangebyscoreWithscores key :: ByteString
key min :: Double
min max :: Double
max =
[ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZREVRANGEBYSCORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
min, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
max
,"WITHSCORES"]
zrevrangebyscoreLimit
:: (RedisCtx m f)
=> ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [ByteString])
zrevrangebyscoreLimit :: ByteString
-> Double -> Double -> Integer -> Integer -> m (f [ByteString])
zrevrangebyscoreLimit key :: ByteString
key min :: Double
min max :: Double
max offset :: Integer
offset count :: Integer
count =
[ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZREVRANGEBYSCORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
min, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
max
,"LIMIT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
offset, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
count]
zrevrangebyscoreWithscoresLimit
:: (RedisCtx m f)
=> ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrevrangebyscoreWithscoresLimit :: ByteString
-> Double
-> Double
-> Integer
-> Integer
-> m (f [(ByteString, Double)])
zrevrangebyscoreWithscoresLimit key :: ByteString
key min :: Double
min max :: Double
max offset :: Integer
offset count :: Integer
count =
[ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZREVRANGEBYSCORE", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
min, Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
max
,"WITHSCORES","LIMIT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
offset, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
count]
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
(Int -> SortOpts -> ShowS)
-> (SortOpts -> String) -> ([SortOpts] -> ShowS) -> Show SortOpts
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
(SortOpts -> SortOpts -> Bool)
-> (SortOpts -> SortOpts -> Bool) -> Eq SortOpts
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)
defaultSortOpts :: SortOpts
defaultSortOpts :: SortOpts
defaultSortOpts = SortOpts :: Maybe ByteString
-> (Integer, Integer)
-> [ByteString]
-> SortOrder
-> Bool
-> SortOpts
SortOpts
{ sortBy :: Maybe ByteString
sortBy = Maybe ByteString
forall a. Maybe a
Nothing
, sortLimit :: (Integer, Integer)
sortLimit = (0,-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
(Int -> SortOrder -> ShowS)
-> (SortOrder -> String)
-> ([SortOrder] -> ShowS)
-> Show SortOrder
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
(SortOrder -> SortOrder -> Bool)
-> (SortOrder -> SortOrder -> Bool) -> Eq SortOrder
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
-> ByteString
-> SortOpts
-> m (f Integer)
sortStore :: ByteString -> ByteString -> SortOpts -> m (f Integer)
sortStore key :: ByteString
key dest :: ByteString
dest = ByteString -> Maybe ByteString -> SortOpts -> m (f Integer)
forall a (m :: * -> *) (f :: * -> *).
(RedisResult a, RedisCtx m f) =>
ByteString -> Maybe ByteString -> SortOpts -> m (f a)
sortInternal ByteString
key (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
dest)
sort
:: (RedisCtx m f)
=> ByteString
-> SortOpts
-> m (f [ByteString])
sort :: ByteString -> SortOpts -> m (f [ByteString])
sort key :: ByteString
key = ByteString -> Maybe ByteString -> SortOpts -> m (f [ByteString])
forall a (m :: * -> *) (f :: * -> *).
(RedisResult a, RedisCtx m f) =>
ByteString -> Maybe ByteString -> SortOpts -> m (f a)
sortInternal ByteString
key Maybe ByteString
forall a. Maybe a
Nothing
sortInternal
:: (RedisResult a, RedisCtx m f)
=> ByteString
-> Maybe ByteString
-> SortOpts
-> m (f a)
sortInternal :: ByteString -> Maybe ByteString -> SortOpts -> m (f a)
sortInternal key :: ByteString
key destination :: Maybe ByteString
destination SortOpts{..} = [ByteString] -> m (f a)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f a)) -> [ByteString] -> m (f a)
forall a b. (a -> b) -> a -> b
$
[[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [["SORT", ByteString -> ByteString
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 = [ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\pattern :: ByteString
pattern -> ["BY", ByteString
pattern]) Maybe ByteString
sortBy
limit :: [ByteString]
limit = let (off :: Integer
off,cnt :: Integer
cnt) = (Integer, Integer)
sortLimit in ["LIMIT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
off, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
cnt]
get :: [ByteString]
get = (ByteString -> [ByteString]) -> [ByteString] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\pattern :: ByteString
pattern -> ["GET", ByteString
pattern]) [ByteString]
sortGet
order :: [ByteString]
order = case SortOrder
sortOrder of Desc -> ["DESC"]; Asc -> ["ASC"]
alpha :: [ByteString]
alpha = ["ALPHA" | Bool
sortAlpha]
store :: [ByteString]
store = [ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\dest :: ByteString
dest -> ["STORE", ByteString
dest]) Maybe ByteString
destination
data Aggregate = Sum | Min | Max deriving (Int -> Aggregate -> ShowS
[Aggregate] -> ShowS
Aggregate -> String
(Int -> Aggregate -> ShowS)
-> (Aggregate -> String)
-> ([Aggregate] -> ShowS)
-> Show Aggregate
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
(Aggregate -> Aggregate -> Bool)
-> (Aggregate -> Aggregate -> Bool) -> Eq Aggregate
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
-> [ByteString]
-> Aggregate
-> m (f Integer)
zunionstore :: ByteString -> [ByteString] -> Aggregate -> m (f Integer)
zunionstore dest :: ByteString
dest keys :: [ByteString]
keys =
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal "ZUNIONSTORE" ByteString
dest [ByteString]
keys []
zunionstoreWeights
:: (RedisCtx m f)
=> ByteString
-> [(ByteString,Double)]
-> Aggregate
-> m (f Integer)
zunionstoreWeights :: ByteString -> [(ByteString, Double)] -> Aggregate -> m (f Integer)
zunionstoreWeights dest :: ByteString
dest kws :: [(ByteString, Double)]
kws =
let (keys :: [ByteString]
keys,weights :: [Double]
weights) = [(ByteString, Double)] -> ([ByteString], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(ByteString, Double)]
kws
in ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal "ZUNIONSTORE" ByteString
dest [ByteString]
keys [Double]
weights
zinterstore
:: (RedisCtx m f)
=> ByteString
-> [ByteString]
-> Aggregate
-> m (f Integer)
zinterstore :: ByteString -> [ByteString] -> Aggregate -> m (f Integer)
zinterstore dest :: ByteString
dest keys :: [ByteString]
keys =
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal "ZINTERSTORE" ByteString
dest [ByteString]
keys []
zinterstoreWeights
:: (RedisCtx m f)
=> ByteString
-> [(ByteString,Double)]
-> Aggregate
-> m (f Integer)
zinterstoreWeights :: ByteString -> [(ByteString, Double)] -> Aggregate -> m (f Integer)
zinterstoreWeights dest :: ByteString
dest kws :: [(ByteString, Double)]
kws =
let (keys :: [ByteString]
keys,weights :: [Double]
weights) = [(ByteString, Double)] -> ([ByteString], [Double])
forall a b. [(a, b)] -> ([a], [b])
unzip [(ByteString, Double)]
kws
in ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal "ZINTERSTORE" ByteString
dest [ByteString]
keys [Double]
weights
zstoreInternal
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal :: ByteString
-> ByteString
-> [ByteString]
-> [Double]
-> Aggregate
-> m (f Integer)
zstoreInternal cmd :: ByteString
cmd dest :: ByteString
dest keys :: [ByteString]
keys weights :: [Double]
weights aggregate :: Aggregate
aggregate = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Integer)) -> [ByteString] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$
[[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ByteString
cmd, ByteString
dest, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode (Integer -> ByteString) -> (Int -> Integer) -> Int -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> ByteString) -> Int -> ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
keys], [ByteString]
keys
, if [Double] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Double]
weights then [] else "WEIGHTS" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: (Double -> ByteString) -> [Double] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode [Double]
weights
, ["AGGREGATE", ByteString
aggregate']
]
where
aggregate' :: ByteString
aggregate' = case Aggregate
aggregate of
Sum -> "SUM"
Min -> "MIN"
Max -> "MAX"
eval
:: (RedisCtx m f, RedisResult a)
=> ByteString
-> [ByteString]
-> [ByteString]
-> m (f a)
eval :: ByteString -> [ByteString] -> [ByteString] -> m (f a)
eval script :: ByteString
script keys :: [ByteString]
keys args :: [ByteString]
args =
[ByteString] -> m (f a)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f a)) -> [ByteString] -> m (f a)
forall a b. (a -> b) -> a -> b
$ ["EVAL", ByteString
script, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
numkeys] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
keys [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
args
where
numkeys :: Integer
numkeys = Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
keys)
evalsha
:: (RedisCtx m f, RedisResult a)
=> ByteString
-> [ByteString]
-> [ByteString]
-> m (f a)
evalsha :: ByteString -> [ByteString] -> [ByteString] -> m (f a)
evalsha script :: ByteString
script keys :: [ByteString]
keys args :: [ByteString]
args =
[ByteString] -> m (f a)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f a)) -> [ByteString] -> m (f a)
forall a b. (a -> b) -> a -> b
$ ["EVALSHA", ByteString
script, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
numkeys] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
keys [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
args
where
numkeys :: Integer
numkeys = Int -> Integer
forall a. Integral a => a -> Integer
toInteger ([ByteString] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ByteString]
keys)
bitcount
:: (RedisCtx m f)
=> ByteString
-> m (f Integer)
bitcount :: ByteString -> m (f Integer)
bitcount key :: ByteString
key = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["BITCOUNT", ByteString
key]
bitcountRange
:: (RedisCtx m f)
=> ByteString
-> Integer
-> Integer
-> m (f Integer)
bitcountRange :: ByteString -> Integer -> Integer -> m (f Integer)
bitcountRange key :: ByteString
key start :: Integer
start end :: Integer
end =
[ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["BITCOUNT", ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
start, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
end]
bitopAnd
:: (RedisCtx m f)
=> ByteString
-> [ByteString]
-> m (f Integer)
bitopAnd :: ByteString -> [ByteString] -> m (f Integer)
bitopAnd dst :: ByteString
dst srcs :: [ByteString]
srcs = ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop "AND" (ByteString
dstByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
srcs)
bitopOr
:: (RedisCtx m f)
=> ByteString
-> [ByteString]
-> m (f Integer)
bitopOr :: ByteString -> [ByteString] -> m (f Integer)
bitopOr dst :: ByteString
dst srcs :: [ByteString]
srcs = ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop "OR" (ByteString
dstByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
srcs)
bitopXor
:: (RedisCtx m f)
=> ByteString
-> [ByteString]
-> m (f Integer)
bitopXor :: ByteString -> [ByteString] -> m (f Integer)
bitopXor dst :: ByteString
dst srcs :: [ByteString]
srcs = ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop "XOR" (ByteString
dstByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:[ByteString]
srcs)
bitopNot
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> m (f Integer)
bitopNot :: ByteString -> ByteString -> m (f Integer)
bitopNot dst :: ByteString
dst src :: ByteString
src = ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
bitop "NOT" [ByteString
dst, ByteString
src]
bitop
:: (RedisCtx m f)
=> ByteString
-> [ByteString]
-> m (f Integer)
bitop :: ByteString -> [ByteString] -> m (f Integer)
bitop op :: ByteString
op ks :: [ByteString]
ks = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Integer)) -> [ByteString] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$ "BITOP" ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString
op ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
ks
migrate
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> Integer
-> Integer
-> m (f Status)
migrate :: ByteString
-> ByteString -> ByteString -> Integer -> Integer -> m (f Status)
migrate host :: ByteString
host port :: ByteString
port key :: ByteString
key destinationDb :: Integer
destinationDb timeout :: Integer
timeout =
[ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["MIGRATE", ByteString
host, ByteString
port, ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
destinationDb, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
timeout]
data MigrateOpts = MigrateOpts
{ MigrateOpts -> Bool
migrateCopy :: Bool
, MigrateOpts -> Bool
migrateReplace :: Bool
} deriving (Int -> MigrateOpts -> ShowS
[MigrateOpts] -> ShowS
MigrateOpts -> String
(Int -> MigrateOpts -> ShowS)
-> (MigrateOpts -> String)
-> ([MigrateOpts] -> ShowS)
-> Show MigrateOpts
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
(MigrateOpts -> MigrateOpts -> Bool)
-> (MigrateOpts -> MigrateOpts -> Bool) -> Eq MigrateOpts
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)
defaultMigrateOpts :: MigrateOpts
defaultMigrateOpts :: MigrateOpts
defaultMigrateOpts = MigrateOpts :: Bool -> Bool -> MigrateOpts
MigrateOpts
{ migrateCopy :: Bool
migrateCopy = Bool
False
, migrateReplace :: Bool
migrateReplace = Bool
False
}
migrateMultiple
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> Integer
-> Integer
-> MigrateOpts
-> [ByteString]
-> m (f Status)
migrateMultiple :: ByteString
-> ByteString
-> Integer
-> Integer
-> MigrateOpts
-> [ByteString]
-> m (f Status)
migrateMultiple host :: ByteString
host port :: ByteString
port destinationDb :: Integer
destinationDb timeout :: Integer
timeout MigrateOpts{..} keys :: [ByteString]
keys =
[ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Status)) -> [ByteString] -> m (f Status)
forall a b. (a -> b) -> a -> b
$
[[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [["MIGRATE", ByteString
host, ByteString
port, ByteString
empty, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
destinationDb, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
timeout],
[ByteString]
copy, [ByteString]
replace, [ByteString]
keys]
where
copy :: [ByteString]
copy = ["COPY" | Bool
migrateCopy]
replace :: [ByteString]
replace = ["REPLACE" | Bool
migrateReplace]
restore
:: (RedisCtx m f)
=> ByteString
-> Integer
-> ByteString
-> m (f Status)
restore :: ByteString -> Integer -> ByteString -> m (f Status)
restore key :: ByteString
key timeToLive :: Integer
timeToLive serializedValue :: ByteString
serializedValue =
[ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["RESTORE", ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
timeToLive, ByteString
serializedValue]
restoreReplace
:: (RedisCtx m f)
=> ByteString
-> Integer
-> ByteString
-> m (f Status)
restoreReplace :: ByteString -> Integer -> ByteString -> m (f Status)
restoreReplace key :: ByteString
key timeToLive :: Integer
timeToLive serializedValue :: ByteString
serializedValue =
[ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["RESTORE", ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
timeToLive, ByteString
serializedValue, "REPLACE"]
set
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> m (f Status)
set :: ByteString -> ByteString -> m (f Status)
set key :: ByteString
key value :: ByteString
value = [ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SET", ByteString
key, ByteString
value]
data Condition = Nx | Xx deriving (Int -> Condition -> ShowS
[Condition] -> ShowS
Condition -> String
(Int -> Condition -> ShowS)
-> (Condition -> String)
-> ([Condition] -> ShowS)
-> Show Condition
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
(Condition -> Condition -> Bool)
-> (Condition -> Condition -> Bool) -> Eq Condition
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 Nx = "NX"
encode Xx = "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
(Int -> SetOpts -> ShowS)
-> (SetOpts -> String) -> ([SetOpts] -> ShowS) -> Show SetOpts
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
(SetOpts -> SetOpts -> Bool)
-> (SetOpts -> SetOpts -> Bool) -> Eq SetOpts
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
-> ByteString
-> SetOpts
-> m (f Status)
setOpts :: ByteString -> ByteString -> SetOpts -> m (f Status)
setOpts key :: ByteString
key value :: ByteString
value SetOpts{..} =
[ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Status)) -> [ByteString] -> m (f Status)
forall a b. (a -> b) -> a -> b
$ [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [["SET", ByteString
key, ByteString
value], [ByteString]
ex, [ByteString]
px, [ByteString]
condition]
where
ex :: [ByteString]
ex = [ByteString]
-> (Integer -> [ByteString]) -> Maybe Integer -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\s :: Integer
s -> ["EX", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
s]) Maybe Integer
setSeconds
px :: [ByteString]
px = [ByteString]
-> (Integer -> [ByteString]) -> Maybe Integer -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\s :: Integer
s -> ["PX", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
s]) Maybe Integer
setMilliseconds
condition :: [ByteString]
condition = (Condition -> ByteString) -> [Condition] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Condition -> ByteString
forall a. RedisArg a => a -> ByteString
encode ([Condition] -> [ByteString]) -> [Condition] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Maybe Condition -> [Condition]
forall a. Maybe a -> [a]
maybeToList Maybe Condition
setCondition
data DebugMode = Yes | Sync | No deriving (Int -> DebugMode -> ShowS
[DebugMode] -> ShowS
DebugMode -> String
(Int -> DebugMode -> ShowS)
-> (DebugMode -> String)
-> ([DebugMode] -> ShowS)
-> Show DebugMode
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
(DebugMode -> DebugMode -> Bool)
-> (DebugMode -> DebugMode -> Bool) -> Eq DebugMode
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 Yes = "YES"
encode Sync = "SYNC"
encode No = "NO"
scriptDebug
:: (RedisCtx m f)
=> DebugMode
-> m (f Bool)
scriptDebug :: DebugMode -> m (f Bool)
scriptDebug mode :: DebugMode
mode =
[ByteString] -> m (f Bool)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SCRIPT DEBUG", DebugMode -> ByteString
forall a. RedisArg a => a -> ByteString
encode DebugMode
mode]
zadd
:: (RedisCtx m f)
=> ByteString
-> [(Double,ByteString)]
-> m (f Integer)
zadd :: ByteString -> [(Double, ByteString)] -> m (f Integer)
zadd key :: ByteString
key scoreMembers :: [(Double, ByteString)]
scoreMembers =
ByteString -> [(Double, ByteString)] -> ZaddOpts -> m (f Integer)
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
(Int -> ZaddOpts -> ShowS)
-> (ZaddOpts -> String) -> ([ZaddOpts] -> ShowS) -> Show ZaddOpts
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
(ZaddOpts -> ZaddOpts -> Bool)
-> (ZaddOpts -> ZaddOpts -> Bool) -> Eq ZaddOpts
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)
defaultZaddOpts :: ZaddOpts
defaultZaddOpts :: ZaddOpts
defaultZaddOpts = ZaddOpts :: Maybe Condition -> Bool -> Bool -> ZaddOpts
ZaddOpts
{ zaddCondition :: Maybe Condition
zaddCondition = Maybe Condition
forall a. Maybe a
Nothing
, zaddChange :: Bool
zaddChange = Bool
False
, zaddIncrement :: Bool
zaddIncrement = Bool
False
}
zaddOpts
:: (RedisCtx m f)
=> ByteString
-> [(Double,ByteString)]
-> ZaddOpts
-> m (f Integer)
zaddOpts :: ByteString -> [(Double, ByteString)] -> ZaddOpts -> m (f Integer)
zaddOpts key :: ByteString
key scoreMembers :: [(Double, ByteString)]
scoreMembers ZaddOpts{..} =
[ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Integer)) -> [ByteString] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$ [[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [["ZADD", ByteString
key], [ByteString]
condition, [ByteString]
change, [ByteString]
increment, [ByteString]
scores]
where
scores :: [ByteString]
scores = ((Double, ByteString) -> [ByteString])
-> [(Double, ByteString)] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(x :: Double
x,y :: ByteString
y) -> [Double -> ByteString
forall a. RedisArg a => a -> ByteString
encode Double
x,ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
y]) [(Double, ByteString)]
scoreMembers
condition :: [ByteString]
condition = (Condition -> ByteString) -> [Condition] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map Condition -> ByteString
forall a. RedisArg a => a -> ByteString
encode ([Condition] -> [ByteString]) -> [Condition] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Maybe Condition -> [Condition]
forall a. Maybe a -> [a]
maybeToList Maybe Condition
zaddCondition
change :: [ByteString]
change = ["CH" | Bool
zaddChange]
increment :: [ByteString]
increment = ["INCR" | Bool
zaddIncrement]
data ReplyMode = On | Off | Skip deriving (Int -> ReplyMode -> ShowS
[ReplyMode] -> ShowS
ReplyMode -> String
(Int -> ReplyMode -> ShowS)
-> (ReplyMode -> String)
-> ([ReplyMode] -> ShowS)
-> Show ReplyMode
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
(ReplyMode -> ReplyMode -> Bool)
-> (ReplyMode -> ReplyMode -> Bool) -> Eq ReplyMode
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 On = "ON"
encode Off = "OFF"
encode Skip = "SKIP"
clientReply
:: (RedisCtx m f)
=> ReplyMode
-> m (f Bool)
clientReply :: ReplyMode -> m (f Bool)
clientReply mode :: ReplyMode
mode =
[ByteString] -> m (f Bool)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["CLIENT REPLY", ReplyMode -> ByteString
forall a. RedisArg a => a -> ByteString
encode ReplyMode
mode]
srandmember
:: (RedisCtx m f)
=> ByteString
-> m (f (Maybe ByteString))
srandmember :: ByteString -> m (f (Maybe ByteString))
srandmember key :: ByteString
key = [ByteString] -> m (f (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SRANDMEMBER", ByteString
key]
srandmemberN
:: (RedisCtx m f)
=> ByteString
-> Integer
-> m (f [ByteString])
srandmemberN :: ByteString -> Integer -> m (f [ByteString])
srandmemberN key :: ByteString
key count :: Integer
count = [ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SRANDMEMBER", ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
count]
spop
:: (RedisCtx m f)
=> ByteString
-> m (f (Maybe ByteString))
spop :: ByteString -> m (f (Maybe ByteString))
spop key :: ByteString
key = [ByteString] -> m (f (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SPOP", ByteString
key]
spopN
:: (RedisCtx m f)
=> ByteString
-> Integer
-> m (f [ByteString])
spopN :: ByteString -> Integer -> m (f [ByteString])
spopN key :: ByteString
key count :: Integer
count = [ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["SPOP", ByteString
key, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
count]
info
:: (RedisCtx m f)
=> m (f ByteString)
info :: m (f ByteString)
info = [ByteString] -> m (f ByteString)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["INFO"]
infoSection
:: (RedisCtx m f)
=> ByteString
-> m (f ByteString)
infoSection :: ByteString -> m (f ByteString)
infoSection section :: ByteString
section = [ByteString] -> m (f ByteString)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["INFO", ByteString
section]
exists
:: (RedisCtx m f)
=> ByteString
-> m (f Bool)
exists :: ByteString -> m (f Bool)
exists key :: ByteString
key = [ByteString] -> m (f Bool)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["EXISTS", ByteString
key]
newtype Cursor = Cursor ByteString deriving (Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
(Int -> Cursor -> ShowS)
-> (Cursor -> String) -> ([Cursor] -> ShowS) -> Show Cursor
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
(Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool) -> Eq Cursor
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 c :: ByteString
c) = ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
c
instance RedisResult Cursor where
decode :: Reply -> Either Reply Cursor
decode (Bulk (Just s :: ByteString
s)) = Cursor -> Either Reply Cursor
forall a b. b -> Either a b
Right (Cursor -> Either Reply Cursor) -> Cursor -> Either Reply Cursor
forall a b. (a -> b) -> a -> b
$ ByteString -> Cursor
Cursor ByteString
s
decode r :: Reply
r = Reply -> Either Reply Cursor
forall a b. a -> Either a b
Left Reply
r
cursor0 :: Cursor
cursor0 :: Cursor
cursor0 = ByteString -> Cursor
Cursor "0"
scan
:: (RedisCtx m f)
=> Cursor
-> m (f (Cursor, [ByteString]))
scan :: Cursor -> m (f (Cursor, [ByteString]))
scan cursor :: Cursor
cursor = Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
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
(Int -> ScanOpts -> ShowS)
-> (ScanOpts -> String) -> ([ScanOpts] -> ShowS) -> Show ScanOpts
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
(ScanOpts -> ScanOpts -> Bool)
-> (ScanOpts -> ScanOpts -> Bool) -> Eq ScanOpts
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)
defaultScanOpts :: ScanOpts
defaultScanOpts :: ScanOpts
defaultScanOpts = ScanOpts :: Maybe ByteString -> Maybe Integer -> ScanOpts
ScanOpts
{ scanMatch :: Maybe ByteString
scanMatch = Maybe ByteString
forall a. Maybe a
Nothing
, scanCount :: Maybe Integer
scanCount = Maybe Integer
forall a. Maybe a
Nothing
}
scanOpts
:: (RedisCtx m f)
=> Cursor
-> ScanOpts
-> m (f (Cursor, [ByteString]))
scanOpts :: Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
scanOpts cursor :: Cursor
cursor opts :: ScanOpts
opts = [ByteString] -> m (f (Cursor, [ByteString]))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f (Cursor, [ByteString])))
-> [ByteString] -> m (f (Cursor, [ByteString]))
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ScanOpts -> [ByteString]
addScanOpts ["SCAN", Cursor -> ByteString
forall a. RedisArg a => a -> ByteString
encode Cursor
cursor] ScanOpts
opts
addScanOpts
:: [ByteString]
-> ScanOpts
-> [ByteString]
addScanOpts :: [ByteString] -> ScanOpts -> [ByteString]
addScanOpts cmd :: [ByteString]
cmd ScanOpts{..} =
[[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ByteString]
cmd, [ByteString]
match, [ByteString]
count]
where
prepend :: a -> a -> [a]
prepend x :: a
x y :: a
y = [a
x, a
y]
match :: [ByteString]
match = [ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (ByteString -> ByteString -> [ByteString]
forall a. a -> a -> [a]
prepend "MATCH") Maybe ByteString
scanMatch
count :: [ByteString]
count = [ByteString]
-> (Integer -> [ByteString]) -> Maybe Integer -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((ByteString -> ByteString -> [ByteString]
forall a. a -> a -> [a]
prepend "COUNT")(ByteString -> [ByteString])
-> (Integer -> ByteString) -> Integer -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode) Maybe Integer
scanCount
sscan
:: (RedisCtx m f)
=> ByteString
-> Cursor
-> m (f (Cursor, [ByteString]))
sscan :: ByteString -> Cursor -> m (f (Cursor, [ByteString]))
sscan key :: ByteString
key cursor :: Cursor
cursor = ByteString -> Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
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
-> Cursor
-> ScanOpts
-> m (f (Cursor, [ByteString]))
sscanOpts :: ByteString -> Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
sscanOpts key :: ByteString
key cursor :: Cursor
cursor opts :: ScanOpts
opts = [ByteString] -> m (f (Cursor, [ByteString]))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f (Cursor, [ByteString])))
-> [ByteString] -> m (f (Cursor, [ByteString]))
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ScanOpts -> [ByteString]
addScanOpts ["SSCAN", ByteString
key, Cursor -> ByteString
forall a. RedisArg a => a -> ByteString
encode Cursor
cursor] ScanOpts
opts
hscan
:: (RedisCtx m f)
=> ByteString
-> Cursor
-> m (f (Cursor, [(ByteString, ByteString)]))
hscan :: ByteString -> Cursor -> m (f (Cursor, [(ByteString, ByteString)]))
hscan key :: ByteString
key cursor :: Cursor
cursor = ByteString
-> Cursor -> ScanOpts -> m (f (Cursor, [(ByteString, ByteString)]))
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
-> Cursor
-> ScanOpts
-> m (f (Cursor, [(ByteString, ByteString)]))
hscanOpts :: ByteString
-> Cursor -> ScanOpts -> m (f (Cursor, [(ByteString, ByteString)]))
hscanOpts key :: ByteString
key cursor :: Cursor
cursor opts :: ScanOpts
opts = [ByteString] -> m (f (Cursor, [(ByteString, ByteString)]))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f (Cursor, [(ByteString, ByteString)])))
-> [ByteString] -> m (f (Cursor, [(ByteString, ByteString)]))
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ScanOpts -> [ByteString]
addScanOpts ["HSCAN", ByteString
key, Cursor -> ByteString
forall a. RedisArg a => a -> ByteString
encode Cursor
cursor] ScanOpts
opts
zscan
:: (RedisCtx m f)
=> ByteString
-> Cursor
-> m (f (Cursor, [(ByteString, Double)]))
zscan :: ByteString -> Cursor -> m (f (Cursor, [(ByteString, Double)]))
zscan key :: ByteString
key cursor :: Cursor
cursor = ByteString
-> Cursor -> ScanOpts -> m (f (Cursor, [(ByteString, Double)]))
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
-> Cursor
-> ScanOpts
-> m (f (Cursor, [(ByteString, Double)]))
zscanOpts :: ByteString
-> Cursor -> ScanOpts -> m (f (Cursor, [(ByteString, Double)]))
zscanOpts key :: ByteString
key cursor :: Cursor
cursor opts :: ScanOpts
opts = [ByteString] -> m (f (Cursor, [(ByteString, Double)]))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f (Cursor, [(ByteString, Double)])))
-> [ByteString] -> m (f (Cursor, [(ByteString, Double)]))
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ScanOpts -> [ByteString]
addScanOpts ["ZSCAN", ByteString
key, Cursor -> ByteString
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 bs :: a
bs) = "[" ByteString -> ByteString -> ByteString
`append` a -> ByteString
forall a. RedisArg a => a -> ByteString
encode a
bs
encode (Excl bs :: a
bs) = "(" ByteString -> ByteString -> ByteString
`append` a -> ByteString
forall a. RedisArg a => a -> ByteString
encode a
bs
encode Minr = "-"
encode Maxr = "+"
zrangebylex::(RedisCtx m f) =>
ByteString
-> RangeLex ByteString
-> RangeLex ByteString
-> m (f [ByteString])
zrangebylex :: ByteString
-> RangeLex ByteString -> RangeLex ByteString -> m (f [ByteString])
zrangebylex key :: ByteString
key min :: RangeLex ByteString
min max :: RangeLex ByteString
max =
[ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZRANGEBYLEX", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, RangeLex ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode RangeLex ByteString
min, RangeLex ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode RangeLex ByteString
max]
zrangebylexLimit
::(RedisCtx m f)
=> ByteString
-> RangeLex ByteString
-> RangeLex ByteString
-> Integer
-> Integer
-> m (f [ByteString])
zrangebylexLimit :: ByteString
-> RangeLex ByteString
-> RangeLex ByteString
-> Integer
-> Integer
-> m (f [ByteString])
zrangebylexLimit key :: ByteString
key min :: RangeLex ByteString
min max :: RangeLex ByteString
max offset :: Integer
offset count :: Integer
count =
[ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["ZRANGEBYLEX", ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode ByteString
key, RangeLex ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode RangeLex ByteString
min, RangeLex ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode RangeLex ByteString
max,
"LIMIT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
offset, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
count]
data TrimOpts = NoArgs | Maxlen Integer | ApproxMaxlen Integer
xaddOpts
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> TrimOpts
-> m (f ByteString)
xaddOpts :: ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> TrimOpts
-> m (f ByteString)
xaddOpts key :: ByteString
key entryId :: ByteString
entryId fieldValues :: [(ByteString, ByteString)]
fieldValues opts :: TrimOpts
opts = [ByteString] -> m (f ByteString)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f ByteString))
-> [ByteString] -> m (f ByteString)
forall a b. (a -> b) -> a -> b
$
["XADD", ByteString
key] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
optArgs [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString
entryId] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
fieldArgs
where
fieldArgs :: [ByteString]
fieldArgs = ((ByteString, ByteString) -> [ByteString])
-> [(ByteString, ByteString)] -> [ByteString]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(x :: ByteString
x,y :: ByteString
y) -> [ByteString
x,ByteString
y]) [(ByteString, ByteString)]
fieldValues
optArgs :: [ByteString]
optArgs = case TrimOpts
opts of
NoArgs -> []
Maxlen max :: Integer
max -> ["MAXLEN", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
max]
ApproxMaxlen max :: Integer
max -> ["MAXLEN", "~", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
max]
xadd
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> m (f ByteString)
xadd :: ByteString
-> ByteString -> [(ByteString, ByteString)] -> m (f ByteString)
xadd key :: ByteString
key entryId :: ByteString
entryId fieldValues :: [(ByteString, ByteString)]
fieldValues = ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> TrimOpts
-> m (f ByteString)
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
(Int -> StreamsRecord -> ShowS)
-> (StreamsRecord -> String)
-> ([StreamsRecord] -> ShowS)
-> Show StreamsRecord
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
(StreamsRecord -> StreamsRecord -> Bool)
-> (StreamsRecord -> StreamsRecord -> Bool) -> Eq StreamsRecord
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 recordId :: ByteString
recordId), MultiBulk (Just rawKeyValues :: [Reply]
rawKeyValues)])) = do
[ByteString]
keyValuesList <- (Reply -> Either Reply ByteString)
-> [Reply] -> Either Reply [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Reply -> Either Reply ByteString
forall a. RedisResult a => Reply -> Either Reply a
decode [Reply]
rawKeyValues
let keyValues :: [(ByteString, ByteString)]
keyValues = [ByteString] -> [(ByteString, ByteString)]
decodeKeyValues [ByteString]
keyValuesList
StreamsRecord -> Either Reply StreamsRecord
forall (m :: * -> *) a. Monad m => a -> m a
return StreamsRecord :: ByteString -> [(ByteString, ByteString)] -> StreamsRecord
StreamsRecord{..}
where
decodeKeyValues :: [ByteString] -> [(ByteString, ByteString)]
decodeKeyValues :: [ByteString] -> [(ByteString, ByteString)]
decodeKeyValues bs :: [ByteString]
bs = ([ByteString] -> (ByteString, ByteString))
-> [[ByteString]] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (\[x :: ByteString
x,y :: ByteString
y] -> (ByteString
x,ByteString
y)) ([[ByteString]] -> [(ByteString, ByteString)])
-> [[ByteString]] -> [(ByteString, ByteString)]
forall a b. (a -> b) -> a -> b
$ [ByteString] -> [[ByteString]]
forall a. [a] -> [[a]]
chunksOfTwo [ByteString]
bs
chunksOfTwo :: [a] -> [[a]]
chunksOfTwo (x :: a
x:y :: a
y:rest :: [a]
rest) = [a
x,a
y][a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[a] -> [[a]]
chunksOfTwo [a]
rest
chunksOfTwo _ = []
decode a :: Reply
a = Reply -> Either Reply StreamsRecord
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
(Int -> XReadOpts -> ShowS)
-> (XReadOpts -> String)
-> ([XReadOpts] -> ShowS)
-> Show XReadOpts
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
(XReadOpts -> XReadOpts -> Bool)
-> (XReadOpts -> XReadOpts -> Bool) -> Eq XReadOpts
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)
defaultXreadOpts :: XReadOpts
defaultXreadOpts :: XReadOpts
defaultXreadOpts = XReadOpts :: Maybe Integer -> Maybe Integer -> XReadOpts
XReadOpts { block :: Maybe Integer
block = Maybe Integer
forall a. Maybe a
Nothing, recordCount :: Maybe Integer
recordCount = Maybe Integer
forall a. Maybe a
Nothing }
data XReadResponse = XReadResponse
{ XReadResponse -> ByteString
stream :: ByteString
, XReadResponse -> [StreamsRecord]
records :: [StreamsRecord]
} deriving (Int -> XReadResponse -> ShowS
[XReadResponse] -> ShowS
XReadResponse -> String
(Int -> XReadResponse -> ShowS)
-> (XReadResponse -> String)
-> ([XReadResponse] -> ShowS)
-> Show XReadResponse
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
(XReadResponse -> XReadResponse -> Bool)
-> (XReadResponse -> XReadResponse -> Bool) -> Eq XReadResponse
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 stream :: ByteString
stream), MultiBulk (Just rawRecords :: [Reply]
rawRecords)])) = do
[StreamsRecord]
records <- (Reply -> Either Reply StreamsRecord)
-> [Reply] -> Either Reply [StreamsRecord]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Reply -> Either Reply StreamsRecord
forall a. RedisResult a => Reply -> Either Reply a
decode [Reply]
rawRecords
XReadResponse -> Either Reply XReadResponse
forall (m :: * -> *) a. Monad m => a -> m a
return XReadResponse :: ByteString -> [StreamsRecord] -> XReadResponse
XReadResponse{..}
decode a :: Reply
a = Reply -> Either Reply XReadResponse
forall a b. a -> Either a b
Left Reply
a
xreadOpts
:: (RedisCtx m f)
=> [(ByteString, ByteString)]
-> XReadOpts
-> m (f (Maybe [XReadResponse]))
xreadOpts :: [(ByteString, ByteString)]
-> XReadOpts -> m (f (Maybe [XReadResponse]))
xreadOpts streamsAndIds :: [(ByteString, ByteString)]
streamsAndIds opts :: XReadOpts
opts = [ByteString] -> m (f (Maybe [XReadResponse]))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f (Maybe [XReadResponse])))
-> [ByteString] -> m (f (Maybe [XReadResponse]))
forall a b. (a -> b) -> a -> b
$
["XREAD"] [ByteString] -> [ByteString] -> [ByteString]
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 streamsAndIds :: [(ByteString, ByteString)]
streamsAndIds XReadOpts{..} =
[[ByteString]] -> [ByteString]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ByteString]
blockArgs, [ByteString]
countArgs, ["STREAMS"], [ByteString]
streams, [ByteString]
recordIds]
where
blockArgs :: [ByteString]
blockArgs = [ByteString]
-> (Integer -> [ByteString]) -> Maybe Integer -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\blockMillis :: Integer
blockMillis -> ["BLOCK", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
blockMillis]) Maybe Integer
block
countArgs :: [ByteString]
countArgs = [ByteString]
-> (Integer -> [ByteString]) -> Maybe Integer -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\countRecords :: Integer
countRecords -> ["COUNT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
countRecords]) Maybe Integer
recordCount
streams :: [ByteString]
streams = ((ByteString, ByteString) -> ByteString)
-> [(ByteString, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(stream :: ByteString
stream, _) -> ByteString
stream) [(ByteString, ByteString)]
streamsAndIds
recordIds :: [ByteString]
recordIds = ((ByteString, ByteString) -> ByteString)
-> [(ByteString, ByteString)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, recordId :: ByteString
recordId) -> ByteString
recordId) [(ByteString, ByteString)]
streamsAndIds
xread
:: (RedisCtx m f)
=> [(ByteString, ByteString)]
-> m( f (Maybe [XReadResponse]))
xread :: [(ByteString, ByteString)] -> m (f (Maybe [XReadResponse]))
xread streamsAndIds :: [(ByteString, ByteString)]
streamsAndIds = [(ByteString, ByteString)]
-> XReadOpts -> m (f (Maybe [XReadResponse]))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[(ByteString, ByteString)]
-> XReadOpts -> m (f (Maybe [XReadResponse]))
xreadOpts [(ByteString, ByteString)]
streamsAndIds XReadOpts
defaultXreadOpts
xreadGroupOpts
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> XReadOpts
-> m (f (Maybe [XReadResponse]))
xreadGroupOpts :: ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> XReadOpts
-> m (f (Maybe [XReadResponse]))
xreadGroupOpts groupName :: ByteString
groupName consumerName :: ByteString
consumerName streamsAndIds :: [(ByteString, ByteString)]
streamsAndIds opts :: XReadOpts
opts = [ByteString] -> m (f (Maybe [XReadResponse]))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f (Maybe [XReadResponse])))
-> [ByteString] -> m (f (Maybe [XReadResponse]))
forall a b. (a -> b) -> a -> b
$
["XREADGROUP", "GROUP", ByteString
groupName, ByteString
consumerName] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ ([(ByteString, ByteString)] -> XReadOpts -> [ByteString]
internalXreadArgs [(ByteString, ByteString)]
streamsAndIds XReadOpts
opts)
xreadGroup
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> m (f (Maybe [XReadResponse]))
xreadGroup :: ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> m (f (Maybe [XReadResponse]))
xreadGroup groupName :: ByteString
groupName consumerName :: ByteString
consumerName streamsAndIds :: [(ByteString, ByteString)]
streamsAndIds = ByteString
-> ByteString
-> [(ByteString, ByteString)]
-> XReadOpts
-> m (f (Maybe [XReadResponse]))
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
-> ByteString
-> ByteString
-> m (f Status)
xgroupCreate :: ByteString -> ByteString -> ByteString -> m (f Status)
xgroupCreate stream :: ByteString
stream groupName :: ByteString
groupName startId :: ByteString
startId = [ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Status)) -> [ByteString] -> m (f Status)
forall a b. (a -> b) -> a -> b
$ ["XGROUP", "CREATE", ByteString
stream, ByteString
groupName, ByteString
startId]
xgroupSetId
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> m (f Status)
xgroupSetId :: ByteString -> ByteString -> ByteString -> m (f Status)
xgroupSetId stream :: ByteString
stream group :: ByteString
group messageId :: ByteString
messageId = [ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["XGROUP", "SETID", ByteString
stream, ByteString
group, ByteString
messageId]
xgroupDelConsumer
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> m (f Integer)
xgroupDelConsumer :: ByteString -> ByteString -> ByteString -> m (f Integer)
xgroupDelConsumer stream :: ByteString
stream group :: ByteString
group consumer :: ByteString
consumer = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["XGROUP", "DELCONSUMER", ByteString
stream, ByteString
group, ByteString
consumer]
xgroupDestroy
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> m (f Bool)
xgroupDestroy :: ByteString -> ByteString -> m (f Bool)
xgroupDestroy stream :: ByteString
stream group :: ByteString
group = [ByteString] -> m (f Bool)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["XGROUP", "DESTROY", ByteString
stream, ByteString
group]
xack
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> [ByteString]
-> m (f Integer)
xack :: ByteString -> ByteString -> [ByteString] -> m (f Integer)
xack stream :: ByteString
stream groupName :: ByteString
groupName messageIds :: [ByteString]
messageIds = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Integer)) -> [ByteString] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$ ["XACK", ByteString
stream, ByteString
groupName] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
messageIds
xrange
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> Maybe Integer
-> m (f [StreamsRecord])
xrange :: ByteString
-> ByteString
-> ByteString
-> Maybe Integer
-> m (f [StreamsRecord])
xrange stream :: ByteString
stream start :: ByteString
start end :: ByteString
end count :: Maybe Integer
count = [ByteString] -> m (f [StreamsRecord])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [StreamsRecord]))
-> [ByteString] -> m (f [StreamsRecord])
forall a b. (a -> b) -> a -> b
$ ["XRANGE", ByteString
stream, ByteString
start, ByteString
end] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
countArgs
where countArgs :: [ByteString]
countArgs = [ByteString]
-> (Integer -> [ByteString]) -> Maybe Integer -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\c :: Integer
c -> ["COUNT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
c]) Maybe Integer
count
xrevRange
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> Maybe Integer
-> m (f [StreamsRecord])
xrevRange :: ByteString
-> ByteString
-> ByteString
-> Maybe Integer
-> m (f [StreamsRecord])
xrevRange stream :: ByteString
stream end :: ByteString
end start :: ByteString
start count :: Maybe Integer
count = [ByteString] -> m (f [StreamsRecord])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [StreamsRecord]))
-> [ByteString] -> m (f [StreamsRecord])
forall a b. (a -> b) -> a -> b
$ ["XREVRANGE", ByteString
stream, ByteString
end, ByteString
start] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
countArgs
where countArgs :: [ByteString]
countArgs = [ByteString]
-> (Integer -> [ByteString]) -> Maybe Integer -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\c :: Integer
c -> ["COUNT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
c]) Maybe Integer
count
xlen
:: (RedisCtx m f)
=> ByteString
-> m (f Integer)
xlen :: ByteString -> m (f Integer)
xlen stream :: ByteString
stream = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["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
(Int -> XPendingSummaryResponse -> ShowS)
-> (XPendingSummaryResponse -> String)
-> ([XPendingSummaryResponse] -> ShowS)
-> Show XPendingSummaryResponse
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
(XPendingSummaryResponse -> XPendingSummaryResponse -> Bool)
-> (XPendingSummaryResponse -> XPendingSummaryResponse -> Bool)
-> Eq XPendingSummaryResponse
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 numPendingMessages :: Integer
numPendingMessages,
Bulk (Just smallestPendingMessageId :: ByteString
smallestPendingMessageId),
Bulk (Just largestPendingMessageId :: ByteString
largestPendingMessageId),
MultiBulk (Just [MultiBulk (Just rawGroupsAndCounts :: [Reply]
rawGroupsAndCounts)])])) = do
let groupsAndCounts :: [(Reply, Reply)]
groupsAndCounts = [Reply] -> [(Reply, Reply)]
forall b. [b] -> [(b, b)]
chunksOfTwo [Reply]
rawGroupsAndCounts
[(ByteString, Integer)]
numPendingMessagesByconsumer <- [(Reply, Reply)] -> Either Reply [(ByteString, Integer)]
decodeGroupsAndCounts [(Reply, Reply)]
groupsAndCounts
XPendingSummaryResponse -> Either Reply XPendingSummaryResponse
forall (m :: * -> *) a. Monad m => a -> m a
return XPendingSummaryResponse :: Integer
-> ByteString
-> ByteString
-> [(ByteString, Integer)]
-> XPendingSummaryResponse
XPendingSummaryResponse{..}
where
decodeGroupsAndCounts :: [(Reply, Reply)] -> Either Reply [(ByteString, Integer)]
decodeGroupsAndCounts :: [(Reply, Reply)] -> Either Reply [(ByteString, Integer)]
decodeGroupsAndCounts bs :: [(Reply, Reply)]
bs = [Either Reply (ByteString, Integer)]
-> Either Reply [(ByteString, Integer)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([Either Reply (ByteString, Integer)]
-> Either Reply [(ByteString, Integer)])
-> [Either Reply (ByteString, Integer)]
-> Either Reply [(ByteString, Integer)]
forall a b. (a -> b) -> a -> b
$ ((Reply, Reply) -> Either Reply (ByteString, Integer))
-> [(Reply, Reply)] -> [Either Reply (ByteString, Integer)]
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 (x :: Reply
x, y :: Reply
y) = do
ByteString
decodedX <- Reply -> Either Reply ByteString
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
x
Integer
decodedY <- Reply -> Either Reply Integer
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
y
(ByteString, Integer) -> Either Reply (ByteString, Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
decodedX, Integer
decodedY)
chunksOfTwo :: [b] -> [(b, b)]
chunksOfTwo (x :: b
x:y :: b
y:rest :: [b]
rest) = (b
x,b
y)(b, b) -> [(b, b)] -> [(b, b)]
forall a. a -> [a] -> [a]
:[b] -> [(b, b)]
chunksOfTwo [b]
rest
chunksOfTwo _ = []
decode a :: Reply
a = Reply -> Either Reply XPendingSummaryResponse
forall a b. a -> Either a b
Left Reply
a
xpendingSummary
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> Maybe ByteString
-> m (f XPendingSummaryResponse)
xpendingSummary :: ByteString
-> ByteString -> Maybe ByteString -> m (f XPendingSummaryResponse)
xpendingSummary stream :: ByteString
stream group :: ByteString
group consumer :: Maybe ByteString
consumer = [ByteString] -> m (f XPendingSummaryResponse)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f XPendingSummaryResponse))
-> [ByteString] -> m (f XPendingSummaryResponse)
forall a b. (a -> b) -> a -> b
$ ["XPENDING", ByteString
stream, ByteString
group] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
consumerArg
where consumerArg :: [ByteString]
consumerArg = [ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\c :: 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
(Int -> XPendingDetailRecord -> ShowS)
-> (XPendingDetailRecord -> String)
-> ([XPendingDetailRecord] -> ShowS)
-> Show XPendingDetailRecord
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
(XPendingDetailRecord -> XPendingDetailRecord -> Bool)
-> (XPendingDetailRecord -> XPendingDetailRecord -> Bool)
-> Eq XPendingDetailRecord
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 messageId :: ByteString
messageId) ,
Bulk (Just consumer :: ByteString
consumer),
Integer millisSinceLastDelivered :: Integer
millisSinceLastDelivered,
Integer numTimesDelivered :: Integer
numTimesDelivered])) = XPendingDetailRecord -> Either Reply XPendingDetailRecord
forall a b. b -> Either a b
Right XPendingDetailRecord :: ByteString
-> ByteString -> Integer -> Integer -> XPendingDetailRecord
XPendingDetailRecord{..}
decode a :: Reply
a = Reply -> Either Reply XPendingDetailRecord
forall a b. a -> Either a b
Left Reply
a
xpendingDetail
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> ByteString
-> Integer
-> Maybe ByteString
-> m (f [XPendingDetailRecord])
xpendingDetail :: ByteString
-> ByteString
-> ByteString
-> ByteString
-> Integer
-> Maybe ByteString
-> m (f [XPendingDetailRecord])
xpendingDetail stream :: ByteString
stream group :: ByteString
group startId :: ByteString
startId endId :: ByteString
endId count :: Integer
count consumer :: Maybe ByteString
consumer = [ByteString] -> m (f [XPendingDetailRecord])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [XPendingDetailRecord]))
-> [ByteString] -> m (f [XPendingDetailRecord])
forall a b. (a -> b) -> a -> b
$
["XPENDING", ByteString
stream, ByteString
group, ByteString
startId, ByteString
endId, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
count] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
consumerArg
where consumerArg :: [ByteString]
consumerArg = [ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\c :: 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
(Int -> XClaimOpts -> ShowS)
-> (XClaimOpts -> String)
-> ([XClaimOpts] -> ShowS)
-> Show XClaimOpts
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
(XClaimOpts -> XClaimOpts -> Bool)
-> (XClaimOpts -> XClaimOpts -> Bool) -> Eq XClaimOpts
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 :: Maybe Integer
-> Maybe Integer -> Maybe Integer -> Bool -> XClaimOpts
XClaimOpts
{ xclaimIdle :: Maybe Integer
xclaimIdle = Maybe Integer
forall a. Maybe a
Nothing
, xclaimTime :: Maybe Integer
xclaimTime = Maybe Integer
forall a. Maybe a
Nothing
, xclaimRetryCount :: Maybe Integer
xclaimRetryCount = Maybe Integer
forall a. Maybe a
Nothing
, xclaimForce :: Bool
xclaimForce = Bool
False
}
xclaimRequest
:: ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> [ByteString]
xclaimRequest :: ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> [ByteString]
xclaimRequest stream :: ByteString
stream group :: ByteString
group consumer :: ByteString
consumer minIdleTime :: Integer
minIdleTime XClaimOpts{..} messageIds :: [ByteString]
messageIds =
["XCLAIM", ByteString
stream, ByteString
group, ByteString
consumer, Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
minIdleTime] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ ( (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ByteString -> ByteString
forall a. RedisArg a => a -> ByteString
encode [ByteString]
messageIds ) [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
optArgs
where optArgs :: [ByteString]
optArgs = [ByteString]
idleArg [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
timeArg [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
retryCountArg [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
forceArg
idleArg :: [ByteString]
idleArg = ByteString -> Maybe Integer -> [ByteString]
forall a. RedisArg a => ByteString -> Maybe a -> [ByteString]
optArg "IDLE" Maybe Integer
xclaimIdle
timeArg :: [ByteString]
timeArg = ByteString -> Maybe Integer -> [ByteString]
forall a. RedisArg a => ByteString -> Maybe a -> [ByteString]
optArg "TIME" Maybe Integer
xclaimTime
retryCountArg :: [ByteString]
retryCountArg = ByteString -> Maybe Integer -> [ByteString]
forall a. RedisArg a => ByteString -> Maybe a -> [ByteString]
optArg "RETRYCOUNT" Maybe Integer
xclaimRetryCount
forceArg :: [ByteString]
forceArg = if Bool
xclaimForce then ["FORCE"] else []
optArg :: ByteString -> Maybe a -> [ByteString]
optArg name :: ByteString
name maybeArg :: Maybe a
maybeArg = [ByteString] -> (a -> [ByteString]) -> Maybe a -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (\x :: a
x -> [ByteString
name, a -> ByteString
forall a. RedisArg a => a -> ByteString
encode a
x]) Maybe a
maybeArg
xclaim
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> m (f [StreamsRecord])
xclaim :: ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> m (f [StreamsRecord])
xclaim stream :: ByteString
stream group :: ByteString
group consumer :: ByteString
consumer minIdleTime :: Integer
minIdleTime opts :: XClaimOpts
opts messageIds :: [ByteString]
messageIds = [ByteString] -> m (f [StreamsRecord])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [StreamsRecord]))
-> [ByteString] -> m (f [StreamsRecord])
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
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> m (f [ByteString])
xclaimJustIds :: ByteString
-> ByteString
-> ByteString
-> Integer
-> XClaimOpts
-> [ByteString]
-> m (f [ByteString])
xclaimJustIds stream :: ByteString
stream group :: ByteString
group consumer :: ByteString
consumer minIdleTime :: Integer
minIdleTime opts :: XClaimOpts
opts messageIds :: [ByteString]
messageIds = [ByteString] -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [ByteString]))
-> [ByteString] -> m (f [ByteString])
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) [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ ["JUSTID"]
data XInfoConsumersResponse = XInfoConsumersResponse
{ XInfoConsumersResponse -> ByteString
xinfoConsumerName :: ByteString
, XInfoConsumersResponse -> Integer
xinfoConsumerNumPendingMessages :: Integer
, XInfoConsumersResponse -> Integer
xinfoConsumerIdleTime :: Integer
} deriving (Int -> XInfoConsumersResponse -> ShowS
[XInfoConsumersResponse] -> ShowS
XInfoConsumersResponse -> String
(Int -> XInfoConsumersResponse -> ShowS)
-> (XInfoConsumersResponse -> String)
-> ([XInfoConsumersResponse] -> ShowS)
-> Show XInfoConsumersResponse
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
(XInfoConsumersResponse -> XInfoConsumersResponse -> Bool)
-> (XInfoConsumersResponse -> XInfoConsumersResponse -> Bool)
-> Eq XInfoConsumersResponse
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 "name"),
Bulk (Just xinfoConsumerName :: ByteString
xinfoConsumerName),
Bulk (Just "pending"),
Integer xinfoConsumerNumPendingMessages :: Integer
xinfoConsumerNumPendingMessages,
Bulk (Just "idle"),
Integer xinfoConsumerIdleTime :: Integer
xinfoConsumerIdleTime])) = XInfoConsumersResponse -> Either Reply XInfoConsumersResponse
forall a b. b -> Either a b
Right XInfoConsumersResponse :: ByteString -> Integer -> Integer -> XInfoConsumersResponse
XInfoConsumersResponse{..}
decode a :: Reply
a = Reply -> Either Reply XInfoConsumersResponse
forall a b. a -> Either a b
Left Reply
a
xinfoConsumers
:: (RedisCtx m f)
=> ByteString
-> ByteString
-> m (f [XInfoConsumersResponse])
xinfoConsumers :: ByteString -> ByteString -> m (f [XInfoConsumersResponse])
xinfoConsumers stream :: ByteString
stream group :: ByteString
group = [ByteString] -> m (f [XInfoConsumersResponse])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [XInfoConsumersResponse]))
-> [ByteString] -> m (f [XInfoConsumersResponse])
forall a b. (a -> b) -> a -> b
$ ["XINFO", "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
(Int -> XInfoGroupsResponse -> ShowS)
-> (XInfoGroupsResponse -> String)
-> ([XInfoGroupsResponse] -> ShowS)
-> Show XInfoGroupsResponse
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
(XInfoGroupsResponse -> XInfoGroupsResponse -> Bool)
-> (XInfoGroupsResponse -> XInfoGroupsResponse -> Bool)
-> Eq XInfoGroupsResponse
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 "name"),Bulk (Just xinfoGroupsGroupName :: ByteString
xinfoGroupsGroupName),
Bulk (Just "consumers"),Integer xinfoGroupsNumConsumers :: Integer
xinfoGroupsNumConsumers,
Bulk (Just "pending"),Integer xinfoGroupsNumPendingMessages :: Integer
xinfoGroupsNumPendingMessages,
Bulk (Just "last-delivered-id"),Bulk (Just xinfoGroupsLastDeliveredMessageId :: ByteString
xinfoGroupsLastDeliveredMessageId)])) = XInfoGroupsResponse -> Either Reply XInfoGroupsResponse
forall a b. b -> Either a b
Right XInfoGroupsResponse :: ByteString
-> Integer -> Integer -> ByteString -> XInfoGroupsResponse
XInfoGroupsResponse{..}
decode a :: Reply
a = Reply -> Either Reply XInfoGroupsResponse
forall a b. a -> Either a b
Left Reply
a
xinfoGroups
:: (RedisCtx m f)
=> ByteString
-> m (f [XInfoGroupsResponse])
xinfoGroups :: ByteString -> m (f [XInfoGroupsResponse])
xinfoGroups stream :: ByteString
stream = [ByteString] -> m (f [XInfoGroupsResponse])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["XINFO", "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
} deriving (Int -> XInfoStreamResponse -> ShowS
[XInfoStreamResponse] -> ShowS
XInfoStreamResponse -> String
(Int -> XInfoStreamResponse -> ShowS)
-> (XInfoStreamResponse -> String)
-> ([XInfoStreamResponse] -> ShowS)
-> Show XInfoStreamResponse
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
(XInfoStreamResponse -> XInfoStreamResponse -> Bool)
-> (XInfoStreamResponse -> XInfoStreamResponse -> Bool)
-> Eq XInfoStreamResponse
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 (MultiBulk (Just [
Bulk (Just "length"),Integer xinfoStreamLength :: Integer
xinfoStreamLength,
Bulk (Just "radix-tree-keys"),Integer xinfoStreamRadixTreeKeys :: Integer
xinfoStreamRadixTreeKeys,
Bulk (Just "radix-tree-nodes"),Integer xinfoStreamRadixTreeNodes :: Integer
xinfoStreamRadixTreeNodes,
Bulk (Just "groups"),Integer xinfoStreamNumGroups :: Integer
xinfoStreamNumGroups,
Bulk (Just "last-generated-id"),Bulk (Just xinfoStreamLastEntryId :: ByteString
xinfoStreamLastEntryId),
Bulk (Just "first-entry"), rawFirstEntry :: Reply
rawFirstEntry ,
Bulk (Just "last-entry"), rawLastEntry :: Reply
rawLastEntry ])) = do
StreamsRecord
xinfoStreamFirstEntry <- Reply -> Either Reply StreamsRecord
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
rawFirstEntry
StreamsRecord
xinfoStreamLastEntry <- Reply -> Either Reply StreamsRecord
forall a. RedisResult a => Reply -> Either Reply a
decode Reply
rawLastEntry
XInfoStreamResponse -> Either Reply XInfoStreamResponse
forall (m :: * -> *) a. Monad m => a -> m a
return XInfoStreamResponse :: Integer
-> Integer
-> Integer
-> Integer
-> ByteString
-> StreamsRecord
-> StreamsRecord
-> XInfoStreamResponse
XInfoStreamResponse{..}
decode a :: Reply
a = Reply -> Either Reply XInfoStreamResponse
forall a b. a -> Either a b
Left Reply
a
xinfoStream
:: (RedisCtx m f)
=> ByteString
-> m (f XInfoStreamResponse)
xinfoStream :: ByteString -> m (f XInfoStreamResponse)
xinfoStream stream :: ByteString
stream = [ByteString] -> m (f XInfoStreamResponse)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ["XINFO", "STREAM", ByteString
stream]
xdel
:: (RedisCtx m f)
=> ByteString
-> [ByteString]
-> m (f Integer)
xdel :: ByteString -> [ByteString] -> m (f Integer)
xdel stream :: ByteString
stream messageIds :: [ByteString]
messageIds = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Integer)) -> [ByteString] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$ ["XDEL", ByteString
stream] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
messageIds
xtrim
:: (RedisCtx m f)
=> ByteString
-> TrimOpts
-> m (f Integer)
xtrim :: ByteString -> TrimOpts -> m (f Integer)
xtrim stream :: ByteString
stream opts :: TrimOpts
opts = [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f Integer)) -> [ByteString] -> m (f Integer)
forall a b. (a -> b) -> a -> b
$ ["XTRIM", ByteString
stream] [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ [ByteString]
optArgs
where
optArgs :: [ByteString]
optArgs = case TrimOpts
opts of
NoArgs -> []
Maxlen max :: Integer
max -> ["MAXLEN", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
max]
ApproxMaxlen max :: Integer
max -> ["MAXLEN", "~", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
max]
inf :: RealFloat a => a
inf :: a
inf = 1 a -> a -> a
forall a. Fractional a => a -> a -> a
/ 0