{-# 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
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)
}
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