-- | SortedSets, like lists, support automatic cardinality management when provided a @TrimScheme@.
-- HLRDB exports a more opinionated and less easy-to-make-mistakes API than Redis supports. Scores are golf-(or race) style, where lower numbers are better. The API is setup to make retrieving the best items and discarding the worst items natural, rather than trying to remember which direction the data is sorted in.
-- 
-- You should ensure that your Haskell @Eq@ instances respect the equality induced by your encoding scheme, i.e., that @a == b ~ encode a == encode b@.

module HLRDB.Structures.SSet
       (
         HLRDB.Structures.SSet.zadd
       , HLRDB.Structures.SSet.zscore
       , HLRDB.Structures.SSet.zupdate
       , HLRDB.Structures.SSet.zbest
       , HLRDB.Structures.SSet.zworst
       , HLRDB.Structures.SSet.zmember
       , HLRDB.Structures.SSet.zrank
       , HLRDB.Structures.SSet.zrevrank
       , HLRDB.Structures.SSet.zrem
       , HLRDB.Structures.SSet.zincrby
       , HLRDB.Structures.SSet.zcard
       , HLRDB.Structures.SSet.zscan
       , HLRDB.Structures.SSet.zrangebyscore
       ) where

import Control.Lens
import Data.Maybe (isJust)
import Database.Redis as Redis
import HLRDB.Primitives.Redis
import HLRDB.Internal
import Data.ByteString.Char8 (ByteString, pack)


trimInternal :: MonadRedis m => RedisSSet a b -> a -> Integer -> m ()
trimInternal :: RedisSSet a b -> a -> Integer -> m ()
trimInternal RedisSSet a b
p a
k =
  let f :: a -> a
f a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* (-a
1) a -> a -> a
forall a. Num a => a -> a -> a
- a
1 in
    m Integer -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
ignore
  (m Integer -> m ()) -> (Integer -> m Integer) -> Integer -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply Integer) -> m Integer
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply Integer) -> m Integer)
-> (Integer -> Redis (Either Reply Integer))
-> Integer
-> m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Integer -> Integer -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f Integer)
zremrangebyrank (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k) Integer
0
  (Integer -> Redis (Either Reply Integer))
-> (Integer -> Integer) -> Integer -> Redis (Either Reply Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Integer
forall a. Num a => a -> a
f

trimSortedSet :: MonadRedis m => RedisSSet a b -> a -> Integer -> m ()
trimSortedSet :: RedisSSet a b -> a -> Integer -> m ()
trimSortedSet (RSortedSet RE a b
_ Maybe TrimScheme
Nothing) a
_ Integer
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
trimSortedSet RedisSSet a b
_ a
_ Integer
0 = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
trimSortedSet p :: RedisSSet a b
p@(RSortedSet RE a b
_ (Just (TrimScheme Integer
limit Double
1.0))) a
k Integer
_ =
  RedisSSet a b -> a -> Integer -> m ()
forall (m :: * -> *) a b.
MonadRedis m =>
RedisSSet a b -> a -> Integer -> m ()
trimInternal RedisSSet a b
p a
k Integer
limit
trimSortedSet p :: RedisSSet a b
p@(RSortedSet RE a b
_ (Just (TrimScheme Integer
limit Double
basep))) a
k Integer
count =
  let prob :: Double
prob = Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- (Double
1.0 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
basep) Double -> Integer -> Double
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
count in
  Redis () -> m ()
forall (m :: * -> *) a. MonadRedis m => Redis a -> m a
liftRedis (Redis () -> m ()) -> Redis () -> m ()
forall a b. (a -> b) -> a -> b
$ Redis (Maybe ()) -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
ignore (Redis (Maybe ()) -> Redis ()) -> Redis (Maybe ()) -> Redis ()
forall a b. (a -> b) -> a -> b
$ Double -> Redis () -> Redis (Maybe ())
forall (m :: * -> *) a. MonadIO m => Double -> m a -> m (Maybe a)
probIO Double
prob (Redis () -> Redis (Maybe ())) -> Redis () -> Redis (Maybe ())
forall a b. (a -> b) -> a -> b
$ RedisSSet a b -> a -> Integer -> Redis ()
forall (m :: * -> *) a b.
MonadRedis m =>
RedisSSet a b -> a -> Integer -> m ()
trimInternal RedisSSet a b
p a
k Integer
limit


-- | Lookup an element's score
zscore :: MonadRedis m => RedisSSet a b -> a -> b -> m (Maybe Double)
zscore :: RedisSSet a b -> a -> b -> m (Maybe Double)
zscore p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
e Identity ByteString -> b
_) Maybe TrimScheme
_) a
k =
    Redis (Either Reply (Maybe Double)) -> m (Maybe Double)
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply (Maybe Double)) -> m (Maybe Double))
-> (b -> Redis (Either Reply (Maybe Double)))
-> b
-> m (Maybe Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Redis (Either Reply (Maybe Double))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe Double))
Redis.zscore (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k)
  (ByteString -> Redis (Either Reply (Maybe Double)))
