{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK prune not-home #-}

{- |
Copyright   : (c) 2018-2022 Tim Emiola
SPDX-License-Identifier: BSD3
Maintainer  : Tim Emiola <tim@emio.la>

Provides a 'Handle' that stores data in Redis.
-}
module KeyedVals.Handle.Redis.Internal (
  -- * Handle creation
  fromConnectInfo,

  -- * Configuration
  readEnvConnectInfo,

  -- * module re-exports
  module KeyedVals.Handle,
) where

import Control.Exception (throwIO)
import Control.Monad.IO.Unlift (MonadIO, MonadUnliftIO, liftIO)
import qualified Data.ByteString as B
import Data.Functor ((<&>))
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.Strict as Map
import Data.Maybe (mapMaybe)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8)
import Database.Redis (
  ConnectInfo (..),
  Connection,
  Redis,
  Reply (..),
  Status (..),
  checkedConnect,
  del,
  disconnect,
  get,
  hdel,
  hget,
  hgetall,
  hkeys,
  hlen,
  hmget,
  hmset,
  hset,
  keys,
  parseConnectInfo,
  runRedis,
  set,
 )
import KeyedVals.Handle
import KeyedVals.Handle.Internal (Handle (..))
import Numeric.Natural (Natural)
import System.ReadEnvVar (lookupEnv, readEnvDef)


-- | Determine 'ConnectInfo' from the environment.
readEnvConnectInfo :: IO (Maybe ConnectInfo)
readEnvConnectInfo :: IO (Maybe ConnectInfo)
readEnvConnectInfo = do
  Int
maxConns <- String -> Int -> IO Int
forall (m :: * -> *) a. (MonadIO m, Read a) => String -> a -> m a
readEnvDef String
"REDIS_MAX_CONNECTIONS" Int
fallbackMaxConns
  String -> IO (Maybe String)
forall a (m :: * -> *).
(IsString a, MonadIO m) =>
String -> m (Maybe a)
lookupEnv String
"REDIS_URL" IO (Maybe String)
-> (Maybe String -> IO (Maybe ConnectInfo))
-> IO (Maybe ConnectInfo)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO (Maybe ConnectInfo)
-> (String -> IO (Maybe ConnectInfo))
-> Maybe String
-> IO (Maybe ConnectInfo)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe ConnectInfo -> IO (Maybe ConnectInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ConnectInfo
forall a. Maybe a
Nothing) (Int -> String -> IO (Maybe ConnectInfo)
parseLocator Int
maxConns)


-- | Obtain a @ConnectInfo@ from a Redis Url and max connections
parseLocator :: Int -> String -> IO (Maybe ConnectInfo)
parseLocator :: Int -> String -> IO (Maybe ConnectInfo)
parseLocator Int
maxConns String
l = do
  let parseConnectInfo' :: String -> IO ConnectInfo
parseConnectInfo' = (String -> IO ConnectInfo)
-> (ConnectInfo -> IO ConnectInfo)
-> Either String ConnectInfo
-> IO ConnectInfo
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> IO ConnectInfo
forall a. String -> IO a
invalidLocator ConnectInfo -> IO ConnectInfo
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String ConnectInfo -> IO ConnectInfo)
-> (String -> Either String ConnectInfo)
-> String
-> IO ConnectInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either String ConnectInfo
parseConnectInfo
      setMaxConns :: Int -> ConnectInfo -> ConnectInfo
setMaxConns Int
x ConnectInfo
cfg = ConnectInfo
cfg {connectMaxConnections = x}
  ConnectInfo -> Maybe ConnectInfo
forall a. a -> Maybe a
Just (ConnectInfo -> Maybe ConnectInfo)
-> (ConnectInfo -> ConnectInfo) -> ConnectInfo -> Maybe ConnectInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConnectInfo -> ConnectInfo
setMaxConns Int
maxConns (ConnectInfo -> Maybe ConnectInfo)
-> IO ConnectInfo -> IO (Maybe ConnectInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ConnectInfo
parseConnectInfo' String
l


invalidLocator :: String -> IO a
invalidLocator :: forall a. String -> IO a
invalidLocator String
x = IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO a) -> IOError -> IO a
forall a b. (a -> b) -> a -> b
$ String -> IOError
userError (String -> IOError) -> String -> IOError
forall a b. (a -> b) -> a -> b
$ String
"REDIS connection url: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" is invalid"


