-- | An HSet is a sub-hash table in Redis, indexed by both a key and a subkey.

module HLRDB.Structures.HSet where

import Database.Redis as Redis
import HLRDB.Primitives.Redis
import HLRDB.Internal
import Control.Monad.State

-- I wanted to only have the list get/set commands, but ultimately
-- decided to include the single commands separately because `hset`
-- has a return value which specifies whether a subkey was created or not,
-- whereas hmset does not, and this can be critically useful. Amusingly,
-- even the standard `set` command does not return this information.


-- | Retrieve all elements of an HSet
hgetall :: MonadRedis m => RedisHSet a s b -> a -> m [ (s,b) ]
hgetall :: RedisHSet a s b -> a -> m [(s, b)]
hgetall p :: RedisHSet a s b
p@(RHSet (E a -> ByteString
_ b -> Identity ByteString
_ Identity ByteString -> b
d) (HSET v -> ByteString
_ ByteString -> v
ds)) =
   (([(ByteString, ByteString)] -> [(v, b)])
-> m [(ByteString, ByteString)] -> m [(v, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([(ByteString, ByteString)] -> [(v, b)])
 -> m [(ByteString, ByteString)] -> m [(v, b)])
-> (((ByteString, ByteString) -> (v, b))
    -> [(ByteString, ByteString)] -> [(v, b)])
-> ((ByteString, ByteString) -> (v, b))
-> m [(ByteString, ByteString)]
-> m [(v, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, ByteString) -> (v, b))
-> [(ByteString, ByteString)] -> [(v, b)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (\(ByteString
s,ByteString
b) -> (ByteString -> v
ds ByteString
s , Identity ByteString -> b
d (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
b)))
 (m [(ByteString, ByteString)] -> m [(v, b)])
-> (a -> m [(ByteString, ByteString)]) -> a -> m [(v, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply [(ByteString, ByteString)])
-> m [(ByteString, ByteString)]
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
 (Redis (Either Reply [(ByteString, ByteString)])
 -> m [(ByteString, ByteString)])
-> (a -> Redis (Either Reply [(ByteString, ByteString)]))
-> a
-> m [(ByteString, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Redis (Either Reply [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
Redis.hgetall
 (ByteString -> Redis (Either Reply [(ByteString, ByteString)]))
-> (a -> ByteString)
-> a
-> Redis (Either Reply [(ByteString, ByteString)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisHSet a s b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisHSet a s b
p

-- | Lookup via key and subkey
hget :: MonadRedis m => RedisHSet a s b -> a -> s -> m (Maybe b)
hget :: RedisHSet a s b -> a -> s -> m (Maybe b)
hget p :: RedisHSet a s b
p@(RHSet (E a -> ByteString
_ b -> Identity ByteString
_ Identity ByteString -> b
d) (HSET v -> ByteString
e ByteString -> v
_)) a
k =
    ((Maybe ByteString -> Maybe b)
-> m (Maybe ByteString) -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe ByteString -> Maybe b)
 -> m (Maybe ByteString) -> m (Maybe b))
-> ((ByteString -> b) -> Maybe ByteString -> Maybe b)
-> (ByteString -> b)
-> m (Maybe ByteString)
-> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> b) -> Maybe ByteString -> Maybe 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 (Maybe ByteString) -> m (Maybe b))
-> (v -> m (Maybe ByteString)) -> v -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply (Maybe ByteString)) -> m (Maybe ByteString)
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap
  (Redis (Either Reply (Maybe ByteString)) -> m (Maybe ByteString))
-> (v -> Redis (Either Reply (Maybe ByteString)))
-> v
-> m (Maybe ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
Redis.hget (RedisHSet a s b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisHSet a s b
p a
k)
  (ByteString -> Redis (Either Reply (Maybe ByteString)))
-> (v -> ByteString)
-> v
-> Redis (Either Reply (Maybe ByteString))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
e

-- | Lookup via key and subkeys, pairing each given subkey with the lookup result
hmget :: (MonadRedis m , Traversable t) => RedisHSet a s b -> a -> t s -> m (t (s , Maybe b))
hmget :: RedisHSet a s b -> a -> t s -> m (t (s, Maybe b))
hmget p :: RedisHSet a s b
p@(RHSet (E a -> ByteString
_ b -> Identity ByteString
_ Identity ByteString -> b
d) (HSET v -> ByteString
e ByteString -> v
_)) a
k t s
t = do
  let f :: [v] -> Redis [Maybe b]
f = (([Maybe ByteString] -> [Maybe b])
-> Redis [Maybe ByteString] -> Redis [Maybe b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Maybe ByteString] -> [Maybe b])
 -> Redis [Maybe ByteString] -> Redis [Maybe b])
-> ((ByteString -> b) -> [Maybe ByteString] -> [Maybe b])
-> (ByteString -> b)
-> Redis [Maybe ByteString]
-> Redis [Maybe b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> Maybe b) -> [Maybe ByteString] -> [Maybe b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe ByteString -> Maybe b) -> [Maybe ByteString] -> [Maybe b])
-> ((ByteString -> b) -> Maybe ByteString -> Maybe b)
-> (ByteString -> b)
-> [Maybe ByteString]
-> [Maybe b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> b) -> Maybe ByteString -> Maybe 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) (Redis [Maybe ByteString] -> Redis [Maybe b])
-> ([v] -> Redis [Maybe ByteString]) -> [v] -> Redis [Maybe b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Redis [Maybe ByteString])
-> (ByteString -> ByteString)
-> [ByteString]
-> Redis [Maybe ByteString]
forall (m :: * -> *) e (t :: * -> *) b a.
(MonadRedis m, Monoid e, Traversable t) =>
([b] -> Redis e) -> (a -> b) -> t a -> m e
fixEmpty (Redis (Either Reply [Maybe ByteString]) -> Redis [Maybe ByteString]
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap (Redis (Either Reply [Maybe ByteString])
 -> Redis [Maybe ByteString])
-> ([ByteString] -> Redis (Either Reply [Maybe ByteString]))
-> [ByteString]
-> Redis [Maybe ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> [ByteString] -> Redis (Either Reply [Maybe ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f [Maybe ByteString])
Redis.hmget (RedisHSet a s b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisHSet a s b
p a
k)) ByteString -> ByteString
forall a. a -> a
id ([ByteString] -> Redis [Maybe ByteString])
-> ([v] -> [ByteString]) -> [v] -> Redis [Maybe ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (v -> ByteString) -> [v] -> [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> ByteString
e
  let xs :: [s]
xs = (s -> [s] -> [s]) -> [s] -> t s -> [s]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (:) [] t s
t
  t s -> [Maybe b] -> t (s, Maybe b)
forall (t :: * -> *) a b. Traversable t => t a -> [b] -> t (a, b)
reifyTraversal t s
t ([Maybe b] -> t (s, Maybe b)) -> m [Maybe b] -> m (t (s, Maybe b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Redis [Maybe b] -> m [Maybe b]
forall (m :: * -> *) a. MonadRedis m => Redis a -> m a
liftRedis ([v] -> Redis [Maybe b]
f [s]
[v]
xs)
  where
    reifyTraversal :: Traversable t => t a -> [ b ] -> t (a,b)
    reifyTraversal :: t a -> [b] -> t (a, b)
reifyTraversal t a
tr [b]
bs = State [b] (t (a, b)) -> [b] -> t (a, b)
forall s a. State s a -> s -> a
evalState ((a -> StateT [b] Identity (a, b)) -> t a -> State [b] (t (a, b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> StateT [b] Identity (a, b)
forall (m :: * -> *) b a. MonadState [b] m => a -> m (a, b)
g t a
tr) [b]
bs
      where
        g :: a -> m (a, b)
g a
a = do
          [b]
xs <- m [b]
forall s (m :: * -> *). MonadState s m => m s
Control.Monad.State.get
          case [b]
xs of
            [] -> [Char] -> m (a, b)
forall a. HasCallStack => [Char] -> a
error [Char]
"Impossible in hmget: unexpected data size in HLRDB.Structures.HSet.hmget"
            (b
b:[b]
bs') -> do
              [b] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [b]
bs'
              (a, b) -> m (a, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
a,b
b)

-- | Set via key and subkey
hset :: MonadRedis m => RedisHSet a s b -> a -> s -> b -> m (ActionPerformed Creation)
hset :: RedisHSet a s b -> a -> s -> b -> m (ActionPerformed Creation)
hset p :: RedisHSet a s b
p@(RHSet (E a -> ByteString
_ b -> Identity ByteString
eb Identity ByteString -> b
_) (HSET v -> ByteString
e ByteString -> v
_)) a
k s
s =
    Redis (Either Reply Integer) -> m (ActionPerformed Creation)
forall (m :: * -> *).
MonadRedis m =>
Redis (Either Reply Integer) -> m (ActionPerformed Creation)
unwrapCreated
  (Redis (Either Reply Integer) -> m (ActionPerformed Creation))
-> (b -> Redis (Either Reply Integer))
-> b
-> m (ActionPerformed Creation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> ByteString -> ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
Redis.hset (RedisHSet a s b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisHSet a s b
p a
k) (v -> ByteString
e s
v
s)
  (ByteString -> Redis (Either Reply Integer))
-> (b -> ByteString) -> b -> Redis (Either Reply 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
eb

-- | Set via key and subkeys
hmset :: (MonadRedis m , Traversable t) => RedisHSet a s b -> a -> t (s , b) -> m ()
hmset :: RedisHSet a s b -> a -> t (s, b) -> m ()
hmset p :: RedisHSet a s b
p@(RHSet (E a -> ByteString
_ b -> Identity ByteString
eb Identity ByteString -> b
_) (HSET v -> ByteString
e ByteString -> v
_)) a
k =
    ([(ByteString, ByteString)] -> Redis ())
-> ((v, b) -> (ByteString, ByteString)) -> t (v, b) -> m ()
forall (m :: * -> *) e (t :: * -> *) b a.
(MonadRedis m, Monoid e, Traversable t) =>
([b] -> Redis e) -> (a -> b) -> t a -> m e
fixEmpty (Redis Status -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
ignore (Redis Status -> Redis ())
-> ([(ByteString, ByteString)] -> Redis Status)
-> [(ByteString, ByteString)]
-> Redis ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Redis (Either Reply Status) -> Redis Status
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap (Redis (Either Reply Status) -> Redis Status)
-> ([(ByteString, ByteString)] -> Redis (Either Reply Status))
-> [(ByteString, ByteString)]
-> Redis Status
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString
-> [(ByteString, ByteString)] -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, ByteString)] -> m (f Status)
Redis.hmset (RedisHSet a s b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisHSet a s b
p a
k)) (\(v
s,b
b) -> (v -> ByteString
e v
s , Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity (Identity ByteString -> ByteString)
-> Identity ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ b -> Identity ByteString
eb b
b))

-- | Delete via key and subkeys
hdel :: (MonadRedis m , Traversable t) => RedisHSet a s b -> a -> t s -> m (ActionPerformed Deletion)
hdel :: RedisHSet a s b -> a -> t s -> m (ActionPerformed Deletion)
hdel p :: RedisHSet a s b
p@(RHSet RE a b
_ (HSET v -> ByteString
e ByteString -> v
_)) 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 v -> m Integer) -> t v -> m (ActionPerformed Deletion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([ByteString] -> Redis Integer)
-> (v -> ByteString) -> t v -> 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.hdel (RedisHSet a s b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisHSet a s b
p a
k)) v -> ByteString
e

-- | Set a value only if it does not currently exist in the HSET
hsetnx :: MonadRedis m => RedisHSet a s b -> a -> s -> b -> m (ActionPerformed Creation)
hsetnx :: RedisHSet a s b -> a -> s -> b -> m (ActionPerformed Creation)
hsetnx p :: RedisHSet a s b
p@(RHSet (E a -> ByteString
_ b -> Identity ByteString
eb Identity ByteString -> b
_) (HSET v -> ByteString
e ByteString -> v
_)) a
k s
s =
    Redis (Either Reply Bool) -> m (ActionPerformed Creation)
forall (m :: * -> *).
MonadRedis m =>
Redis (Either Reply Bool) -> m (ActionPerformed Creation)
unwrapCreatedBool
  (Redis (Either Reply Bool) -> m (ActionPerformed Creation))
-> (b -> Redis (Either Reply Bool))
-> b
-> m (ActionPerformed Creation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString -> Redis (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Bool)
Redis.hsetnx (RedisHSet a s b -> a -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisHSet a s b
p a
k) (v -> ByteString
e s
v
s)
  (ByteString -> Redis (Either Reply Bool))
-> (b -> ByteString) -> b -> Redis (Either Reply Bool)
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
eb

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