-> (b -> ByteString) -> b -> Redis (Either Reply (Maybe Double))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity
  (Identity ByteString -> ByteString)
-> (b -> Identity ByteString) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
e

-- | Add items and scores
zadd :: (MonadRedis m , Traversable t) => RedisSSet a b -> a -> t (Double,b) -> m (ActionPerformed Creation)
zadd :: RedisSSet a b -> a -> t (Double, b) -> m (ActionPerformed Creation)
zadd p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
e Identity ByteString -> b
_) Maybe TrimScheme
_) a
k t (Double, b)
t = do
  Integer
i <- ([(Double, ByteString)] -> Redis Integer)
-> ((Double, b) -> (Double, ByteString))
-> t (Double, b)
-> m Integer
forall (m :: * -> *) (t :: * -> *) i b a.
(MonadRedis m, Traversable t, Integral i) =>
([b] -> Redis i) -> (a -> b) -> t a -> m i
fixEmpty' (Redis (Either Reply Integer) -> Redis Integer
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap (Redis (Either Reply Integer) -> Redis Integer)
-> ([(Double, ByteString)] -> Redis (Either Reply Integer))
-> [(Double, ByteString)]
-> Redis Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> [(Double, ByteString)] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
Redis.zadd (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k)) (ASetter (Double, b) (Double, ByteString) b ByteString
-> (b -> ByteString) -> (Double, b) -> (Double, ByteString)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (Double, b) (Double, ByteString) b ByteString
forall s t a b. Field2 s t a b => Lens s t a b
_2 (Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> (b -> Identity ByteString) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
e)) t (Double, b)
t
  !()
_ <- RedisSSet a b -> a -> Integer -> m ()
forall (m :: * -> *) a b.
MonadRedis m =>
RedisSSet a b -> a -> Integer -> m ()
trimSortedSet RedisSSet a b
p a
k Integer
i
  ActionPerformed Creation -> m (ActionPerformed Creation)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ActionPerformed Creation -> m (ActionPerformed Creation))
-> ActionPerformed Creation -> m (ActionPerformed Creation)
forall a b. (a -> b) -> a -> b
$ Integer -> ActionPerformed Creation
FreshlyCreated (Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)

-- | Read the scores from Redis, apply the given trasformation, and write the resulting data
zupdate :: MonadRedis m => RedisSSet a b -> a -> (Double -> Double) -> m ()
zupdate :: RedisSSet a b -> a -> (Double -> Double) -> m ()
zupdate RedisSSet a b
p a
k Double -> Double
f = let key :: ByteString
key = RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k in
  Redis (Either Reply [(ByteString, Double)])