-- | Create a 'Handle'.
fromConnectInfo :: MonadUnliftIO m => ConnectInfo -> m (Handle m)
fromConnectInfo :: forall (m :: * -> *).
MonadUnliftIO m =>
ConnectInfo -> m (Handle m)
fromConnectInfo ConnectInfo
connectInfo = do
  Connection
conn <- IO Connection -> m Connection
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> IO Connection
checkedConnect ConnectInfo
connectInfo
  Handle m -> m (Handle m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Handle m -> m (Handle m)) -> Handle m -> m (Handle m)
forall a b. (a -> b) -> a -> b
$
    Handle
      { hClose :: m ()
hClose = Connection -> m ()
forall (m :: * -> *). MonadUnliftIO m => Connection -> m ()
hClose' Connection
conn
      , hLoadVal :: ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadVal = Connection -> ByteString -> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadVal' Connection
conn
      , hSaveVal :: ByteString -> ByteString -> m (Either HandleErr ())
hSaveVal = Connection -> ByteString -> ByteString -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ByteString -> m (Either HandleErr ())
hSaveVal' Connection
conn
      , hLoadKVs :: ByteString -> m (Either HandleErr ValsByKey)
hLoadKVs = Connection -> ByteString -> m (Either HandleErr ValsByKey)
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m (Either HandleErr ValsByKey)
hLoadKVs' Connection
conn
      , hSaveKVs :: ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs = Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs' Connection
conn
      , hUpdateKVs :: ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs = Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs' Connection
conn
      , hLoadFrom :: ByteString -> ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadFrom = Connection
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
hLoadFrom' Connection
conn
      , hLoadSlice :: ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice = Connection
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice' Connection
conn
      , hSaveTo :: ByteString -> ByteString -> ByteString -> m (Either HandleErr ())
hSaveTo = Connection
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
hSaveTo' Connection
conn
      , hDeleteSelected :: Selection -> m (Either HandleErr ())
hDeleteSelected = Connection -> Selection -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> Selection -> m (Either HandleErr ())
hDeleteSelected' Connection
conn
      , hDeleteSelectedKVs :: ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs = Connection -> ByteString -> Selection -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs' Connection
conn
      , hCountKVs :: ByteString -> m (Either HandleErr Natural)
hCountKVs = Connection -> ByteString -> m (Either HandleErr Natural)
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m (Either HandleErr Natural)
hCountKVs' Connection
conn
      }


hClose' :: MonadUnliftIO m => Connection -> m ()
hClose' :: forall (m :: * -> *). MonadUnliftIO m => Connection -> m ()
hClose' = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Connection -> IO ()) -> Connection -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
disconnect


hLoadVal' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  m (Either HandleErr (Maybe Val))
hLoadVal' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadVal' Connection
conn ByteString
key = Connection
-> Redis (Either Reply (Maybe ByteString))
-> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (Redis (Either Reply (Maybe ByteString))
 -> m (Either HandleErr (Maybe ByteString)))
