diff options
Diffstat (limited to 'fig-web/src/Fig/Web/DB.hs')
| -rw-r--r-- | fig-web/src/Fig/Web/DB.hs | 29 |
1 files changed, 29 insertions, 0 deletions
diff --git a/fig-web/src/Fig/Web/DB.hs b/fig-web/src/Fig/Web/DB.hs index 5a51560..9b1728c 100644 --- a/fig-web/src/Fig/Web/DB.hs +++ b/fig-web/src/Fig/Web/DB.hs @@ -2,6 +2,10 @@ module Fig.Web.DB where import Control.Error.Util (hush) +import Data.Maybe (mapMaybe) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map + import qualified Database.Redis as Redis import Fig.Prelude @@ -18,6 +22,10 @@ get (DB c) key = liftIO $ Redis.runRedis c do v <- Redis.get key pure . join $ hush v +del :: MonadIO m => DB -> [ByteString] -> m () +del (DB c) keys = liftIO $ Redis.runRedis c do + void $ Redis.del keys + incr :: MonadIO m => DB -> ByteString -> m () incr (DB c) key = liftIO $ Redis.runRedis c do void $ Redis.incr key @@ -26,11 +34,32 @@ decr :: MonadIO m => DB -> ByteString -> m () decr (DB c) key = liftIO $ Redis.runRedis c do void $ Redis.decr key +hset :: MonadIO m => DB -> ByteString -> ByteString -> ByteString -> m () +hset (DB c) key hkey val = liftIO $ Redis.runRedis c do + void $ Redis.hset key hkey val + hget :: MonadIO m => DB -> ByteString -> ByteString -> m (Maybe ByteString) hget (DB c) key hkey = liftIO $ Redis.runRedis c do v <- Redis.hget key hkey pure . join $ hush v +hmset :: MonadIO m => DB -> ByteString -> [(ByteString, ByteString)] -> m () +hmset (DB c) key m = liftIO $ Redis.runRedis c do + void $ Redis.hmset key m + +hmget :: MonadIO m => DB -> ByteString -> [ByteString] -> m (Map ByteString ByteString) +hmget (DB c) key hk = liftIO $ Redis.runRedis c do + Redis.hmget key hk >>= \case + Left _ -> pure Map.empty + Right vals -> do + pure . Map.fromList . mapMaybe (\(a, mb) -> mb >>= \b -> Just (a, b)) $ zip hk vals + +hgetall :: MonadIO m => DB -> ByteString -> m (Map ByteString ByteString) +hgetall (DB c) key = liftIO $ Redis.runRedis c do + Redis.hgetall key >>= \case + Left _ -> pure Map.empty + Right m -> pure $ Map.fromList m + hkeys :: MonadIO m => DB -> ByteString -> m (Maybe [ByteString]) hkeys (DB c) key = liftIO $ Redis.runRedis c do hush <$> Redis.hkeys key |
