{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE GADTs #-}

module Redis.Handler
  ( handler,
    handlerAutoExtendExpire,
    withQueryTimeoutMilliseconds,
    withoutQueryTimeout,
  )
where

import qualified Control.Exception.Safe as Exception
import Control.Monad.IO.Class (liftIO)
import qualified Data.Acquire
import qualified Data.ByteString
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text.Encoding
import qualified Database.Redis
import qualified Dict
import qualified GHC.Stack as Stack
import qualified Log
import qualified Platform
import qualified Redis.Internal as Internal
import qualified Redis.Script as Script
import qualified Redis.Settings as Settings
import qualified Set
import qualified Text
import Prelude (Either (Left, Right), IO, fromIntegral, pure)
import qualified Prelude

-- | Produce a namespaced handler for Redis access.
handler :: Text -> Settings.Settings -> Data.Acquire.Acquire Internal.Handler
handler :: Text -> Settings -> Acquire Handler
handler Text
namespace Settings
settings = do
  (Handler
namespacedHandler, Connection
_) <- IO (Handler, Connection)
-> ((Handler, Connection) -> IO ())
-> Acquire (Handler, Connection)
forall a. IO a -> (a -> IO ()) -> Acquire a
Data.Acquire.mkAcquire (Text -> Settings -> IO (Handler, Connection)
forall (x :: HasAutoExtendExpire).
Text -> Settings -> IO (Handler' x, Connection)
acquireHandler Text
namespace Settings
settings) (Handler, Connection) -> IO ()
forall (x :: HasAutoExtendExpire).
(Handler' x, Connection) -> IO ()
releaseHandler
  Handler
namespacedHandler
    Handler -> (Handler -> Acquire Handler) -> Acquire Handler
forall a b. a -> (a -> b) -> b
|> Handler -> Acquire Handler
forall a. a -> Acquire a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure

-- | Produce a namespaced handler for Redis access.
-- This will ensure that we extend all keys accessed by a query by a configured default time (see Settings.defaultExpiry)
handlerAutoExtendExpire :: Text -> Settings.Settings -> Data.Acquire.Acquire Internal.HandlerAutoExtendExpire
handlerAutoExtendExpire :: Text -> Settings -> Acquire HandlerAutoExtendExpire
handlerAutoExtendExpire Text
namespace Settings
settings = do
  (HandlerAutoExtendExpire
namespacedHandler, Connection
_) <- IO (HandlerAutoExtendExpire, Connection)
-> ((HandlerAutoExtendExpire, Connection) -> IO ())
-> Acquire (HandlerAutoExtendExpire, Connection)
forall a. IO a -> (a -> IO ()) -> Acquire a
Data.Acquire.mkAcquire (Text -> Settings -> IO (HandlerAutoExtendExpire, Connection)
forall (x :: HasAutoExtendExpire).
Text -> Settings -> IO (Handler' x, Connection)
acquireHandler Text
namespace Settings
settings) (HandlerAutoExtendExpire, Connection) -> IO ()
forall (x :: HasAutoExtendExpire).
(Handler' x, Connection) -> IO ()
releaseHandler
  HandlerAutoExtendExpire
namespacedHandler
    HandlerAutoExtendExpire
-> (HandlerAutoExtendExpire -> IO HandlerAutoExtendExpire)
-> IO HandlerAutoExtendExpire
forall a b. a -> (a -> b) -> b
|> ( \HandlerAutoExtendExpire
handler' -> case Settings -> DefaultExpiry
Settings.defaultExpiry Settings
settings of
           DefaultExpiry
Settings.NoDefaultExpiry ->
             -- We create the handler as part of starting the application. Throwing
             -- means that if there's a problem with the settings the application will
             -- fail immediately upon start. It won't result in runtime errors during
             -- operation.
             [ Text
"Setting up an auto extend expire handler for",
               Text
"redis failed. Auto extending the expire of keys only works if",
               Text
"there is a setting for `REDIS_DEFAULT_EXPIRY_SECONDS`."
             ]
               [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> Text -> [Text] -> Text
Text.join Text
" "
               Text -> (Text -> List Char) -> List Char
forall a b. a -> (a -> b) -> b
|> Text -> List Char
Text.toList
               List Char
-> (List Char -> IO HandlerAutoExtendExpire)
-> IO HandlerAutoExtendExpire
forall a b. a -> (a -> b) -> b
|> List Char -> IO HandlerAutoExtendExpire
forall (m :: * -> *) a.
(MonadThrow m, HasCallStack) =>
List Char -> m a
Exception.throwString
           Settings.ExpireKeysAfterSeconds Int
secs ->
             Int -> HandlerAutoExtendExpire -> HandlerAutoExtendExpire
defaultExpiryKeysAfterSeconds Int
secs HandlerAutoExtendExpire
handler'
               HandlerAutoExtendExpire
-> (HandlerAutoExtendExpire -> IO HandlerAutoExtendExpire)
-> IO HandlerAutoExtendExpire
forall a b. a -> (a -> b) -> b
|> HandlerAutoExtendExpire -> IO HandlerAutoExtendExpire
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure
       )
    IO HandlerAutoExtendExpire
-> (IO HandlerAutoExtendExpire -> Acquire HandlerAutoExtendExpire)
-> Acquire HandlerAutoExtendExpire
forall a b. a -> (a -> b) -> b
|> IO HandlerAutoExtendExpire -> Acquire HandlerAutoExtendExpire
forall a. IO a -> Acquire a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Sets a timeout for the query in milliseconds.
withQueryTimeoutMilliseconds :: Int -> Internal.Handler' x -> Task () (Internal.Handler' x)
withQueryTimeoutMilliseconds :: forall (x :: HasAutoExtendExpire).
Int -> Handler' x -> Task () (Handler' x)
withQueryTimeoutMilliseconds Int
timeoutMs Handler' x
handler' =
  (Handler' x
handler' {Internal.queryTimeout = Settings.TimeoutQueryAfterMilliseconds timeoutMs})
    Handler' x
-> (Handler' x -> Task () (Handler' x)) -> Task () (Handler' x)
forall a b. a -> (a -> b) -> b
|> Handler' x -> Task () (Handler' x)
forall a x. a -> Task x a
Task.succeed
    Task () (Handler' x)
-> (Task () (Handler' x) -> Task () (Handler' x))
-> Task () (Handler' x)
forall a b. a -> (a -> b) -> b
|> Text -> [Context] -> Task () (Handler' x) -> Task () (Handler' x)
forall e b.
HasCallStack =>
Text -> [Context] -> Task e b -> Task e b
Log.withContext Text
"setting redis query timeout" [Text -> Text -> Context
forall a. (Show a, ToJSON a) => Text -> a -> Context
Log.context Text
"timeoutMilliseconds" (Int -> Text
Text.fromInt Int
timeoutMs)]

-- | Disables timeout for query in milliseconds
withoutQueryTimeout :: Internal.Handler' x -> Task () (Internal.Handler' x)
withoutQueryTimeout :: forall (x :: HasAutoExtendExpire).
Handler' x -> Task () (Handler' x)
withoutQueryTimeout Handler' x
handler' =
  (Handler' x
handler' {Internal.queryTimeout = Settings.NoQueryTimeout})
    Handler' x
-> (Handler' x -> Task () (Handler' x)) -> Task () (Handler' x)
forall a b. a -> (a -> b) -> b
|> Handler' x -> Task () (Handler' x)
forall a x. a -> Task x a
Task.succeed
    Task () (Handler' x)
-> (Task () (Handler' x) -> Task () (Handler' x))
-> Task () (Handler' x)
forall a b. a -> (a -> b) -> b
|> Text -> [Context] -> Task () (Handler' x) -> Task () (Handler' x)
forall e b.
HasCallStack =>
Text -> [Context] -> Task e b -> Task e b
Log.withContext Text
"setting no redis query timeout" []

defaultExpiryKeysAfterSeconds :: Int -> Internal.HandlerAutoExtendExpire -> Internal.HandlerAutoExtendExpire
defaultExpiryKeysAfterSeconds :: Int -> HandlerAutoExtendExpire -> HandlerAutoExtendExpire
defaultExpiryKeysAfterSeconds Int
secs HandlerAutoExtendExpire
handler' =
  let wrapWithExpire :: Internal.Query a -> Internal.Query a
      wrapWithExpire :: forall a. Query a -> Query a
wrapWithExpire Query a
query' =
        Query a -> Set Text
forall a. Query a -> Set Text
Internal.keysTouchedByQuery Query a
query'
          Set Text -> (Set Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
|> Set Text -> [Text]
forall a. Set a -> List a
Set.toList
          [Text] -> ([Text] -> List (Query ())) -> List (Query ())
forall a b. a -> (a -> b) -> b
|> (Text -> Query ()) -> [Text] -> List (Query ())
forall a b. (a -> b) -> List a -> List b
List.map (\Text
key -> Text -> Int -> Query ()
Internal.Expire Text
key Int
secs)
          List (Query ())
-> (List (Query ()) -> Query (List ())) -> Query (List ())
forall a b. a -> (a -> b) -> b
|> List (Query ()) -> Query (List ())
forall a. List (Query a) -> Query (List a)
Internal.sequence
          Query (List ()) -> (Query (List ()) -> Query a) -> Query a
forall a b. a -> (a -> b) -> b
|> (a -> List () -> a) -> Query a -> Query (List ()) -> Query a
forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
Internal.map2 (\a
res List ()
_ -> a
res) Query a
query'
   in HandlerAutoExtendExpire
handler'
        { Internal.doQuery = \QueryTimeout
queryTimeout Query a
query' ->
            Query a -> Query a
forall a. Query a -> Query a
wrapWithExpire Query a
query'
              Query a -> (Query a -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (HasCallStack => QueryTimeout -> Query a -> Task Error a)
-> QueryTimeout -> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (HandlerAutoExtendExpire
-> forall a.
   HasCallStack =>
   QueryTimeout -> Query a -> Task Error a
forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
   HasCallStack =>
   QueryTimeout -> Query a -> Task Error a
Internal.doQuery HandlerAutoExtendExpire
handler') QueryTimeout
queryTimeout,
          Internal.doTransaction = \QueryTimeout
queryTimeout Query a
query' ->
            Query a -> Query a
forall a. Query a -> Query a
wrapWithExpire Query a
query'
              Query a -> (Query a -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (HasCallStack => QueryTimeout -> Query a -> Task Error a)
-> QueryTimeout -> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (HandlerAutoExtendExpire
-> forall a.
   HasCallStack =>
   QueryTimeout -> Query a -> Task Error a
forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
   HasCallStack =>
   QueryTimeout -> Query a -> Task Error a
Internal.doTransaction HandlerAutoExtendExpire
handler') QueryTimeout
queryTimeout,
          Internal.doEval = \QueryTimeout
queryTimeout Script a
script' ->
            -- We can't guarantee auto-expire for EVAL, so we just run it as-is
            (HasCallStack => Task Error a) -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (HandlerAutoExtendExpire
-> forall a.
   (HasCallStack, RedisResult a) =>
   QueryTimeout -> Script a -> Task Error a
forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
   (HasCallStack, RedisResult a) =>
   QueryTimeout -> Script a -> Task Error a
Internal.doEval HandlerAutoExtendExpire
handler' QueryTimeout
queryTimeout Script a
script')
        }

acquireHandler :: Text -> Settings.Settings -> IO (Internal.Handler' x, Connection)
acquireHandler :: forall (x :: HasAutoExtendExpire).
Text -> Settings -> IO (Handler' x, Connection)
acquireHandler Text
namespace Settings
settings = do
  Connection
connection <- do
    let connectionInfo :: ConnectInfo
connectionInfo = Settings -> ConnectInfo
Settings.connectionInfo Settings
settings
    Connection
connectionHedis <-
      case Settings -> ClusterMode
Settings.clusterMode Settings
settings of
        ClusterMode
Settings.Cluster ->
          ConnectInfo -> IO Connection
Database.Redis.connectCluster ConnectInfo
connectionInfo
        ClusterMode
Settings.NotCluster ->
          ConnectInfo -> IO Connection
Database.Redis.checkedConnect ConnectInfo
connectionInfo
    let connectionHost :: Text
connectionHost = List Char -> Text
Text.fromList (ConnectInfo -> List Char
Database.Redis.connectHost ConnectInfo
connectionInfo)
    let connectionPort :: Maybe Int
connectionPort =
          case ConnectInfo -> PortID
Database.Redis.connectPort ConnectInfo
connectionInfo of
            Database.Redis.PortNumber PortNumber
port -> Int -> Maybe Int
forall a. a -> Maybe a
Just (PortNumber -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral PortNumber
port)
            Database.Redis.UnixSocket List Char
_ -> Maybe Int
forall a. Maybe a
Nothing
    Connection -> IO Connection
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Connection {Connection
connectionHedis :: Connection
connectionHedis :: Connection
connectionHedis, Text
connectionHost :: Text
connectionHost :: Text
connectionHost, Maybe Int
connectionPort :: Maybe Int
connectionPort :: Maybe Int
connectionPort}
  Handler
anything <- IO Handler
Platform.doAnythingHandler
  (Handler' x, Connection) -> IO (Handler' x, Connection)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Internal.Handler'
        { doQuery :: forall a. HasCallStack => QueryTimeout -> Query a -> Task Error a
Internal.doQuery = \QueryTimeout
queryTimeout Query a
query ->
            let PreparedQuery {Redis (Either Reply (Result Error a))
redisCtx :: Redis (Either Reply (Result Error a))
redisCtx :: forall (m :: * -> *) (f :: * -> *) result.
PreparedQuery m f result -> m (f result)
redisCtx} = Query a -> PreparedQuery Redis (Either Reply) (Result Error a)
forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query a
query
             in (HasCallStack =>
 [Text]
 -> Connection
 -> Handler
 -> QueryTimeout
 -> Redis (Either Reply (Result Error a))
 -> Task Error a)
-> [Text]
-> Connection
-> Handler
-> QueryTimeout
-> Redis (Either Reply (Result Error a))
-> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack =>
[Text]
-> Connection
-> Handler
-> QueryTimeout
-> Redis (Either Reply (Result Error a))
-> Task Error a
[Text]
-> Connection
-> Handler
-> QueryTimeout
-> Redis (Either Reply (Result Error a))
-> Task Error a
forall a.
HasCallStack =>
[Text]
-> Connection
-> Handler
-> QueryTimeout
-> Redis (Either Reply (Result Error a))
-> Task Error a
platformRedis (Query a -> [Text]
forall b. Query b -> [Text]
Internal.cmds Query a
query) Connection
connection Handler
anything QueryTimeout
queryTimeout Redis (Either Reply (Result Error a))
redisCtx,
          doTransaction :: forall a. HasCallStack => QueryTimeout -> Query a -> Task Error a
Internal.doTransaction = \QueryTimeout
queryTimeout Query a
query ->
            let PreparedQuery {RedisTx (Queued (Result Error a))
redisCtx :: forall (m :: * -> *) (f :: * -> *) result.
PreparedQuery m f result -> m (f result)
redisCtx :: RedisTx (Queued (Result Error a))
redisCtx} = Query a -> PreparedQuery RedisTx Queued (Result Error a)
forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query a
query
                redisCmd :: Redis (TxResult (Result Error a))
redisCmd = RedisTx (Queued (Result Error a))
-> Redis (TxResult (Result Error a))
forall a. RedisTx (Queued a) -> Redis (TxResult a)
Database.Redis.multiExec RedisTx (Queued (Result Error a))
redisCtx
             in Redis (TxResult (Result Error a))
redisCmd
                  Redis (TxResult (Result Error a))
-> (Redis (TxResult (Result Error a))
    -> Redis (Either Reply (Result Error a)))
-> Redis (Either Reply (Result Error a))
forall a b. a -> (a -> b) -> b
|> (TxResult (Result Error a) -> Either Reply (Result Error a))
-> Redis (TxResult (Result Error a))
-> Redis (Either Reply (Result Error a))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map
                    ( \TxResult (Result Error a)
txResult ->
                        case TxResult (Result Error a)
txResult of
                          Database.Redis.TxSuccess Result Error a
y -> Result Error a -> Either Reply (Result Error a)
forall a b. b -> Either a b
Right Result Error a
y
                          TxResult (Result Error a)
Database.Redis.TxAborted -> Result Error a -> Either Reply (Result Error a)
forall a b. b -> Either a b
Right (Error -> Result Error a
forall error value. error -> Result error value
Err Error
Internal.TransactionAborted)
                          Database.Redis.TxError List Char
err -> Result Error a -> Either Reply (Result Error a)
forall a b. b -> Either a b
Right (Error -> Result Error a
forall error value. error -> Result error value
Err (Text -> Error
Internal.RedisError (List Char -> Text
Text.fromList List Char
err)))
                    )
                  Redis (Either Reply (Result Error a))
-> (Redis (Either Reply (Result Error a)) -> Task Error a)
-> Task Error a
forall a b. a -> (a -> b) -> b
|> (HasCallStack =>
 Redis (Either Reply (Result Error a)) -> Task Error a)
-> Redis (Either Reply (Result Error a)) -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack ([Text]
-> Connection
-> Handler
-> QueryTimeout
-> Redis (Either Reply (Result Error a))
-> Task Error a
forall a.
HasCallStack =>
[Text]
-> Connection
-> Handler
-> QueryTimeout
-> Redis (Either Reply (Result Error a))
-> Task Error a
platformRedis (Query a -> [Text]
forall b. Query b -> [Text]
Internal.cmds Query a
query) Connection
connection Handler
anything QueryTimeout
queryTimeout),
          doEval :: forall a.
(HasCallStack, RedisResult a) =>
QueryTimeout -> Script a -> Task Error a
Internal.doEval = \QueryTimeout
queryTimeout Script a
script' ->
            (HasCallStack => Task Error a) -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (Script a -> Connection -> Handler -> QueryTimeout -> Task Error a
forall a.
(HasCallStack, RedisResult a) =>
Script a -> Connection -> Handler -> QueryTimeout -> Task Error a
platformRedisScript Script a
script' Connection
connection Handler
anything QueryTimeout
queryTimeout),
          namespace :: Text
Internal.namespace = Text
namespace,
          maxKeySize :: MaxKeySize
Internal.maxKeySize = Settings -> MaxKeySize
Settings.maxKeySize Settings
settings,
          queryTimeout :: QueryTimeout
Internal.queryTimeout = Settings -> QueryTimeout
Settings.queryTimeout Settings
settings
        },
      Connection
connection
    )

newtype PreparedQuery m f result = PreparedQuery
  { forall (m :: * -> *) (f :: * -> *) result.
PreparedQuery m f result -> m (f result)
redisCtx :: m (f result)
  }
  deriving ((forall a b.
 (a -> b) -> PreparedQuery m f a -> PreparedQuery m f b)
-> (forall a b. a -> PreparedQuery m f b -> PreparedQuery m f a)
-> Functor (PreparedQuery m f)
forall a b. a -> PreparedQuery m f b -> PreparedQuery m f a
forall a b. (a -> b) -> PreparedQuery m f a -> PreparedQuery m f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) (f :: * -> *) a b.
(Functor m, Functor f) =>
a -> PreparedQuery m f b -> PreparedQuery m f a
forall (m :: * -> *) (f :: * -> *) a b.
(Functor m, Functor f) =>
(a -> b) -> PreparedQuery m f a -> PreparedQuery m f b
$cfmap :: forall (m :: * -> *) (f :: * -> *) a b.
(Functor m, Functor f) =>
(a -> b) -> PreparedQuery m f a -> PreparedQuery m f b
fmap :: forall a b. (a -> b) -> PreparedQuery m f a -> PreparedQuery m f b
$c<$ :: forall (m :: * -> *) (f :: * -> *) a b.
(Functor m, Functor f) =>
a -> PreparedQuery m f b -> PreparedQuery m f a
<$ :: forall a b. a -> PreparedQuery m f b -> PreparedQuery m f a
Prelude.Functor)

instance (Prelude.Applicative m, Prelude.Applicative f) => Prelude.Applicative (PreparedQuery m f) where
  pure :: forall a. a -> PreparedQuery m f a
pure a
x =
    PreparedQuery
      { redisCtx :: m (f a)
redisCtx = f a -> m (f a)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
      }
  PreparedQuery m f (a -> b)
f <*> :: forall a b.
PreparedQuery m f (a -> b)
-> PreparedQuery m f a -> PreparedQuery m f b
<*> PreparedQuery m f a
x =
    PreparedQuery
      { redisCtx :: m (f b)
redisCtx = (f (a -> b) -> f a -> f b) -> m (f (a -> b)) -> m (f a) -> m (f b)
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
map2 (((a -> b) -> a -> b) -> f (a -> b) -> f a -> f b
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
map2 (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
(<|)) (PreparedQuery m f (a -> b) -> m (f (a -> b))
forall (m :: * -> *) (f :: * -> *) result.
PreparedQuery m f result -> m (f result)
redisCtx PreparedQuery m f (a -> b)
f) (PreparedQuery m f a -> m (f a)
forall (m :: * -> *) (f :: * -> *) result.
PreparedQuery m f result -> m (f result)
redisCtx PreparedQuery m f a
x)
      }

-- Construct a query in the underlying `hedis` library we depend on. It has a
-- polymorphic type signature that allows the returning query to be passed to
-- `Database.Redis.run` for direct execution, or `Database.Redis.multiExec` for
-- executation as part of a transaction.
doRawQuery :: (Prelude.Applicative f, Database.Redis.RedisCtx m f) => Internal.Query result -> PreparedQuery m f (Result Internal.Error result)
doRawQuery :: forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query result
query =
  case Query result
query of
    Internal.Apply Query (a1 -> result)
f Query a1
x ->
      (Result Error (a1 -> result)
 -> Result Error a1 -> Result Error result)
-> PreparedQuery m f (Result Error (a1 -> result))
-> PreparedQuery m f (Result Error a1)
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
map2 (((a1 -> result) -> a1 -> result)
-> Result Error (a1 -> result)
-> Result Error a1
-> Result Error result
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
map2 (a1 -> result) -> a1 -> result
forall a b. (a -> b) -> a -> b
(<|)) (Query (a1 -> result)
-> PreparedQuery m f (Result Error (a1 -> result))
forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query (a1 -> result)
f) (Query a1 -> PreparedQuery m f (Result Error a1)
forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query a1
x)
    Internal.Del NonEmpty Text
keys ->
      [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Database.Redis.del (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList ((Text -> ByteString) -> NonEmpty Text -> NonEmpty ByteString
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> ByteString
toB NonEmpty Text
keys))
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
    Internal.Exists Text
key ->
      ByteString -> m (f Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Bool)
Database.Redis.exists (Text -> ByteString
toB Text
key)
        m (f Bool)
-> (m (f Bool) -> PreparedQuery m f Bool) -> PreparedQuery m f Bool
forall a b. a -> (a -> b) -> b
|> m (f Bool) -> PreparedQuery m f Bool
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Bool
-> (PreparedQuery m f Bool
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error result)
-> PreparedQuery m f Bool
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Bool -> Result Error result
Bool -> Result Error Bool
forall error value. value -> Result error value
Ok
    Internal.Expire Text
key Int
secs ->
      ByteString -> Integer -> m (f Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Database.Redis.expire (Text -> ByteString
toB Text
key) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
secs)
        m (f Bool)
-> (m (f Bool) -> PreparedQuery m f Bool) -> PreparedQuery m f Bool
forall a b. a -> (a -> b) -> b
|> m (f Bool) -> PreparedQuery m f Bool
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Bool
-> (PreparedQuery m f Bool
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error result)
-> PreparedQuery m f Bool
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Bool
_ -> result -> Result Error result
forall error value. value -> Result error value
Ok ())
    Internal.Get Text
key ->
      ByteString -> m (f (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Database.Redis.get (Text -> ByteString
toB Text
key)
        m (f (Maybe ByteString))
-> (m (f (Maybe ByteString))
    -> PreparedQuery m f (Maybe ByteString))
-> PreparedQuery m f (Maybe ByteString)
forall a b. a -> (a -> b) -> b
|> m (f (Maybe ByteString)) -> PreparedQuery m f (Maybe ByteString)
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f (Maybe ByteString)
-> (PreparedQuery m f (Maybe ByteString)
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Maybe ByteString -> Result Error result)
-> PreparedQuery m f (Maybe ByteString)
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Maybe ByteString -> Result Error result
Maybe ByteString -> Result Error (Maybe ByteString)
forall error value. value -> Result error value
Ok
    Internal.Getset Text
key ByteString
val ->
      ByteString -> ByteString -> m (f (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
Database.Redis.getset (Text -> ByteString
toB Text
key) ByteString
val
        m (f (Maybe ByteString))
-> (m (f (Maybe ByteString))
    -> PreparedQuery m f (Maybe ByteString))
-> PreparedQuery m f (Maybe ByteString)
forall a b. a -> (a -> b) -> b
|> m (f (Maybe ByteString)) -> PreparedQuery m f (Maybe ByteString)
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f (Maybe ByteString)
-> (PreparedQuery m f (Maybe ByteString)
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Maybe ByteString -> Result Error result)
-> PreparedQuery m f (Maybe ByteString)
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Maybe ByteString -> Result Error result
Maybe ByteString -> Result Error (Maybe ByteString)
forall error value. value -> Result error value
Ok
    Internal.Hdel Text
key NonEmpty Text
fields ->
      ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Database.Redis.hdel (Text -> ByteString
toB Text
key) (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList ((Text -> ByteString) -> NonEmpty Text -> NonEmpty ByteString
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> ByteString
toB NonEmpty Text
fields))
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
    Internal.Hget Text
key Text
field ->
      ByteString -> ByteString -> m (f (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
Database.Redis.hget (Text -> ByteString
toB Text
key) (Text -> ByteString
toB Text
field)
        m (f (Maybe ByteString))
-> (m (f (Maybe ByteString))
    -> PreparedQuery m f (Maybe ByteString))
-> PreparedQuery m f (Maybe ByteString)
forall a b. a -> (a -> b) -> b
|> m (f (Maybe ByteString)) -> PreparedQuery m f (Maybe ByteString)
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f (Maybe ByteString)
-> (PreparedQuery m f (Maybe ByteString)
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Maybe ByteString -> Result Error result)
-> PreparedQuery m f (Maybe ByteString)
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Maybe ByteString -> Result Error result
Maybe ByteString -> Result Error (Maybe ByteString)
forall error value. value -> Result error value
Ok
    Internal.Hgetall Text
key ->
      ByteString -> m (f [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
Database.Redis.hgetall (Text -> ByteString
toB Text
key)
        m (f [(ByteString, ByteString)])
-> (m (f [(ByteString, ByteString)])
    -> PreparedQuery m f [(ByteString, ByteString)])
-> PreparedQuery m f [(ByteString, ByteString)]
forall a b. a -> (a -> b) -> b
|> m (f [(ByteString, ByteString)])
-> PreparedQuery m f [(ByteString, ByteString)]
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f [(ByteString, ByteString)]
-> (PreparedQuery m f [(ByteString, ByteString)]
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> ([(ByteString, ByteString)] -> Result Error result)
-> PreparedQuery m f [(ByteString, ByteString)]
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map
          ( \[(ByteString, ByteString)]
results ->
              [(ByteString, ByteString)]
results
                [(ByteString, ByteString)]
-> ([(ByteString, ByteString)] -> Result Error result)
-> Result Error result
forall a b. a -> (a -> b) -> b
|> ((ByteString, ByteString) -> Result Error (Text, ByteString))
-> [(ByteString, ByteString)] -> Result Error [(Text, ByteString)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
Prelude.traverse
                  ( \(ByteString
byteKey, ByteString
v) ->
                      case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
byteKey of
                        Prelude.Right Text
textKey -> (Text, ByteString) -> Result Error (Text, ByteString)
forall error value. value -> Result error value
Ok (Text
textKey, ByteString
v)
                        Prelude.Left UnicodeException
_ -> Error -> Result Error (Text, ByteString)
forall error value. error -> Result error value
Err (Text -> Error
Internal.LibraryError Text
"key exists but not parsable text")
                  )
          )
    Internal.Hkeys Text
key ->
      ByteString -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [ByteString])
Database.Redis.hkeys (Text -> ByteString
toB Text
key)
        m (f [ByteString])
-> (m (f [ByteString]) -> PreparedQuery m f [ByteString])
-> PreparedQuery m f [ByteString]
forall a b. a -> (a -> b) -> b
|> m (f [ByteString]) -> PreparedQuery m f [ByteString]
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f [ByteString]
-> (PreparedQuery m f [ByteString]
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> ([ByteString] -> Result Error result)
-> PreparedQuery m f [ByteString]
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map
          ( (ByteString -> Result Error Text)
-> [ByteString] -> Result Error [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
Prelude.traverse
              ( \ByteString
byteKey -> case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
byteKey of
                  Prelude.Right Text
textKey -> Text -> Result Error Text
forall error value. value -> Result error value
Ok Text
textKey
                  Prelude.Left UnicodeException
_ -> Error -> Result Error Text
forall error value. error -> Result error value
Err (Text -> Error
Internal.LibraryError Text
"key exists but not parsable text")
              )
          )
    Internal.Hsetnx Text
key Text
field ByteString
val ->
      ByteString -> ByteString -> ByteString -> m (f Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Bool)
Database.Redis.hsetnx (Text -> ByteString
toB Text
key) (Text -> ByteString
toB Text
field) ByteString
val
        m (f Bool)
-> (m (f Bool) -> PreparedQuery m f Bool) -> PreparedQuery m f Bool
forall a b. a -> (a -> b) -> b
|> m (f Bool) -> PreparedQuery m f Bool
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Bool
-> (PreparedQuery m f Bool
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error result)
-> PreparedQuery m f Bool
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Bool -> Result Error result
Bool -> Result Error Bool
forall error value. value -> Result error value
Ok
    Internal.Hmget Text
key NonEmpty Text
fields ->
      ByteString -> [ByteString] -> m (f [Maybe ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f [Maybe ByteString])
Database.Redis.hmget (Text -> ByteString
toB Text
key) (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList ((Text -> ByteString) -> NonEmpty Text -> NonEmpty ByteString
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> ByteString
toB NonEmpty Text
fields))
        m (f [Maybe ByteString])
-> (m (f [Maybe ByteString])
    -> PreparedQuery m f [Maybe ByteString])
-> PreparedQuery m f [Maybe ByteString]
forall a b. a -> (a -> b) -> b
|> m (f [Maybe ByteString]) -> PreparedQuery m f [Maybe ByteString]
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f [Maybe ByteString]
-> (PreparedQuery m f [Maybe ByteString]
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> ([Maybe ByteString] -> Result Error result)
-> PreparedQuery m f [Maybe ByteString]
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [Maybe ByteString] -> Result Error result
[Maybe ByteString] -> Result Error [Maybe ByteString]
forall error value. value -> Result error value
Ok
    Internal.Hmset Text
key NonEmpty (Text, ByteString)
vals ->
      ByteString -> [(ByteString, ByteString)] -> m (f Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, ByteString)] -> m (f Status)
Database.Redis.hmset (Text -> ByteString
toB Text
key) (((Text, ByteString) -> (ByteString, ByteString))
-> [(Text, ByteString)] -> [(ByteString, ByteString)]
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\(Text
field, ByteString
val) -> (Text -> ByteString
toB Text
field, ByteString
val)) (NonEmpty (Text, ByteString) -> [(Text, ByteString)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Text, ByteString)
vals))
        m (f Status)
-> (m (f Status) -> PreparedQuery m f Status)
-> PreparedQuery m f Status
forall a b. a -> (a -> b) -> b
|> m (f Status) -> PreparedQuery m f Status
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Status
-> (PreparedQuery m f Status
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error result)
-> PreparedQuery m f Status
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> result -> Result Error result
forall error value. value -> Result error value
Ok ())
    Internal.Hset Text
key Text
field ByteString
val ->
      ByteString -> ByteString -> ByteString -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
Database.Redis.hset (Text -> ByteString
toB Text
key) (Text -> ByteString
toB Text
field) ByteString
val
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Integer
_ -> result -> Result Error result
forall error value. value -> Result error value
Ok ())
    Internal.Incr Text
key ->
      ByteString -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
Database.Redis.incr (Text -> ByteString
toB Text
key)
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    Internal.Incrby Text
key Int
amount ->
      ByteString -> Integer -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Integer)
Database.Redis.incrby (Text -> ByteString
toB Text
key) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
amount)
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    Internal.Lrange Text
key Int
lower Int
upper ->
      ByteString -> Integer -> Integer -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [ByteString])
Database.Redis.lrange (Text -> ByteString
toB Text
key) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lower) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
upper)
        m (f [ByteString])
-> (m (f [ByteString]) -> PreparedQuery m f [ByteString])
-> PreparedQuery m f [ByteString]
forall a b. a -> (a -> b) -> b
|> m (f [ByteString]) -> PreparedQuery m f [ByteString]
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f [ByteString]
-> (PreparedQuery m f [ByteString]
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> ([ByteString] -> Result Error result)
-> PreparedQuery m f [ByteString]
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [ByteString] -> Result Error result
[ByteString] -> Result Error [ByteString]
forall error value. value -> Result error value
Ok
    Internal.Mget NonEmpty Text
keys ->
      [ByteString] -> m (f [Maybe ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f [Maybe ByteString])
Database.Redis.mget (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList ((Text -> ByteString) -> NonEmpty Text -> NonEmpty ByteString
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> ByteString
toB NonEmpty Text
keys))
        m (f [Maybe ByteString])
-> (m (f [Maybe ByteString])
    -> PreparedQuery m f [Maybe ByteString])
-> PreparedQuery m f [Maybe ByteString]
forall a b. a -> (a -> b) -> b
|> m (f [Maybe ByteString]) -> PreparedQuery m f [Maybe ByteString]
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f [Maybe ByteString]
-> (PreparedQuery m f [Maybe ByteString]
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> ([Maybe ByteString] -> Result Error result)
-> PreparedQuery m f [Maybe ByteString]
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [Maybe ByteString] -> Result Error result
[Maybe ByteString] -> Result Error [Maybe ByteString]
forall error value. value -> Result error value
Ok
    Internal.Mset NonEmpty (Text, ByteString)
vals ->
      [(ByteString, ByteString)] -> m (f Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[(ByteString, ByteString)] -> m (f Status)
Database.Redis.mset (NonEmpty (ByteString, ByteString) -> [(ByteString, ByteString)]
forall a. NonEmpty a -> [a]
NonEmpty.toList (((Text, ByteString) -> (ByteString, ByteString))
-> NonEmpty (Text, ByteString) -> NonEmpty (ByteString, ByteString)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (\(Text
key, ByteString
val) -> (Text -> ByteString
toB Text
key, ByteString
val)) NonEmpty (Text, ByteString)
vals))
        m (f Status)
-> (m (f Status) -> PreparedQuery m f Status)
-> PreparedQuery m f Status
forall a b. a -> (a -> b) -> b
|> m (f Status) -> PreparedQuery m f Status
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Status
-> (PreparedQuery m f Status
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error result)
-> PreparedQuery m f Status
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> result -> Result Error result
forall error value. value -> Result error value
Ok ())
    Query result
Internal.Ping ->
      m (f Status)
forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Status)
Database.Redis.ping
        m (f Status)
-> (m (f Status) -> PreparedQuery m f Status)
-> PreparedQuery m f Status
forall a b. a -> (a -> b) -> b
|> m (f Status) -> PreparedQuery m f Status
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Status
-> (PreparedQuery m f Status
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error result)
-> PreparedQuery m f Status
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Status -> Result Error result
Status -> Result Error Status
forall error value. value -> Result error value
Ok
    Internal.Pure result
x ->
      Result Error result -> PreparedQuery m f (Result Error result)
forall a. a -> PreparedQuery m f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (result -> Result Error result
forall error value. value -> Result error value
Ok result
x)
    Internal.Rpush Text
key NonEmpty ByteString
vals ->
      ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Database.Redis.rpush (Text -> ByteString
toB Text
key) (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
vals)
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
    Internal.Scan Cursor
cursor Maybe Text
maybeMatch Maybe Int
maybeCount ->
      Maybe ByteString -> Maybe Integer -> ScanOpts
Database.Redis.ScanOpts ((Text -> ByteString) -> Maybe Text -> Maybe ByteString
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> ByteString
toB Maybe Text
maybeMatch) ((Int -> Integer) -> Maybe Int -> Maybe Integer
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Int
maybeCount)
        ScanOpts
-> (ScanOpts -> m (f (Cursor, [ByteString])))
-> m (f (Cursor, [ByteString]))
forall a b. a -> (a -> b) -> b
|> Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
Database.Redis.scanOpts Cursor
cursor
        m (f (Cursor, [ByteString]))
-> (m (f (Cursor, [ByteString]))
    -> PreparedQuery m f (Cursor, [ByteString]))
-> PreparedQuery m f (Cursor, [ByteString])
forall a b. a -> (a -> b) -> b
|> m (f (Cursor, [ByteString]))
-> PreparedQuery m f (Cursor, [ByteString])
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f (Cursor, [ByteString])
-> (PreparedQuery m f (Cursor, [ByteString])
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> ((Cursor, [ByteString]) -> Result Error result)
-> PreparedQuery m f (Cursor, [ByteString])
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map
          ( \(Cursor
nextCursor, [ByteString]
byteKeys) ->
              [ByteString]
byteKeys
                [ByteString]
-> ([ByteString] -> Result Error [Text]) -> Result Error [Text]
forall a b. a -> (a -> b) -> b
|> (ByteString -> Result Error Text)
-> [ByteString] -> Result Error [Text]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
Prelude.traverse
                  ( \ByteString
byteKey -> case ByteString -> Either UnicodeException Text
Data.Text.Encoding.decodeUtf8' ByteString
byteKey of
                      Prelude.Right Text
textKey -> Text -> Result Error Text
forall error value. value -> Result error value
Ok Text
textKey
                      Prelude.Left UnicodeException
_ -> Error -> Result Error Text
forall error value. error -> Result error value
Err (Text -> Error
Internal.LibraryError Text
"key exists but not parsable text")
                  )
                Result Error [Text]
-> (Result Error [Text] -> Result Error result)
-> Result Error result
forall a b. a -> (a -> b) -> b
|> ([Text] -> result) -> Result Error [Text] -> Result Error result
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\[Text]
textKeys -> (Cursor
nextCursor, [Text]
textKeys))
          )
    Internal.Set Text
key ByteString
val ->
      ByteString -> ByteString -> m (f Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Database.Redis.set (Text -> ByteString
toB Text
key) ByteString
val
        m (f Status)
-> (m (f Status) -> PreparedQuery m f Status)
-> PreparedQuery m f Status
forall a b. a -> (a -> b) -> b
|> m (f Status) -> PreparedQuery m f Status
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Status
-> (PreparedQuery m f Status
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error result)
-> PreparedQuery m f Status
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> result -> Result Error result
forall error value. value -> Result error value
Ok ())
    Internal.Setex Text
key Int
seconds ByteString
val ->
      ByteString -> Integer -> ByteString -> m (f Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> ByteString -> m (f Status)
Database.Redis.setex (Text -> ByteString
toB Text
key) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
seconds) ByteString
val
        m (f Status)
-> (m (f Status) -> PreparedQuery m f Status)
-> PreparedQuery m f Status
forall a b. a -> (a -> b) -> b
|> m (f Status) -> PreparedQuery m f Status
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Status
-> (PreparedQuery m f Status
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error result)
-> PreparedQuery m f Status
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> result -> Result Error result
forall error value. value -> Result error value
Ok ())
    Internal.Setnx Text
key ByteString
val ->
      ByteString -> ByteString -> m (f Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Bool)
Database.Redis.setnx (Text -> ByteString
toB Text
key) ByteString
val
        m (f Bool)
-> (m (f Bool) -> PreparedQuery m f Bool) -> PreparedQuery m f Bool
forall a b. a -> (a -> b) -> b
|> m (f Bool) -> PreparedQuery m f Bool
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Bool
-> (PreparedQuery m f Bool
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error result)
-> PreparedQuery m f Bool
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Bool -> Result Error result
Bool -> Result Error Bool
forall error value. value -> Result error value
Ok
    Internal.Sadd Text
key NonEmpty ByteString
vals ->
      ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Database.Redis.sadd (Text -> ByteString
toB Text
key) (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
vals)
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
    Internal.Scard Text
key ->
      ByteString -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
Database.Redis.scard (Text -> ByteString
toB Text
key)
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
    Internal.Srem Text
key NonEmpty ByteString
vals ->
      ByteString -> [ByteString] -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Database.Redis.srem (Text -> ByteString
toB Text
key) (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
vals)
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
    Internal.Sismember Text
key ByteString
val ->
      ByteString -> ByteString -> m (f Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Bool)
Database.Redis.sismember (Text -> ByteString
toB Text
key) ByteString
val
        m (f Bool)
-> (m (f Bool) -> PreparedQuery m f Bool) -> PreparedQuery m f Bool
forall a b. a -> (a -> b) -> b
|> m (f Bool) -> PreparedQuery m f Bool
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Bool
-> (PreparedQuery m f Bool
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error result)
-> PreparedQuery m f Bool
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Bool -> Result Error result
Bool -> Result Error Bool
forall error value. value -> Result error value
Ok
    Internal.Smembers Text
key ->
      ByteString -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [ByteString])
Database.Redis.smembers (Text -> ByteString
toB Text
key)
        m (f [ByteString])
-> (m (f [ByteString]) -> PreparedQuery m f [ByteString])
-> PreparedQuery m f [ByteString]
forall a b. a -> (a -> b) -> b
|> m (f [ByteString]) -> PreparedQuery m f [ByteString]
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f [ByteString]
-> (PreparedQuery m f [ByteString]
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> ([ByteString] -> Result Error result)
-> PreparedQuery m f [ByteString]
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [ByteString] -> Result Error result
[ByteString] -> Result Error [ByteString]
forall error value. value -> Result error value
Ok
    Internal.Zadd Text
key Dict ByteString Float
vals ->
      Dict ByteString Float -> List (ByteString, Float)
forall k v. Dict k v -> List (k, v)
Dict.toList Dict ByteString Float
vals
        List (ByteString, Float)
-> (List (ByteString, Float) -> List (Float, ByteString))
-> List (Float, ByteString)
forall a b. a -> (a -> b) -> b
|> ((ByteString, Float) -> (Float, ByteString))
-> List (ByteString, Float) -> List (Float, ByteString)
forall a b. (a -> b) -> List a -> List b
List.map (\(ByteString
a, Float
b) -> (Float
b, ByteString
a))
        List (Float, ByteString)
-> (List (Float, ByteString) -> m (f Integer)) -> m (f Integer)
forall a b. a -> (a -> b) -> b
|> ByteString -> List (Float, ByteString) -> m (f Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> List (Float, ByteString) -> m (f Integer)
Database.Redis.zadd (Text -> ByteString
toB Text
key)
        m (f Integer)
-> (m (f Integer) -> PreparedQuery m f Integer)
-> PreparedQuery m f Integer
forall a b. a -> (a -> b) -> b
|> m (f Integer) -> PreparedQuery m f Integer
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f Integer
-> (PreparedQuery m f Integer
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error result)
-> PreparedQuery m f Integer
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Integer -> result) -> Integer -> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Integer -> result
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
    Internal.Zrange Text
key Int
start Int
stop ->
      ByteString -> Integer -> Integer -> m (f [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [ByteString])
Database.Redis.zrange
        (Text -> ByteString
toB Text
key)
        (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
start)
        (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Int
stop)
        m (f [ByteString])
-> (m (f [ByteString]) -> PreparedQuery m f [ByteString])
-> PreparedQuery m f [ByteString]
forall a b. a -> (a -> b) -> b
|> m (f [ByteString]) -> PreparedQuery m f [ByteString]
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f [ByteString]
-> (PreparedQuery m f [ByteString]
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> ([ByteString] -> Result Error result)
-> PreparedQuery m f [ByteString]
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [ByteString] -> Result Error result
[ByteString] -> Result Error [ByteString]
forall error value. value -> Result error value
Ok
    Internal.ZrangeByScoreWithScores Text
key Float
start Float
stop ->
      ByteString -> Float -> Float -> m (f (List (ByteString, Float)))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Float -> Float -> m (f (List (ByteString, Float)))
Database.Redis.zrangebyscoreWithscores
        (Text -> ByteString
toB Text
key)
        Float
start
        Float
stop
        m (f (List (ByteString, Float)))
-> (m (f (List (ByteString, Float)))
    -> PreparedQuery m f (List (ByteString, Float)))
-> PreparedQuery m f (List (ByteString, Float))
forall a b. a -> (a -> b) -> b
|> m (f (List (ByteString, Float)))
-> PreparedQuery m f (List (ByteString, Float))
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f (List (ByteString, Float))
-> (PreparedQuery m f (List (ByteString, Float))
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (List (ByteString, Float) -> Result Error result)
-> PreparedQuery m f (List (ByteString, Float))
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map List (ByteString, Float) -> Result Error result
List (ByteString, Float) -> Result Error (List (ByteString, Float))
forall error value. value -> Result error value
Ok
    Internal.Zrank Text
key ByteString
member ->
      ByteString -> ByteString -> m (f (Maybe Integer))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe Integer))
Database.Redis.zrank (Text -> ByteString
toB Text
key) ByteString
member
        m (f (Maybe Integer))
-> (m (f (Maybe Integer)) -> PreparedQuery m f (Maybe Integer))
-> PreparedQuery m f (Maybe Integer)
forall a b. a -> (a -> b) -> b
|> m (f (Maybe Integer)) -> PreparedQuery m f (Maybe Integer)
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f (Maybe Integer)
-> (PreparedQuery m f (Maybe Integer)
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Maybe Integer -> Result Error result)
-> PreparedQuery m f (Maybe Integer)
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Maybe Integer -> result)
-> Maybe Integer
-> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Integer -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
    Internal.Zrevrank Text
key ByteString
member ->
      ByteString -> ByteString -> m (f (Maybe Integer))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe Integer))
Database.Redis.zrevrank (Text -> ByteString
toB Text
key) ByteString
member
        m (f (Maybe Integer))
-> (m (f (Maybe Integer)) -> PreparedQuery m f (Maybe Integer))
-> PreparedQuery m f (Maybe Integer)
forall a b. a -> (a -> b) -> b
|> m (f (Maybe Integer)) -> PreparedQuery m f (Maybe Integer)
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
        PreparedQuery m f (Maybe Integer)
-> (PreparedQuery m f (Maybe Integer)
    -> PreparedQuery m f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall a b. a -> (a -> b) -> b
|> (Maybe Integer -> Result Error result)
-> PreparedQuery m f (Maybe Integer)
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (result -> Result Error result
forall error value. value -> Result error value
Ok (result -> Result Error result)
-> (Maybe Integer -> result)
-> Maybe Integer
-> Result Error result
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< (Integer -> Int) -> Maybe Integer -> Maybe Int
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Integer -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral)
    Internal.WithResult a1 -> Result Error result
f Query a1
q ->
      let PreparedQuery m (f (Result Error a1))
redisCtx = Query a1 -> PreparedQuery m f (Result Error a1)
forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query a1
q
       in m (f (Result Error result))
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
            ( ((f (Result Error a1) -> f (Result Error result))
-> m (f (Result Error a1)) -> m (f (Result Error result))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map ((f (Result Error a1) -> f (Result Error result))
 -> m (f (Result Error a1)) -> m (f (Result Error result)))
-> ((Result Error a1 -> Result Error result)
    -> f (Result Error a1) -> f (Result Error result))
-> (Result Error a1 -> Result Error result)
-> m (f (Result Error a1))
-> m (f (Result Error result))
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< (Result Error a1 -> Result Error result)
-> f (Result Error a1) -> f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map)
                ( \Result Error a1
result -> case Result Error a1
result of
                    Err Error
a -> Error -> Result Error result
forall error value. error -> Result error value
Err Error
a
                    Ok a1
res -> a1 -> Result Error result
f a1
res
                )
                m (f (Result Error a1))
redisCtx
            )

releaseHandler :: (Internal.Handler' x, Connection) -> IO ()
releaseHandler :: forall (x :: HasAutoExtendExpire).
(Handler' x, Connection) -> IO ()
releaseHandler (Handler' x
_, Connection {Connection
connectionHedis :: Connection -> Connection
connectionHedis :: Connection
connectionHedis}) = Connection -> IO ()
Database.Redis.disconnect Connection
connectionHedis

data Connection = Connection
  { Connection -> Connection
connectionHedis :: Database.Redis.Connection,
    Connection -> Text
connectionHost :: Text,
    Connection -> Maybe Int
connectionPort :: Maybe Int
  }

platformRedis ::
  (Stack.HasCallStack) =>
  [Text] ->
  Connection ->
  Platform.DoAnythingHandler ->
  Settings.QueryTimeout ->
  Database.Redis.Redis (Either Database.Redis.Reply (Result Internal.Error a)) ->
  Task Internal.Error a
platformRedis :: forall a.
HasCallStack =>
[Text]
-> Connection
-> Handler
-> QueryTimeout
-> Redis (Either Reply (Result Error a))
-> Task Error a
platformRedis [Text]
cmds Connection
connection Handler
anything QueryTimeout
queryTimeout Redis (Either Reply (Result Error a))
action =
  Connection
-> Redis (Either Reply (Result Error a))
-> IO (Either Reply (Result Error a))
forall a. Connection -> Redis a -> IO a
Database.Redis.runRedis (Connection -> Connection
connectionHedis Connection
connection) Redis (Either Reply (Result Error a))
action
    IO (Either Reply (Result Error a))
-> (IO (Either Reply (Result Error a))
    -> IO (Result Error (Result Error a)))
-> IO (Result Error (Result Error a))
forall a b. a -> (a -> b) -> b
|> (Either Reply (Result Error a) -> Result Error (Result Error a))
-> IO (Either Reply (Result Error a))
-> IO (Result Error (Result Error a))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Either Reply (Result Error a) -> Result Error (Result Error a)
forall a. Either Reply a -> Result Error a
toResult
    IO (Result Error (Result Error a))
-> (IO (Result Error (Result Error a)) -> IO (Result Error a))
-> IO (Result Error a)
forall a b. a -> (a -> b) -> b
|> (Result Error (Result Error a) -> Result Error a)
-> IO (Result Error (Result Error a)) -> IO (Result Error a)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map
      ( \Result Error (Result Error a)
result ->
          case Result Error (Result Error a)
result of
            Ok Result Error a
a -> Result Error a
a
            Err Error
err -> Error -> Result Error a
forall error value. error -> Result error value
Err Error
err
      )
    IO (Result Error a)
-> (IO (Result Error a) -> IO (Result Error a))
-> IO (Result Error a)
forall a b. a -> (a -> b) -> b
|> IO (Result Error a) -> IO (Result Error a)
forall value. IO (Result Error value) -> IO (Result Error value)
handleExceptions
    IO (Result Error a)
-> (IO (Result Error a) -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> Handler -> IO (Result Error a) -> Task Error a
forall e a. Handler -> IO (Result e a) -> Task e a
Platform.doAnything Handler
anything
    Task Error a -> (Task Error a -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (HasCallStack =>
 QueryTimeout
 -> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a)
-> QueryTimeout
-> [Text]
-> Text
-> Maybe Int
-> Task Error a
-> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack =>
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
forall a.
HasCallStack =>
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
Internal.wrapQuery QueryTimeout
queryTimeout [Text]
cmds (Connection -> Text
connectionHost Connection
connection) (Connection -> Maybe Int
connectionPort Connection
connection)

toResult :: Either Database.Redis.Reply a -> Result Internal.Error a
toResult :: forall a. Either Reply a -> Result Error a
toResult Either Reply a
reply =
  case Either Reply a
reply of
    Left (Database.Redis.Error ByteString
err) -> Error -> Result Error a
forall error value. error -> Result error value
Err (Text -> Error
Internal.RedisError (Text -> Error) -> Text -> Error
forall a b. (a -> b) -> a -> b
<| ByteString -> Text
Data.Text.Encoding.decodeUtf8 ByteString
err)
    Left Reply
err -> Error -> Result Error a
forall error value. error -> Result error value
Err (Text -> Error
Internal.RedisError (Text
"Redis library got back a value with a type it didn't expect: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ List Char -> Text
Text.fromList (Reply -> List Char
forall a. Show a => a -> List Char
Prelude.show Reply
err)))
    Right a
r -> a -> Result Error a
forall error value. value -> Result error value
Ok a
r

handleExceptions :: IO (Result Internal.Error value) -> IO (Result Internal.Error value)
handleExceptions :: forall value. IO (Result Error value) -> IO (Result Error value)
handleExceptions =
  (ConnectionLostException -> IO (Result Error value))
-> IO (Result Error value) -> IO (Result Error value)
forall (m :: * -> *) e a.
(HasCallStack, MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
Exception.handle (\(ConnectionLostException
_ :: Database.Redis.ConnectionLostException) -> Result Error value -> IO (Result Error value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Error value -> IO (Result Error value))
-> Result Error value -> IO (Result Error value)
forall a b. (a -> b) -> a -> b
<| Error -> Result Error value
forall error value. error -> Result error value
Err Error
Internal.ConnectionLost)
    (IO (Result Error value) -> IO (Result Error value))
-> (IO (Result Error value) -> IO (Result Error value))
-> IO (Result Error value)
-> IO (Result Error value)
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> (SomeException -> IO (Result Error value))
-> IO (Result Error value) -> IO (Result Error value)
forall (m :: * -> *) a.
(HasCallStack, MonadCatch m) =>
(SomeException -> m a) -> m a -> m a
Exception.handleAny
      ( \SomeException
err ->
          SomeException -> List Char
forall e. Exception e => e -> List Char
Exception.displayException SomeException
err
            List Char -> (List Char -> Text) -> Text
forall a b. a -> (a -> b) -> b
|> List Char -> Text
Text.fromList
            Text -> (Text -> Error) -> Error
forall a b. a -> (a -> b) -> b
|> Text -> Error
Internal.LibraryError
            Error -> (Error -> Result Error value) -> Result Error value
forall a b. a -> (a -> b) -> b
|> Error -> Result Error value
forall error value. error -> Result error value
Err
            Result Error value
-> (Result Error value -> IO (Result Error value))
-> IO (Result Error value)
forall a b. a -> (a -> b) -> b
|> Result Error value -> IO (Result Error value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      )

-- | Run a script in Redis trying to leverage the script cache
platformRedisScript ::
  (Stack.HasCallStack, Database.Redis.RedisResult a) =>
  Script.Script a ->
  Connection ->
  Platform.DoAnythingHandler ->
  Settings.QueryTimeout ->
  Task Internal.Error a
platformRedisScript :: forall a.
(HasCallStack, RedisResult a) =>
Script a -> Connection -> Handler -> QueryTimeout -> Task Error a
platformRedisScript Script a
script Connection
connection Handler
anything QueryTimeout
queryTimeout = do
  -- Try EVALSHA
  Script a -> Connection -> Handler -> QueryTimeout -> Task Error a
forall a.
(HasCallStack, RedisResult a) =>
Script a -> Connection -> Handler -> QueryTimeout -> Task Error a
evalsha Script a
script Connection
connection Handler
anything QueryTimeout
queryTimeout
    Task Error a -> (Task Error a -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (Error -> Task Error a) -> Task Error a -> Task Error a
forall x y a. (x -> Task y a) -> Task x a -> Task y a
Task.onError
      ( \Error
err ->
          case Error
err of
            Internal.RedisError Text
"NOSCRIPT No matching script. Please use EVAL." -> do
              -- If it fails with NOSCRIPT, load the script and try again
              Script a -> Connection -> Handler -> QueryTimeout -> Task Error ()
forall a.
HasCallStack =>
Script a -> Connection -> Handler -> QueryTimeout -> Task Error ()
loadScript Script a
script Connection
connection Handler
anything QueryTimeout
queryTimeout
              Script a -> Connection -> Handler -> QueryTimeout -> Task Error a
forall a.
(HasCallStack, RedisResult a) =>
Script a -> Connection -> Handler -> QueryTimeout -> Task Error a
evalsha Script a
script Connection
connection Handler
anything QueryTimeout
queryTimeout
            Error
_ -> Error -> Task Error a
forall x a. x -> Task x a
Task.fail Error
err
      )

evalsha ::
  (Stack.HasCallStack, Database.Redis.RedisResult a) =>
  Script.Script a ->
  Connection ->
  Platform.DoAnythingHandler ->
  Settings.QueryTimeout ->
  Task Internal.Error a
evalsha :: forall a.
(HasCallStack, RedisResult a) =>
Script a -> Connection -> Handler -> QueryTimeout -> Task Error a
evalsha Script a
script Connection
connection Handler
anything QueryTimeout
queryTimeout =
  ByteString
-> [ByteString] -> [ByteString] -> Redis (Either Reply a)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
ByteString -> [ByteString] -> [ByteString] -> m (f a)
Database.Redis.evalsha
    (Text -> ByteString
toB (Script a -> Text
forall a. Script a -> Text
Script.luaScriptHash Script a
script))
    ((Text -> ByteString) -> [Text] -> [ByteString]
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> ByteString
toB (Script a -> [Text]
forall result. Script result -> [Text]
Script.keys Script a
script))
    ((Text -> ByteString) -> [Text] -> [ByteString]
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Text -> ByteString
toB (Secret [Text] -> [Text]
forall a. Secret a -> a
Log.unSecret (Script a -> Secret [Text]
forall result. Script result -> Secret [Text]
Script.arguments Script a
script)))
    Redis (Either Reply a)
-> (Redis (Either Reply a) -> IO (Either Reply a))
-> IO (Either Reply a)
forall a b. a -> (a -> b) -> b
|> Connection -> Redis (Either Reply a) -> IO (Either Reply a)
forall a. Connection -> Redis a -> IO a
Database.Redis.runRedis (Connection -> Connection
connectionHedis Connection
connection)
    IO (Either Reply a)
-> (IO (Either Reply a) -> IO (Result Error a))
-> IO (Result Error a)
forall a b. a -> (a -> b) -> b
|> (Either Reply a -> Result Error a)
-> IO (Either Reply a) -> IO (Result Error a)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Either Reply a -> Result Error a
forall a. Either Reply a -> Result Error a
toResult
    IO (Result Error a)
-> (IO (Result Error a) -> IO (Result Error a))
-> IO (Result Error a)
forall a b. a -> (a -> b) -> b
|> IO (Result Error a) -> IO (Result Error a)
forall value. IO (Result Error value) -> IO (Result Error value)
handleExceptions
    IO (Result Error a)
-> (IO (Result Error a) -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> Handler -> IO (Result Error a) -> Task Error a
forall e a. Handler -> IO (Result e a) -> Task e a
Platform.doAnything Handler
anything
    Task Error a -> (Task Error a -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (HasCallStack =>
 QueryTimeout
 -> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a)
-> QueryTimeout
-> [Text]
-> Text
-> Maybe Int
-> Task Error a
-> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack =>
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
forall a.
HasCallStack =>
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
Internal.wrapQuery QueryTimeout
queryTimeout [Script a -> Text
forall a. Script a -> Text
Script.evalShaString Script a
script] (Connection -> Text
connectionHost Connection
connection) (Connection -> Maybe Int
connectionPort Connection
connection)

loadScript ::
  (Stack.HasCallStack) =>
  Script.Script a ->
  Connection ->
  Platform.DoAnythingHandler ->
  Settings.QueryTimeout ->
  Task Internal.Error ()
loadScript :: forall a.
HasCallStack =>
Script a -> Connection -> Handler -> QueryTimeout -> Task Error ()
loadScript Script a
script Connection
connection Handler
anything QueryTimeout
queryTimeout = do
  ByteString -> Redis (Either Reply ByteString)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f ByteString)
Database.Redis.scriptLoad (Text -> ByteString
toB (Script a -> Text
forall a. Script a -> Text
Script.luaScript Script a
script))
    Redis (Either Reply ByteString)
-> (Redis (Either Reply ByteString)
    -> IO (Either Reply ByteString))
-> IO (Either Reply ByteString)
forall a b. a -> (a -> b) -> b
|> Connection
-> Redis (Either Reply ByteString) -> IO (Either Reply ByteString)
forall a. Connection -> Redis a -> IO a
Database.Redis.runRedis (Connection -> Connection
connectionHedis Connection
connection)
    IO (Either Reply ByteString)
-> (IO (Either Reply ByteString) -> IO (Result Error ByteString))
-> IO (Result Error ByteString)
forall a b. a -> (a -> b) -> b
|> (Either Reply ByteString -> Result Error ByteString)
-> IO (Either Reply ByteString) -> IO (Result Error ByteString)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map Either Reply ByteString -> Result Error ByteString
forall a. Either Reply a -> Result Error a
toResult
    IO (Result Error ByteString)
-> (IO (Result Error ByteString) -> IO (Result Error ByteString))
-> IO (Result Error ByteString)
forall a b. a -> (a -> b) -> b
|> IO (Result Error ByteString) -> IO (Result Error ByteString)
forall value. IO (Result Error value) -> IO (Result Error value)
handleExceptions
    -- The result is the hash, which we already have. No sense in decoding it.
    IO (Result Error ByteString)
-> (IO (Result Error ByteString) -> IO (Result Error ()))
-> IO (Result Error ())
forall a b. a -> (a -> b) -> b
|> (Result Error ByteString -> Result Error ())
-> IO (Result Error ByteString) -> IO (Result Error ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map ((ByteString -> ()) -> Result Error ByteString -> Result Error ()
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\ByteString
_ -> ()))
    IO (Result Error ())
-> (IO (Result Error ()) -> Task Error ()) -> Task Error ()
forall a b. a -> (a -> b) -> b
|> Handler -> IO (Result Error ()) -> Task Error ()
forall e a. Handler -> IO (Result e a) -> Task e a
Platform.doAnything Handler
anything
    Task Error () -> (Task Error () -> Task Error ()) -> Task Error ()
forall a b. a -> (a -> b) -> b
|> (HasCallStack =>
 QueryTimeout
 -> [Text] -> Text -> Maybe Int -> Task Error () -> Task Error ())
-> QueryTimeout
-> [Text]
-> Text
-> Maybe Int
-> Task Error ()
-> Task Error ()
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack =>
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error () -> Task Error ()
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error () -> Task Error ()
forall a.
HasCallStack =>
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
Internal.wrapQuery QueryTimeout
queryTimeout [Script a -> Text
forall a. Script a -> Text
Script.scriptLoadString Script a
script] (Connection -> Text
connectionHost Connection
connection) (Connection -> Maybe Int
connectionPort Connection
connection)

toB :: Text -> Data.ByteString.ByteString
toB :: Text -> ByteString
toB = Text -> ByteString
Data.Text.Encoding.encodeUtf8