-> m [(ByteString, Double)]
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap (ByteString
-> Integer
-> Integer
-> Redis (Either Reply [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [(ByteString, Double)])
zrangeWithscores ByteString
key Integer
0 (-Integer
1)) m [(ByteString, Double)]
-> ([(ByteString, Double)] -> m ()) -> m ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  ([(ByteString, Double)] -> Redis ())
-> ((ByteString, Double) -> (ByteString, Double))
-> [(ByteString, Double)]
-> m ()
forall (m :: * -> *) e (t :: * -> *) b a.
(MonadRedis m, Monoid e, Traversable t) =>
([b] -> Redis e) -> (a -> b) -> t a -> m e
fixEmpty (Redis Integer -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
ignore (Redis Integer -> Redis ())
-> ([(ByteString, Double)] -> Redis Integer)
-> [(ByteString, Double)]
-> Redis ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply Integer) -> Redis Integer
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap (Redis (Either Reply Integer) -> Redis Integer)
-> ([(ByteString, Double)] -> Redis (Either Reply Integer))
-> [(ByteString, Double)]
-> Redis Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> [(Double, ByteString)] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
Redis.zadd ByteString
key ([(Double, ByteString)] -> Redis (Either Reply Integer))
-> ([(ByteString, Double)] -> [(Double, ByteString)])
-> [(ByteString, Double)]
-> Redis (Either Reply Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Double) -> (Double, ByteString))
-> [(ByteString, Double)] -> [(Double, ByteString)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(ByteString
bs,Double
s) -> (Double -> Double
f Double
s , ByteString
bs))) (ByteString, Double) -> (ByteString, Double)
forall a. a -> a
id

-- | Retrieve the given range of best-performing elements. Range is inclusive, just as with Haskell's [ 1 .. 5 ] notation, and it is 0-based, which means [ 0 .. 4 ] is what corresponds to the English phrase "Best 5."
zbest :: MonadRedis m => RedisSSet a b -> a -> Integer -> Integer -> m [ b ]
zbest :: RedisSSet a b -> a -> Integer -> Integer -> m [b]
zbest p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
_ Identity ByteString -> b
d) Maybe TrimScheme
_) a
k Integer
s =
    (([ByteString] -> [b]) -> m [ByteString] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([ByteString] -> [b]) -> m [ByteString] -> m [b])
-> ((ByteString -> b) -> [ByteString] -> [b])
-> (ByteString -> b)
-> m [ByteString]
-> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> b) -> [ByteString] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Identity ByteString -> b
d (Identity ByteString -> b)
-> (ByteString -> Identity ByteString) -> ByteString -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  (m [ByteString] -> m [b])
-> (Integer -> m [ByteString]) -> Integer -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply [ByteString]) -> m [ByteString]
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply [ByteString]) -> m [ByteString])
-> (Integer -> Redis (Either Reply [ByteString]))
-> Integer
-> m [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Integer -> Integer -> Redis (Either Reply [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [ByteString])
zrange (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k) Integer
s

-- | Retrieve the given range of worst-performing elements. Range is inclusive, just as with Haskell's [ 1 .. 5 ] notation, and it is 0-based, which means [ 0 .. 4 ] is what corresponds to the English phrase "Worst 5."
zworst :: MonadRedis m => RedisSSet a b -> a -> Integer -> Integer -> m [ b ]
zworst :: RedisSSet a b -> a -> Integer -> Integer -> m [b]
zworst p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
_ Identity ByteString -> b
d) Maybe TrimScheme
_) a
k Integer
s =
    (([ByteString] -> [b]) -> m [ByteString] -> m [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([ByteString] -> [b]) -> m [ByteString] -> m [b])
-> ((ByteString -> b) -> [ByteString] -> [b])
-> (ByteString -> b)
-> m [ByteString]
-> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> b) -> [ByteString] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Identity ByteString -> b
d (Identity ByteString -> b)
-> (ByteString -> Identity ByteString) -> ByteString -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure)
  (m [ByteString] -> m [b])
-> (Integer -> m [ByteString]) -> Integer -> m [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply [ByteString]) -> m [ByteString]
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply [ByteString]) -> m [ByteString])
-> (Integer -> Redis (Either Reply [ByteString]))
-> Integer
-> m [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Integer -> Integer -> Redis (Either Reply [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [ByteString])
zrevrange (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k) Integer
s

-- | Test if an object is a member of the set.
zmember :: MonadRedis m => RedisSSet a b -> a -> b -> m Bool
zmember :: RedisSSet a b -> a -> b -> m Bool
zmember p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
e Identity ByteString -> b
_) Maybe TrimScheme
_) a
k =
    (Maybe Integer -> Bool) -> m (Maybe Integer) -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe Integer -> Bool
forall a. Maybe a -> Bool
isJust
  (m (Maybe Integer) -> m Bool)