-> Redis (Either Reply (Maybe ByteString))
-> m (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
get ByteString
key


hSaveVal' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  Val ->
  m (Either HandleErr ())
hSaveVal' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ByteString -> m (Either HandleErr ())
hSaveVal' Connection
conn ByteString
key ByteString
value = Connection
-> Redis (Either Reply Status) -> m (Either HandleErr ())
forall (m :: * -> *).
MonadIO m =>
Connection
-> Redis (Either Reply Status) -> m (Either HandleErr ())
doStore Connection
conn (Redis (Either Reply Status) -> m (Either HandleErr ()))
-> Redis (Either Reply Status) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
set ByteString
key ByteString
value


hLoadFrom' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  Key ->
  m (Either HandleErr (Maybe Val))
hLoadFrom' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
hLoadFrom' Connection
conn ByteString
key ByteString
dictKey = Connection
-> Redis (Either Reply (Maybe ByteString))
-> m (Either HandleErr (Maybe ByteString))
forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (Redis (Either Reply (Maybe ByteString))
 -> m (Either HandleErr (Maybe ByteString)))
-> Redis (Either Reply (Maybe ByteString))
-> m (Either HandleErr (Maybe ByteString))
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
hget ByteString
key ByteString
dictKey


hLoadKVs' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  m (Either HandleErr ValsByKey)
hLoadKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m (Either HandleErr ValsByKey)
hLoadKVs' Connection
conn ByteString
key = Connection
-> Redis (Either Reply ValsByKey) -> m (Either HandleErr ValsByKey)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (Redis (Either Reply ValsByKey) -> m (Either HandleErr ValsByKey))
-> Redis (Either Reply ValsByKey) -> m (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ ByteString -> Redis (Either Reply [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
hgetall ByteString
key Redis (Either Reply [(ByteString, ByteString)])
-> (Either Reply [(ByteString, ByteString)]
    -> Either Reply ValsByKey)
-> Redis (Either Reply ValsByKey)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ([(ByteString, ByteString)] -> ValsByKey)
-> Either Reply [(ByteString, ByteString)]
-> Either Reply ValsByKey
forall a b. (a -> b) -> Either Reply a -> Either Reply b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(ByteString, ByteString)] -> ValsByKey
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList


hLoadSlice' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  Selection ->
  m (Either HandleErr ValsByKey)
hLoadSlice' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice' Connection
conn ByteString
key m :: Selection
m@(Match Glob
_) = (Connection
 -> ByteString -> Selection -> m (Either HandleErr ValsByKey))
-> Connection
-> ByteString
-> Selection
-> m (Either HandleErr ValsByKey)
forall b (m :: * -> *).
(Monoid b, MonadUnliftIO m) =>
(Connection -> ByteString -> Selection -> m (Either HandleErr b))
-> Connection -> ByteString -> Selection -> m (Either HandleErr b)
selectKeysThen Connection
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice' Connection
conn ByteString
key Selection
m
hLoadSlice' Connection
conn ByteString
key (AllOf NonEmpty ByteString
dictKeys') = do
  let dictKeys :: [ByteString]
dictKeys = NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
dictKeys'
  Connection
-> Redis (Either Reply [Maybe ByteString])
-> m (Either HandleErr [Maybe ByteString])
forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (ByteString
-> [ByteString] -> Redis (Either Reply [Maybe ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f [Maybe ByteString])
hmget ByteString
key [ByteString]
dictKeys) m (Either HandleErr [Maybe ByteString])
-> (Either HandleErr [Maybe ByteString]
    -> m (Either HandleErr ValsByKey))
-> m (Either HandleErr ValsByKey)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left HandleErr
err -> Either HandleErr ValsByKey -> m (Either HandleErr ValsByKey)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr ValsByKey -> m (Either HandleErr ValsByKey))
-> Either HandleErr ValsByKey -> m (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ValsByKey
forall a b. a -> Either a b
Left HandleErr
err
    Right [Maybe ByteString]
fetched -> do
      let pairedMaybes :: [(ByteString, Maybe ByteString)]
pairedMaybes = [ByteString]
-> [Maybe ByteString] -> [(ByteString, Maybe ByteString)]
forall a b. [a] -> [b] -> [(a, b)]
zip [ByteString]
dictKeys [Maybe ByteString]
fetched
          mbOf :: (a, Maybe b) -> Maybe (a, b)
mbOf (a
x, Maybe b
mbY) = Maybe b
mbY Maybe b -> (b -> Maybe (a, b)) -> Maybe (a, b)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
y -> (a, b) -> Maybe (a, b)
forall a. a -> Maybe a
Just (a
x, b
y)
      Either HandleErr ValsByKey -> m (Either HandleErr ValsByKey)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr ValsByKey -> m (Either HandleErr ValsByKey))
-> Either HandleErr ValsByKey -> m (Either HandleErr ValsByKey)
forall a b. (a -> b) -> a -> b
$ ValsByKey -> Either HandleErr ValsByKey
forall a b. b -> Either a b
Right (ValsByKey -> Either HandleErr ValsByKey)
-> ValsByKey -> Either HandleErr ValsByKey
forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)] -> ValsByKey
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(ByteString, ByteString)] -> ValsByKey)
-> [(ByteString, ByteString)] -> ValsByKey
forall a b. (a -> b) -> a -> b
$ ((ByteString, Maybe ByteString) -> Maybe (ByteString, ByteString))
-> [(ByteString, Maybe ByteString)] -> [(ByteString, ByteString)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ByteString, Maybe ByteString) -> Maybe (ByteString, ByteString)
forall {a} {b}. (a, Maybe b) -> Maybe (a, b)
mbOf [(ByteString, Maybe ByteString)]
pairedMaybes


