{-# 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 <- forall (m :: * -> *) a. (MonadIO m, Read a) => String -> a -> m a
readEnvDef String
"REDIS_MAX_CONNECTIONS" Int
fallbackMaxConns
  forall a (m :: * -> *).
(IsString a, MonadIO m) =>
String -> m (Maybe a)
lookupEnv String
"REDIS_URL" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure 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' = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> IO a
invalidLocator forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: Int
connectMaxConnections = Int
x}
  forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ConnectInfo -> ConnectInfo
setMaxConns Int
maxConns 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 = forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ String -> IOError
userError forall a b. (a -> b) -> a -> b
$ String
"REDIS connection url: " forall a. [a] -> [a] -> [a]
++ String
x 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ConnectInfo -> IO Connection
checkedConnect ConnectInfo
connectInfo
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    Handle
      { hClose :: m ()
hClose = forall (m :: * -> *). MonadUnliftIO m => Connection -> m ()
hClose' Connection
conn
      , hLoadVal :: ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadVal = forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadVal' Connection
conn
      , hSaveVal :: ByteString -> ByteString -> m (Either HandleErr ())
hSaveVal = forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ByteString -> m (Either HandleErr ())
hSaveVal' Connection
conn
      , hLoadKVs :: ByteString -> m (Either HandleErr ValsByKey)
hLoadKVs = forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> m (Either HandleErr ValsByKey)
hLoadKVs' Connection
conn
      , hSaveKVs :: ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs = forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
hSaveKVs' Connection
conn
      , hUpdateKVs :: ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs = forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> ValsByKey -> m (Either HandleErr ())
hUpdateKVs' Connection
conn
      , hLoadFrom :: ByteString -> ByteString -> m (Either HandleErr (Maybe ByteString))
hLoadFrom = forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString
-> ByteString
-> m (Either HandleErr (Maybe ByteString))
hLoadFrom' Connection
conn
      , hLoadSlice :: ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice = forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString -> Selection -> m (Either HandleErr ValsByKey)
hLoadSlice' Connection
conn
      , hSaveTo :: ByteString -> ByteString -> ByteString -> m (Either HandleErr ())
hSaveTo = forall (m :: * -> *).
MonadUnliftIO m =>
Connection
-> ByteString
-> ByteString
-> ByteString
-> m (Either HandleErr ())
hSaveTo' Connection
conn
      , hDeleteSelected :: Selection -> m (Either HandleErr ())
hDeleteSelected = forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> Selection -> m (Either HandleErr ())
hDeleteSelected' Connection
conn
      , hDeleteSelectedKVs :: ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs = forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> ByteString -> Selection -> m (Either HandleErr ())
hDeleteSelectedKVs' Connection
conn
      , hCountKVs :: ByteString -> m (Either HandleErr Natural)
hCountKVs = 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' = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO 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 = forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *).
MonadIO m =>
Connection
-> Redis (Either Reply Status) -> m (Either HandleErr ())
doStore Connection
conn forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
hgetall ByteString
key forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
_) = forall b (m :: * -> *).
(Monoid b, MonadUnliftIO m) =>
(Connection -> ByteString -> Selection -> m (Either HandleErr b))
-> Connection -> ByteString -> Selection -> m (Either HandleErr b)
selectKeysThen 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 = forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
dictKeys'
  forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f [Maybe ByteString])
hmget ByteString
key [ByteString]
dictKeys) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left HandleErr
err -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left HandleErr
err
    Right [Maybe ByteString]
fetched -> do
      let pairedMaybes :: [(ByteString, Maybe ByteString)]
pairedMaybes = 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \b
y -> forall a. a -> Maybe a
Just (a
x, b
y)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe 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 = forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
hlen ByteString
key forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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 = forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn forall a b. (a -> b) -> a -> b
$ 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 ()
_ <- forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> Selection -> m (Either HandleErr ())
hDeleteSelected' Connection
conn forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> Selection
AllOf (ByteString
key forall a. a -> [a] -> NonEmpty a
:| [])
  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 = forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, ByteString)] -> m (f Status)
hmset ByteString
key forall a b. (a -> b) -> a -> b
$ 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) = forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
del forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
ks
hDeleteSelected' Connection
conn (Match Glob
g) = do
  forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn (forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [ByteString])
keys forall a b. (a -> b) -> a -> b
$ Glob -> ByteString
globPattern Glob
g) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left HandleErr
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left HandleErr
e
    Right [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
    Right (ByteString
k : [ByteString]
ks) -> forall (m :: * -> *).
MonadUnliftIO m =>
Connection -> Selection -> m (Either HandleErr ())
hDeleteSelected' Connection
conn forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> Selection
AllOf (ByteString
k 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) = forall (m :: * -> *) a.
MonadIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr ())
doStore' Connection
conn forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
hdel ByteString
key forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
dictKeys
hDeleteSelectedKVs' Connection
conn ByteString
key m :: Selection
m@(Match Glob
_) = forall b (m :: * -> *).
(Monoid b, MonadUnliftIO m) =>
(Connection -> ByteString -> Selection -> m (Either HandleErr b))
-> Connection -> ByteString -> Selection -> m (Either HandleErr b)
selectKeysThen 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
  (forall (m :: * -> *) a.
MonadUnliftIO m =>
Connection -> Redis (Either Reply a) -> m (Either HandleErr a)
doFetch Connection
conn forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [ByteString])
hkeys ByteString
key) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left HandleErr
e -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left HandleErr
e
    Right [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
    Right [ByteString]
xs -> do
      case (forall a. (a -> Bool) -> [a] -> [a]
filter (\ByteString
k -> ByteString
k ByteString -> Selection -> Bool
`isIn` Selection
selection) [ByteString]
xs) of
        [] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall a. Monoid a => a
mempty
        (ByteString
k : [ByteString]
ks) -> Connection -> ByteString -> Selection -> m (Either HandleErr b)
f Connection
conn ByteString
key forall a b. (a -> b) -> a -> b
$ NonEmpty ByteString -> Selection
AllOf (ByteString
k 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 forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 ByteString
e
toHandleErr Reply
r = Text -> HandleErr
Unanticipated forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
Monad m =>
m (Either Reply Status) -> m (Either HandleErr ())
leftErr forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Left Reply
l) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Reply -> HandleErr
toHandleErr Reply
l
    Right Status
Ok -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
    Right Status
Pong -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ()
    Right (Status ByteString
err) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Text -> HandleErr
Unanticipated forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
Monad m =>
m (Either Reply a) -> m (Either HandleErr ())
leftErr'' forall a b. (a -> b) -> a -> b
$ 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    (Left Reply
l) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Reply -> HandleErr
toHandleErr Reply
l
    Right a
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
m (Either Reply a) -> m (Either HandleErr a)
leftErr' forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' = (forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> HandleErr
toHandleErr) forall a b. b -> Either a b
Right)