-> (b -> m (Maybe Integer)) -> b -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply (Maybe Integer)) -> m (Maybe Integer)
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply (Maybe Integer)) -> m (Maybe Integer))
-> (b -> Redis (Either Reply (Maybe Integer)))
-> b
-> m (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Redis (Either Reply (Maybe Integer))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe Integer))
Redis.zrank (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k)
  (ByteString -> Redis (Either Reply (Maybe Integer)))
-> (b -> ByteString) -> b -> Redis (Either Reply (Maybe Integer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity
  (Identity ByteString -> ByteString)
-> (b -> Identity ByteString) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
e

-- | Calculate the rank of an item. The best item has rank 0.
zrank :: MonadRedis m => RedisSSet a b -> a -> b -> m (Maybe Integer)
zrank :: RedisSSet a b -> a -> b -> m (Maybe Integer)
zrank p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
e Identity ByteString -> b
_) Maybe TrimScheme
_) a
k =
    Redis (Either Reply (Maybe Integer)) -> m (Maybe Integer)
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply (Maybe Integer)) -> m (Maybe Integer))
-> (b -> Redis (Either Reply (Maybe Integer)))
-> b
-> m (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Redis (Either Reply (Maybe Integer))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe Integer))
Redis.zrank (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k)
  (ByteString -> Redis (Either Reply (Maybe Integer)))
-> (b -> ByteString) -> b -> Redis (Either Reply (Maybe Integer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity
  (Identity ByteString -> ByteString)
-> (b -> Identity ByteString) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
e

-- | Calculate the rank of an item starting from the end, e.g., the worst item has rank 0.
zrevrank :: MonadRedis m => RedisSSet a b -> a -> b -> m (Maybe Integer)
zrevrank :: RedisSSet a b -> a -> b -> m (Maybe Integer)
zrevrank p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
e Identity ByteString -> b
_) Maybe TrimScheme
_) a
k =
    Redis (Either Reply (Maybe Integer)) -> m (Maybe Integer)
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply (Maybe Integer)) -> m (Maybe Integer))
-> (b -> Redis (Either Reply (Maybe Integer)))
-> b
-> m (Maybe Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Redis (Either Reply (Maybe Integer))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe Integer))
Redis.zrevrank (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k)
  (ByteString -> Redis (Either Reply (Maybe Integer)))
-> (b -> ByteString) -> b -> Redis (Either Reply (Maybe Integer))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity
  (Identity ByteString -> ByteString)
-> (b -> Identity ByteString) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
e

-- | Increment an item's score. If the item does not already exist, it is inserted with the given score.
zincrby :: MonadRedis m => RedisSSet a b -> a -> (Integer,b) -> m Double
zincrby :: RedisSSet a b -> a -> (Integer, b) -> m Double
zincrby p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
e Identity ByteString -> b
_) Maybe TrimScheme
_) a
k (Integer
s,b
b) = do
  Double
v <- Redis (Either Reply Double) -> m Double
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap (Redis (Either Reply Double) -> m Double)
-> Redis (Either Reply Double) -> m Double
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer -> ByteString -> Redis (Either Reply Double)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> ByteString -> m (f Double)
Redis.zincrby (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k) Integer
s (ByteString -> Redis (Either Reply Double))
-> ByteString -> Redis (Either Reply Double)
forall a b. (a -> b) -> a -> b
$ Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> (b -> Identity ByteString) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
e (b -> ByteString) -> b -> ByteString
forall a b. (a -> b) -> a -> b
$ b
b
  !()
_ <- RedisSSet a b -> a -> Integer -> m ()
forall (m :: * -> *) a b.
MonadRedis m =>
RedisSSet a b -> a -> Integer -> m ()
trimSortedSet RedisSSet a b
p a
k Integer
1
  Double -> m Double
forall (f :: * -> *) a. Applicative f => a -> f a
pure Double
v

-- | Remove items from a sorted set
zrem :: (MonadRedis m , Traversable t) => RedisSSet a b -> a -> t b -> m (ActionPerformed Deletion)
zrem :: RedisSSet a b -> a -> t b -> m (ActionPerformed Deletion)
zrem p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
e Identity ByteString -> b
_) Maybe TrimScheme
_) a
k =
  (Integer -> ActionPerformed Deletion)
