{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE RankNTypes #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Redis.Internal
( Error (..),
Handler,
Handler' (..),
HandlerAutoExtendExpire,
HasAutoExtendExpire (..),
Query (..),
Database.Redis.Cursor,
Database.Redis.cursor0,
cmds,
map,
map2,
map3,
sequence,
query,
transaction,
eval,
foldWithScan,
wrapQuery,
maybesToDict,
keysTouchedByQuery,
)
where
import qualified Data.Aeson as Aeson
import Data.ByteString (ByteString)
import Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Text.Encoding
import qualified Database.Redis
import qualified Dict
import qualified GHC.Stack as Stack
import qualified List
import qualified Log.RedisCommands as RedisCommands
import NriPrelude hiding (map, map2, map3)
import qualified Platform
import qualified Redis.Script as Script
import qualified Redis.Settings as Settings
import qualified Set
import qualified Text
import qualified Tuple
import qualified Prelude
data Error
= RedisError Text
| ConnectionLost
| DecodingError Text
| DecodingFieldError Text
| LibraryError Text
| TransactionAborted
| TimeoutError
| KeyExceedsMaxSize Text Int
instance Aeson.ToJSON Error where
toJSON :: Error -> Value
toJSON Error
err = Text -> Value
forall a. ToJSON a => a -> Value
Aeson.toJSON (Error -> Text
errorForHumans Error
err)
instance Show Error where
show :: Error -> String
show = Error -> Text
errorForHumans (Error -> Text) -> (Text -> String) -> Error -> String
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> Text -> String
Text.toList
errorForHumans :: Error -> Text
errorForHumans :: Error -> Text
errorForHumans Error
topError =
case Error
topError of
RedisError Text
err -> Text
"Redis error: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
err
Error
ConnectionLost -> Text
"Connection Lost"
LibraryError Text
err -> Text
"Library error when executing (probably due to a bug in the library): " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
err
DecodingError Text
err -> Text
"Could not decode value in key: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
err
DecodingFieldError Text
err -> Text
"Could not decode field of hash: " Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
err
Error
TransactionAborted -> Text
"Transaction aborted."
Error
TimeoutError -> Text
"Redis query took too long."
KeyExceedsMaxSize Text
key Int
maxKeySize -> Text
"Redis key (" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
") exceeded max size (" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Int -> Text
Text.fromInt Int
maxKeySize Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
")."
cmds :: Query b -> [Text]
cmds :: forall b. Query b -> [Text]
cmds Query b
query'' =
case Query b
query'' of
Del NonEmpty Text
keys -> [[Text] -> Text
unwords (Text
"DEL" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
keys)]
Exists Text
key -> [[Text] -> Text
unwords [Text
"EXISTS", Text
key]]
Expire Text
key Int
val -> [[Text] -> Text
unwords [Text
"EXPIRE", Text
key, Int -> Text
Text.fromInt Int
val]]
Get Text
key -> [[Text] -> Text
unwords [Text
"GET", Text
key]]
Getset Text
key ByteString
_ -> [[Text] -> Text
unwords [Text
"GETSET", Text
key, Text
"*****"]]
Hdel Text
key NonEmpty Text
fields -> [[Text] -> Text
unwords (Text
"HDEL" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
fields)]
Hgetall Text
key -> [[Text] -> Text
unwords [Text
"HGETALL", Text
key]]
Hget Text
key Text
field -> [[Text] -> Text
unwords [Text
"HGET", Text
key, Text
field]]
Hkeys Text
key -> [[Text] -> Text
unwords [Text
"HKEY", Text
key]]
Hmget Text
key NonEmpty Text
fields -> [[Text] -> Text
unwords (Text
"HMGET" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
fields)]
Hmset Text
key NonEmpty (Text, ByteString)
pairs ->
[[Text] -> Text
unwords (Text
"HMSET" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text, ByteString) -> [Text]) -> [(Text, ByteString)] -> [Text]
forall a b. (a -> List b) -> List a -> List b
List.concatMap (\(Text
field, ByteString
_) -> [Text
field, Text
"*****"]) (NonEmpty (Text, ByteString) -> [(Text, ByteString)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Text, ByteString)
pairs))]
Hset Text
key Text
field ByteString
_ -> [[Text] -> Text
unwords [Text
"HSET", Text
key, Text
field, Text
"*****"]]
Hsetnx Text
key Text
field ByteString
_ -> [[Text] -> Text
unwords [Text
"HSETNX", Text
key, Text
field, Text
"*****"]]
Incr Text
key -> [[Text] -> Text
unwords [Text
"INCR", Text
key]]
Incrby Text
key Int
amount -> [[Text] -> Text
unwords [Text
"INCRBY", Text
key, Int -> Text
Text.fromInt Int
amount]]
Lrange Text
key Int
lower Int
upper -> [[Text] -> Text
unwords [Text
"LRANGE", Text
key, Int -> Text
Text.fromInt Int
lower, Int -> Text
Text.fromInt Int
upper]]
Mget NonEmpty Text
keys -> [[Text] -> Text
unwords (Text
"MGET" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
keys)]
Mset NonEmpty (Text, ByteString)
pairs -> [[Text] -> Text
unwords (Text
"MSET" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((Text, ByteString) -> [Text]) -> [(Text, ByteString)] -> [Text]
forall a b. (a -> List b) -> List a -> List b
List.concatMap (\(Text
key, ByteString
_) -> [Text
key, Text
"*****"]) (NonEmpty (Text, ByteString) -> [(Text, ByteString)]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Text, ByteString)
pairs))]
Query b
Ping -> [Text
"PING"]
Rpush Text
key NonEmpty ByteString
vals -> [[Text] -> Text
unwords (Text
"RPUSH" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map (\ByteString
_ -> Text
"*****") (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
vals))]
Scan Cursor
cursor Maybe Text
maybeMatch Maybe Int
maybeCount -> [Cursor -> Maybe Text -> Maybe Int -> Text
scanCmd Cursor
cursor Maybe Text
maybeMatch Maybe Int
maybeCount]
Set Text
key ByteString
_ -> [[Text] -> Text
unwords [Text
"SET", Text
key, Text
"*****"]]
Setex Text
key Int
seconds ByteString
_ -> [[Text] -> Text
unwords [Text
"SETEX", Text
key, Int -> Text
Text.fromInt Int
seconds, Text
"*****"]]
Setnx Text
key ByteString
_ -> [[Text] -> Text
unwords [Text
"SETNX", Text
key, Text
"*****"]]
Sadd Text
key NonEmpty ByteString
vals -> [[Text] -> Text
unwords (Text
"SADD" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map (\ByteString
_ -> Text
"*****") (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
vals))]
Scard Text
key -> [[Text] -> Text
unwords [Text
"SCARD", Text
key]]
Srem Text
key NonEmpty ByteString
vals -> [[Text] -> Text
unwords (Text
"SREM" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (ByteString -> Text) -> [ByteString] -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map (\ByteString
_ -> Text
"*****") (NonEmpty ByteString -> [ByteString]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
vals))]
Sismember Text
key ByteString
_ -> [[Text] -> Text
unwords [Text
"SISMEMBER", Text
key, Text
"*****"]]
Smembers Text
key -> [[Text] -> Text
unwords [Text
"SMEMBERS", Text
key]]
Zadd Text
key Dict ByteString Float
vals -> [[Text] -> Text
unwords (Text
"ZADD" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
key Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: ((ByteString, Float) -> [Text])
-> List (ByteString, Float) -> [Text]
forall a b. (a -> List b) -> List a -> List b
List.concatMap (\(ByteString
_, Float
val) -> [Text
"*****", Float -> Text
Text.fromFloat Float
val]) (Dict ByteString Float -> List (ByteString, Float)
forall k v. Dict k v -> List (k, v)
Dict.toList Dict ByteString Float
vals))]
Zrange Text
key Int
start Int
stop -> [[Text] -> Text
unwords [Text
"ZRANGE", Text
key, Int -> Text
Text.fromInt Int
start, Int -> Text
Text.fromInt Int
stop]]
ZrangeByScoreWithScores Text
key Float
start Float
stop -> [[Text] -> Text
unwords [Text
"ZRANGE", Text
key, Text
"BYSCORE", Float -> Text
Text.fromFloat Float
start, Float -> Text
Text.fromFloat Float
stop, Text
"WITHSCORES"]]
Zrank Text
key ByteString
_ -> [[Text] -> Text
unwords [Text
"ZRANK", Text
key, Text
"*****"]]
Zrevrank Text
key ByteString
_ -> [[Text] -> Text
unwords [Text
"ZREVRANK", Text
key, Text
"*****"]]
Pure b
_ -> []
Apply Query (a -> b)
f Query a
x -> Query (a -> b) -> [Text]
forall b. Query b -> [Text]
cmds Query (a -> b)
f [Text] -> [Text] -> [Text]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Query a -> [Text]
forall b. Query b -> [Text]
cmds Query a
x
WithResult a -> Result Error b
_ Query a
x -> Query a -> [Text]
forall b. Query b -> [Text]
cmds Query a
x
where
scanCmd :: Database.Redis.Cursor -> Maybe Text -> Maybe Int -> Text
scanCmd :: Cursor -> Maybe Text -> Maybe Int -> Text
scanCmd Cursor
cursor Maybe Text
maybeMatch Maybe Int
maybeCount =
let cursorWord :: Text
cursorWord =
String -> Text
Text.fromList (Cursor -> String
forall a. Show a => a -> String
Prelude.show Cursor
cursor)
matchWords :: [Text]
matchWords =
case Maybe Text
maybeMatch of
Maybe Text
Nothing -> []
Just Text
keyPattern -> [Text
"MATCH", Text
keyPattern]
countWords :: [Text]
countWords =
case Maybe Int
maybeCount of
Maybe Int
Nothing -> []
Just Int
c -> [Text
"COUNT", Int -> Text
Text.fromInt Int
c]
in [Text] -> Text
unwords (Text
"SCAN" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
cursorWord Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
matchWords [Text] -> [Text] -> [Text]
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ [Text]
countWords)
unwords :: [Text] -> Text
unwords :: [Text] -> Text
unwords = Text -> [Text] -> Text
Text.join Text
" "
data Query a where
Del :: NonEmpty Text -> Query Int
Exists :: Text -> Query Bool
Expire :: Text -> Int -> Query ()
Get :: Text -> Query (Maybe ByteString)
Getset :: Text -> ByteString -> Query (Maybe ByteString)
Hdel :: Text -> NonEmpty Text -> Query Int
Hgetall :: Text -> Query [(Text, ByteString)]
Hget :: Text -> Text -> Query (Maybe ByteString)
Hkeys :: Text -> Query [Text]
Hmget :: Text -> NonEmpty Text -> Query [Maybe ByteString]
Hmset :: Text -> NonEmpty (Text, ByteString) -> Query ()
Hset :: Text -> Text -> ByteString -> Query ()
Hsetnx :: Text -> Text -> ByteString -> Query Bool
Incr :: Text -> Query Int
Incrby :: Text -> Int -> Query Int
Lrange :: Text -> Int -> Int -> Query [ByteString]
Mget :: NonEmpty Text -> Query [Maybe ByteString]
Mset :: NonEmpty (Text, ByteString) -> Query ()
Ping :: Query Database.Redis.Status
Rpush :: Text -> NonEmpty ByteString -> Query Int
Scan :: Database.Redis.Cursor -> Maybe Text -> Maybe Int -> Query (Database.Redis.Cursor, [Text])
Set :: Text -> ByteString -> Query ()
Setex :: Text -> Int -> ByteString -> Query ()
Setnx :: Text -> ByteString -> Query Bool
Sadd :: Text -> NonEmpty ByteString -> Query Int
Scard :: Text -> Query Int
Srem :: Text -> NonEmpty ByteString -> Query Int
Sismember :: Text -> ByteString -> Query Bool
Smembers :: Text -> Query (List ByteString)
Zadd :: Text -> Dict.Dict ByteString Float -> Query Int
Zrange :: Text -> Int -> Int -> Query [ByteString]
ZrangeByScoreWithScores :: Text -> Float -> Float -> Query [(ByteString, Float)]
Zrank :: Text -> ByteString -> Query (Maybe Int)
Zrevrank :: Text -> ByteString -> Query (Maybe Int)
Pure :: a -> Query a
Apply :: Query (a -> b) -> Query a -> Query b
WithResult :: (a -> Result Error b) -> Query a -> Query b
instance Prelude.Functor Query where
fmap :: forall a b. (a -> b) -> Query a -> Query b
fmap = (a -> b) -> Query a -> Query b
forall a b. (a -> b) -> Query a -> Query b
map
instance Prelude.Show (Query a) where
show :: Query a -> String
show = Text -> String
Text.toList (Text -> String) -> ([Text] -> Text) -> [Text] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Text -> [Text] -> Text
Text.join Text
"<|" ([Text] -> String) -> (Query a -> [Text]) -> Query a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Query a -> [Text]
forall b. Query b -> [Text]
cmds
map :: (a -> b) -> Query a -> Query b
map :: forall a b. (a -> b) -> Query a -> Query b
map a -> b
f Query a
q = (a -> Result Error b) -> Query a -> Query b
forall a b. (a -> Result Error b) -> Query a -> Query b
WithResult (a -> b
f (a -> b) -> (b -> Result Error b) -> a -> Result Error b
forall a b c. (a -> b) -> (b -> c) -> a -> c
>> b -> Result Error b
forall error value. value -> Result error value
Ok) Query a
q
map2 :: (a -> b -> c) -> Query a -> Query b -> Query c
map2 :: forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
map2 a -> b -> c
f Query a
queryA Query b
queryB =
Query (b -> c) -> Query b -> Query c
forall a b. Query (a -> b) -> Query a -> Query b
Apply ((a -> b -> c) -> Query a -> Query (b -> c)
forall a b. (a -> b) -> Query a -> Query b
map a -> b -> c
f Query a
queryA) Query b
queryB
map3 :: (a -> b -> c -> d) -> Query a -> Query b -> Query c -> Query d
map3 :: forall a b c d.
(a -> b -> c -> d) -> Query a -> Query b -> Query c -> Query d
map3 a -> b -> c -> d
f Query a
queryA Query b
queryB Query c
queryC =
Query (c -> d) -> Query c -> Query d
forall a b. Query (a -> b) -> Query a -> Query b
Apply (Query (b -> c -> d) -> Query b -> Query (c -> d)
forall a b. Query (a -> b) -> Query a -> Query b
Apply ((a -> b -> c -> d) -> Query a -> Query (b -> c -> d)
forall a b. (a -> b) -> Query a -> Query b
map a -> b -> c -> d
f Query a
queryA) Query b
queryB) Query c
queryC
sequence :: List (Query a) -> Query (List a)
sequence :: forall a. List (Query a) -> Query (List a)
sequence =
(Query a -> Query (List a) -> Query (List a))
-> Query (List a) -> List (Query a) -> Query (List a)
forall a b. (a -> b -> b) -> b -> List a -> b
List.foldr ((a -> List a -> List a)
-> Query a -> Query (List a) -> Query (List a)
forall a b c. (a -> b -> c) -> Query a -> Query b -> Query c
map2 (:)) (List a -> Query (List a)
forall a. a -> Query a
Pure [])
data HasAutoExtendExpire = NoAutoExtendExpire | AutoExtendExpire
data Handler' (x :: HasAutoExtendExpire) = Handler'
{ forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
HasCallStack =>
QueryTimeout -> Query a -> Task Error a
doQuery :: (Stack.HasCallStack) => forall a. Settings.QueryTimeout -> Query a -> Task Error a,
forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
HasCallStack =>
QueryTimeout -> Query a -> Task Error a
doTransaction :: (Stack.HasCallStack) => forall a. Settings.QueryTimeout -> Query a -> Task Error a,
forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
(HasCallStack, RedisResult a) =>
QueryTimeout -> Script a -> Task Error a
doEval :: (Stack.HasCallStack) => forall a. (Database.Redis.RedisResult a) => Settings.QueryTimeout -> Script.Script a -> Task Error a,
forall (x :: HasAutoExtendExpire). Handler' x -> Text
namespace :: Text,
forall (x :: HasAutoExtendExpire). Handler' x -> MaxKeySize
maxKeySize :: Settings.MaxKeySize,
forall (x :: HasAutoExtendExpire). Handler' x -> QueryTimeout
queryTimeout :: Settings.QueryTimeout
}
type Handler = Handler' 'NoAutoExtendExpire
type HandlerAutoExtendExpire = Handler' 'AutoExtendExpire
query :: (Stack.HasCallStack) => Handler' x -> Query a -> Task Error a
query :: forall (x :: HasAutoExtendExpire) a.
HasCallStack =>
Handler' x -> Query a -> Task Error a
query Handler' x
handler Query a
query' =
Text -> Query a -> Task Error (Query a)
forall a err. Text -> Query a -> Task err (Query a)
namespaceQuery (Handler' x -> Text
forall (x :: HasAutoExtendExpire). Handler' x -> Text
namespace Handler' x
handler Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
":") Query a
query'
Task Error (Query a)
-> (Task Error (Query a) -> Task Error (Query a))
-> Task Error (Query a)
forall a b. a -> (a -> b) -> b
|> (Query a -> Task Error (Query a))
-> Task Error (Query a) -> Task Error (Query a)
forall a x b. (a -> Task x b) -> Task x a -> Task x b
Task.andThen (Handler' x -> Query a -> Task Error (Query a)
forall (x :: HasAutoExtendExpire) a.
Handler' x -> Query a -> Task Error (Query a)
ensureMaxKeySize Handler' x
handler)
Task Error (Query a)
-> (Task Error (Query a) -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (Query a -> Task Error a) -> Task Error (Query a) -> Task Error a
forall a x b. (a -> Task x b) -> Task x a -> Task x b
Task.andThen ((HasCallStack => QueryTimeout -> Query a -> Task Error a)
-> QueryTimeout -> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (Handler' x
-> forall a.
HasCallStack =>
QueryTimeout -> Query a -> Task Error a
forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
HasCallStack =>
QueryTimeout -> Query a -> Task Error a
doQuery Handler' x
handler) (Handler' x -> QueryTimeout
forall (x :: HasAutoExtendExpire). Handler' x -> QueryTimeout
queryTimeout Handler' x
handler))
transaction :: (Stack.HasCallStack) => Handler' x -> Query a -> Task Error a
transaction :: forall (x :: HasAutoExtendExpire) a.
HasCallStack =>
Handler' x -> Query a -> Task Error a
transaction Handler' x
handler Query a
query' =
Text -> Query a -> Task Error (Query a)
forall a err. Text -> Query a -> Task err (Query a)
namespaceQuery (Handler' x -> Text
forall (x :: HasAutoExtendExpire). Handler' x -> Text
namespace Handler' x
handler Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
":") Query a
query'
Task Error (Query a)
-> (Task Error (Query a) -> Task Error (Query a))
-> Task Error (Query a)
forall a b. a -> (a -> b) -> b
|> (Query a -> Task Error (Query a))
-> Task Error (Query a) -> Task Error (Query a)
forall a x b. (a -> Task x b) -> Task x a -> Task x b
Task.andThen (Handler' x -> Query a -> Task Error (Query a)
forall (x :: HasAutoExtendExpire) a.
Handler' x -> Query a -> Task Error (Query a)
ensureMaxKeySize Handler' x
handler)
Task Error (Query a)
-> (Task Error (Query a) -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (Query a -> Task Error a) -> Task Error (Query a) -> Task Error a
forall a x b. (a -> Task x b) -> Task x a -> Task x b
Task.andThen ((HasCallStack => QueryTimeout -> Query a -> Task Error a)
-> QueryTimeout -> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (Handler' x
-> forall a.
HasCallStack =>
QueryTimeout -> Query a -> Task Error a
forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
HasCallStack =>
QueryTimeout -> Query a -> Task Error a
doTransaction Handler' x
handler) (Handler' x -> QueryTimeout
forall (x :: HasAutoExtendExpire). Handler' x -> QueryTimeout
queryTimeout Handler' x
handler))
eval :: (Stack.HasCallStack, Database.Redis.RedisResult a) => Handler' x -> Script.Script a -> Task Error a
eval :: forall a (x :: HasAutoExtendExpire).
(HasCallStack, RedisResult a) =>
Handler' x -> Script a -> Task Error a
eval Handler' x
handler Script a
script =
(Text -> Task Error Text) -> Script a -> Task Error (Script a)
forall err a.
(Text -> Task err Text) -> Script a -> Task err (Script a)
Script.mapKeys (\Text
key -> Text -> Task Error Text
forall a x. a -> Task x a
Task.succeed (Handler' x -> Text
forall (x :: HasAutoExtendExpire). Handler' x -> Text
namespace Handler' x
handler Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
":" Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)) Script a
script
Task Error (Script a)
-> (Task Error (Script a) -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (Script a -> Task Error a) -> Task Error (Script a) -> Task Error a
forall a x b. (a -> Task x b) -> Task x a -> Task x b
Task.andThen ((HasCallStack => QueryTimeout -> Script a -> Task Error a)
-> QueryTimeout -> Script a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack (Handler' x
-> forall a.
(HasCallStack, RedisResult a) =>
QueryTimeout -> Script a -> Task Error a
forall (x :: HasAutoExtendExpire).
Handler' x
-> forall a.
(HasCallStack, RedisResult a) =>
QueryTimeout -> Script a -> Task Error a
doEval Handler' x
handler) (Handler' x -> QueryTimeout
forall (x :: HasAutoExtendExpire). Handler' x -> QueryTimeout
queryTimeout Handler' x
handler))
namespaceQuery :: Text -> Query a -> Task err (Query a)
namespaceQuery :: forall a err. Text -> Query a -> Task err (Query a)
namespaceQuery Text
prefix Query a
query' =
(Text -> Task err Text) -> Query a -> Task err (Query a)
forall err a.
(Text -> Task err Text) -> Query a -> Task err (Query a)
mapKeys (\Text
key -> Text -> Task err Text
forall a x. a -> Task x a
Task.succeed (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)) Query a
query'
Task err (Query a)
-> (Task err (Query a) -> Task err (Query a)) -> Task err (Query a)
forall a b. a -> (a -> b) -> b
|> (Query a -> Query a) -> Task err (Query a) -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map ((Text -> Text) -> Query a -> Query a
forall a. (Text -> Text) -> Query a -> Query a
mapReturnedKeys (Int -> Text -> Text
Text.dropLeft (Text -> Int
Text.length Text
prefix)))
mapKeys :: (Text -> Task err Text) -> Query a -> Task err (Query a)
mapKeys :: forall err a.
(Text -> Task err Text) -> Query a -> Task err (Query a)
mapKeys Text -> Task err Text
fn Query a
query' =
case Query a
query' of
Exists Text
key -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map Text -> Query a
Text -> Query Bool
Exists (Text -> Task err Text
fn Text
key)
Query a
Ping -> Query a -> Task err (Query a)
forall a x. a -> Task x a
Task.succeed Query a
Query Status
Ping
Get Text
key -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map Text -> Query a
Text -> Query (Maybe ByteString)
Get (Text -> Task err Text
fn Text
key)
Set Text
key ByteString
value -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> ByteString -> Query ()
Set Text
newKey ByteString
value) (Text -> Task err Text
fn Text
key)
Setex Text
key Int
seconds ByteString
value -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Int -> ByteString -> Query ()
Setex Text
newKey Int
seconds ByteString
value) (Text -> Task err Text
fn Text
key)
Setnx Text
key ByteString
value -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> ByteString -> Query Bool
Setnx Text
newKey ByteString
value) (Text -> Task err Text
fn Text
key)
Getset Text
key ByteString
value -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> ByteString -> Query (Maybe ByteString)
Getset Text
newKey ByteString
value) (Text -> Task err Text
fn Text
key)
Mget NonEmpty Text
keys -> (NonEmpty Text -> Query a)
-> Task err (NonEmpty Text) -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map NonEmpty Text -> Query a
NonEmpty Text -> Query [Maybe ByteString]
Mget ((Text -> Task err Text)
-> NonEmpty Text -> Task err (NonEmpty Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
Prelude.traverse (\Text
k -> Text -> Task err Text
fn Text
k) NonEmpty Text
keys)
Mset NonEmpty (Text, ByteString)
assocs -> (NonEmpty (Text, ByteString) -> Query a)
-> Task err (NonEmpty (Text, ByteString)) -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map NonEmpty (Text, ByteString) -> Query a
NonEmpty (Text, ByteString) -> Query ()
Mset (((Text, ByteString) -> Task err (Text, ByteString))
-> NonEmpty (Text, ByteString)
-> Task err (NonEmpty (Text, ByteString))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
Prelude.traverse (\(Text
k, ByteString
v) -> (Text -> (Text, ByteString))
-> Task err Text -> Task err (Text, ByteString)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> (Text
newKey, ByteString
v)) (Text -> Task err Text
fn Text
k)) NonEmpty (Text, ByteString)
assocs)
Del NonEmpty Text
keys -> (NonEmpty Text -> Query a)
-> Task err (NonEmpty Text) -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map NonEmpty Text -> Query a
NonEmpty Text -> Query Int
Del ((Text -> Task err Text)
-> NonEmpty Text -> Task err (NonEmpty Text)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NonEmpty a -> f (NonEmpty b)
Prelude.traverse (Text -> Task err Text
fn) NonEmpty Text
keys)
Hgetall Text
key -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map Text -> Query a
Text -> Query [(Text, ByteString)]
Hgetall (Text -> Task err Text
fn Text
key)
Hkeys Text
key -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map Text -> Query a
Text -> Query [Text]
Hkeys (Text -> Task err Text
fn Text
key)
Hmget Text
key NonEmpty Text
fields -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> NonEmpty Text -> Query [Maybe ByteString]
Hmget Text
newKey NonEmpty Text
fields) (Text -> Task err Text
fn Text
key)
Hget Text
key Text
field -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Text -> Query (Maybe ByteString)
Hget Text
newKey Text
field) (Text -> Task err Text
fn Text
key)
Hset Text
key Text
field ByteString
val -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Text -> ByteString -> Query ()
Hset Text
newKey Text
field ByteString
val) (Text -> Task err Text
fn Text
key)
Hsetnx Text
key Text
field ByteString
val -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Text -> ByteString -> Query Bool
Hsetnx Text
newKey Text
field ByteString
val) (Text -> Task err Text
fn Text
key)
Hmset Text
key NonEmpty (Text, ByteString)
vals -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> NonEmpty (Text, ByteString) -> Query ()
Hmset Text
newKey NonEmpty (Text, ByteString)
vals) (Text -> Task err Text
fn Text
key)
Hdel Text
key NonEmpty Text
fields -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> NonEmpty Text -> Query Int
Hdel Text
newKey NonEmpty Text
fields) (Text -> Task err Text
fn Text
key)
Incr Text
key -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map Text -> Query a
Text -> Query Int
Incr (Text -> Task err Text
fn Text
key)
Incrby Text
key Int
amount -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Int -> Query Int
Incrby Text
newKey Int
amount) (Text -> Task err Text
fn Text
key)
Expire Text
key Int
secs -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Int -> Query ()
Expire Text
newKey Int
secs) (Text -> Task err Text
fn Text
key)
Lrange Text
key Int
lower Int
upper -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Int -> Int -> Query [ByteString]
Lrange Text
newKey Int
lower Int
upper) (Text -> Task err Text
fn Text
key)
Rpush Text
key NonEmpty ByteString
vals -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> NonEmpty ByteString -> Query Int
Rpush Text
newKey NonEmpty ByteString
vals) (Text -> Task err Text
fn Text
key)
Scan Cursor
cursor Maybe Text
maybeMatch Maybe Int
maybeCount ->
case Maybe Text
maybeMatch of
Just Text
match -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newMatch -> Cursor -> Maybe Text -> Maybe Int -> Query (Cursor, [Text])
Scan Cursor
cursor (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
newMatch) Maybe Int
maybeCount) (Text -> Task err Text
fn Text
match)
Maybe Text
Nothing -> Query a -> Task err (Query a)
forall a x. a -> Task x a
Task.succeed (Cursor -> Maybe Text -> Maybe Int -> Query (Cursor, [Text])
Scan Cursor
cursor Maybe Text
forall a. Maybe a
Nothing Maybe Int
maybeCount)
Sadd Text
key NonEmpty ByteString
vals -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> NonEmpty ByteString -> Query Int
Sadd Text
newKey NonEmpty ByteString
vals) (Text -> Task err Text
fn Text
key)
Scard Text
key -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map Text -> Query a
Text -> Query Int
Scard (Text -> Task err Text
fn Text
key)
Srem Text
key NonEmpty ByteString
vals -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> NonEmpty ByteString -> Query Int
Srem Text
newKey NonEmpty ByteString
vals) (Text -> Task err Text
fn Text
key)
Sismember Text
key ByteString
val -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> ByteString -> Query Bool
Sismember Text
newKey ByteString
val) (Text -> Task err Text
fn Text
key)
Smembers Text
key -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map Text -> Query a
Text -> Query [ByteString]
Smembers (Text -> Task err Text
fn Text
key)
Zadd Text
key Dict ByteString Float
vals -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Dict ByteString Float -> Query Int
Zadd Text
newKey Dict ByteString Float
vals) (Text -> Task err Text
fn Text
key)
Zrange Text
key Int
start Int
stop -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Int -> Int -> Query [ByteString]
Zrange Text
newKey Int
start Int
stop) (Text -> Task err Text
fn Text
key)
ZrangeByScoreWithScores Text
key Float
start Float
stop -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> Float -> Float -> Query (List (ByteString, Float))
ZrangeByScoreWithScores Text
newKey Float
start Float
stop) (Text -> Task err Text
fn Text
key)
Zrank Text
key ByteString
member -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> ByteString -> Query (Maybe Int)
Zrank Text
newKey ByteString
member) (Text -> Task err Text
fn Text
key)
Zrevrank Text
key ByteString
member -> (Text -> Query a) -> Task err Text -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map (\Text
newKey -> Text -> ByteString -> Query (Maybe Int)
Zrevrank Text
newKey ByteString
member) (Text -> Task err Text
fn Text
key)
Pure a
x -> Query a -> Task err (Query a)
forall a x. a -> Task x a
Task.succeed (a -> Query a
forall a. a -> Query a
Pure a
x)
Apply Query (a -> a)
f Query a
x -> (Query (a -> a) -> Query a -> Query a)
-> Task err (Query (a -> a))
-> Task err (Query a)
-> Task err (Query a)
forall a b result x.
(a -> b -> result) -> Task x a -> Task x b -> Task x result
Task.map2 Query (a -> a) -> Query a -> Query a
forall a b. Query (a -> b) -> Query a -> Query b
Apply ((Text -> Task err Text)
-> Query (a -> a) -> Task err (Query (a -> a))
forall err a.
(Text -> Task err Text) -> Query a -> Task err (Query a)
mapKeys Text -> Task err Text
fn Query (a -> a)
f) ((Text -> Task err Text) -> Query a -> Task err (Query a)
forall err a.
(Text -> Task err Text) -> Query a -> Task err (Query a)
mapKeys Text -> Task err Text
fn Query a
x)
WithResult a -> Result Error a
f Query a
q -> (Query a -> Query a) -> Task err (Query a) -> Task err (Query a)
forall a b x. (a -> b) -> Task x a -> Task x b
Task.map ((a -> Result Error a) -> Query a -> Query a
forall a b. (a -> Result Error b) -> Query a -> Query b
WithResult a -> Result Error a
f) ((Text -> Task err Text) -> Query a -> Task err (Query a)
forall err a.
(Text -> Task err Text) -> Query a -> Task err (Query a)
mapKeys Text -> Task err Text
fn Query a
q)
mapReturnedKeys :: (Text -> Text) -> Query a -> Query a
mapReturnedKeys :: forall a. (Text -> Text) -> Query a -> Query a
mapReturnedKeys Text -> Text
fn Query a
query' =
case Query a
query' of
Exists Text
key -> Text -> Query Bool
Exists Text
key
Query a
Ping -> Query a
Query Status
Ping
Get Text
key -> Text -> Query (Maybe ByteString)
Get Text
key
Set Text
key ByteString
value -> Text -> ByteString -> Query ()
Set Text
key ByteString
value
Setex Text
key Int
seconds ByteString
value -> Text -> Int -> ByteString -> Query ()
Setex Text
key Int
seconds ByteString
value
Setnx Text
key ByteString
value -> Text -> ByteString -> Query Bool
Setnx Text
key ByteString
value
Getset Text
key ByteString
value -> Text -> ByteString -> Query (Maybe ByteString)
Getset Text
key ByteString
value
Mget NonEmpty Text
keys -> NonEmpty Text -> Query [Maybe ByteString]
Mget NonEmpty Text
keys
Mset NonEmpty (Text, ByteString)
assocs -> NonEmpty (Text, ByteString) -> Query ()
Mset NonEmpty (Text, ByteString)
assocs
Del NonEmpty Text
keys -> NonEmpty Text -> Query Int
Del NonEmpty Text
keys
Hgetall Text
key -> Text -> Query [(Text, ByteString)]
Hgetall Text
key
Hkeys Text
key -> Text -> Query [Text]
Hkeys Text
key
Hmget Text
key NonEmpty Text
fields -> Text -> NonEmpty Text -> Query [Maybe ByteString]
Hmget Text
key NonEmpty Text
fields
Hget Text
key Text
field -> Text -> Text -> Query (Maybe ByteString)
Hget Text
key Text
field
Hset Text
key Text
field ByteString
val -> Text -> Text -> ByteString -> Query ()
Hset Text
key Text
field ByteString
val
Hsetnx Text
key Text
field ByteString
val -> Text -> Text -> ByteString -> Query Bool
Hsetnx Text
key Text
field ByteString
val
Hmset Text
key NonEmpty (Text, ByteString)
vals -> Text -> NonEmpty (Text, ByteString) -> Query ()
Hmset Text
key NonEmpty (Text, ByteString)
vals
Hdel Text
key NonEmpty Text
fields -> Text -> NonEmpty Text -> Query Int
Hdel Text
key NonEmpty Text
fields
Incr Text
key -> Text -> Query Int
Incr Text
key
Incrby Text
key Int
amount -> Text -> Int -> Query Int
Incrby Text
key Int
amount
Expire Text
key Int
secs -> Text -> Int -> Query ()
Expire Text
key Int
secs
Lrange Text
key Int
lower Int
upper -> Text -> Int -> Int -> Query [ByteString]
Lrange Text
key Int
lower Int
upper
Rpush Text
key NonEmpty ByteString
vals -> Text -> NonEmpty ByteString -> Query Int
Rpush Text
key NonEmpty ByteString
vals
Scan Cursor
cursor Maybe Text
maybeMatch Maybe Int
maybeCount ->
Cursor -> Maybe Text -> Maybe Int -> Query (Cursor, [Text])
Scan Cursor
cursor Maybe Text
maybeMatch Maybe Int
maybeCount
Query (Cursor, [Text])
-> (Query (Cursor, [Text]) -> Query a) -> Query a
forall a b. a -> (a -> b) -> b
|> ((Cursor, [Text]) -> a) -> Query (Cursor, [Text]) -> Query a
forall a b. (a -> b) -> Query a -> Query b
map (\(Cursor
nextCursor, [Text]
keys) -> (Cursor
nextCursor, (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map Text -> Text
fn [Text]
keys))
Sadd Text
key NonEmpty ByteString
vals -> Text -> NonEmpty ByteString -> Query Int
Sadd Text
key NonEmpty ByteString
vals
Scard Text
key -> Text -> Query Int
Scard Text
key
Srem Text
key NonEmpty ByteString
vals -> Text -> NonEmpty ByteString -> Query Int
Srem Text
key NonEmpty ByteString
vals
Sismember Text
key ByteString
val -> Text -> ByteString -> Query Bool
Sismember Text
key ByteString
val
Smembers Text
key -> Text -> Query [ByteString]
Smembers Text
key
Zadd Text
key Dict ByteString Float
vals -> Text -> Dict ByteString Float -> Query Int
Zadd Text
key Dict ByteString Float
vals
Zrange Text
key Int
start Int
stop -> Text -> Int -> Int -> Query [ByteString]
Zrange Text
key Int
start Int
stop
ZrangeByScoreWithScores Text
key Float
start Float
stop -> Text -> Float -> Float -> Query (List (ByteString, Float))
ZrangeByScoreWithScores Text
key Float
start Float
stop
Zrank Text
key ByteString
member -> Text -> ByteString -> Query (Maybe Int)
Zrank Text
key ByteString
member
Zrevrank Text
key ByteString
member -> Text -> ByteString -> Query (Maybe Int)
Zrevrank Text
key ByteString
member
Pure a
x -> a -> Query a
forall a. a -> Query a
Pure a
x
Apply Query (a -> a)
f Query a
x -> Query (a -> a) -> Query a -> Query a
forall a b. Query (a -> b) -> Query a -> Query b
Apply ((Text -> Text) -> Query (a -> a) -> Query (a -> a)
forall a. (Text -> Text) -> Query a -> Query a
mapReturnedKeys Text -> Text
fn Query (a -> a)
f) ((Text -> Text) -> Query a -> Query a
forall a. (Text -> Text) -> Query a -> Query a
mapReturnedKeys Text -> Text
fn Query a
x)
WithResult a -> Result Error a
f Query a
q -> ((a -> Result Error a) -> Query a -> Query a
forall a b. (a -> Result Error b) -> Query a -> Query b
WithResult a -> Result Error a
f) ((Text -> Text) -> Query a -> Query a
forall a. (Text -> Text) -> Query a -> Query a
mapReturnedKeys Text -> Text
fn Query a
q)
ensureMaxKeySize :: Handler' x -> Query a -> Task Error (Query a)
ensureMaxKeySize :: forall (x :: HasAutoExtendExpire) a.
Handler' x -> Query a -> Task Error (Query a)
ensureMaxKeySize Handler' x
handler Query a
query' =
case Handler' x -> MaxKeySize
forall (x :: HasAutoExtendExpire). Handler' x -> MaxKeySize
maxKeySize Handler' x
handler of
MaxKeySize
Settings.NoMaxKeySize -> Query a -> Task Error (Query a)
forall a x. a -> Task x a
Task.succeed Query a
query'
Settings.MaxKeySize Int
maxKeySize ->
(Text -> Task Error Text) -> Query a -> Task Error (Query a)
forall err a.
(Text -> Task err Text) -> Query a -> Task err (Query a)
mapKeys (Int -> Text -> Task Error Text
checkMaxKeySize Int
maxKeySize) Query a
query'
checkMaxKeySize :: Int -> Text -> Task Error Text
checkMaxKeySize :: Int -> Text -> Task Error Text
checkMaxKeySize Int
maxKeySize Text
key =
if Text -> Int
Text.length Text
key Int -> Int -> Bool
forall comparable.
Ord comparable =>
comparable -> comparable -> Bool
<= Int
maxKeySize
then Text -> Task Error Text
forall a x. a -> Task x a
Task.succeed Text
key
else Error -> Task Error Text
forall x a. x -> Task x a
Task.fail (Text -> Int -> Error
KeyExceedsMaxSize Text
key Int
maxKeySize)
keysTouchedByQuery :: Query a -> Set.Set Text
keysTouchedByQuery :: forall a. Query a -> Set Text
keysTouchedByQuery Query a
query' =
case Query a
query' of
Apply Query (a -> a)
f Query a
x -> Set Text -> Set Text -> Set Text
forall comparable.
Ord comparable =>
Set comparable -> Set comparable -> Set comparable
Set.union (Query (a -> a) -> Set Text
forall a. Query a -> Set Text
keysTouchedByQuery Query (a -> a)
f) (Query a -> Set Text
forall a. Query a -> Set Text
keysTouchedByQuery Query a
x)
Del NonEmpty Text
keys -> [Text] -> Set Text
forall comparable.
Ord comparable =>
List comparable -> Set comparable
Set.fromList (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
keys)
Exists Text
key -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Expire Text
_key Int
_ -> Set Text
forall a. Set a
Set.empty
Get Text
key -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Getset Text
key ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Hdel Text
key NonEmpty Text
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Hget Text
key Text
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Hgetall Text
key -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Hkeys Text
key -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Hmget Text
key NonEmpty Text
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Hmset Text
key NonEmpty (Text, ByteString)
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Hset Text
key Text
_ ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Hsetnx Text
key Text
_ ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Incr Text
key -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Incrby Text
key Int
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Lrange Text
key Int
_ Int
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Mget NonEmpty Text
keys -> [Text] -> Set Text
forall comparable.
Ord comparable =>
List comparable -> Set comparable
Set.fromList (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Text
keys)
Mset NonEmpty (Text, ByteString)
assocs -> [Text] -> Set Text
forall comparable.
Ord comparable =>
List comparable -> Set comparable
Set.fromList (NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NonEmpty.toList (((Text, ByteString) -> Text)
-> NonEmpty (Text, ByteString) -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (Text, ByteString) -> Text
forall a b. (a, b) -> a
Tuple.first NonEmpty (Text, ByteString)
assocs))
Query a
Ping -> Set Text
forall a. Set a
Set.empty
Pure a
_ -> Set Text
forall a. Set a
Set.empty
Rpush Text
key NonEmpty ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Scan {} -> Set Text
forall a. Set a
Set.empty
Set Text
key ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Setex Text
key Int
_ ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Setnx Text
key ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Sadd Text
key NonEmpty ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Scard Text
key -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Srem Text
key NonEmpty ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Sismember Text
key ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Smembers Text
key -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Zadd Text
key Dict ByteString Float
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Zrange Text
key Int
_ Int
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
ZrangeByScoreWithScores Text
key Float
_ Float
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Zrank Text
key ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
Zrevrank Text
key ByteString
_ -> Text -> Set Text
forall comparable. comparable -> Set comparable
Set.singleton Text
key
WithResult a -> Result Error a
_ Query a
q -> Query a -> Set Text
forall a. Query a -> Set Text
keysTouchedByQuery Query a
q
maybesToDict :: (Ord key) => List key -> List (Maybe a) -> Dict.Dict key a
maybesToDict :: forall key a. Ord key => List key -> List (Maybe a) -> Dict key a
maybesToDict List key
keys List (Maybe a)
values =
(key -> Maybe a -> (key, Maybe a))
-> List key -> List (Maybe a) -> List (key, Maybe a)
forall a b result.
(a -> b -> result) -> List a -> List b -> List result
List.map2 (,) List key
keys List (Maybe a)
values
List (key, Maybe a)
-> (List (key, Maybe a) -> List (key, a)) -> List (key, a)
forall a b. a -> (a -> b) -> b
|> ((key, Maybe a) -> Maybe (key, a))
-> List (key, Maybe a) -> List (key, a)
forall a b. (a -> Maybe b) -> List a -> List b
List.filterMap
( \(key
key, Maybe a
value) ->
case Maybe a
value of
Maybe a
Nothing -> Maybe (key, a)
forall a. Maybe a
Nothing
Just a
v -> (key, a) -> Maybe (key, a)
forall a. a -> Maybe a
Just (key
key, a
v)
)
List (key, a) -> (List (key, a) -> Dict key a) -> Dict key a
forall a b. a -> (a -> b) -> b
|> List (key, a) -> Dict key a
forall comparable v.
Ord comparable =>
List (comparable, v) -> Dict comparable v
Dict.fromList
wrapQuery :: (Stack.HasCallStack) => Settings.QueryTimeout -> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
wrapQuery :: forall a.
HasCallStack =>
QueryTimeout
-> [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
wrapQuery QueryTimeout
queryTimeout [Text]
commands Text
host Maybe Int
port Task Error a
task =
[Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
forall a.
HasCallStack =>
[Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
traceQuery [Text]
commands Text
host Maybe Int
port (Task Error a -> Task Error a) -> Task Error a -> Task Error a
forall a b. (a -> b) -> a -> b
<| case QueryTimeout
queryTimeout of
QueryTimeout
Settings.NoQueryTimeout ->
Task Error a
task
Settings.TimeoutQueryAfterMilliseconds Int
timeoutMs ->
Float -> Error -> Task Error a -> Task Error a
forall err a. Float -> err -> Task err a -> Task err a
Task.timeout (Int -> Float
toFloat Int
timeoutMs) Error
TimeoutError Task Error a
task
traceQuery :: (Stack.HasCallStack) => [Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
traceQuery :: forall a.
HasCallStack =>
[Text] -> Text -> Maybe Int -> Task Error a -> Task Error a
traceQuery [Text]
commands Text
host Maybe Int
port Task Error a
task =
let info :: Details
info =
Details
RedisCommands.emptyDetails
{ RedisCommands.commands = commands,
RedisCommands.host = Just host,
RedisCommands.port = port
}
in (HasCallStack => Text -> Task Error a -> Task Error a)
-> Text -> Task Error a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => Text -> Task Error a -> Task Error a
Text -> Task Error a -> Task Error a
forall e a. HasCallStack => Text -> Task e a -> Task e a
Platform.tracingSpan
Text
"Redis Query"
( Task Error a -> Task Error () -> Task Error a
forall e a b. Task e a -> Task e b -> Task e a
Platform.finally
Task Error a
task
( do
Details -> Task Error ()
forall d e. TracingSpanDetails d => d -> Task e ()
Platform.setTracingSpanDetails Details
info
Text -> Task Error ()
forall e. Text -> Task e ()
Platform.setTracingSpanSummary
( case [Text]
commands of
[] -> Text
""
[Text
cmd] -> Text
cmd
Text
cmd : [Text]
_ -> Text
cmd Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
" (+ more)"
)
)
)
foldWithScan :: Handler' x -> Maybe Text -> Maybe Int -> ([Text] -> a -> Task Error a) -> a -> Task Error a
foldWithScan :: forall (x :: HasAutoExtendExpire) a.
Handler' x
-> Maybe Text
-> Maybe Int
-> ([Text] -> a -> Task Error a)
-> a
-> Task Error a
foldWithScan Handler' x
handler Maybe Text
keyMatchPattern Maybe Int
approxCountPerBatch [Text] -> a -> Task Error a
processKeyBatch a
initAccumulator =
let go :: a -> Cursor -> Task Error a
go a
accumulator Cursor
cursor = do
(Cursor
nextCursor, [Text]
keyBatch) <-
Cursor -> Maybe Text -> Maybe Int -> Query (Cursor, [Text])
Scan Cursor
cursor Maybe Text
keyMatchPattern Maybe Int
approxCountPerBatch
Query (Cursor, [Text])
-> (Query (Cursor, [Text]) -> Task Error (Cursor, [Text]))
-> Task Error (Cursor, [Text])
forall a b. a -> (a -> b) -> b
|> Handler' x -> Query (Cursor, [Text]) -> Task Error (Cursor, [Text])
forall (x :: HasAutoExtendExpire) a.
HasCallStack =>
Handler' x -> Query a -> Task Error a
query Handler' x
handler
a
nextAccumulator <-
[Text] -> a -> Task Error a
processKeyBatch [Text]
keyBatch a
accumulator
if Cursor
nextCursor Cursor -> Cursor -> Bool
forall a. Eq a => a -> a -> Bool
== Cursor
Database.Redis.cursor0
then a -> Task Error a
forall a x. a -> Task x a
Task.succeed a
nextAccumulator
else a -> Cursor -> Task Error a
go a
nextAccumulator Cursor
nextCursor
in a -> Cursor -> Task Error a
go a
initAccumulator Cursor
Database.Redis.cursor0
instance Database.Redis.RedisResult Text where
decode :: Reply -> Either Reply Text
decode Reply
r = do
ByteString
decodedBs <- Reply -> Either Reply ByteString
forall a. RedisResult a => Reply -> Either Reply a
Database.Redis.decode Reply
r
Text -> Either Reply Text
forall a. a -> Either Reply a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Text -> Either Reply Text) -> Text -> Either Reply Text
forall a b. (a -> b) -> a -> b
<| ByteString -> Text
Data.Text.Encoding.decodeUtf8 ByteString
decodedBs
instance Database.Redis.RedisResult Int where
decode :: Reply -> Either Reply Int
decode Reply
r = do
(Integer
decodedInteger :: Prelude.Integer) <- Reply -> Either Reply Integer
forall a. RedisResult a => Reply -> Either Reply a
Database.Redis.decode Reply
r
Int -> Either Reply Int
forall a. a -> Either Reply a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (Int -> Either Reply Int) -> Int -> Either Reply Int
forall a b. (a -> b) -> a -> b
<| Integer -> Int
forall a b. (Integral a, Num b) => a -> b
Prelude.fromIntegral Integer
decodedInteger
instance Database.Redis.RedisResult () where
decode :: Reply -> Either Reply ()
decode Reply
r = do
(Reply
reply :: Database.Redis.Reply) <- Reply -> Either Reply Reply
forall a. RedisResult a => Reply -> Either Reply a
Database.Redis.decode Reply
r
case Reply
reply of
Database.Redis.Bulk Maybe ByteString
Nothing -> () -> Either Reply ()
forall a. a -> Either Reply a
forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ()
Reply
other -> Reply -> Either Reply ()
forall a b. a -> Either a b
Prelude.Left Reply
other