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

module Redis.Real
  ( handler,
  )
where

import qualified Control.Exception.Safe as Exception
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 GHC.Stack as Stack
import qualified Platform
import qualified Redis.Internal as Internal
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)
acquireHandler Text
namespace Settings
settings) (Handler, Connection) -> IO ()
releaseHandler
  Handler
namespacedHandler
    Handler -> (Handler -> Handler) -> Handler
forall a b. a -> (a -> b) -> b
|> ( \Handler
handler' ->
           case Settings -> DefaultExpiry
Settings.defaultExpiry Settings
settings of
             DefaultExpiry
Settings.NoDefaultExpiry -> Handler
handler'
             Settings.ExpireKeysAfterSeconds Int
secs ->
               Int -> Handler -> Handler
defaultExpiryKeysAfterSeconds Int
secs Handler
handler'
       )
    Handler -> (Handler -> Handler) -> Handler
forall a b. a -> (a -> b) -> b
|> ( \Handler
handler' ->
           case Settings -> QueryTimeout
Settings.queryTimeout Settings
settings of
             QueryTimeout
Settings.NoQueryTimeout -> Handler
handler'
             Settings.TimeoutQueryAfterMilliseconds Int
milliseconds ->
               Float -> Handler -> Handler
timeoutAfterMilliseconds (Int -> Float
toFloat Int
milliseconds) Handler
handler'
       )
    Handler -> (Handler -> Acquire Handler) -> Acquire Handler
forall a b. a -> (a -> b) -> b
|> Handler -> Acquire Handler
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure

timeoutAfterMilliseconds :: Float -> Internal.Handler -> Internal.Handler
timeoutAfterMilliseconds :: Float -> Handler -> Handler
timeoutAfterMilliseconds Float
milliseconds Handler
handler' =
  Handler