-> m Integer -> m (ActionPerformed Deletion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> ActionPerformed Deletion
Deleted (m Integer -> m (ActionPerformed Deletion))
-> (t b -> m Integer) -> t b -> m (ActionPerformed Deletion)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([ByteString] -> Redis Integer)
-> (b -> ByteString) -> t b -> m Integer
forall (m :: * -> *) (t :: * -> *) i b a.
(MonadRedis m, Traversable t, Integral i) =>
([b] -> Redis i) -> (a -> b) -> t a -> m i
fixEmpty' (Redis (Either Reply Integer) -> Redis Integer
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap (Redis (Either Reply Integer) -> Redis Integer)
-> ([ByteString] -> Redis (Either Reply Integer))
-> [ByteString]
-> Redis Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Redis.zrem (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k)) (Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> (b -> Identity ByteString) -> b -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
e)

-- | The cardinality of a sorted set
zcard :: MonadRedis m => RedisSSet a b -> a -> m Integer
zcard :: RedisSSet a b -> a -> m Integer
zcard RedisSSet a b
p =
    Redis (Either Reply Integer) -> m Integer
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply Integer) -> m Integer)
-> (a -> Redis (Either Reply Integer)) -> a -> m Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
Redis.zcard
  (ByteString -> Redis (Either Reply Integer))
-> (a -> ByteString) -> a -> Redis (Either Reply Integer)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p

-- | Use a cursor to iterate a collection.
zscan :: MonadRedis m => RedisSSet a b -> a -> Cursor -> m (Maybe Cursor , [ (b , Double) ])
zscan :: RedisSSet a b -> a -> Cursor -> m (Maybe Cursor, [(b, Double)])
zscan p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
_ Identity ByteString -> b
d) Maybe TrimScheme
_) a
k =
  let f :: (ByteString, Double) -> (b, Double)
f (ByteString
x,Double
s) = (Identity ByteString -> b
d (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
x) , Double
s) in
    ([(ByteString, Double)] -> [(b, Double)])
