summaryrefslogtreecommitdiff
path: root/fig-frontend/src/Fig/Frontend/DB.hs
blob: b0f065de36764caa81c610d375680823512374f9 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
module Fig.Frontend.DB where

import Control.Error.Util (hush)

import qualified Database.Redis as Redis

import Fig.Prelude
import Fig.Frontend.Utils

connect :: MonadIO m => Config -> m Redis.Connection
connect cfg = liftIO $ 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
  v <- Redis.get key
  pure . join $ hush v

hget :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m (Maybe ByteString)
hget c key hkey = liftIO $ Redis.runRedis c do
  v <- Redis.hget key hkey
  pure . join $ hush v

hvals :: MonadIO m => Redis.Connection -> ByteString -> m (Maybe [ByteString])
hvals 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
  _ <- Redis.sadd key skeys
  pure ()

srem :: MonadIO m => Redis.Connection -> ByteString -> [ByteString] -> m ()
srem 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
  hush <$> Redis.smembers key

sismember :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m Bool
sismember 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
  join . hush <$> Redis.lpop key

rpush :: MonadIO m => Redis.Connection -> ByteString -> ByteString -> m ()
rpush c key val = liftIO $ Redis.runRedis c do
  _ <- Redis.rpush key [val]
  pure ()