From 1f2e453d0c9f8412b9032cb4e655713ecdcf1fa3 Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Mon, 26 May 2025 04:43:38 -0400 Subject: web: Refactor major style --- fig-web/src/Fig/Web/DB.hs | 53 ++++++++++++++++++++++++----------------------- 1 file changed, 27 insertions(+), 26 deletions(-) (limited to 'fig-web/src/Fig/Web/DB.hs') diff --git a/fig-web/src/Fig/Web/DB.hs b/fig-web/src/Fig/Web/DB.hs index d8a70c2..5a51560 100644 --- a/fig-web/src/Fig/Web/DB.hs +++ b/fig-web/src/Fig/Web/DB.hs @@ -5,64 +5,65 @@ import Control.Error.Util (hush) import qualified Database.Redis as Redis import Fig.Prelude +import Fig.Web.Types import Fig.Web.Utils -connect :: MonadIO m => Config -> m Redis.Connection -connect cfg = liftIO $ Redis.checkedConnect Redis.defaultConnectInfo +connect :: MonadIO m => Config -> m DB +connect cfg = liftIO $ DB <$> Redis.checkedConnect Redis.defaultConnectInfo { Redis.connectHost = unpack cfg.dbHost } -get :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe ByteString) -get c key = liftIO $ Redis.runRedis c do +get :: MonadIO m => DB -> ByteString -> m (Maybe ByteString) +get (DB c) key = liftIO $ Redis.runRedis c do v <- Redis.get key pure . join $ hush v -incr :: MonadIO m => Redis.Connection -> ByteString -> m () -incr c key = liftIO $ Redis.runRedis c do +incr :: MonadIO m => DB -> ByteString -> m () +incr (DB c) key = liftIO $ Redis.runRedis c do void $ Redis.incr key -decr :: MonadIO m => Redis.Connection -> ByteString -> m () -decr c key = liftIO $ Redis.runRedis c do +decr :: MonadIO m => DB -> ByteString -> m () +decr (DB c) key = liftIO $ Redis.runRedis c do void $ Redis.decr key -hget :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m (Maybe ByteString) -hget c key hkey = liftIO $ Redis.runRedis c do +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 -hkeys :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe [ByteString]) -hkeys c key = liftIO $ Redis.runRedis c do +hkeys :: MonadIO m => DB -> ByteString -> m (Maybe [ByteString]) +hkeys (DB c) key = liftIO $ Redis.runRedis c do hush <$> Redis.hkeys key -hvals :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe [ByteString]) -hvals c key = liftIO $ Redis.runRedis c do +hvals :: MonadIO m => DB -> ByteString -> m (Maybe [ByteString]) +hvals (DB c) key = liftIO $ Redis.runRedis c do hush <$> Redis.hvals key -sadd :: MonadIO m => Redis.Connection -> ByteString -> [ByteString] -> m () -sadd c key skeys = liftIO $ Redis.runRedis c do +sadd :: MonadIO m => DB -> ByteString -> [ByteString] -> m () +sadd (DB c) key skeys = liftIO $ Redis.runRedis c do _ <- Redis.sadd key skeys pure () -srem :: MonadIO m => Redis.Connection -> ByteString -> [ByteString] -> m () -srem c key skeys = liftIO $ Redis.runRedis c do +srem :: MonadIO m => DB -> ByteString -> [ByteString] -> m () +srem (DB c) key skeys = liftIO $ Redis.runRedis c do _ <- Redis.srem key skeys pure () -smembers :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe [ByteString]) -smembers c key = liftIO $ Redis.runRedis c do +smembers :: MonadIO m => DB -> ByteString -> m (Maybe [ByteString]) +smembers (DB c) key = liftIO $ Redis.runRedis c do hush <$> Redis.smembers key -sismember :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m Bool -sismember c key skey = liftIO $ Redis.runRedis c do +sismember :: MonadIO m => DB -> ByteString -> ByteString -> m Bool +sismember (DB c) key skey = liftIO $ Redis.runRedis c do Redis.sismember key skey >>= hush >>> \case Just x -> pure x Nothing -> pure False -lpop :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe ByteString) -lpop c key = liftIO $ Redis.runRedis c do +lpop :: MonadIO m => DB -> ByteString -> m (Maybe ByteString) +lpop (DB c) key = liftIO $ Redis.runRedis c do join . hush <$> Redis.lpop key -rpush :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m () -rpush c key val = liftIO $ Redis.runRedis c do +rpush :: MonadIO m => DB -> ByteString -> ByteString -> m () +rpush (DB c) key val = liftIO $ Redis.runRedis c do _ <- Redis.rpush key [val] pure () -- cgit v1.2.3