-> Redis (Either Reply (Cursor, [(ByteString, Double)]))
-> m (Maybe Cursor, [(b, Double)])
forall (m :: * -> *) a b.
MonadRedis m =>
(a -> b) -> Redis (Either Reply (Cursor, a)) -> m (Maybe Cursor, b)
unwrapCursor (((ByteString, Double) -> (b, Double))
-> [(ByteString, Double)] -> [(b, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString, Double) -> (b, Double)
f)
  (Redis (Either Reply (Cursor, [(ByteString, Double)]))
 -> m (Maybe Cursor, [(b, Double)]))
-> (Cursor
    -> Redis (Either Reply (Cursor, [(ByteString, Double)])))
-> Cursor
-> m (Maybe Cursor, [(b, Double)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> Cursor -> Redis (Either Reply (Cursor, [(ByteString, Double)]))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Cursor -> m (f (Cursor, [(ByteString, Double)]))
Redis.zscan (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k)

-- | Retrieve items in a score range; final parameters are @min@, @max@, @offset@, and @limit@
zrangebyscore :: MonadRedis m => RedisSSet a b -> a -> Maybe Double -> Maybe Double -> Maybe Integer -> Maybe Integer -> m [ (b , Double) ]
zrangebyscore :: RedisSSet a b
-> a
-> Maybe Double
-> Maybe Double
-> Maybe Integer
-> Maybe Integer
-> m [(b, Double)]
zrangebyscore p :: RedisSSet a b
p@(RSortedSet (E a -> ByteString
_ b -> Identity ByteString
_ Identity ByteString -> b
d) Maybe TrimScheme
_) a
k Maybe Double
mmin Maybe Double
mmax Maybe Integer
mo Maybe Integer
ml =
    (([(ByteString, Double)] -> [(b, Double)])
-> m [(ByteString, Double)] -> m [(b, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(ByteString, Double)] -> [(b, Double)])
 -> m [(ByteString, Double)] -> m [(b, Double)])
-> (((ByteString, Double) -> (b, Double))
    -> [(ByteString, Double)] -> [(b, Double)])
-> ((ByteString, Double) -> (b, Double))
-> m [(ByteString, Double)]
-> m [(b, Double)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Double) -> (b, Double))
-> [(ByteString, Double)] -> [(b, Double)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (ASetter (ByteString, Double) (b, Double) ByteString b
-> (ByteString -> b) -> (ByteString, Double) -> (b, Double)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter (ByteString, Double) (b, Double) ByteString b
forall s t a b. Field1 s t a b => Lens s t a b
_1 (Identity ByteString -> b
d (Identity ByteString -> b)
-> (ByteString -> Identity ByteString) -> ByteString -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Identity ByteString
forall a. a -> Identity a
Identity))
  (m [(ByteString, Double)] -> m [(b, Double)])
-> m [(ByteString, Double)] -> m [(b, Double)]
forall a b. (a -> b) -> a -> b
$ Redis (Either Reply [(ByteString, Double)])
-> m [(ByteString, Double)]
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply [(ByteString, Double)])
 -> m [(ByteString, Double)])
-> Redis (Either Reply [(ByteString, Double)])
-> m [(ByteString, Double)]
forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString
-> ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Redis (Either Reply [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> ByteString
-> ByteString
-> Maybe ByteString
-> Maybe ByteString
-> m (f [(ByteString, Double)])
req
      (RedisSSet a b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisSSet a b
p a
k)
      (ByteString -> (Double -> ByteString) -> Maybe Double -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"-inf" Double -> ByteString
forall a. Show a => a -> ByteString
encode Maybe Double
mmin)
      (ByteString -> (Double -> ByteString) -> Maybe Double -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"+inf" Double -> ByteString
forall a. Show a => a -> ByteString
encode Maybe Double
mmax)
      (Integer -> ByteString
forall a. Show a => a -> ByteString
encode (Integer -> ByteString) -> Maybe Integer -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
mo)
      (Integer -> ByteString
forall a. Show a => a -> ByteString
encode (Integer -> ByteString) -> Maybe Integer -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Integer
ml)
  where
    encode :: Show a => a -> ByteString
    encode :: a -> ByteString
encode = String -> ByteString
pack (String -> ByteString) -> (a -> String) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

    req :: RedisCtx m f => ByteString -> ByteString -> ByteString -> Maybe ByteString -> Maybe ByteString-> m (f [ (ByteString , Double) ])
    req :: ByteString
-> ByteString
-> ByteString
-> Maybe ByteString
-> Maybe ByteString
-> m (f [(ByteString, Double)])
req ByteString
ke ByteString
mi ByteString
ma Maybe ByteString
Nothing Maybe ByteString
Nothing =
      [ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [(ByteString, Double)]))
-> [ByteString] -> m (f [(ByteString, Double)])
forall a b. (a -> b) -> a -> b
$ [ ByteString
"ZRANGEBYSCORE", ByteString
ke , ByteString
mi , ByteString
ma , ByteString
"WITHSCORES" ]
    req ByteString
ke ByteString
mi ByteString
ma (Just ByteString
off) Maybe ByteString
mli =
      [ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [(ByteString, Double)]))
-> [ByteString] -> m (f [(ByteString, Double)])
forall a b. (a -> b) -> a -> b
$ [ ByteString
"ZRANGEBYSCORE", ByteString
ke , ByteString
mi , ByteString
ma , ByteString
"WITHSCORES" , ByteString
"LIMIT", ByteString
off , ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Int64 -> ByteString
forall a. Show a => a -> ByteString
encode (Int64
forall a. Bounded a => a
maxBound :: Int64)) ByteString -> ByteString
forall a. a -> a
id Maybe ByteString
mli ]
    req ByteString
ke ByteString
mi ByteString
ma Maybe ByteString
Nothing (Just ByteString
li) =
      [ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString] -> m (f [(ByteString, Double)]))
-> [ByteString] -> m (f [(ByteString, Double)])
forall a b. (a -> b) -> a -> b
$ [ ByteString
"ZRANGEBYSCORE", ByteString
ke , ByteString
mi , ByteString
ma , ByteString
"WITHSCORES" , ByteString
"LIMIT", ByteString
"0" , ByteString
li ]