-- | 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 p@(RHSet (E _ _ d) (HSET _ ds)) =
(fmap . fmap) (\(s,b) -> (ds s , d (pure b)))
. unwrap
. Redis.hgetall
. primKey p
-- | Lookup via key and subkey
hget :: MonadRedis m => RedisHSet a s b -> a -> s -> m (Maybe b)
hget p@(RHSet (E _ _ d) (HSET e _)) k =
(fmap . fmap) (d . pure)
. unwrap
. Redis.hget (primKey p k)
. 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 p@(RHSet (E _ _ d) (HSET e _)) k t = do
let f = (fmap . fmap . fmap) (d . pure) . fixEmpty (unwrap . Redis.hmget (primKey p k)) id . fmap e
let xs = foldr (:) [] t
reifyTraversal t <$> liftRedis (f xs)
where
reifyTraversal :: Traversable t => t a -> [ b ] -> t (a,b)
reifyTraversal tr bs = evalState (traverse g tr) bs
where
g a = do
xs <- Control.Monad.State.get
case xs of
[] -> error "Impossible in hmget: unexpected data size in HLRDB.Structures.HSet.hmget"
(b:bs') -> do
put bs'
return (a,b)
-- | Set via key and subkey
hset :: MonadRedis m => RedisHSet a s b -> a -> s -> b -> m (ActionPerformed Creation)
hset p@(RHSet (E _ eb _) (HSET e _)) k s =
unwrapCreatedBool
. Redis.hset (primKey p k) (e s)
. runIdentity
. eb
-- | Set via key and subkeys
hmset :: (MonadRedis m , Traversable t) => RedisHSet a s b -> a -> t (s , b) -> m ()
hmset p@(RHSet (E _ eb _) (HSET e _)) k =
fixEmpty (ignore . unwrap . Redis.hmset (primKey p k)) (\(s,b) -> (e s , runIdentity $ eb b))
-- | Delete via key and subkeys
hdel :: (MonadRedis m , Traversable t) => RedisHSet a s b -> a -> t s -> m (ActionPerformed Deletion)
hdel p@(RHSet _ (HSET e _)) k =
fmap Deleted
. fixEmpty' (unwrap . Redis.hdel (primKey p k)) 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 p@(RHSet (E _ eb _) (HSET e _)) k s =
unwrapCreatedBool
. Redis.hsetnx (primKey p k) (e s)
. runIdentity
. eb
-- | Use a cursor to iterate a collection
hscan :: RedisHSet a s b -> a -> Cursor -> Redis (Maybe Cursor , [ (s , b) ])
hscan p@(RHSet (E _ _ d) (HSET _ d')) k =
let f (a,b) = (d' a , d (pure b)) in
unwrapCursor (fmap f)
. Redis.hscan (primKey p k)