fig-utils: Guile FFI

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