{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
module Redis.Internal
( Error (..),
Handler (..),
Query (..),
cmds,
map,
map2,
map3,
sequence,
query,
transaction,
traceQuery,
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 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 Set
import qualified Text
import qualified Tuple
import qualified Prelude
data Error
= RedisError Text
| ConnectionLost
| DecodingError Text
| DecodingFieldError Text
| LibraryError Text
| TransactionAborted
| TimeoutError
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."
cmds :: Query b -> [Text]
cmds :: 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]) -> List (Text, ByteString) -> [Text]
forall a b. (a -> List b) -> List a -> List b
List.concatMap (\(Text
field, ByteString
_) -> [Text
field, Text
"*****"]) (NonEmpty (Text, ByteString) -> List (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]) -> List (Text, ByteString) -> [Text]
forall a b. (a -> List b) -> List a -> List b
List.concatMap (\(Text
key, ByteString
_) -> [Text
key, Text
"*****"]) (NonEmpty (Text, ByteString) -> List (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) -> List ByteString -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map (\ByteString
_ -> Text
"*****") (NonEmpty ByteString -> List ByteString
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
vals))]
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) -> List ByteString -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map (\ByteString
_ -> Text
"*****") (NonEmpty ByteString -> List 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) -> List ByteString -> [Text]
forall a b. (a -> b) -> List a -> List b
List.map (\ByteString
_ -> Text
"*****") (NonEmpty ByteString -> List ByteString
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty ByteString
vals))]
Smembers Text
key -> [[Text] -> Text
unwords [Text
"SMEMBERS", Text
key]]
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
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
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
Smembers :: Text -> Query (List ByteString)
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 :: (a -> b) -> Query a -> Query b
fmap = (a -> b) -> Query a -> Query b
forall a b. (a -> b) -> Query a -> Query b
map
map :: (a -> b) -> Query a -> Query b
map :: (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 :: (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 :: (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 :: 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 Handler = Handler
{ Handler -> forall a. HasCallStack => Query a -> Task Error a
doQuery :: Stack.HasCallStack => forall a. Query a -> Task Error a,
Handler -> forall a. HasCallStack => Query a -> Task Error a
doTransaction :: Stack.HasCallStack => forall a. Query a -> Task Error a,
Handler -> Text
namespace :: Text
}
query :: Stack.HasCallStack => Handler -> Query a -> Task Error a
query :: Handler -> Query a -> Task Error a
query Handler
handler Query a
query' =
Text -> Query a -> Query a
forall a. Text -> Query a -> Query a
namespaceQuery (Handler -> Text
namespace Handler
handler Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
":") Query a
query'
Query a -> (Query a -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (HasCallStack => Handler -> Query a -> Task Error a)
-> Handler -> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Handler -> Query a -> Task Error a
Handler -> forall a. HasCallStack => Query a -> Task Error a
doQuery Handler
handler
transaction :: Stack.HasCallStack => Handler -> Query a -> Task Error a
transaction :: Handler -> Query a -> Task Error a
transaction Handler
handler Query a
query' =
Text -> Query a -> Query a
forall a. Text -> Query a -> Query a
namespaceQuery (Handler -> Text
namespace Handler
handler Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
":") Query a
query'
Query a -> (Query a -> Task Error a) -> Task Error a
forall a b. a -> (a -> b) -> b
|> (HasCallStack => Handler -> Query a -> Task Error a)
-> Handler -> Query a -> Task Error a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack HasCallStack => Handler -> Query a -> Task Error a
Handler -> forall a. HasCallStack => Query a -> Task Error a
doTransaction Handler
handler
namespaceQuery :: Text -> Query a -> Query a
namespaceQuery :: Text -> Query a -> Query a
namespaceQuery Text
prefix Query a
query' =
case Query a
query' of
Exists Text
key -> Text -> Query Bool
Exists (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)
Query a
Ping -> Query a
Query Status
Ping
Get Text
key -> Text -> Query (Maybe ByteString)
Get (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)
Set Text
key ByteString
value -> Text -> ByteString -> Query ()
Set (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) ByteString
value
Setex Text
key Int
seconds ByteString
value -> Text -> Int -> ByteString -> Query ()
Setex (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) Int
seconds ByteString
value
Setnx Text
key ByteString
value -> Text -> ByteString -> Query Bool
Setnx (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) ByteString
value
Getset Text
key ByteString
value -> Text -> ByteString -> Query (Maybe ByteString)
Getset (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) ByteString
value
Mget NonEmpty Text
keys -> NonEmpty Text -> Query [Maybe ByteString]
Mget ((Text -> Text) -> NonEmpty Text -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (\Text
k -> Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
k) NonEmpty Text
keys)
Mset NonEmpty (Text, ByteString)
assocs -> NonEmpty (Text, ByteString) -> Query ()
Mset (((Text, ByteString) -> (Text, ByteString))
-> NonEmpty (Text, ByteString) -> NonEmpty (Text, ByteString)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (\(Text
k, ByteString
v) -> (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
k, ByteString
v)) NonEmpty (Text, ByteString)
assocs)
Del NonEmpty Text
keys -> NonEmpty Text -> Query Int
Del ((Text -> Text) -> NonEmpty Text -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++) NonEmpty Text
keys)
Hgetall Text
key -> Text -> Query (List (Text, ByteString))
Hgetall (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)
Hkeys Text
key -> Text -> Query [Text]
Hkeys (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)
Hmget Text
key NonEmpty Text
fields -> Text -> NonEmpty Text -> Query [Maybe ByteString]
Hmget (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) NonEmpty Text
fields
Hget Text
key Text
field -> Text -> Text -> Query (Maybe ByteString)
Hget (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) Text
field
Hset Text
key Text
field ByteString
val -> Text -> Text -> ByteString -> Query ()
Hset (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) Text
field ByteString
val
Hsetnx Text
key Text
field ByteString
val -> Text -> Text -> ByteString -> Query Bool
Hsetnx (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) Text
field ByteString
val
Hmset Text
key NonEmpty (Text, ByteString)
vals -> Text -> NonEmpty (Text, ByteString) -> Query ()
Hmset (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) NonEmpty (Text, ByteString)
vals
Hdel Text
key NonEmpty Text
fields -> Text -> NonEmpty Text -> Query Int
Hdel (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) NonEmpty Text
fields
Incr Text
key -> Text -> Query Int
Incr (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)
Incrby Text
key Int
amount -> Text -> Int -> Query Int
Incrby (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) Int
amount
Expire Text
key Int
secs -> Text -> Int -> Query ()
Expire (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) Int
secs
Lrange Text
key Int
lower Int
upper -> Text -> Int -> Int -> Query (List ByteString)
Lrange (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) Int
lower Int
upper
Rpush Text
key NonEmpty ByteString
vals -> Text -> NonEmpty ByteString -> Query Int
Rpush (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) NonEmpty ByteString
vals
Sadd Text
key NonEmpty ByteString
vals -> Text -> NonEmpty ByteString -> Query Int
Sadd (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) NonEmpty ByteString
vals
Scard Text
key -> Text -> Query Int
Scard (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)
Srem Text
key NonEmpty ByteString
vals -> Text -> NonEmpty ByteString -> Query Int
Srem (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key) NonEmpty ByteString
vals
Smembers Text
key -> Text -> Query (List ByteString)
Smembers (Text
prefix Text -> Text -> Text
forall appendable.
Semigroup appendable =>
appendable -> appendable -> appendable
++ Text
key)
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 -> Query (a -> a) -> Query (a -> a)
forall a. Text -> Query a -> Query a
namespaceQuery Text
prefix Query (a -> a)
f) (Text -> Query a -> Query a
forall a. Text -> Query a -> Query a
namespaceQuery Text
prefix 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 -> Query a -> Query a
forall a. Text -> Query a -> Query a
namespaceQuery Text
prefix Query a
q)
keysTouchedByQuery :: Query a -> Set.Set Text
keysTouchedByQuery :: 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
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
Smembers Text
key -> 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 :: 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
traceQuery :: Stack.HasCallStack => [Text] -> Text -> Maybe Int -> Task e a -> Task e a
traceQuery :: [Text] -> Text -> Maybe Int -> Task e a -> Task e a
traceQuery [Text]
commands Text
host Maybe Int
port Task e a
task =
let info :: Details
info =
Details
RedisCommands.emptyDetails
{ commands :: [Text]
RedisCommands.commands = [Text]
commands,
host :: Maybe Text
RedisCommands.host = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
host,
port :: Maybe Int
RedisCommands.port = Maybe Int
port
}
in (HasCallStack => Text -> Task e a -> Task e a)
-> Text -> Task e a -> Task e a
forall a. HasCallStack => (HasCallStack => a) -> a
Stack.withFrozenCallStack
HasCallStack => Text -> Task e a -> Task e a
forall e a. HasCallStack => Text -> Task e a -> Task e a
Platform.tracingSpan
Text
"Redis Query"
( Task e a -> Task e () -> Task e a
forall e a b. Task e a -> Task e b -> Task e a
Platform.finally
Task e a
task
( do
Details -> Task e ()
forall d e. TracingSpanDetails d => d -> Task e ()
Platform.setTracingSpanDetails Details
info
Text -> Task e ()
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)"
)
)
)