hCountKVs' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  m (Either HandleErr Natural)
hCountKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m (Either HandleErr Natural)
hCountKVs' Connection
conn ByteString
key = Connection
-> Redis (Either Reply Natural) -> m (Either HandleErr Natural)
forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (Redis (Either Reply Natural) -> m (Either HandleErr Natural))
-> Redis (Either Reply Natural) -> m (Either HandleErr Natural)
forall a b. (a -> b) -> a -> b
$ ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
hlen ByteString
key Redis (Either Reply Integer)
-> (Either Reply Integer -> Either Reply Natural)
-> Redis (Either Reply Natural)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Integer -> Natural)
-> Either Reply Integer -> Either Reply Natural
forall a b. (a -> b) -> Either Reply a -> Either Reply b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> Natural
forall a. Num a => Integer -> a
fromInteger


hSaveTo' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  Key ->
  Val ->
  m (Either HandleErr ())
hSaveTo' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
hSaveTo' Connection
conn ByteString
key ByteString
dictKey ByteString
value = Connection
-> Redis (Either Reply Integer) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn (Redis (Either Reply Integer) -> m (Either HandleErr ()))
-> Redis (Either Reply Integer) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString
-> ByteString -> ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
hset ByteString
key ByteString
dictKey ByteString
value


hSaveKVs' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  ValsByKey ->
  m (Either HandleErr ())
hSaveKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs' Connection
conn ByteString
key ValsByKey
dict = do
  Either HandleErr ()
_ <- Connection -> Selection -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> Selection -> m (Either HandleErr ())
hDeleteSelected' Connection
conn (Selection -> m (Either HandleErr ()))
-> Selection -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> Selection
AllOf (ByteString
key ByteString -> [ByteString] -> NonEmpty ByteString
forall a. a -> [a] -> NonEmpty a
:| [])
  Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs' Connection
conn ByteString
key ValsByKey
dict


hUpdateKVs' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  ValsByKey ->
  m (Either HandleErr ())
hUpdateKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs' Connection
conn ByteString
key ValsByKey
dict = Connection
-> Redis (Either Reply Status) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn (Redis (Either Reply Status) -> m (Either HandleErr ()))
-> Redis (Either Reply Status) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString
-> [(ByteString, ByteString)] -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, ByteString)] -> m (f Status)
hmset ByteString
key ([(ByteString, ByteString)] -> Redis (Either Reply Status))
-> [(ByteString, ByteString)] -> Redis (Either Reply Status)
forall a b. (a -> b) -> a -> b
$ ValsByKey -> [(ByteString, ByteString)]
forall k a. Map k a -> [(k, a)]
Map.toList ValsByKey
dict


hDeleteSelected' ::
  MonadUnliftIO m =>
  Connection ->
  Selection ->
  m (Either HandleErr ())