handler'
    { doQuery :: forall a. HasCallStack => Query a -> Task Error a
Internal.doQuery =
        (HasCallStack => Query a -> Task Error a)
-> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (Handler -> forall a. HasCallStack => Query a -> Task Error a
Internal.doQuery Handler
handler')
          (Query a -> Task Error a)
-> (Task Error a -> Task Error a) -> Query a -> Task Error a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Float -> Error -> Task Error a -> Task Error a
forall err a. Float -> err -> Task err a -> Task err a
Task.timeout Float
milliseconds Error
Internal.TimeoutError,
      doTransaction :: forall a. HasCallStack => Query a -> Task Error a
Internal.doTransaction =
        (HasCallStack => Query a -> Task Error a)
-> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (Handler -> forall a. HasCallStack => Query a -> Task Error a
Internal.doTransaction Handler
handler')
          (Query a -> Task Error a)
-> (Task Error a -> Task Error a) -> Query a -> Task Error a
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Float -> Error -> Task Error a -> Task Error a
forall err a. Float -> err -> Task err a -> Task err a
Task.timeout Float
milliseconds Error
Internal.TimeoutError
    }

defaultExpiryKeysAfterSeconds :: Int -> Internal.Handler -> Internal.Handler
defaultExpiryKeysAfterSeconds :: Int -> Handler -> Handler
defaultExpiryKeysAfterSeconds Int
secs Handler
handler' =
  let wrapWithExpire :: Internal.Query a -> Internal.Query a
      wrapWithExpire :: 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 -> List Text) -> List Text
forall a b. a -> (a -> b) -> b
|> Set Text -> List Text
forall a. Set a -> List a
Set.toList
          List Text -> (List Text -> List (Query ())) -> List (Query ())
forall a b. a -> (a -> b) -> b
|> (Text -> Query ()) -> List 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 Handler
handler'
        { doQuery :: forall a. HasCallStack => Query a -> Task Error a
Internal.doQuery = \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 => Query a -> Task Error a)
-> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (Handler -> forall a. HasCallStack => Query a -> Task Error a
Internal.doQuery Handler
handler'),
          doTransaction :: forall a. HasCallStack => Query a -> Task Error a
Internal.doTransaction = \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 => Query a -> Task Error a)
-> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (Handler -> forall a. HasCallStack => Query a -> Task Error a
Internal.doTransaction Handler
handler')
        }

acquireHandler :: Text -> Settings.Settings -> IO (Internal.Handler, Connection)
acquireHandler :: Text -> Settings -> IO (Handler, 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 (f :: * -> *) a. Applicative f => a -> f a
pure Connection :: Connection -> Text -> Maybe Int -> Connection
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, Connection) -> IO (Handler, Connection)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( Handler :: (forall a. HasCallStack => Query a -> Task Error a)
-> (forall a. HasCallStack => Query a -> Task Error a)
-> Text
-> MaxKeySize
-> Handler
Internal.Handler
        { doQuery :: forall a. HasCallStack => Query a -> Task Error a
Internal.doQuery = \Query a
query ->
            let PreparedQuery {Redis (Either Reply (Result Error a))
redisCtx :: forall (m :: * -> *) (f :: * -> *) result.
PreparedQuery m f result -> m (f result)
redisCtx :: Redis (Either Reply (Result Error a))
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 =>
 List Text
 -> Connection
 -> Handler
 -> Redis (Either Reply (Result Error a))
 -> Task Error a)
-> List Text
-> Connection
-> Handler
-> Redis (Either Reply (Result Error a))
-> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack =>
List Text
-> Connection
-> Handler
-> Redis (Either Reply (Result Error a))
-> Task Error a
forall a.
HasCallStack =>
List Text
-> Connection
-> Handler
-> Redis (Either Reply (Result Error a))
-> Task Error a
platformRedis (Query a -> List Text
forall b. Query b -> List Text
Internal.cmds Query a
query) Connection
connection Handler
anything Redis (Either Reply (Result Error a))
redisCtx,
          doTransaction :: forall a. HasCallStack => Query a -> Task Error a
Internal.doTransaction = \Query a
query ->
            let PreparedQuery {RedisTx (Queued (Result Error a))
redisCtx :: RedisTx (Queued (Result Error a))
redisCtx :: forall (m :: * -> *) (f :: * -> *) result.
PreparedQuery m f result -> m (f result)
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 (List Text
-> Connection
-> Handler
-> Redis (Either Reply (Result Error a))
-> Task Error a
forall a.
HasCallStack =>
List Text
-> Connection
-> Handler
-> Redis (Either Reply (Result Error a))
-> Task Error a
platformRedis (Query a -> List Text
forall b. Query b -> List Text
Internal.cmds Query a
query) Connection
connection Handler
anything),
          namespace :: Text
Internal.namespace = Text
namespace,
          maxKeySize :: MaxKeySize
Internal.maxKeySize = Settings -> MaxKeySize
Settings.maxKeySize Settings
settings
        },
      Connection
connection
    )

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

instance (Prelude.Applicative m, Prelude.Applicative f) => Prelude.Applicative (PreparedQuery m f) where
  pure :: a -> PreparedQuery m f a
pure a
x =
    PreparedQuery :: forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
PreparedQuery
      { redisCtx :: m (f a)
redisCtx = f a -> m (f a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
      }
  PreparedQuery m f (a -> b)
f <*> :: PreparedQuery m f (a -> b)
-> PreparedQuery m f a -> PreparedQuery m f b
<*> PreparedQuery m f a
x =
    PreparedQuery :: forall (m :: * -> *) (f :: * -> *) result.
m (f result) -> PreparedQuery m f result
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 :: Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query result
query =
  case Query result
query of
    Internal.Apply Query (a -> result)
f Query a
x ->
      (Result Error (a -> result)
 -> Result Error a -> Result Error result)
-> PreparedQuery m f (Result Error (a -> result))
-> PreparedQuery m f (Result Error a)
-> PreparedQuery m f (Result Error result)
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
map2 (((a -> result) -> a -> result)
-> Result Error (a -> result)
-> Result Error a
-> Result Error result
forall (m :: * -> *) a b value.
Applicative m =>
(a -> b -> value) -> m a -> m b -> m value
map2 (a -> result) -> a -> result
forall a b. (a -> b) -> a -> b
(<|)) (Query (a -> result)
-> PreparedQuery m f (Result Error (a -> result))
forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query (a -> result)
f) (Query a -> PreparedQuery m f (Result Error a)
forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query a
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 Bool))
-> PreparedQuery m f (Result Error Bool)
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error Bool)
-> PreparedQuery m f Bool -> PreparedQuery m f (Result Error Bool)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map 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 ()))
-> PreparedQuery m f (Result Error ())
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error ())
-> PreparedQuery m f Bool -> PreparedQuery m f (Result Error ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Bool
_ -> () -> Result Error ()
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 (Maybe ByteString)))
-> PreparedQuery m f (Result Error (Maybe ByteString))
forall a b. a -> (a -> b) -> b
|> (Maybe ByteString -> Result Error (Maybe ByteString))
-> PreparedQuery m f (Maybe ByteString)
-> PreparedQuery m f (Result Error (Maybe ByteString))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map 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 (Maybe ByteString)))
-> PreparedQuery m f (Result Error (Maybe ByteString))
forall a b. a -> (a -> b) -> b
|> (Maybe ByteString -> Result Error (Maybe ByteString))
-> PreparedQuery m f (Maybe ByteString)
-> PreparedQuery m f (Result Error (Maybe ByteString))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map 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 (Maybe ByteString)))
-> PreparedQuery m f (Result Error (Maybe ByteString))
forall a b. a -> (a -> b) -> b
|> (Maybe ByteString -> Result Error (Maybe ByteString))
-> PreparedQuery m f (Maybe ByteString)
-> PreparedQuery m f (Result Error (Maybe ByteString))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map 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 [(Text, ByteString)]))
-> PreparedQuery m f (Result Error [(Text, ByteString)])
forall a b. a -> (a -> b) -> b
|> ([(ByteString, ByteString)] -> Result Error [(Text, ByteString)])
-> PreparedQuery m f [(ByteString, ByteString)]
-> PreparedQuery m f (Result Error [(Text, ByteString)])
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 [(Text, ByteString)])
-> Result Error [(Text, ByteString)]
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)
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 (List Text)))
-> PreparedQuery m f (Result Error (List Text))
forall a b. a -> (a -> b) -> b
|> ([ByteString] -> Result Error (List Text))
-> PreparedQuery m f [ByteString]
-> PreparedQuery m f (Result Error (List Text))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map
          ( (ByteString -> Result Error Text)
-> [ByteString] -> Result Error (List Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t 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 Bool))
-> PreparedQuery m f (Result Error Bool)
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error Bool)
-> PreparedQuery m f Bool -> PreparedQuery m f (Result Error Bool)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map 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 [Maybe ByteString]))
-> PreparedQuery m f (Result Error [Maybe ByteString])
forall a b. a -> (a -> b) -> b
|> ([Maybe ByteString] -> Result Error [Maybe ByteString])
-> PreparedQuery m f [Maybe ByteString]
-> PreparedQuery m f (Result Error [Maybe ByteString])
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [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 ()))
-> PreparedQuery m f (Result Error ())
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error ())
-> PreparedQuery m f Status -> PreparedQuery m f (Result Error ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> () -> Result Error ()
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 ()))
-> PreparedQuery m f (Result Error ())
forall a b. a -> (a -> b) -> b
|> (Integer -> Result Error ())
-> PreparedQuery m f Integer -> PreparedQuery m f (Result Error ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Integer
_ -> () -> Result Error ()
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 [ByteString]))
-> PreparedQuery m f (Result Error [ByteString])
forall a b. a -> (a -> b) -> b
|> ([ByteString] -> Result Error [ByteString])
-> PreparedQuery m f [ByteString]
-> PreparedQuery m f (Result Error [ByteString])
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [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 [Maybe ByteString]))
-> PreparedQuery m f (Result Error [Maybe ByteString])
forall a b. a -> (a -> b) -> b
|> ([Maybe ByteString] -> Result Error [Maybe ByteString])
-> PreparedQuery m f [Maybe ByteString]
-> PreparedQuery m f (Result Error [Maybe ByteString])
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [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 ()))
-> PreparedQuery m f (Result Error ())
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error ())
-> PreparedQuery m f Status -> PreparedQuery m f (Result Error ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> () -> Result Error ()
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 Status))
-> PreparedQuery m f (Result Error Status)
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error Status)
-> PreparedQuery m f Status
-> PreparedQuery m f (Result Error Status)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map 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 (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.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 ()))
-> PreparedQuery m f (Result Error ())
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error ())
-> PreparedQuery m f Status -> PreparedQuery m f (Result Error ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> () -> Result Error ()
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 ()))
-> PreparedQuery m f (Result Error ())
forall a b. a -> (a -> b) -> b
|> (Status -> Result Error ())
-> PreparedQuery m f Status -> PreparedQuery m f (Result Error ())
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> () -> Result Error ()
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 Bool))
-> PreparedQuery m f (Result Error Bool)
forall a b. a -> (a -> b) -> b
|> (Bool -> Result Error Bool)
-> PreparedQuery m f Bool -> PreparedQuery m f (Result Error Bool)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map 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.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 [ByteString]))
-> PreparedQuery m f (Result Error [ByteString])
forall a b. a -> (a -> b) -> b
|> ([ByteString] -> Result Error [ByteString])
-> PreparedQuery m f [ByteString]
-> PreparedQuery m f (Result Error [ByteString])
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map [ByteString] -> Result Error [ByteString]
forall error value. value -> Result error value
Ok
    Internal.WithResult a -> Result Error result