hDeleteSelected' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> Selection -> m (Either HandleErr ())
hDeleteSelected' Connection
conn (AllOf NonEmpty ByteString
ks) = Connection
-> Redis (Either Reply Integer) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn (Redis (Either Reply Integer) -> m (Either HandleErr ()))
-> Redis (Either Reply Integer) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
del ([ByteString] -> Redis (Either Reply Integer))
-> [ByteString] -> Redis (Either Reply Integer)
forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
ks
hDeleteSelected' Connection
conn (Match Glob
g) = do
  Connection
-> Redis (Either Reply [ByteString])
-> m (Either HandleErr [ByteString])
forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (ByteString -> Redis (Either Reply [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [ByteString])
keys (ByteString -> Redis (Either Reply [ByteString]))
-> ByteString -> Redis (Either Reply [ByteString])
forall a b. (a -> b) -> a -> b
$ Glob -> ByteString
globPattern Glob
g) m (Either HandleErr [ByteString])
-> (Either HandleErr [ByteString] -> m (Either HandleErr ()))
-> m (Either HandleErr ())
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left HandleErr
e -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ()
forall a b. a -> Either a b
Left HandleErr
e
    Right [] -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ () -> Either HandleErr ()
forall a b. b -> Either a b
Right ()
    Right (ByteString
k : [ByteString]
ks) -> Connection -> Selection -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> Selection -> m (Either HandleErr ())
hDeleteSelected' Connection
conn (Selection -> m (Either HandleErr ()))
-> Selection -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> Selection
AllOf (ByteString
k ByteString -> [ByteString] -> NonEmpty ByteString
forall a. a -> [a] -> NonEmpty a
:| [ByteString]
ks)


hDeleteSelectedKVs' ::
  MonadUnliftIO m =>
  Connection ->
  Key ->
  Selection ->
  m (Either HandleErr ())
hDeleteSelectedKVs' :: forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs' Connection
conn ByteString
key (AllOf NonEmpty ByteString
dictKeys) = Connection
-> Redis (Either Reply Integer) -> m (Either HandleErr ())
forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn (Redis (Either Reply Integer) -> m (Either HandleErr ()))
-> Redis (Either Reply Integer) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
hdel ByteString
key ([ByteString] -> Redis (Either Reply Integer))
-> [ByteString] -> Redis (Either Reply Integer)
forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
dictKeys
hDeleteSelectedKVs' Connection
conn ByteString
key m :: Selection
m@(Match Glob
_) = (Connection -> ByteString -> Selection -> m (Either HandleErr ()))
-> Connection -> ByteString -> Selection -> m (Either HandleErr ())
forall b (m :: * -> *).
(Monoid b, MonadUnliftIO m) =>
(Connection -> ByteString -> Selection -> m (Either HandleErr b))
-> Connection -> ByteString -> Selection -> m (Either HandleErr b)
selectKeysThen Connection -> ByteString -> Selection -> m (Either HandleErr ())
forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs' Connection
conn ByteString
key Selection
m


selectKeysThen ::
  (Monoid b, MonadUnliftIO m) =>
  (Connection -> B.ByteString -> Selection -> m (Either HandleErr b)) ->
  Connection ->
  B.ByteString ->
  Selection ->
  m (Either HandleErr b)
selectKeysThen :: forall b (m :: * -> *).
(Monoid b, MonadUnliftIO m) =>
(Connection -> ByteString -> Selection -> m (Either HandleErr b))
-> Connection -> ByteString -> Selection -> m (Either HandleErr b)
selectKeysThen Connection -> ByteString -> Selection -> m (Either HandleErr b)
f Connection
conn ByteString
key Selection
selection = do
  (Connection
-> Redis (Either Reply [ByteString])
-> m (Either HandleErr [ByteString])
forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (Redis (Either Reply [ByteString])
 -> m (Either HandleErr [ByteString]))
-> Redis (Either Reply [ByteString])
-> m (Either HandleErr [ByteString])
forall a b. (a -> b) -> a -> b
$ ByteString -> Redis (Either Reply [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [ByteString])
hkeys ByteString
key) m (Either HandleErr [ByteString])
-> (Either HandleErr [ByteString] -> m (Either HandleErr b))
-> m (Either HandleErr b)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left HandleErr
e -> Either HandleErr b -> m (Either HandleErr b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr b -> m (Either HandleErr b))
-> Either HandleErr b -> m (Either HandleErr b)
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr b
forall a b. a -> Either a b
Left HandleErr
e
    Right [] -> Either HandleErr b -> m (Either HandleErr b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr b -> m (Either HandleErr b))
-> Either HandleErr b -> m (Either HandleErr b)
forall a b. (a -> b) -> a -> b
$ b -> Either HandleErr b
forall a b. b -> Either a b
Right b
forall a. Monoid a => a
mempty
    Right [ByteString]
xs -> do
      case ((ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (\ByteString
k -> ByteString
k ByteString -> Selection -> Bool
`isIn` Selection
selection) [ByteString]
xs) of
        [] -> Either HandleErr b -> m (Either HandleErr b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr b -> m (Either HandleErr b))
-> Either HandleErr b -> m (Either HandleErr b)
forall a b. (a -> b) -> a -> b
$ b -> Either HandleErr b
forall a b. b -> Either a b
Right b
forall a. Monoid a => a
mempty
        (ByteString
k : [ByteString]
ks) -> Connection -> ByteString -> Selection -> m (Either HandleErr b)
f Connection
conn ByteString
key (Selection -> m (Either HandleErr b))
-> Selection -> m (Either HandleErr b)
forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> Selection
AllOf (ByteString
k ByteString -> [ByteString] -> NonEmpty ByteString
forall a. a -> [a] -> NonEmpty a
:| [ByteString]
ks)


fallbackMaxConns :: Int
fallbackMaxConns :: Int
fallbackMaxConns = Int
10


toHandleErr :: Reply -> HandleErr
toHandleErr :: Reply -> HandleErr
toHandleErr (Error ByteString
e) | ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
"WRONGTYPE" ByteString
e = HandleErr
BadKey
toHandleErr (Error ByteString
e) = Text -> HandleErr
Unanticipated (Text -> HandleErr) -> Text -> HandleErr
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
e
toHandleErr Reply
r = Text -> HandleErr
Unanticipated (Text -> HandleErr) -> Text -> HandleErr
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Reply -> String
forall a. Show a => a -> String
show Reply
r


doStore ::
  MonadIO m =>
  Connection ->
  Redis (Either Reply Status) ->
  m (Either HandleErr ())
doStore :: forall (m :: * -> *).
MonadIO m =>
Connection
-> Redis (Either Reply Status) -> m (Either HandleErr ())
doStore Connection
conn Redis (Either Reply Status)
action = IO (Either HandleErr ()) -> m (Either HandleErr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HandleErr ()) -> m (Either HandleErr ()))
-> IO (Either HandleErr ()) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ IO (Either Reply Status) -> IO (Either HandleErr ())
forall (m :: * -> *).
Monad m =>
m (Either Reply Status) -> m (Either HandleErr ())
leftErr (IO (Either Reply Status) -> IO (Either HandleErr ()))
-> IO (Either Reply Status) -> IO (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ Connection
-> Redis (Either Reply Status) -> IO (Either Reply Status)
forall a. Connection -> Redis a -> IO a
runRedis Connection
conn Redis (Either Reply Status)
action


leftErr :: Monad m => m (Either Reply Status) -> m (Either HandleErr ())
leftErr :: forall (m :: * -> *).
Monad m =>
m (Either Reply Status) -> m (Either HandleErr ())
leftErr m (Either Reply Status)
x =
  m (Either Reply Status)
x m (Either Reply Status)
-> (Either Reply Status -> m (Either HandleErr ()))
-> m (Either HandleErr ())
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Left Reply
l) -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ()
forall a b. a -> Either a b
Left (HandleErr -> Either HandleErr ())
-> HandleErr -> Either HandleErr ()
forall a b. (a -> b) -> a -> b
$ Reply -> HandleErr
toHandleErr Reply
l
    Right Status
Ok -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ () -> Either HandleErr ()
forall a b. b -> Either a b
Right ()
    Right Status
Pong -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ () -> Either HandleErr ()
forall a b. b -> Either a b
Right ()
    Right (Status ByteString
err) -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ()
forall a b. a -> Either a b
Left (HandleErr -> Either HandleErr ())
-> HandleErr -> Either HandleErr ()
forall a b. (a -> b) -> a -> b
$ Text -> HandleErr
Unanticipated (Text -> HandleErr) -> Text -> HandleErr
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
forall a. Show a => a -> String
show ByteString
err


doStore' ::
  MonadIO m =>
  Connection ->
  Redis (Either Reply a) ->
  m (Either HandleErr ())
doStore' :: forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn Redis (Either Reply a)
action = IO (Either HandleErr ()) -> m (Either HandleErr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HandleErr ()) -> m (Either HandleErr ()))
-> IO (Either HandleErr ()) -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ IO (Either Reply a) -> IO (Either HandleErr ())
forall (m :: * -> *) a.
Monad m =>
m (Either Reply a) -> m (Either HandleErr ())
leftErr'' (IO (Either Reply a) -> IO (Either HandleErr ()))
-> IO (Either Reply a) -> IO (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ Connection -> Redis (Either Reply a) -> IO (Either Reply a)
forall a. Connection -> Redis a -> IO a
runRedis Connection
conn Redis (Either Reply a)
action


leftErr'' :: Monad m => m (Either Reply a) -> m (Either HandleErr ())
leftErr'' :: forall (m :: * -> *) a.
Monad m =>
m (Either Reply a) -> m (Either HandleErr ())
leftErr'' m (Either Reply a)
x =
  m (Either Reply a)
x m (Either Reply a)
-> (Either Reply a -> m (Either HandleErr ()))
-> m (Either HandleErr ())
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Left Reply
l) -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ HandleErr -> Either HandleErr ()
forall a b. a -> Either a b
Left (HandleErr -> Either HandleErr ())
-> HandleErr -> Either HandleErr ()
forall a b. (a -> b) -> a -> b
$ Reply -> HandleErr
toHandleErr Reply
l
    Right a
_ -> Either HandleErr () -> m (Either HandleErr ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either HandleErr () -> m (Either HandleErr ()))
-> Either HandleErr () -> m (Either HandleErr ())
forall a b. (a -> b) -> a -> b
$ () -> Either HandleErr ()
forall a b. b -> Either a b
Right ()


doFetch ::
  MonadUnliftIO m =>
  Connection ->
  Redis (Either Reply a) ->
  m (Either HandleErr a)
doFetch :: forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn = IO (Either HandleErr a) -> m (Either HandleErr a)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either HandleErr a) -> m (Either HandleErr a))
-> (Redis (Either Reply a) -> IO (Either HandleErr a))
-> Redis (Either Reply a)
-> m (Either HandleErr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either Reply a) -> IO (Either HandleErr a)
forall (m :: * -> *) a.
Monad m =>
m (Either Reply a) -> m (Either HandleErr a)
leftErr' (IO (Either Reply a) -> IO (Either HandleErr a))
-> (Redis (Either Reply a) -> IO (Either Reply a))
-> Redis (Either Reply a)
-> IO (Either HandleErr a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Redis (Either Reply a) -> IO (Either Reply a)
forall a. Connection -> Redis a -> IO a
runRedis Connection
conn


leftErr' :: Monad m => m (Either Reply a) -> m (Either HandleErr a)
leftErr' :: forall (m :: * -> *) a.
Monad m =>
m (Either Reply a) -> m (Either HandleErr a)
leftErr' = (m (Either Reply a)
-> (Either Reply a -> Either HandleErr a) -> m (Either HandleErr a)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Reply -> Either HandleErr a)
-> (a -> Either HandleErr a)
-> Either Reply a
-> Either HandleErr a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (HandleErr -> Either HandleErr a
forall a b. a -> Either a b
Left (HandleErr -> Either HandleErr a)
-> (Reply -> HandleErr) -> Reply -> Either HandleErr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> HandleErr
toHandleErr) a -> Either HandleErr a
forall a b. b -> Either a b
Right)