f Query a
q ->
      let PreparedQuery m (f (Result Error a))
redisCtx = Query a -> PreparedQuery m f (Result Error a)
forall (f :: * -> *) (m :: * -> *) result.
(Applicative f, RedisCtx m f) =>
Query result -> PreparedQuery m f (Result Error result)
doRawQuery Query a
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 a) -> f (Result Error result))
-> m (f (Result Error a)) -> m (f (Result Error result))
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map ((f (Result Error a) -> f (Result Error result))
 -> m (f (Result Error a)) -> m (f (Result Error result)))
-> ((Result Error a -> Result Error result)
    -> f (Result Error a) -> f (Result Error result))
-> (Result Error a -> Result Error result)
-> m (f (Result Error a))
-> m (f (Result Error result))
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< (Result Error a -> Result Error result)
-> f (Result Error a) -> f (Result Error result)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map)
                ( \Result Error a
result -> case Result Error a
result of
                    Err Error
a -> Error -> Result Error result
forall error value. error -> Result error value
Err Error
a
                    Ok a
res -> a -> Result Error result
f a
res
                )
                m (f (Result Error a))
redisCtx
            )

releaseHandler :: (Internal.Handler, Connection) -> IO ()
releaseHandler :: (Handler, Connection) -> IO ()
releaseHandler (Handler
_, Connection {Connection
connectionHedis :: Connection
connectionHedis :: Connection -> 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 ->
  Database.Redis.Redis (Either Database.Redis.Reply (Result Internal.Error a)) ->
  Task Internal.Error a
platformRedis :: List Text
-> Connection
-> Handler
-> Redis (Either Reply (Result Error a))
-> Task Error a
platformRedis List Text
cmds Connection
connection Handler
anything 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
|> (ConnectionLostException -> IO (Result Error a))
-> IO (Result Error a) -> IO (Result Error a)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
(e -> m a) -> m a -> m a
Exception.handle (\(ConnectionLostException
_ :: Database.Redis.ConnectionLostException) -> Result Error a -> IO (Result Error a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result Error a -> IO (Result Error a))
-> Result Error a -> IO (Result Error a)
forall a b. (a -> b) -> a -> b
<| Error -> Result Error a
forall error value. error -> Result error value
Err Error
Internal.ConnectionLost)
    IO (Result Error a)
-> (IO (Result Error a) -> IO (Result Error a))
-> IO (Result Error a)
forall a b. a -> (a -> b) -> b
|> (SomeException -> IO (Result Error a))
-> IO (Result Error a) -> IO (Result Error a)
forall (m :: * -> *) a.
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 a) -> Result Error a
forall a b. a -> (a -> b) -> b
|> Error -> Result Error a
forall error value. error -> Result error value
Err
            Result Error a
-> (Result Error a -> IO (Result Error a)) -> IO (Result Error a)
forall a b. a -> (a -> b) -> b
|> Result Error a -> IO (Result Error a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      )
    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 =>
 List Text -> Text -> Maybe Int -> Task Error a -> Task Error a)
-> List Text -> Text -> Maybe Int -> Task Error a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack =>
List Text -> Text -> Maybe Int -> Task Error a -> Task Error a
forall e a.
HasCallStack =>
List Text -> Text -> Maybe Int -> Task e a -> Task e a
Internal.traceQuery List Text
cmds (Connection -> Text
connectionHost Connection
connection) (Connection -> Maybe Int
connectionPort Connection
connection)

toResult :: Either Database.Redis.Reply a -> Result Internal.Error a
toResult :: 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

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