{-# LANGUAGE Strict #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-} -- for (RefInstance ref) in constraints in instance head
{-# OPTIONS_GHC -fno-warn-orphans #-} -- for Hedis.RedisResult (a,b,c)

-- | The schema-based Redis module.
--   This module is intended to be imported qualified.
--   That's why we don't have 'RedisRef' but rather 'Redis.Ref'.
module Database.Redis.Schema
  ( Pool(..), RedisM(..)
    -- Pool and RedisM export their internals so other libraries can provide combinators
    -- like runNonBlocking or others. These internals are not meant to be used ordinarily.
  , Redis, Instance, DefaultInstance
  , Tx, atomically, runTx
  , RedisException(..)
  , Ref(..), Value(..)
  , SimpleRef, SimpleValue, SimpleValueIdentifier(..), Serializable(..), Serializables(..)
  , TTL(..)
  , run
  , connect
  , incrementBy, incrementByFloat
  , txIncrementBy
  , get, set, getSet
  , txGet, txSet, txExpect
  , setWithTTL, setIfNotExists, setIfNotExists_
  , txSetWithTTL, txSetIfNotExists, txSetIfNotExists_
  , delete_, txDelete_
  , Database.Redis.Schema.take, txTake
  , setTTL, setTTLIfExists, setTTLIfExists_
  , txSetTTL, txSetTTLIfExists, txSetTTLIfExists_
  , readBS, showBS
  , showBinary, readBinary, colonSep
  , Tuple(..)
  , day, hour, minute, second
  , throw, throwMsg
  , sInsert, sDelete, sContains, sSize
  , Priority(..), zInsert, zSize, zCount, zDelete, zPopMin, bzPopMin, zRangeByScoreLimit
  , txSInsert, txSDelete, txSContains, txSSize
  , MapItem(..)
  , RecordField(..), RecordItem(..), Record
  , lLength, lAppend, txLAppend, lPushLeft, lPopRight, lPopRightBlocking, lRem
  , watch, unwatch
  , unliftIO
  , deleteIfEqual, setIfNotExistsTTL
  , PubSub, pubSubListen, pubSubCountSubs
  ) where

import GHC.Word         ( Word32  )
import Data.Functor     ( void, (<&>) )
import Data.Function    ( (&) )
import Data.Time        ( UTCTime, LocalTime, Day )
import Text.Read        ( readMaybe )
import Data.ByteString  ( ByteString )
import Data.Binary      ( Binary, encode, decodeOrFail )
import Data.Text        ( Text )
import Data.Text.Encoding ( encodeUtf8, decodeUtf8 )
import Data.Kind        ( Type )
import Data.Map         ( Map )
import Data.Set         ( Set )
import Data.Int         ( Int64 )
import Data.UUID        ( UUID )
import qualified Data.UUID as UUID

import Control.Applicative
import qualified Control.Arrow as Arrow
import Control.Monad        ( (<=<) )
import Control.Exception    ( throwIO, Exception )
import Control.Monad.Reader ( runReaderT, ask )
import Control.Monad.IO.Class ( liftIO, MonadIO )

import qualified Numeric.Limits
import qualified Database.Redis as Hedis
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified System.IO.Error as IOE

-- | Each instance has a distinct connection pool type.
-- (Hedis names it Connection but it's a pool.)
newtype Pool inst = Pool{Pool inst -> Connection
_unPool :: Hedis.Connection}

-- | Instance-indexed monad for Redis computations.
newtype RedisM inst a = Redis{RedisM inst a -> Redis a
unRedis :: Hedis.Redis a}
 deriving newtype (a -> RedisM inst b -> RedisM inst a
(a -> b) -> RedisM inst a -> RedisM inst b
(forall a b. (a -> b) -> RedisM inst a -> RedisM inst b)
-> (forall a b. a -> RedisM inst b -> RedisM inst a)
-> Functor (RedisM inst)
forall k (inst :: k) a b. a -> RedisM inst b -> RedisM inst a
forall k (inst :: k) a b.
(a -> b) -> RedisM inst a -> RedisM inst b
forall a b. a -> RedisM inst b -> RedisM inst a
forall a b. (a -> b) -> RedisM inst a -> RedisM inst b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RedisM inst b -> RedisM inst a
$c<$ :: forall k (inst :: k) a b. a -> RedisM inst b -> RedisM inst a
fmap :: (a -> b) -> RedisM inst a -> RedisM inst b
$cfmap :: forall k (inst :: k) a b.
(a -> b) -> RedisM inst a -> RedisM inst b
Functor, Functor (RedisM inst)
a -> RedisM inst a
Functor (RedisM inst)
-> (forall a. a -> RedisM inst a)
-> (forall a b.
    RedisM inst (a -> b) -> RedisM inst a -> RedisM inst b)
-> (forall a b c.
    (a -> b -> c) -> RedisM inst a -> RedisM inst b -> RedisM inst c)
-> (forall a b. RedisM inst a -> RedisM inst b -> RedisM inst b)
-> (forall a b. RedisM inst a -> RedisM inst b -> RedisM inst a)
-> Applicative (RedisM inst)
RedisM inst a -> RedisM inst b -> RedisM inst b
RedisM inst a -> RedisM inst b -> RedisM inst a
RedisM inst (a -> b) -> RedisM inst a -> RedisM inst b
(a -> b -> c) -> RedisM inst a -> RedisM inst b -> RedisM inst c
forall a. a -> RedisM inst a
forall k (inst :: k). Functor (RedisM inst)
forall k (inst :: k) a. a -> RedisM inst a
forall k (inst :: k) a b.
RedisM inst a -> RedisM inst b -> RedisM inst a
forall k (inst :: k) a b.
RedisM inst a -> RedisM inst b -> RedisM inst b
forall k (inst :: k) a b.
RedisM inst (a -> b) -> RedisM inst a -> RedisM inst b
forall k (inst :: k) a b c.
(a -> b -> c) -> RedisM inst a -> RedisM inst b -> RedisM inst c
forall a b. RedisM inst a -> RedisM inst b -> RedisM inst a
forall a b. RedisM inst a -> RedisM inst b -> RedisM inst b
forall a b. RedisM inst (a -> b) -> RedisM inst a -> RedisM inst b
forall a b c.
(a -> b -> c) -> RedisM inst a -> RedisM inst b -> RedisM inst c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: RedisM inst a -> RedisM inst b -> RedisM inst a
$c<* :: forall k (inst :: k) a b.
RedisM inst a -> RedisM inst b -> RedisM inst a
*> :: RedisM inst a -> RedisM inst b -> RedisM inst b
$c*> :: forall k (inst :: k) a b.
RedisM inst a -> RedisM inst b -> RedisM inst b
liftA2 :: (a -> b -> c) -> RedisM inst a -> RedisM inst b -> RedisM inst c
$cliftA2 :: forall k (inst :: k) a b c.
(a -> b -> c) -> RedisM inst a -> RedisM inst b -> RedisM inst c
<*> :: RedisM inst (a -> b) -> RedisM inst a -> RedisM inst b
$c<*> :: forall k (inst :: k) a b.
RedisM inst (a -> b) -> RedisM inst a -> RedisM inst b
pure :: a -> RedisM inst a
$cpure :: forall k (inst :: k) a. a -> RedisM inst a
$cp1Applicative :: forall k (inst :: k). Functor (RedisM inst)
Applicative, Applicative (RedisM inst)
a -> RedisM inst a
Applicative (RedisM inst)
-> (forall a b.
    RedisM inst a -> (a -> RedisM inst b) -> RedisM inst b)
-> (forall a b. RedisM inst a -> RedisM inst b -> RedisM inst b)
-> (forall a. a -> RedisM inst a)
-> Monad (RedisM inst)
RedisM inst a -> (a -> RedisM inst b) -> RedisM inst b
RedisM inst a -> RedisM inst b -> RedisM inst b
forall a. a -> RedisM inst a
forall k (inst :: k). Applicative (RedisM inst)
forall k (inst :: k) a. a -> RedisM inst a
forall k (inst :: k) a b.
RedisM inst a -> RedisM inst b -> RedisM inst b
forall k (inst :: k) a b.
RedisM inst a -> (a -> RedisM inst b) -> RedisM inst b
forall a b. RedisM inst a -> RedisM inst b -> RedisM inst b
forall a b. RedisM inst a -> (a -> RedisM inst b) -> RedisM inst b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> RedisM inst a
$creturn :: forall k (inst :: k) a. a -> RedisM inst a
>> :: RedisM inst a -> RedisM inst b -> RedisM inst b
$c>> :: forall k (inst :: k) a b.
RedisM inst a -> RedisM inst b -> RedisM inst b
>>= :: RedisM inst a -> (a -> RedisM inst b) -> RedisM inst b
$c>>= :: forall k (inst :: k) a b.
RedisM inst a -> (a -> RedisM inst b) -> RedisM inst b
$cp1Monad :: forall k (inst :: k). Applicative (RedisM inst)
Monad, Monad (RedisM inst)
Monad (RedisM inst)
-> (forall a. IO a -> RedisM inst a) -> MonadIO (RedisM inst)
IO a -> RedisM inst a
forall a. IO a -> RedisM inst a
forall k (inst :: k). Monad (RedisM inst)
forall k (inst :: k) a. IO a -> RedisM inst a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> RedisM inst a
$cliftIO :: forall k (inst :: k) a. IO a -> RedisM inst a
$cp1MonadIO :: forall k (inst :: k). Monad (RedisM inst)
MonadIO, Monad (RedisM inst)
Monad (RedisM inst)
-> (forall a. Redis a -> RedisM inst a) -> MonadRedis (RedisM inst)
Redis a -> RedisM inst a
forall a. Redis a -> RedisM inst a
forall k (inst :: k). Monad (RedisM inst)
forall k (inst :: k) a. Redis a -> RedisM inst a
forall (m :: * -> *).
Monad m -> (forall a. Redis a -> m a) -> MonadRedis m
liftRedis :: Redis a -> RedisM inst a
$cliftRedis :: forall k (inst :: k) a. Redis a -> RedisM inst a
$cp1MonadRedis :: forall k (inst :: k). Monad (RedisM inst)
Hedis.MonadRedis)

-- | The kind of Redis instances. Ideally, this would be a user-defined DataKind,
--   but since Haskell does not have implicit arguments,
--   that would require that we index everything with it explicitly,
--   which would create a lot of syntactic noise.
--
--   (Ab)using the Type kind for instances is a compromise.
type Instance = Type

-- | We also define a default instance.
--   This is convenient for code bases using only one Redis instance,
--   since 'RefInstance' defaults to this. (See the 'Ref' typeclass below.)
data DefaultInstance

-- | The Redis monad related to the default instance.
type Redis = RedisM DefaultInstance

instance Hedis.RedisCtx (RedisM inst) (Either Hedis.Reply) where
  returnDecode :: Reply -> RedisM inst (Either Reply a)
returnDecode = Redis (Either Reply a) -> RedisM inst (Either Reply a)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (Redis (Either Reply a) -> RedisM inst (Either Reply a))
-> (Reply -> Redis (Either Reply a))
-> Reply
-> RedisM inst (Either Reply a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> Redis (Either Reply a)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
Reply -> m (f a)
Hedis.returnDecode

data RedisException
  = BadConnectionString String String
  | CouldNotPing String
  | UnexpectedResult String String
  | UserException String
  | TransactionAborted
  | TransactionError String
  | CouldNotDecodeValue (Maybe ByteString)
  | LockAcquireTimeout
  | UnexpectedStatus String Hedis.Status
  | EmptyAlternative  -- for 'instance Alternative Tx'
  deriving (Int -> RedisException -> ShowS
[RedisException] -> ShowS
RedisException -> String
(Int -> RedisException -> ShowS)
-> (RedisException -> String)
-> ([RedisException] -> ShowS)
-> Show RedisException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RedisException] -> ShowS
$cshowList :: [RedisException] -> ShowS
show :: RedisException -> String
$cshow :: RedisException -> String
showsPrec :: Int -> RedisException -> ShowS
$cshowsPrec :: Int -> RedisException -> ShowS
Show, Show RedisException
Typeable RedisException
Typeable RedisException
-> Show RedisException
-> (RedisException -> SomeException)
-> (SomeException -> Maybe RedisException)
-> (RedisException -> String)
-> Exception RedisException
SomeException -> Maybe RedisException
RedisException -> String
RedisException -> SomeException
forall e.
Typeable e
-> Show e
-> (e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> Exception e
displayException :: RedisException -> String
$cdisplayException :: RedisException -> String
fromException :: SomeException -> Maybe RedisException
$cfromException :: SomeException -> Maybe RedisException
toException :: RedisException -> SomeException
$ctoException :: RedisException -> SomeException
$cp2Exception :: Show RedisException
$cp1Exception :: Typeable RedisException
Exception)

-- | Time-To-Live for Redis values. The Num instance works in (integral) seconds.
newtype TTL = TTLSec { TTL -> Integer
ttlToSeconds :: Integer }
  deriving newtype (TTL -> TTL -> Bool
(TTL -> TTL -> Bool) -> (TTL -> TTL -> Bool) -> Eq TTL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TTL -> TTL -> Bool
$c/= :: TTL -> TTL -> Bool
== :: TTL -> TTL -> Bool
$c== :: TTL -> TTL -> Bool
Eq, Eq TTL
Eq TTL
-> (TTL -> TTL -> Ordering)
-> (TTL -> TTL -> Bool)
-> (TTL -> TTL -> Bool)
-> (TTL -> TTL -> Bool)
-> (TTL -> TTL -> Bool)
-> (TTL -> TTL -> TTL)
-> (TTL -> TTL -> TTL)
-> Ord TTL
TTL -> TTL -> Bool
TTL -> TTL -> Ordering
TTL -> TTL -> TTL
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TTL -> TTL -> TTL
$cmin :: TTL -> TTL -> TTL
max :: TTL -> TTL -> TTL
$cmax :: TTL -> TTL -> TTL
>= :: TTL -> TTL -> Bool
$c>= :: TTL -> TTL -> Bool
> :: TTL -> TTL -> Bool
$c> :: TTL -> TTL -> Bool
<= :: TTL -> TTL -> Bool
$c<= :: TTL -> TTL -> Bool
< :: TTL -> TTL -> Bool
$c< :: TTL -> TTL -> Bool
compare :: TTL -> TTL -> Ordering
$ccompare :: TTL -> TTL -> Ordering
$cp1Ord :: Eq TTL
Ord, Integer -> TTL
TTL -> TTL
TTL -> TTL -> TTL
(TTL -> TTL -> TTL)
-> (TTL -> TTL -> TTL)
-> (TTL -> TTL -> TTL)
-> (TTL -> TTL)
-> (TTL -> TTL)
-> (TTL -> TTL)
-> (Integer -> TTL)
-> Num TTL
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> TTL
$cfromInteger :: Integer -> TTL
signum :: TTL -> TTL
$csignum :: TTL -> TTL
abs :: TTL -> TTL
$cabs :: TTL -> TTL
negate :: TTL -> TTL
$cnegate :: TTL -> TTL
* :: TTL -> TTL -> TTL
$c* :: TTL -> TTL -> TTL
- :: TTL -> TTL -> TTL
$c- :: TTL -> TTL -> TTL
+ :: TTL -> TTL -> TTL
$c+ :: TTL -> TTL -> TTL
Num)

run :: MonadIO m => Pool inst -> RedisM inst a -> m a
run :: Pool inst -> RedisM inst a -> m a
run (Pool Connection
pool) = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> (RedisM inst a -> IO a) -> RedisM inst a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> Redis a -> IO a
forall a. Connection -> Redis a -> IO a
Hedis.runRedis Connection
pool (Redis a -> IO a)
-> (RedisM inst a -> Redis a) -> RedisM inst a -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisM inst a -> Redis a
forall k (inst :: k) a. RedisM inst a -> Redis a
unRedis

throw :: RedisException -> RedisM inst a
throw :: RedisException -> RedisM inst a
throw = IO a -> RedisM inst a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> RedisM inst a)
-> (RedisException -> IO a) -> RedisException -> RedisM inst a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisException -> IO a
forall e a. Exception e => e -> IO a
throwIO

throwMsg :: String -> RedisM inst a
throwMsg :: String -> RedisM inst a
throwMsg = RedisException -> RedisM inst a
forall k (inst :: k) a. RedisException -> RedisM inst a
throw (RedisException -> RedisM inst a)
-> (String -> RedisException) -> String -> RedisM inst a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RedisException
UserException

-- | Expect Right, otherwise throw UnexpectedResult.
expectRight :: Show e => String -> Either e a -> RedisM inst a
expectRight :: String -> Either e a -> RedisM inst a
expectRight String
_msg (Right a
x) = a -> RedisM inst a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
expectRight  String
msg (Left e
e) = RedisException -> RedisM inst a
forall k (inst :: k) a. RedisException -> RedisM inst a
throw (RedisException -> RedisM inst a)
-> RedisException -> RedisM inst a
forall a b. (a -> b) -> a -> b
$ String -> String -> RedisException
UnexpectedResult (String
"Redis.expectRight: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg) (Either e () -> String
forall a. Show a => a -> String
show (Either e () -> String) -> Either e () -> String
forall a b. (a -> b) -> a -> b
$ e -> Either e ()
forall e. e -> Either e ()
left e
e)
  where
    -- hard to give this type to Left inline
    left :: e -> Either e ()
    left :: e -> Either e ()
left = e -> Either e ()
forall a b. a -> Either a b
Left

-- | Expect transaction success, otherwise throw.
expectTxSuccess :: Hedis.TxResult a -> RedisM inst a
expectTxSuccess :: TxResult a -> RedisM inst a
expectTxSuccess (Hedis.TxSuccess a
x) = a -> RedisM inst a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
expectTxSuccess  TxResult a
Hedis.TxAborted    = RedisException -> RedisM inst a
forall k (inst :: k) a. RedisException -> RedisM inst a
throw RedisException
TransactionAborted
expectTxSuccess (Hedis.TxError String
err) = RedisException -> RedisM inst a
forall k (inst :: k) a. RedisException -> RedisM inst a
throw (RedisException -> RedisM inst a)
-> RedisException -> RedisM inst a
forall a b. (a -> b) -> a -> b
$ String -> RedisException
TransactionError String
err

-- | Expect exact value, otherwise throw UnexpectedResult.
expect :: (Eq a, Show a) => String -> a -> a -> RedisM inst ()
expect :: String -> a -> a -> RedisM inst ()
expect String
msg a
expected a
actual
  | a
expected a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
actual = () -> RedisM inst ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = RedisException -> RedisM inst ()
forall k (inst :: k) a. RedisException -> RedisM inst a
throw (RedisException -> RedisM inst ())
-> RedisException -> RedisM inst ()
forall a b. (a -> b) -> a -> b
$ String -> String -> RedisException
UnexpectedResult (String
"Redis.expect: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg) (a -> String
forall a. Show a => a -> String
show a
actual)

-- Useful in combination with the expect* functions.
ignore :: a -> RedisM inst ()
ignore :: a -> RedisM inst ()
ignore a
_ = () -> RedisM inst ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Open a connection pool to redis
connect :: String -> Int -> IO (Pool inst)
connect :: String -> Int -> IO (Pool inst)
connect String
connectionString Int
poolSize =
  case String -> Either String ConnectInfo
Hedis.parseConnectInfo String
connectionString of
    Left String
err -> RedisException -> IO (Pool inst)
forall e a. Exception e => e -> IO a
throwIO (RedisException -> IO (Pool inst))
-> RedisException -> IO (Pool inst)
forall a b. (a -> b) -> a -> b
$ String -> String -> RedisException
BadConnectionString String
connectionString String
err
    Right ConnectInfo
connInfo -> do
      Connection
pool <- ConnectInfo -> IO Connection
Hedis.connect ConnectInfo
connInfo
        { connectMaxConnections :: Int
Hedis.connectMaxConnections = Int
poolSize
        }
      String -> IO (Either Reply Status) -> IO (Either Reply Status)
forall a. String -> IO a -> IO a
customizeIOError String
connectionString (Connection
-> Redis (Either Reply Status) -> IO (Either Reply Status)
forall a. Connection -> Redis a -> IO a
Hedis.runRedis Connection
pool Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Status)
Hedis.ping) IO (Either Reply Status)
-> (Either Reply Status -> IO (Pool inst)) -> IO (Pool inst)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Right Status
Hedis.Pong -> Pool inst -> IO (Pool inst)
forall (m :: * -> *) a. Monad m => a -> m a
return (Connection -> Pool inst
forall k (inst :: k). Connection -> Pool inst
Pool Connection
pool)
        Either Reply Status
resp -> RedisException -> IO (Pool inst)
forall e a. Exception e => e -> IO a
throwIO (RedisException -> IO (Pool inst))
-> RedisException -> IO (Pool inst)
forall a b. (a -> b) -> a -> b
$ String -> RedisException
CouldNotPing (Either Reply Status -> String
forall a. Show a => a -> String
show Either Reply Status
resp)
  where
    -- Runs an IO action and prepends a custom error message to any occuring IOError
    customizeIOError :: String -> IO a -> IO a
    customizeIOError :: String -> IO a -> IO a
customizeIOError String
errorMessage IO a
action = (IOError -> IOError) -> IO a -> IO a
forall a. (IOError -> IOError) -> IO a -> IO a
IOE.modifyIOError IOError -> IOError
customError IO a
action
      where
      customError :: IOError -> IOError
      customError :: IOError -> IOError
customError IOError
err = IOError -> String -> IOError
IOE.ioeSetErrorString IOError
err (String
errorMessage String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"; " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> IOError -> String
IOE.ioeGetErrorString IOError
err)

-- | Redis transactions.
--
-- In comparison with Hedis transactions:
--
-- * 'Tx' is newtyped as a separate functor for clearer types and better error messages.
--
-- * 'Tx' is not a monad, just an 'Applicative' functor.
--   Applicative exactly corresponds to the nature of Redis transactions,
--   and does not need 'Queued' hacks.
--
-- * 'Tx' supports throwing, and catching via 'Alternative'.
--   Beware that 'Tx' is 'Applicative' so all side effects will be carried out,
--   whether any actions throw or not. Throwing and catching is done at the level
--   where the _results_ of the individual applicative actions are composed.
--
-- You can still have do-notation with the @ApplicativeDo@ extension.
newtype Tx inst a = Tx
  { Tx inst a -> RedisTx (Queued (Either RedisException a))
unTx :: Hedis.RedisTx (Hedis.Queued (Either RedisException a))
  }

instance Functor (Tx inst) where
  fmap :: (a -> b) -> Tx inst a -> Tx inst b
fmap a -> b
f (Tx RedisTx (Queued (Either RedisException a))
tx) = RedisTx (Queued (Either RedisException b)) -> Tx inst b
forall k (inst :: k) a.
RedisTx (Queued (Either RedisException a)) -> Tx inst a
Tx (RedisTx (Queued (Either RedisException b)) -> Tx inst b)
-> RedisTx (Queued (Either RedisException b)) -> Tx inst b
forall a b. (a -> b) -> a -> b
$ (Queued (Either RedisException a)
 -> Queued (Either RedisException b))
-> RedisTx (Queued (Either RedisException a))
-> RedisTx (Queued (Either RedisException b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either RedisException a -> Either RedisException b)
-> Queued (Either RedisException a)
-> Queued (Either RedisException b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either RedisException a -> Either RedisException b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f)) RedisTx (Queued (Either RedisException a))
tx

instance Applicative (Tx inst) where
  pure :: a -> Tx inst a
pure a
x = RedisTx (Queued (Either RedisException a)) -> Tx inst a
forall k (inst :: k) a.
RedisTx (Queued (Either RedisException a)) -> Tx inst a
Tx (RedisTx (Queued (Either RedisException a)) -> Tx inst a)
-> RedisTx (Queued (Either RedisException a)) -> Tx inst a
forall a b. (a -> b) -> a -> b
$ Queued (Either RedisException a)
-> RedisTx (Queued (Either RedisException a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RedisException a -> Queued (Either RedisException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either RedisException a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x))
  Tx RedisTx (Queued (Either RedisException (a -> b)))
txF <*> :: Tx inst (a -> b) -> Tx inst a -> Tx inst b
<*> Tx RedisTx (Queued (Either RedisException a))
txX = RedisTx (Queued (Either RedisException b)) -> Tx inst b
forall k (inst :: k) a.
RedisTx (Queued (Either RedisException a)) -> Tx inst a
Tx (RedisTx (Queued (Either RedisException b)) -> Tx inst b)
-> RedisTx (Queued (Either RedisException b)) -> Tx inst b
forall a b. (a -> b) -> a -> b
$ do
    Queued (Either RedisException (a -> b))
queuedF <- RedisTx (Queued (Either RedisException (a -> b)))
txF
    Queued (Either RedisException a)
queuedX <- RedisTx (Queued (Either RedisException a))
txX
    Queued (Either RedisException b)
-> RedisTx (Queued (Either RedisException b))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Queued (Either RedisException b)
 -> RedisTx (Queued (Either RedisException b)))
-> Queued (Either RedisException b)
-> RedisTx (Queued (Either RedisException b))
forall a b. (a -> b) -> a -> b
$ do
      Either RedisException (a -> b)
eitherF <- Queued (Either RedisException (a -> b))
queuedF
      Either RedisException a
eitherX <- Queued (Either RedisException a)
queuedX
      Either RedisException b -> Queued (Either RedisException b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RedisException (a -> b)
eitherF Either RedisException (a -> b)
-> Either RedisException a -> Either RedisException b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either RedisException a
eitherX)

instance Alternative (Tx inst) where
  empty :: Tx inst a
empty = RedisException -> Tx inst a
forall k (inst :: k) a. RedisException -> Tx inst a
txThrow RedisException
EmptyAlternative
  Tx RedisTx (Queued (Either RedisException a))
txX <|> :: Tx inst a -> Tx inst a -> Tx inst a
<|> Tx RedisTx (Queued (Either RedisException a))
txY = RedisTx (Queued (Either RedisException a)) -> Tx inst a
forall k (inst :: k) a.
RedisTx (Queued (Either RedisException a)) -> Tx inst a
Tx (RedisTx (Queued (Either RedisException a)) -> Tx inst a)
-> RedisTx (Queued (Either RedisException a)) -> Tx inst a
forall a b. (a -> b) -> a -> b
$ do
    Queued (Either RedisException a)
queuedX <- RedisTx (Queued (Either RedisException a))
txX
    Queued (Either RedisException a)
queuedY <- RedisTx (Queued (Either RedisException a))
txY
    Queued (Either RedisException a)
-> RedisTx (Queued (Either RedisException a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Queued (Either RedisException a)
 -> RedisTx (Queued (Either RedisException a)))
-> Queued (Either RedisException a)
-> RedisTx (Queued (Either RedisException a))
forall a b. (a -> b) -> a -> b
$ do
      Either RedisException a
eitherX <- Queued (Either RedisException a)
queuedX
      Either RedisException a
eitherY <- Queued (Either RedisException a)
queuedY
      Either RedisException a -> Queued (Either RedisException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RedisException a -> Queued (Either RedisException a))
-> Either RedisException a -> Queued (Either RedisException a)
forall a b. (a -> b) -> a -> b
$ case Either RedisException a
eitherX of
        Right a
x -> a -> Either RedisException a
forall a b. b -> Either a b
Right a
x
        Left RedisException
_err -> case Either RedisException a
eitherY of
          Right a
y -> a -> Either RedisException a
forall a b. b -> Either a b
Right a
y
          Left RedisException
err -> RedisException -> Either RedisException a
forall a b. a -> Either a b
Left RedisException
err

-- | Run a Redis transaction and return its result.
--
-- Most code will probably want to use 'atomically' instead,
-- which automatically propagates errors.
runTx :: Tx inst a -> RedisM inst (Hedis.TxResult (Either RedisException a))
runTx :: Tx inst a -> RedisM inst (TxResult (Either RedisException a))
runTx = Redis (TxResult (Either RedisException a))
-> RedisM inst (TxResult (Either RedisException a))
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (Redis (TxResult (Either RedisException a))
 -> RedisM inst (TxResult (Either RedisException a)))
-> (Tx inst a -> Redis (TxResult (Either RedisException a)))
-> Tx inst a
-> RedisM inst (TxResult (Either RedisException a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued (Either RedisException a))
-> Redis (TxResult (Either RedisException a))
forall a. RedisTx (Queued a) -> Redis (TxResult a)
Hedis.multiExec (RedisTx (Queued (Either RedisException a))
 -> Redis (TxResult (Either RedisException a)))
-> (Tx inst a -> RedisTx (Queued (Either RedisException a)))
-> Tx inst a
-> Redis (TxResult (Either RedisException a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tx inst a -> RedisTx (Queued (Either RedisException a))
forall k (inst :: k) a.
Tx inst a -> RedisTx (Queued (Either RedisException a))
unTx

-- | Throw in a transaction.
txThrow :: RedisException -> Tx inst a
txThrow :: RedisException -> Tx inst a
txThrow RedisException
e = RedisTx (Queued (Either RedisException a)) -> Tx inst a
forall k (inst :: k) a.
RedisTx (Queued (Either RedisException a)) -> Tx inst a
Tx (RedisTx (Queued (Either RedisException a)) -> Tx inst a)
-> RedisTx (Queued (Either RedisException a)) -> Tx inst a
forall a b. (a -> b) -> a -> b
$ Queued (Either RedisException a)
-> RedisTx (Queued (Either RedisException a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either RedisException a -> Queued (Either RedisException a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (RedisException -> Either RedisException a
forall a b. a -> Either a b
Left RedisException
e))

-- | Embed a raw Hedis action in a 'Tx' transaction.
txWrap :: Hedis.RedisTx (Hedis.Queued a) -> Tx inst a
txWrap :: RedisTx (Queued a) -> Tx inst a
txWrap RedisTx (Queued a)
action = RedisTx (Queued (Either RedisException a)) -> Tx inst a
forall k (inst :: k) a.
RedisTx (Queued (Either RedisException a)) -> Tx inst a
Tx ((a -> Either RedisException a)
-> Queued a -> Queued (Either RedisException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Either RedisException a
forall a b. b -> Either a b
Right (Queued a -> Queued (Either RedisException a))
-> RedisTx (Queued a) -> RedisTx (Queued (Either RedisException a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RedisTx (Queued a)
action)

-- | Run a 'Tx' transaction, propagating any errors.
atomically :: Tx inst a -> RedisM inst a
atomically :: Tx inst a -> RedisM inst a
atomically Tx inst a
tx = Tx inst a -> RedisM inst (TxResult (Either RedisException a))
forall k (inst :: k) a.
Tx inst a -> RedisM inst (TxResult (Either RedisException a))
runTx Tx inst a
tx RedisM inst (TxResult (Either RedisException a))
-> (TxResult (Either RedisException a)
    -> RedisM inst (Either RedisException a))
-> RedisM inst (Either RedisException a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxResult (Either RedisException a)
-> RedisM inst (Either RedisException a)
forall k a (inst :: k). TxResult a -> RedisM inst a
expectTxSuccess RedisM inst (Either RedisException a)
-> (Either RedisException a -> RedisM inst a) -> RedisM inst a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Right a
x -> a -> RedisM inst a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
  Left  RedisException
e -> RedisException -> RedisM inst a
forall k (inst :: k) a. RedisException -> RedisM inst a
throw RedisException
e

-- | Apply a possibly failing computation to the result of a transaction.
--
-- Useful for implementation of various checks.
txCheckMap :: (a -> Either RedisException b) -> Tx inst a -> Tx inst b
txCheckMap :: (a -> Either RedisException b) -> Tx inst a -> Tx inst b
txCheckMap a -> Either RedisException b
f (Tx RedisTx (Queued (Either RedisException a))
tx) = RedisTx (Queued (Either RedisException b)) -> Tx inst b
forall k (inst :: k) a.
RedisTx (Queued (Either RedisException a)) -> Tx inst a
Tx ((Queued (Either RedisException a)
 -> Queued (Either RedisException b))
-> RedisTx (Queued (Either RedisException a))
-> RedisTx (Queued (Either RedisException b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Either RedisException a -> Either RedisException b)
-> Queued (Either RedisException a)
-> Queued (Either RedisException b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either RedisException a -> Either RedisException b
g) RedisTx (Queued (Either RedisException a))
tx)
  where
    g :: Either RedisException a -> Either RedisException b
g (Left RedisException
e) = RedisException -> Either RedisException b
forall a b. a -> Either a b
Left RedisException
e  -- we already had an error here
    g (Right a
x) = a -> Either RedisException b
f a
x    -- possibly fail

-- | Expect an exact value.
txExpect :: (Eq a, Show a) => String -> a -> Tx inst a -> Tx inst ()
txExpect :: String -> a -> Tx inst a -> Tx inst ()
txExpect String
msg a
expected = Tx inst a -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst a -> Tx inst ())
-> (Tx inst a -> Tx inst a) -> Tx inst a -> Tx inst ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Either RedisException a) -> Tx inst a -> Tx inst a
forall k a b (inst :: k).
(a -> Either RedisException b) -> Tx inst a -> Tx inst b
txCheckMap a -> Either RedisException a
f
  where
    f :: a -> Either RedisException a
f a
x | a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected = a -> Either RedisException a
forall a b. b -> Either a b
Right a
x
        | Bool
otherwise = RedisException -> Either RedisException a
forall a b. a -> Either a b
Left (RedisException -> Either RedisException a)
-> RedisException -> Either RedisException a
forall a b. (a -> b) -> a -> b
$ String -> String -> RedisException
UnexpectedResult String
msg (a -> String
forall a. Show a => a -> String
show a
x)

-- | Reference to some abstract Redis value.
--
-- 'ByteString's are inappropriate for this purpose:
--
-- * 'Ref's are typed.
--
-- * bytestring concatenation and other faffing is ugly and error-prone.
--
-- * some values may be stored across several Redis keys,
--   (such as Tiers.Redis.Profile),
--   in which case bytestrings are not even sufficient.
--
-- All methods have defaults for easy implementation of 'SimpleValue's for new types.
-- For simple values, it's sufficient to implement (or newtype-derive) 'SimpleValue',
-- and declare an empty @instance Value <TheType>@.
class Value (RefInstance ref) (ValueType ref) => Ref ref where
  -- | Type of the value that this ref points to.
  type ValueType ref :: Type

  -- | RedisM instance this ref points into, with a default.
  type RefInstance ref :: Instance
  type RefInstance ref = DefaultInstance

  -- | How to convert the ref to an identifier that its value accepts.
  toIdentifier :: ref -> Identifier (ValueType ref)

-- | Type that can be read/written from Redis.
--
-- This can be a simple value, such as string or integer, or a composite value,
-- such as a complex record stored across multiple keys, hashes, sets and lists.
--
-- We parameterise the typeclass with the Redis instance.
-- Most Value instances will want to keep 'inst' open
-- but some may need to restrict it to a particular Redis instance;
-- especially those that access Refs under the hood, since Refs are instance-specific.
class Value inst val where
  -- | How the value is identified in Redis.
  --
  -- Types like hashes, sets or list are always top-level keys in Redis,
  -- so these are identified by bytestrings. Simple values can be top-level
  -- or hash fields, so they are identified by SimpleValueIdentifier.
  -- Complex values may be identified by something else; for example
  -- 'Tiers.Redis.Profile' is identified by a 'Tiers.Token',
  -- because it's a complex value spread across multiple Redis keys.
  type Identifier val :: Type
  type Identifier val = SimpleValueIdentifier  -- default


  -- | Read a value from Redis in a transaction.
  txValGet :: Identifier val -> Tx inst (Maybe val)

  default txValGet :: SimpleValue inst val => Identifier val -> Tx inst (Maybe val)
  txValGet (SviTopLevel keyBS) = (Maybe ByteString -> Maybe val)
-> Tx inst (Maybe ByteString) -> Tx inst (Maybe val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Maybe val
forall val. Serializable val => ByteString -> Maybe val
fromBS (ByteString -> Maybe val) -> Maybe ByteString -> Maybe val
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Tx inst (Maybe ByteString) -> Tx inst (Maybe val))
-> (RedisTx (Queued (Maybe ByteString))
    -> Tx inst (Maybe ByteString))
-> RedisTx (Queued (Maybe ByteString))
-> Tx inst (Maybe val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued (Maybe ByteString)) -> Tx inst (Maybe ByteString)
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued (Maybe ByteString)) -> Tx inst (Maybe val))
-> RedisTx (Queued (Maybe ByteString)) -> Tx inst (Maybe val)
forall a b. (a -> b) -> a -> b
$ ByteString -> RedisTx (Queued (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Hedis.get ByteString
keyBS
  txValGet (SviHash keyBS hkeyBS) = (Maybe ByteString -> Maybe val)
-> Tx inst (Maybe ByteString) -> Tx inst (Maybe val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Maybe val
forall val. Serializable val => ByteString -> Maybe val
fromBS (ByteString -> Maybe val) -> Maybe ByteString -> Maybe val
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Tx inst (Maybe ByteString) -> Tx inst (Maybe val))
-> (RedisTx (Queued (Maybe ByteString))
    -> Tx inst (Maybe ByteString))
-> RedisTx (Queued (Maybe ByteString))
-> Tx inst (Maybe val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued (Maybe ByteString)) -> Tx inst (Maybe ByteString)
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued (Maybe ByteString)) -> Tx inst (Maybe val))
-> RedisTx (Queued (Maybe ByteString)) -> Tx inst (Maybe val)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> RedisTx (Queued (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
Hedis.hget ByteString
keyBS ByteString
hkeyBS

  -- | Write a value to Redis in a transaction.
  txValSet :: Identifier val -> val -> Tx inst ()

  default txValSet :: SimpleValue inst val => Identifier val -> val -> Tx inst ()
  txValSet (SviTopLevel keyBS) val
val =
    String -> Status -> Tx inst Status -> Tx inst ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> Tx inst a -> Tx inst ()
txExpect String
"txValSet/plain" Status
Hedis.Ok
      (Tx inst Status -> Tx inst ()) -> Tx inst Status -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ RedisTx (Queued Status) -> Tx inst Status
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (ByteString -> ByteString -> RedisTx (Queued Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Hedis.set ByteString
keyBS (ByteString -> RedisTx (Queued Status))
-> ByteString -> RedisTx (Queued Status)
forall a b. (a -> b) -> a -> b
$ val -> ByteString
forall val. Serializable val => val -> ByteString
toBS val
val)
  txValSet (SviHash keyBS hkeyBS) val
val =
    Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void
      (Tx inst Integer -> Tx inst ()) -> Tx inst Integer -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (ByteString -> ByteString -> ByteString -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
Hedis.hset ByteString
keyBS ByteString
hkeyBS (ByteString -> RedisTx (Queued Integer))
-> ByteString -> RedisTx (Queued Integer)
forall a b. (a -> b) -> a -> b
$ val -> ByteString
forall val. Serializable val => val -> ByteString
toBS val
val)

  -- | Delete a value from Redis in a transaction.
  txValDelete :: Identifier val -> Tx inst ()

  default txValDelete :: SimpleValue inst val => Identifier val -> Tx inst ()
  txValDelete (SviTopLevel keyBS) = Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ())
-> (RedisTx (Queued Integer) -> Tx inst Integer)
-> RedisTx (Queued Integer)
-> Tx inst ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Integer) -> Tx inst ())
-> RedisTx (Queued Integer) -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
keyBS]
  txValDelete (SviHash keyBS hkeyBS) = Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ())
-> (RedisTx (Queued Integer) -> Tx inst Integer)
-> RedisTx (Queued Integer)
-> Tx inst ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Integer) -> Tx inst ())
-> RedisTx (Queued Integer) -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.hdel ByteString
keyBS [ByteString
hkeyBS]

  -- | Set time-to-live for a value in a transaction. Return 'True' if the value exists.
  txValSetTTLIfExists :: Identifier val -> TTL -> Tx inst Bool

  default txValSetTTLIfExists :: SimpleValue inst val => Identifier val -> TTL -> Tx inst Bool
  txValSetTTLIfExists (SviTopLevel keyBS) (TTLSec Integer
ttlSec) =
    RedisTx (Queued Bool) -> Tx inst Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Bool) -> Tx inst Bool)
-> RedisTx (Queued Bool) -> Tx inst Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
keyBS Integer
ttlSec
  txValSetTTLIfExists (SviHash keyBS _hkeyBS) (TTLSec Integer
ttlSec) =
    RedisTx (Queued Bool) -> Tx inst Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Bool) -> Tx inst Bool)
-> RedisTx (Queued Bool) -> Tx inst Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
keyBS Integer
ttlSec


  -- | Read a value.
  valGet :: Identifier val -> RedisM inst (Maybe val)

  default valGet :: SimpleValue inst val => Identifier val -> RedisM inst (Maybe val)
  valGet (SviTopLevel keyBS) =
    (Maybe ByteString -> Maybe val)
-> RedisM inst (Maybe ByteString) -> RedisM inst (Maybe val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Maybe val
forall val. Serializable val => ByteString -> Maybe val
fromBS (ByteString -> Maybe val) -> Maybe ByteString -> Maybe val
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (RedisM inst (Maybe ByteString) -> RedisM inst (Maybe val))
-> (Either Reply (Maybe ByteString)
    -> RedisM inst (Maybe ByteString))
-> Either Reply (Maybe ByteString)
-> RedisM inst (Maybe val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Either Reply (Maybe ByteString)
-> RedisM inst (Maybe ByteString)
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valGet/plain" (Either Reply (Maybe ByteString) -> RedisM inst (Maybe val))
-> RedisM inst (Either Reply (Maybe ByteString))
-> RedisM inst (Maybe val)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> RedisM inst (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Hedis.get ByteString
keyBS
  valGet (SviHash keyBS hkeyBS) =
    (Maybe ByteString -> Maybe val)
-> RedisM inst (Maybe ByteString) -> RedisM inst (Maybe val)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Maybe val
forall val. Serializable val => ByteString -> Maybe val
fromBS (ByteString -> Maybe val) -> Maybe ByteString -> Maybe val
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (RedisM inst (Maybe ByteString) -> RedisM inst (Maybe val))
-> (Either Reply (Maybe ByteString)
    -> RedisM inst (Maybe ByteString))
-> Either Reply (Maybe ByteString)
-> RedisM inst (Maybe val)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Either Reply (Maybe ByteString)
-> RedisM inst (Maybe ByteString)
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valGet/hash" (Either Reply (Maybe ByteString) -> RedisM inst (Maybe val))
-> RedisM inst (Either Reply (Maybe ByteString))
-> RedisM inst (Maybe val)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString
-> ByteString -> RedisM inst (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
Hedis.hget ByteString
keyBS ByteString
hkeyBS

  -- | Write a value.
  valSet :: Identifier val -> val -> RedisM inst ()

  default valSet :: SimpleValue inst val => Identifier val -> val -> RedisM inst ()
  valSet (SviTopLevel keyBS) val
val =
    String
-> Either Reply Status -> Either Reply Status -> RedisM inst ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> a -> RedisM inst ()
expect String
"valSet/plain" (Status -> Either Reply Status
forall a b. b -> Either a b
Right Status
Hedis.Ok) (Either Reply Status -> RedisM inst ())
-> RedisM inst (Either Reply Status) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> ByteString -> RedisM inst (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Status)
Hedis.set ByteString
keyBS (val -> ByteString
forall val. Serializable val => val -> ByteString
toBS val
val)
  valSet (SviHash keyBS hkeyBS) val
val =
    Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore {- @Integer -} (Integer -> RedisM inst ())
-> RedisM inst Integer -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Either Reply Integer -> RedisM inst Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valSet/hash" (Either Reply Integer -> RedisM inst Integer)
-> RedisM inst (Either Reply Integer) -> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString
-> ByteString -> ByteString -> RedisM inst (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Integer)
Hedis.hset ByteString
keyBS ByteString
hkeyBS (val -> ByteString
forall val. Serializable val => val -> ByteString
toBS val
val)
      --   ^- this is Bool in some versions of Hedis and Integer in others

  -- | Delete a value.
  valDelete :: Identifier val -> RedisM inst ()

  default valDelete :: SimpleValue inst val => Identifier val -> RedisM inst ()
  valDelete (SviTopLevel keyBS) =
    forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer (Integer -> RedisM inst ())
-> RedisM inst Integer -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Either Reply Integer -> RedisM inst Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valDelete/plain" (Either Reply Integer -> RedisM inst Integer)
-> RedisM inst (Either Reply Integer) -> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [ByteString] -> RedisM inst (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
keyBS]
  valDelete (SviHash keyBS hkeyBS) =
    forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer (Integer -> RedisM inst ())
-> RedisM inst Integer -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< String -> Either Reply Integer -> RedisM inst Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valDelete/hash" (Either Reply Integer -> RedisM inst Integer)
-> RedisM inst (Either Reply Integer) -> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> [ByteString] -> RedisM inst (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.hdel ByteString
keyBS [ByteString
hkeyBS]

  -- | Set time-to-live for a value. Return 'True' if the value exists.
  valSetTTLIfExists :: Identifier val -> TTL -> RedisM inst Bool

  default valSetTTLIfExists :: SimpleValue inst val => Identifier val -> TTL -> RedisM inst Bool
  valSetTTLIfExists (SviTopLevel keyBS) (TTLSec Integer
ttlSec) =
    String -> Either Reply Bool -> RedisM inst Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valSetTTLIfExists/plain" (Either Reply Bool -> RedisM inst Bool)
-> RedisM inst (Either Reply Bool) -> RedisM inst Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Integer -> RedisM inst (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
keyBS Integer
ttlSec
  valSetTTLIfExists (SviHash keyBS _hkeyBS) (TTLSec Integer
ttlSec) =
    String -> Either Reply Bool -> RedisM inst Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valSetTTLIfExists/hash" (Either Reply Bool -> RedisM inst Bool)
-> RedisM inst (Either Reply Bool) -> RedisM inst Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> Integer -> RedisM inst (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
keyBS Integer
ttlSec

data SimpleValueIdentifier
  = SviTopLevel ByteString         -- ^ Stored in a top-level key.
  | SviHash ByteString ByteString  -- ^ Stored in a hash field.

-- | Simple values, like strings, integers or enums,
-- that be represented as a single bytestring.
--
-- Of course, any value can be represented as a single bytestring,
-- but structures like lists, hashes and sets have special support in Redis.
-- This allows insertions, updates, etc. in Redis directly,
-- but they cannot be read or written as bytestrings, and thus are not 'SimpleValue's.
class (Value inst val, Identifier val ~ SimpleValueIdentifier, Serializable val) => SimpleValue inst val

class Serializable val where
  fromBS :: ByteString -> Maybe val
  toBS :: val -> ByteString

-- | 'Ref' pointing to a 'SimpleValue'.
type SimpleRef ref = (Ref ref, SimpleValue (RefInstance ref) (ValueType ref))

get :: Ref ref => ref -> RedisM (RefInstance ref) (Maybe (ValueType ref))
get :: ref -> RedisM (RefInstance ref) (Maybe (ValueType ref))
get = Identifier (ValueType ref)
-> RedisM (RefInstance ref) (Maybe (ValueType ref))
forall k (inst :: k) val.
Value inst val =>
Identifier val -> RedisM inst (Maybe val)
valGet (Identifier (ValueType ref)
 -> RedisM (RefInstance ref) (Maybe (ValueType ref)))
-> (ref -> Identifier (ValueType ref))
-> ref
-> RedisM (RefInstance ref) (Maybe (ValueType ref))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier

txGet :: Ref ref => ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
txGet :: ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
txGet = Identifier (ValueType ref)
-> Tx (RefInstance ref) (Maybe (ValueType ref))
forall k (inst :: k) val.
Value inst val =>
Identifier val -> Tx inst (Maybe val)
txValGet (Identifier (ValueType ref)
 -> Tx (RefInstance ref) (Maybe (ValueType ref)))
-> (ref -> Identifier (ValueType ref))
-> ref
-> Tx (RefInstance ref) (Maybe (ValueType ref))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier

set :: Ref ref => ref -> ValueType ref -> RedisM (RefInstance ref) ()
set :: ref -> ValueType ref -> RedisM (RefInstance ref) ()
set = Identifier (ValueType ref)
-> ValueType ref -> RedisM (RefInstance ref) ()
forall k (inst :: k) val.
Value inst val =>
Identifier val -> val -> RedisM inst ()
valSet (Identifier (ValueType ref)
 -> ValueType ref -> RedisM (RefInstance ref) ())
-> (ref -> Identifier (ValueType ref))
-> ref
-> ValueType ref
-> RedisM (RefInstance ref) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier

txSet :: Ref ref => ref -> ValueType ref -> Tx (RefInstance ref) ()
txSet :: ref -> ValueType ref -> Tx (RefInstance ref) ()
txSet = Identifier (ValueType ref)
-> ValueType ref -> Tx (RefInstance ref) ()
forall k (inst :: k) val.
Value inst val =>
Identifier val -> val -> Tx inst ()
txValSet (Identifier (ValueType ref)
 -> ValueType ref -> Tx (RefInstance ref) ())
-> (ref -> Identifier (ValueType ref))
-> ref
-> ValueType ref
-> Tx (RefInstance ref) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier

delete_ :: forall ref. Ref ref => ref -> RedisM (RefInstance ref) ()
delete_ :: ref -> RedisM (RefInstance ref) ()
delete_ = Value (RefInstance ref) (ValueType ref) =>
Identifier (ValueType ref) -> RedisM (RefInstance ref) ()
forall k (inst :: k) val.
Value inst val =>
Identifier val -> RedisM inst ()
valDelete @_ @(ValueType ref) (Identifier (ValueType ref) -> RedisM (RefInstance ref) ())
-> (ref -> Identifier (ValueType ref))
-> ref
-> RedisM (RefInstance ref) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier

txDelete_ :: forall ref. Ref ref => ref -> Tx (RefInstance ref) ()
txDelete_ :: ref -> Tx (RefInstance ref) ()
txDelete_ = Value (RefInstance ref) (ValueType ref) =>
Identifier (ValueType ref) -> Tx (RefInstance ref) ()
forall k (inst :: k) val.
Value inst val =>
Identifier val -> Tx inst ()
txValDelete @_ @(ValueType ref) (Identifier (ValueType ref) -> Tx (RefInstance ref) ())
-> (ref -> Identifier (ValueType ref))
-> ref
-> Tx (RefInstance ref) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier

-- | Atomically read and delete.
take :: Ref ref => ref -> RedisM (RefInstance ref) (Maybe (ValueType ref))
take :: ref -> RedisM (RefInstance ref) (Maybe (ValueType ref))
take ref
ref = Tx (RefInstance ref) (Maybe (ValueType ref))
-> RedisM (RefInstance ref) (Maybe (ValueType ref))
forall k (inst :: k) a. Tx inst a -> RedisM inst a
atomically (ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
forall ref.
Ref ref =>
ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
txTake ref
ref)

-- | Atomically read and delete in a transaction.
txTake :: Ref ref => ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
txTake :: ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
txTake ref
ref = ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
forall ref.
Ref ref =>
ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
txGet ref
ref Tx (RefInstance ref) (Maybe (ValueType ref))
-> Tx (RefInstance ref) ()
-> Tx (RefInstance ref) (Maybe (ValueType ref))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ref -> Tx (RefInstance ref) ()
forall ref. Ref ref => ref -> Tx (RefInstance ref) ()
txDelete_ ref
ref

-- | Atomically set a value and return its old value.
getSet :: forall ref. SimpleRef ref => ref -> ValueType ref -> RedisM (RefInstance ref) (Maybe (ValueType ref))
getSet :: ref
-> ValueType ref
-> RedisM (RefInstance ref) (Maybe (ValueType ref))
getSet ref
ref ValueType ref
val = case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
  SviTopLevel keyBS ->
    (Maybe ByteString -> Maybe (ValueType ref))
-> RedisM (RefInstance ref) (Maybe ByteString)
-> RedisM (RefInstance ref) (Maybe (ValueType ref))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Maybe (ValueType ref)
forall val. Serializable val => ByteString -> Maybe val
fromBS (ByteString -> Maybe (ValueType ref))
-> Maybe ByteString -> Maybe (ValueType ref)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (RedisM (RefInstance ref) (Maybe ByteString)
 -> RedisM (RefInstance ref) (Maybe (ValueType ref)))
-> (Either Reply (Maybe ByteString)
    -> RedisM (RefInstance ref) (Maybe ByteString))
-> Either Reply (Maybe ByteString)
-> RedisM (RefInstance ref) (Maybe (ValueType ref))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Either Reply (Maybe ByteString)
-> RedisM (RefInstance ref) (Maybe ByteString)
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"getSet/plain"
      (Either Reply (Maybe ByteString)
 -> RedisM (RefInstance ref) (Maybe (ValueType ref)))
-> RedisM (RefInstance ref) (Either Reply (Maybe ByteString))
-> RedisM (RefInstance ref) (Maybe (ValueType ref))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString
-> ByteString
-> RedisM (RefInstance ref) (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f (Maybe ByteString))
Hedis.getset ByteString
keyBS (ValueType ref -> ByteString
forall val. Serializable val => val -> ByteString
toBS ValueType ref
val)

  -- no native Redis call for this
  SviHash _ _ -> Tx (RefInstance ref) (Maybe (ValueType ref))
-> RedisM (RefInstance ref) (Maybe (ValueType ref))
forall k (inst :: k) a. Tx inst a -> RedisM inst a
atomically (ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
forall ref.
Ref ref =>
ref -> Tx (RefInstance ref) (Maybe (ValueType ref))
txGet ref
ref Tx (RefInstance ref) (Maybe (ValueType ref))
-> Tx (RefInstance ref) ()
-> Tx (RefInstance ref) (Maybe (ValueType ref))
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ref -> ValueType ref -> Tx (RefInstance ref) ()
forall ref.
Ref ref =>
ref -> ValueType ref -> Tx (RefInstance ref) ()
txSet ref
ref ValueType ref
val)

-- | Bump the TTL without changing the content.
setTTLIfExists :: forall ref. Ref ref => ref -> TTL -> RedisM (RefInstance ref) Bool
setTTLIfExists :: ref -> TTL -> RedisM (RefInstance ref) Bool
setTTLIfExists = Value (RefInstance ref) (ValueType ref) =>
Identifier (ValueType ref) -> TTL -> RedisM (RefInstance ref) Bool
forall k (inst :: k) val.
Value inst val =>
Identifier val -> TTL -> RedisM inst Bool
valSetTTLIfExists @_ @(ValueType ref) (Identifier (ValueType ref)
 -> TTL -> RedisM (RefInstance ref) Bool)
-> (ref -> Identifier (ValueType ref))
-> ref
-> TTL
-> RedisM (RefInstance ref) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier

setTTLIfExists_ :: Ref ref => ref -> TTL -> RedisM (RefInstance ref) ()
setTTLIfExists_ :: ref -> TTL -> RedisM (RefInstance ref) ()
setTTLIfExists_ ref
ref = RedisM (RefInstance ref) Bool -> RedisM (RefInstance ref) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RedisM (RefInstance ref) Bool -> RedisM (RefInstance ref) ())
-> (TTL -> RedisM (RefInstance ref) Bool)
-> TTL
-> RedisM (RefInstance ref) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> TTL -> RedisM (RefInstance ref) Bool
forall ref. Ref ref => ref -> TTL -> RedisM (RefInstance ref) Bool
setTTLIfExists ref
ref

setTTL :: Ref ref => ref -> TTL -> RedisM (RefInstance ref) ()
setTTL :: ref -> TTL -> RedisM (RefInstance ref) ()
setTTL ref
ref TTL
ttl = ref -> TTL -> RedisM (RefInstance ref) Bool
forall ref. Ref ref => ref -> TTL -> RedisM (RefInstance ref) Bool
setTTLIfExists ref
ref TTL
ttl RedisM (RefInstance ref) Bool
-> (Bool -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Bool -> Bool -> RedisM (RefInstance ref) ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> a -> RedisM inst ()
expect String
"setTTL: ref should exist" Bool
True

txSetTTLIfExists :: forall ref. Ref ref => ref -> TTL -> Tx (RefInstance ref) Bool
txSetTTLIfExists :: ref -> TTL -> Tx (RefInstance ref) Bool
txSetTTLIfExists = Value (RefInstance ref) (ValueType ref) =>
Identifier (ValueType ref) -> TTL -> Tx (RefInstance ref) Bool
forall k (inst :: k) val.
Value inst val =>
Identifier val -> TTL -> Tx inst Bool
txValSetTTLIfExists @_ @(ValueType ref) (Identifier (ValueType ref) -> TTL -> Tx (RefInstance ref) Bool)
-> (ref -> Identifier (ValueType ref))
-> ref
-> TTL
-> Tx (RefInstance ref) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier

txSetTTLIfExists_ :: forall ref. Ref ref => ref -> TTL -> Tx (RefInstance ref) ()
txSetTTLIfExists_ :: ref -> TTL -> Tx (RefInstance ref) ()
txSetTTLIfExists_ ref
ref TTL
ttl = Tx (RefInstance ref) Bool -> Tx (RefInstance ref) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx (RefInstance ref) Bool -> Tx (RefInstance ref) ())
-> Tx (RefInstance ref) Bool -> Tx (RefInstance ref) ()
forall a b. (a -> b) -> a -> b
$ ref -> TTL -> Tx (RefInstance ref) Bool
forall ref. Ref ref => ref -> TTL -> Tx (RefInstance ref) Bool
txSetTTLIfExists ref
ref TTL
ttl

txSetTTL :: Ref ref => ref -> TTL -> Tx (RefInstance ref) ()
txSetTTL :: ref -> TTL -> Tx (RefInstance ref) ()
txSetTTL ref
ref TTL
ttl =
  ref -> TTL -> Tx (RefInstance ref) Bool
forall ref. Ref ref => ref -> TTL -> Tx (RefInstance ref) Bool
txSetTTLIfExists ref
ref TTL
ttl
    Tx (RefInstance ref) Bool
-> (Tx (RefInstance ref) Bool -> Tx (RefInstance ref) ())
-> Tx (RefInstance ref) ()
forall a b. a -> (a -> b) -> b
& String
-> Bool -> Tx (RefInstance ref) Bool -> Tx (RefInstance ref) ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> Tx inst a -> Tx inst ()
txExpect String
"txSetTTL: ref should exist" Bool
True

txSetWithTTL :: SimpleRef ref => ref -> TTL -> ValueType ref -> Tx (RefInstance ref) ()
txSetWithTTL :: ref -> TTL -> ValueType ref -> Tx (RefInstance ref) ()
txSetWithTTL ref
ref TTL
ttl ValueType ref
val = ref -> ValueType ref -> Tx (RefInstance ref) ()
forall ref.
Ref ref =>
ref -> ValueType ref -> Tx (RefInstance ref) ()
txSet ref
ref ValueType ref
val Tx (RefInstance ref) ()
-> Tx (RefInstance ref) () -> Tx (RefInstance ref) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ref -> TTL -> Tx (RefInstance ref) ()
forall ref. Ref ref => ref -> TTL -> Tx (RefInstance ref) ()
txSetTTL ref
ref TTL
ttl

-- | Set value and TTL atomically.
setWithTTL :: forall ref. SimpleRef ref => ref -> TTL -> ValueType ref  -> RedisM (RefInstance ref) ()
setWithTTL :: ref -> TTL -> ValueType ref -> RedisM (RefInstance ref) ()
setWithTTL ref
ref ttl :: TTL
ttl@(TTLSec Integer
ttlSec) ValueType ref
val = case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
  SviTopLevel keyBS -> ByteString
-> Integer
-> ByteString
-> RedisM (RefInstance ref) (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> ByteString -> m (f Status)
Hedis.setex ByteString
keyBS Integer
ttlSec (ValueType ref -> ByteString
forall val. Serializable val => val -> ByteString
toBS ValueType ref
val)
    RedisM (RefInstance ref) (Either Reply Status)
-> (Either Reply Status -> RedisM (RefInstance ref) Status)
-> RedisM (RefInstance ref) Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Status -> RedisM (RefInstance ref) Status
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"setWithTTL/SETEX"
    RedisM (RefInstance ref) Status
-> (Status -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Status -> Status -> RedisM (RefInstance ref) ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> a -> RedisM inst ()
expect String
"setWithTTL/SETEX should return OK" Status
Hedis.Ok
  SviHash _ _ -> Tx (RefInstance ref) () -> RedisM (RefInstance ref) ()
forall k (inst :: k) a. Tx inst a -> RedisM inst a
atomically (ref -> ValueType ref -> Tx (RefInstance ref) ()
forall ref.
Ref ref =>
ref -> ValueType ref -> Tx (RefInstance ref) ()
txSet ref
ref ValueType ref
val Tx (RefInstance ref) ()
-> Tx (RefInstance ref) () -> Tx (RefInstance ref) ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ref -> TTL -> Tx (RefInstance ref) ()
forall ref. Ref ref => ref -> TTL -> Tx (RefInstance ref) ()
txSetTTL ref
ref TTL
ttl)

-- | Increment the value under the given ref.
incrementBy :: (SimpleRef ref, Num (ValueType ref)) => ref -> Integer -> RedisM (RefInstance ref) (ValueType ref)
incrementBy :: ref -> Integer -> RedisM (RefInstance ref) (ValueType ref)
incrementBy ref
ref Integer
val = (Integer -> ValueType ref)
-> RedisM (RefInstance ref) Integer
-> RedisM (RefInstance ref) (ValueType ref)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> ValueType ref
forall a. Num a => Integer -> a
fromInteger (RedisM (RefInstance ref) Integer
 -> RedisM (RefInstance ref) (ValueType ref))
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> Either Reply Integer
-> RedisM (RefInstance ref) (ValueType ref)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"incrementBy" (Either Reply Integer -> RedisM (RefInstance ref) (ValueType ref))
-> RedisM (RefInstance ref) (Either Reply Integer)
-> RedisM (RefInstance ref) (ValueType ref)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
  SviTopLevel keyBS -> ByteString
-> Integer -> RedisM (RefInstance ref) (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Integer)
Hedis.incrby ByteString
keyBS Integer
val
  SviHash keyBS hkeyBS -> ByteString
-> ByteString
-> Integer
-> RedisM (RefInstance ref) (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> Integer -> m (f Integer)
Hedis.hincrby ByteString
keyBS ByteString
hkeyBS Integer
val

txIncrementBy :: (SimpleRef ref, Num (ValueType ref)) => ref -> Integer -> Tx (RefInstance ref) (ValueType ref)
txIncrementBy :: ref -> Integer -> Tx (RefInstance ref) (ValueType ref)
txIncrementBy ref
ref Integer
val = (Integer -> ValueType ref)
-> Tx (RefInstance ref) Integer
-> Tx (RefInstance ref) (ValueType ref)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> ValueType ref
forall a. Num a => Integer -> a
fromInteger (Tx (RefInstance ref) Integer
 -> Tx (RefInstance ref) (ValueType ref))
-> (RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer)
-> RedisTx (Queued Integer)
-> Tx (RefInstance ref) (ValueType ref)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Integer) -> Tx (RefInstance ref) (ValueType ref))
-> RedisTx (Queued Integer) -> Tx (RefInstance ref) (ValueType ref)
forall a b. (a -> b) -> a -> b
$ case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
  SviTopLevel keyBS -> ByteString -> Integer -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Integer)
Hedis.incrby ByteString
keyBS Integer
val
  SviHash keyBS hkeyBS -> ByteString -> ByteString -> Integer -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> Integer -> m (f Integer)
Hedis.hincrby ByteString
keyBS ByteString
hkeyBS Integer
val

-- | Increment the value under the given ref.
incrementByFloat :: (SimpleRef ref, Floating (ValueType ref)) => ref -> Double -> RedisM (RefInstance ref) (ValueType ref)
incrementByFloat :: ref -> Double -> RedisM (RefInstance ref) (ValueType ref)
incrementByFloat ref
ref Double
val = (Double -> ValueType ref)
-> RedisM (RefInstance ref) Double
-> RedisM (RefInstance ref) (ValueType ref)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> ValueType ref
forall a b. (Real a, Fractional b) => a -> b
realToFrac (RedisM (RefInstance ref) Double
 -> RedisM (RefInstance ref) (ValueType ref))
-> (Either Reply Double -> RedisM (RefInstance ref) Double)
-> Either Reply Double
-> RedisM (RefInstance ref) (ValueType ref)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Reply Double -> RedisM (RefInstance ref) Double
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"incrementByFloat" (Either Reply Double -> RedisM (RefInstance ref) (ValueType ref))
-> RedisM (RefInstance ref) (Either Reply Double)
-> RedisM (RefInstance ref) (ValueType ref)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
  SviTopLevel keyBS -> ByteString
-> Double -> RedisM (RefInstance ref) (Either Reply Double)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Double -> m (f Double)
Hedis.incrbyfloat ByteString
keyBS Double
val
  SviHash keyBS hkeyBS -> ByteString
-> ByteString
-> Double
-> RedisM (RefInstance ref) (Either Reply Double)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> Double -> m (f Double)
Hedis.hincrbyfloat ByteString
keyBS ByteString
hkeyBS Double
val

setIfNotExists :: forall ref. SimpleRef ref => ref -> ValueType ref -> RedisM (RefInstance ref) Bool
setIfNotExists :: ref -> ValueType ref -> RedisM (RefInstance ref) Bool
setIfNotExists ref
ref ValueType ref
val = String -> Either Reply Bool -> RedisM (RefInstance ref) Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"setIfNotExists" (Either Reply Bool -> RedisM (RefInstance ref) Bool)
-> RedisM (RefInstance ref) (Either Reply Bool)
-> RedisM (RefInstance ref) Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
  SviTopLevel keyBS -> ByteString
-> ByteString -> RedisM (RefInstance ref) (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Bool)
Hedis.setnx ByteString
keyBS (ValueType ref -> ByteString
forall val. Serializable val => val -> ByteString
toBS ValueType ref
val)
  SviHash keyBS hkeyBS -> ByteString
-> ByteString
-> ByteString
-> RedisM (RefInstance ref) (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Bool)
Hedis.hsetnx ByteString
keyBS ByteString
hkeyBS (ValueType ref -> ByteString
forall val. Serializable val => val -> ByteString
toBS ValueType ref
val)

setIfNotExists_ :: SimpleRef ref => ref -> ValueType ref -> RedisM (RefInstance ref) ()
setIfNotExists_ :: ref -> ValueType ref -> RedisM (RefInstance ref) ()
setIfNotExists_ ref
ref ValueType ref
val = RedisM (RefInstance ref) Bool -> RedisM (RefInstance ref) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RedisM (RefInstance ref) Bool -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) Bool -> RedisM (RefInstance ref) ()
forall a b. (a -> b) -> a -> b
$ ref -> ValueType ref -> RedisM (RefInstance ref) Bool
forall ref.
SimpleRef ref =>
ref -> ValueType ref -> RedisM (RefInstance ref) Bool
setIfNotExists ref
ref ValueType ref
val

txSetIfNotExists :: forall ref. SimpleRef ref => ref -> ValueType ref -> Tx (RefInstance ref) Bool
txSetIfNotExists :: ref -> ValueType ref -> Tx (RefInstance ref) Bool
txSetIfNotExists ref
ref ValueType ref
val = RedisTx (Queued Bool) -> Tx (RefInstance ref) Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Bool) -> Tx (RefInstance ref) Bool)
-> RedisTx (Queued Bool) -> Tx (RefInstance ref) Bool
forall a b. (a -> b) -> a -> b
$ case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
  SviTopLevel keyBS -> ByteString -> ByteString -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Bool)
Hedis.setnx ByteString
keyBS (ValueType ref -> ByteString
forall val. Serializable val => val -> ByteString
toBS ValueType ref
val)
  SviHash keyBS hkeyBS -> ByteString -> ByteString -> ByteString -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> ByteString -> m (f Bool)
Hedis.hsetnx ByteString
keyBS ByteString
hkeyBS (ValueType ref -> ByteString
forall val. Serializable val => val -> ByteString
toBS ValueType ref
val)

txSetIfNotExists_ :: SimpleRef ref => ref -> ValueType ref -> Tx (RefInstance ref) ()
txSetIfNotExists_ :: ref -> ValueType ref -> Tx (RefInstance ref) ()
txSetIfNotExists_ ref
ref ValueType ref
val = Tx (RefInstance ref) Bool -> Tx (RefInstance ref) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx (RefInstance ref) Bool -> Tx (RefInstance ref) ())
-> Tx (RefInstance ref) Bool -> Tx (RefInstance ref) ()
forall a b. (a -> b) -> a -> b
$ ref -> ValueType ref -> Tx (RefInstance ref) Bool
forall ref.
SimpleRef ref =>
ref -> ValueType ref -> Tx (RefInstance ref) Bool
txSetIfNotExists ref
ref ValueType ref
val

setIfNotExistsTTL :: forall ref. SimpleRef ref => ref -> ValueType ref -> TTL -> RedisM (RefInstance ref) Bool
setIfNotExistsTTL :: ref -> ValueType ref -> TTL -> RedisM (RefInstance ref) Bool
setIfNotExistsTTL ref
ref ValueType ref
val (TTLSec Integer
ttlSec) =
  (Either Reply Status -> Either Reply Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status -> Either Reply Status
forall a b. b -> Either a b
Right Status
Hedis.Ok) (Either Reply Status -> Bool)
-> RedisM (RefInstance ref) (Either Reply Status)
-> RedisM (RefInstance ref) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
    SviHash _keyBS _hkeyBS -> String -> RedisM (RefInstance ref) (Either Reply Status)
forall a. HasCallStack => String -> a
error String
"setIfNotExistsTTL: hash keys not supported"
    SviTopLevel keyBS -> ByteString
-> ByteString
-> SetOpts
-> RedisM (RefInstance ref) (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> SetOpts -> m (f Status)
Hedis.setOpts ByteString
keyBS (ValueType ref -> ByteString
forall val. Serializable val => val -> ByteString
toBS ValueType ref
val) SetOpts :: Maybe Integer -> Maybe Integer -> Maybe Condition -> SetOpts
Hedis.SetOpts
      { setSeconds :: Maybe Integer
Hedis.setSeconds      = Integer -> Maybe Integer
forall a. a -> Maybe a
Just Integer
ttlSec
      , setMilliseconds :: Maybe Integer
Hedis.setMilliseconds = Maybe Integer
forall a. Maybe a
Nothing
      , setCondition :: Maybe Condition
Hedis.setCondition    = Condition -> Maybe Condition
forall a. a -> Maybe a
Just Condition
Hedis.Nx
      }

deleteIfEqual :: forall ref. SimpleRef ref => ref -> ValueType ref -> RedisM (RefInstance ref) Bool
deleteIfEqual :: ref -> ValueType ref -> RedisM (RefInstance ref) Bool
deleteIfEqual ref
ref ValueType ref
val =
  (Integer -> Bool)
-> RedisM (RefInstance ref) Integer
-> RedisM (RefInstance ref) Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= (Integer
0 :: Integer)) (RedisM (RefInstance ref) Integer -> RedisM (RefInstance ref) Bool)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> Either Reply Integer
-> RedisM (RefInstance ref) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"deleteIfEqual" (Either Reply Integer -> RedisM (RefInstance ref) Bool)
-> RedisM (RefInstance ref) (Either Reply Integer)
-> RedisM (RefInstance ref) Bool
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
    SviHash _keyBS _hkeyBS -> String -> RedisM (RefInstance ref) (Either Reply Integer)
forall a. HasCallStack => String -> a
error String
"deleteIfEqual: hash keys not supported"
    SviTopLevel keyBS -> ByteString
-> [ByteString]
-> [ByteString]
-> RedisM (RefInstance ref) (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
ByteString -> [ByteString] -> [ByteString] -> m (f a)
Hedis.eval ByteString
luaSource [ByteString
keyBS] [ValueType ref -> ByteString
forall val. Serializable val => val -> ByteString
toBS ValueType ref
val]
  where
    luaSource :: ByteString
    luaSource :: ByteString
luaSource = [ByteString] -> ByteString
BS.unlines
      [ ByteString
"if redis.call(\"get\",KEYS[1]) == ARGV[1] then"
      , ByteString
"  return redis.call(\"del\",KEYS[1])"
      , ByteString
"else"
      , ByteString
"  return 0"
      , ByteString
"end"
      ]

-- | Make any subsequent transaction fail if the watched ref is modified
-- between the call to 'watch' and the transaction.
watch :: SimpleRef ref => ref -> RedisM (RefInstance ref) ()
watch :: ref -> RedisM (RefInstance ref) ()
watch ref
ref = case ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref of
  SviTopLevel keyBS ->
    Redis (Either Reply Status)
-> RedisM (RefInstance ref) (Either Reply Status)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis ([ByteString] -> Redis (Either Reply Status)
Hedis.watch [ByteString
keyBS]) RedisM (RefInstance ref) (Either Reply Status)
-> (Either Reply Status -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either Reply Status
-> Either Reply Status
-> RedisM (RefInstance ref) ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> a -> RedisM inst ()
expect String
"watch/plain: OK expected" (Status -> Either Reply Status
forall a b. b -> Either a b
Right Status
Hedis.Ok)
  SviHash keyBS _hkeyBS ->
    Redis (Either Reply Status)
-> RedisM (RefInstance ref) (Either Reply Status)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis ([ByteString] -> Redis (Either Reply Status)
Hedis.watch [ByteString
keyBS]) RedisM (RefInstance ref) (Either Reply Status)
-> (Either Reply Status -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either Reply Status
-> Either Reply Status
-> RedisM (RefInstance ref) ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> a -> RedisM inst ()
expect String
"watch/hash: OK expected" (Status -> Either Reply Status
forall a b. b -> Either a b
Right Status
Hedis.Ok)

-- | Unwatch all watched keys.
-- I can't find it anywhere in the documentation
-- but I hope that this unwatches only the keys for the current connection,
-- and does not affect other connections. Nothing else would make much sense.
unwatch :: RedisM inst ()
unwatch :: RedisM inst ()
unwatch = Redis (Either Reply Status) -> RedisM inst (Either Reply Status)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis Redis (Either Reply Status)
Hedis.unwatch RedisM inst (Either Reply Status)
-> (Either Reply Status -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either Reply Status -> Either Reply Status -> RedisM inst ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> a -> RedisM inst ()
expect String
"unwatch: OK expected" (Status -> Either Reply Status
forall a b. b -> Either a b
Right Status
Hedis.Ok)

-- | Decode a list of ByteStrings.
-- On failure, return the first ByteString that could not be decoded.
fromBSMany :: Serializable val => [ByteString] -> Either ByteString [val]
fromBSMany :: [ByteString] -> Either ByteString [val]
fromBSMany = (ByteString -> Either ByteString val)
-> [ByteString] -> Either ByteString [val]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((ByteString -> Either ByteString val)
 -> [ByteString] -> Either ByteString [val])
-> (ByteString -> Either ByteString val)
-> [ByteString]
-> Either ByteString [val]
forall a b. (a -> b) -> a -> b
$ \ByteString
valBS -> case ByteString -> Maybe val
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
valBS of
  Just val
val -> val -> Either ByteString val
forall a b. b -> Either a b
Right val
val    -- decoded correctly
  Maybe val
Nothing  -> ByteString -> Either ByteString val
forall a b. a -> Either a b
Left  ByteString
valBS  -- decoding failure, return the malformed bytestring

txFromBSMany :: Serializable val => Tx inst [ByteString] -> Tx inst [val]
txFromBSMany :: Tx inst [ByteString] -> Tx inst [val]
txFromBSMany = ([ByteString] -> Either RedisException [val])
-> Tx inst [ByteString] -> Tx inst [val]
forall k a b (inst :: k).
(a -> Either RedisException b) -> Tx inst a -> Tx inst b
txCheckMap (Either ByteString [val] -> Either RedisException [val]
forall b. Either ByteString b -> Either RedisException b
f (Either ByteString [val] -> Either RedisException [val])
-> ([ByteString] -> Either ByteString [val])
-> [ByteString]
-> Either RedisException [val]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Either ByteString [val]
forall val.
Serializable val =>
[ByteString] -> Either ByteString [val]
fromBSMany)
  where
    f :: Either ByteString b -> Either RedisException b
f (Left ByteString
badBS) = RedisException -> Either RedisException b
forall a b. a -> Either a b
Left (RedisException -> Either RedisException b)
-> RedisException -> Either RedisException b
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> RedisException
CouldNotDecodeValue (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
badBS)
    f (Right b
vals) = b -> Either RedisException b
forall a b. b -> Either a b
Right b
vals

instance Value inst ()
instance Serializable () where
  fromBS :: ByteString -> Maybe ()
fromBS = Maybe () -> ByteString -> Maybe ()
forall a b. a -> b -> a
const (Maybe () -> ByteString -> Maybe ())
-> Maybe () -> ByteString -> Maybe ()
forall a b. (a -> b) -> a -> b
$ () -> Maybe ()
forall a. a -> Maybe a
Just ()
  toBS :: () -> ByteString
toBS = ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
""
instance SimpleValue inst ()

{- conflicts with the [a] instance
instance Value inst String
instance Serializable String where
  fromBS = fmap Text.unpack . fromBS
  toBS = toBS . Text.pack
-}

instance Value inst Text
instance Serializable Text where
  fromBS :: ByteString -> Maybe Text
fromBS = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> (ByteString -> Text) -> ByteString -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8
  toBS :: Text -> ByteString
toBS = Text -> ByteString
encodeUtf8
instance SimpleValue inst Text

instance Value inst Int
instance Serializable Int where
  fromBS :: ByteString -> Maybe Int
fromBS = ByteString -> Maybe Int
forall val. Read val => ByteString -> Maybe val
readBS
  toBS :: Int -> ByteString
toBS   = Int -> ByteString
forall val. Show val => val -> ByteString
showBS
instance SimpleValue inst Int

instance Value inst Word32
instance Serializable Word32 where
  fromBS :: ByteString -> Maybe Word32
fromBS = ByteString -> Maybe Word32
forall val. Read val => ByteString -> Maybe val
readBS
  toBS :: Word32 -> ByteString
toBS   = Word32 -> ByteString
forall val. Show val => val -> ByteString
showBS
instance SimpleValue inst Word32

instance Value inst Int64
instance Serializable Int64 where
  fromBS :: ByteString -> Maybe Int64
fromBS = ByteString -> Maybe Int64
forall val. Read val => ByteString -> Maybe val
readBS
  toBS :: Int64 -> ByteString
toBS   = Int64 -> ByteString
forall val. Show val => val -> ByteString
showBS
instance SimpleValue inst Int64

instance Value inst Integer
instance Serializable Integer where
  fromBS :: ByteString -> Maybe Integer
fromBS = ByteString -> Maybe Integer
forall val. Read val => ByteString -> Maybe val
readBS
  toBS :: Integer -> ByteString
toBS   = Integer -> ByteString
forall val. Show val => val -> ByteString
showBS
instance SimpleValue inst Integer

instance Value inst Double
instance Serializable Double where
  fromBS :: ByteString -> Maybe Double
fromBS = ByteString -> Maybe Double
forall val. Read val => ByteString -> Maybe val
readBS
  toBS :: Double -> ByteString
toBS   = Double -> ByteString
forall val. Show val => val -> ByteString
showBS
instance SimpleValue inst Double

instance Value inst Bool
instance Serializable Bool where
  fromBS :: ByteString -> Maybe Bool
fromBS ByteString
"0" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
  fromBS ByteString
"1" = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
  fromBS ByteString
_ = Maybe Bool
forall a. Maybe a
Nothing

  toBS :: Bool -> ByteString
toBS Bool
True  = ByteString
"1"
  toBS Bool
False = ByteString
"0"
instance SimpleValue inst Bool

instance Value inst UTCTime
instance Serializable UTCTime where
  fromBS :: ByteString -> Maybe UTCTime
fromBS = ByteString -> Maybe UTCTime
forall val. Read val => ByteString -> Maybe val
readBS
  toBS :: UTCTime -> ByteString
toBS = UTCTime -> ByteString
forall val. Show val => val -> ByteString
showBS
instance SimpleValue inst UTCTime

instance Value inst Day
instance Serializable Day where
  fromBS :: ByteString -> Maybe Day
fromBS = ByteString -> Maybe Day
forall val. Read val => ByteString -> Maybe val
readBS
  toBS :: Day -> ByteString
toBS = Day -> ByteString
forall val. Show val => val -> ByteString
showBS
instance SimpleValue inst Day

instance Value inst LocalTime
instance Serializable LocalTime where
  fromBS :: ByteString -> Maybe LocalTime
fromBS = ByteString -> Maybe LocalTime
forall val. Read val => ByteString -> Maybe val
readBS
  toBS :: LocalTime -> ByteString
toBS = LocalTime -> ByteString
forall val. Show val => val -> ByteString
showBS
instance SimpleValue inst LocalTime

instance Value inst ByteString
instance Serializable ByteString where
  toBS :: ByteString -> ByteString
toBS   = ByteString -> ByteString
forall a. a -> a
id
  fromBS :: ByteString -> Maybe ByteString
fromBS = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
instance SimpleValue inst ByteString

instance Value inst BSL.ByteString
instance Serializable BSL.ByteString where
  toBS :: ByteString -> ByteString
toBS   = ByteString -> ByteString
BSL.toStrict
  fromBS :: ByteString -> Maybe ByteString
fromBS = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (ByteString -> ByteString) -> ByteString -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict
instance SimpleValue inst BSL.ByteString

instance Serializable UUID where
  toBS :: UUID -> ByteString
toBS = Text -> ByteString
forall val. Serializable val => val -> ByteString
toBS (Text -> ByteString) -> (UUID -> Text) -> UUID -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UUID -> Text
UUID.toText
  fromBS :: ByteString -> Maybe UUID
fromBS = Text -> Maybe UUID
UUID.fromText (Text -> Maybe UUID)
-> (ByteString -> Maybe Text) -> ByteString -> Maybe UUID
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe Text
forall val. Serializable val => ByteString -> Maybe val
fromBS

instance Serializable a => Serializable (Maybe a) where
  fromBS :: ByteString -> Maybe (Maybe a)
fromBS ByteString
b = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
b of
    Just (Char
'N', ByteString
"") -> Maybe a -> Maybe (Maybe a)
forall a. a -> Maybe a
Just Maybe a
forall a. Maybe a
Nothing -- parsing succeeded, found Nothing
    Just (Char
'J', ByteString
r)  -> a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> Maybe a -> Maybe (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe a
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
r
    Maybe (Char, ByteString)
_              -> Maybe (Maybe a)
forall a. Maybe a
Nothing -- Parsing failed
  toBS :: Maybe a -> ByteString
toBS Maybe a
Nothing  = ByteString
"N"
  toBS (Just a
a) = ByteString
"J" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> a -> ByteString
forall val. Serializable val => val -> ByteString
toBS a
a

instance (Serializable a, Serializable b) => Serializable (Either a b) where
  fromBS :: ByteString -> Maybe (Either a b)
fromBS ByteString
b = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
b of
    Just (Char
'L', ByteString
xBS) -> a -> Either a b
forall a b. a -> Either a b
Left (a -> Either a b) -> Maybe a -> Maybe (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe a
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
xBS
    Just (Char
'R', ByteString
yBS) -> b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> Maybe b -> Maybe (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe b
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
yBS
    Maybe (Char, ByteString)
_ -> Maybe (Either a b)
forall a. Maybe a
Nothing
  toBS :: Either a b -> ByteString
toBS (Left a
x) = Char -> ByteString -> ByteString
BS.cons Char
'L' (a -> ByteString
forall val. Serializable val => val -> ByteString
toBS a
x)
  toBS (Right b
y) = Char -> ByteString -> ByteString
BS.cons Char
'R' (b -> ByteString
forall val. Serializable val => val -> ByteString
toBS b
y)

instance (SimpleValue inst a, SimpleValue inst b) => Value inst (a, b)
instance (Serializable a, Serializable b) => Serializable (a, b) where
  toBS :: (a, b) -> ByteString
toBS (a
x, b
y) = Tuple '[a, b] -> ByteString
forall val. Serializable val => val -> ByteString
toBS @(Tuple '[a,b]) (a
x a -> Tuple '[b] -> Tuple '[a, b]
forall a (as :: [*]). a -> Tuple as -> Tuple (a : as)
:*: b
y b -> Tuple '[] -> Tuple '[b]
forall a (as :: [*]). a -> Tuple as -> Tuple (a : as)
:*: Tuple '[]
Nil)
  fromBS :: ByteString -> Maybe (a, b)
fromBS ByteString
bs =
    ByteString -> Maybe (Tuple '[a, b])
forall val. Serializable val => ByteString -> Maybe val
fromBS @(Tuple '[a,b]) ByteString
bs Maybe (Tuple '[a, b]) -> (Tuple '[a, b] -> (a, b)) -> Maybe (a, b)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
      \(a
x :*: a
y :*: Tuple as
Nil) -> (a
x,a
y)
instance (SimpleValue inst a, SimpleValue inst b) => SimpleValue inst (a,b)

instance (SimpleValue inst a, SimpleValue inst b, SimpleValue inst c) => Value inst (a, b, c)
instance (Serializable a, Serializable b, Serializable c) => Serializable (a, b, c) where
  toBS :: (a, b, c) -> ByteString
toBS (a
x, b
y, c
z) = Tuple '[a, b, c] -> ByteString
forall val. Serializable val => val -> ByteString
toBS (a
x a -> Tuple '[b, c] -> Tuple '[a, b, c]
forall a (as :: [*]). a -> Tuple as -> Tuple (a : as)
:*: b
y b -> Tuple '[c] -> Tuple '[b, c]
forall a (as :: [*]). a -> Tuple as -> Tuple (a : as)
:*: c
z c -> Tuple '[] -> Tuple '[c]
forall a (as :: [*]). a -> Tuple as -> Tuple (a : as)
:*: Tuple '[]
Nil)
  fromBS :: ByteString -> Maybe (a, b, c)
fromBS ByteString
bs =
    ByteString -> Maybe (Tuple '[a, b, c])
forall val. Serializable val => ByteString -> Maybe val
fromBS @(Tuple '[a,b,c]) ByteString
bs Maybe (Tuple '[a, b, c])
-> (Tuple '[a, b, c] -> (a, b, c)) -> Maybe (a, b, c)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
      \(a
x :*: a
y :*: a
z :*: Tuple as
Nil) -> (a
x,a
y,a
z)
instance (SimpleValue inst a, SimpleValue inst b, SimpleValue inst c) => SimpleValue inst (a, b, c)

readBS :: Read val => ByteString -> Maybe val
readBS :: ByteString -> Maybe val
readBS = String -> Maybe val
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe val)
-> (ByteString -> String) -> ByteString -> Maybe val
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
BS.unpack

showBS :: Show val => val -> ByteString
showBS :: val -> ByteString
showBS = String -> ByteString
BS.pack (String -> ByteString) -> (val -> String) -> val -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. val -> String
forall a. Show a => a -> String
show

showBinary :: Binary val => val -> ByteString
showBinary :: val -> ByteString
showBinary = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (val -> ByteString) -> val -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. val -> ByteString
forall a. Binary a => a -> ByteString
encode

readBinary :: Binary val => ByteString -> Maybe val
readBinary :: ByteString -> Maybe val
readBinary ByteString
bytes = case ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, val)
forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, a)
decodeOrFail (ByteString
 -> Either (ByteString, Int64, String) (ByteString, Int64, val))
-> ByteString
-> Either (ByteString, Int64, String) (ByteString, Int64, val)
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BSL.fromStrict ByteString
bytes of
  Left (ByteString, Int64, String)
_ -> Maybe val
forall a. Maybe a
Nothing
  Right (ByteString
_, Int64
_, val
val) -> val -> Maybe val
forall a. a -> Maybe a
Just val
val

colonSep :: [BS.ByteString] -> BS.ByteString
colonSep :: [ByteString] -> ByteString
colonSep = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
":"

infixr 3 :*:
data Tuple :: [Type] -> Type where
  Nil :: Tuple '[]
  (:*:) :: a -> Tuple as -> Tuple (a ': as)

instance Eq (Tuple '[]) where
  Tuple '[]
_ == :: Tuple '[] -> Tuple '[] -> Bool
== Tuple '[]
_ = Bool
True

instance Ord (Tuple '[]) where
  compare :: Tuple '[] -> Tuple '[] -> Ordering
compare Tuple '[]
_ Tuple '[]
_ = Ordering
EQ

instance (Eq a, Eq (Tuple as)) => Eq (Tuple (a ': as)) where
  (a
x :*: Tuple as
xs) == :: Tuple (a : as) -> Tuple (a : as) -> Bool
== (a
y :*: Tuple as
ys) = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
y Bool -> Bool -> Bool
&& Tuple as
xs Tuple as -> Tuple as -> Bool
forall a. Eq a => a -> a -> Bool
== Tuple as
Tuple as
ys

instance (Ord a, Ord (Tuple as)) => Ord (Tuple (a ': as)) where
  compare :: Tuple (a : as) -> Tuple (a : as) -> Ordering
compare (a
x :*: Tuple as
xs) (a
y :*: Tuple as
ys) = a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
x a
a
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Tuple as -> Tuple as -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Tuple as
xs Tuple as
Tuple as
ys

class Serializables (as :: [Type]) where
  encodeSerializables :: Tuple as -> [BS.ByteString]
  decodeSerializables :: [BS.ByteString] -> Maybe (Tuple as)

instance Serializables '[] where
  encodeSerializables :: Tuple '[] -> [ByteString]
encodeSerializables Tuple '[]
Nil = []

  decodeSerializables :: [ByteString] -> Maybe (Tuple '[])
decodeSerializables [] = Tuple '[] -> Maybe (Tuple '[])
forall a. a -> Maybe a
Just Tuple '[]
Nil
  decodeSerializables [ByteString]
_  = Maybe (Tuple '[])
forall a. Maybe a
Nothing

instance (Serializable a, Serializables as) => Serializables (a ': as) where
  encodeSerializables :: Tuple (a : as) -> [ByteString]
encodeSerializables (a
x :*: Tuple as
xs) = a -> ByteString
forall val. Serializable val => val -> ByteString
toBS a
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: Tuple as -> [ByteString]
forall (as :: [*]). Serializables as => Tuple as -> [ByteString]
encodeSerializables Tuple as
xs

  decodeSerializables :: [ByteString] -> Maybe (Tuple (a : as))
decodeSerializables [] = Maybe (Tuple (a : as))
forall a. Maybe a
Nothing
  decodeSerializables (ByteString
bs : [ByteString]
bss) = a -> Tuple as -> Tuple (a : as)
forall a (as :: [*]). a -> Tuple as -> Tuple (a : as)
(:*:) (a -> Tuple as -> Tuple (a : as))
-> Maybe a -> Maybe (Tuple as -> Tuple (a : as))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe a
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
bs Maybe (Tuple as -> Tuple (a : as))
-> Maybe (Tuple as) -> Maybe (Tuple (a : as))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [ByteString] -> Maybe (Tuple as)
forall (as :: [*]).
Serializables as =>
[ByteString] -> Maybe (Tuple as)
decodeSerializables [ByteString]
bss

instance Serializables as => Value inst (Tuple as)
instance Serializables as => Serializable (Tuple as) where
  toBS :: Tuple as -> ByteString
toBS = [ByteString] -> ByteString
encodeBSs ([ByteString] -> ByteString)
-> (Tuple as -> [ByteString]) -> Tuple as -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tuple as -> [ByteString]
forall (as :: [*]). Serializables as => Tuple as -> [ByteString]
encodeSerializables
    where
      -- Encode a list of bytestrings into a single bytestring
      -- that's unambiguous (for machines) but human-readable (for humans).
      --
      -- This is useful for tuples and records
      -- that you need to put in a Redis list or a Redis set
      -- so they need to be Serializables.
      --
      -- The format:
      --   <length1>,<length2>,...,<lengthN>:<string1>:<string2>:...:<stringN>
      --
      -- Lengths are base10 numbers, strings are literal binary strings.
      encodeBSs :: [BS.ByteString] -> BS.ByteString
      encodeBSs :: [ByteString] -> ByteString
encodeBSs [ByteString]
bss = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
":" (ByteString
lengths ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
bss)
        where
          lengths :: ByteString
lengths = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
"," [String -> ByteString
BS.pack (Int -> String
forall a. Show a => a -> String
show (ByteString -> Int
BS.length ByteString
bs)) | ByteString
bs <- [ByteString]
bss]

  fromBS :: ByteString -> Maybe (Tuple as)
fromBS = [ByteString] -> Maybe (Tuple as)
forall (as :: [*]).
Serializables as =>
[ByteString] -> Maybe (Tuple as)
decodeSerializables ([ByteString] -> Maybe (Tuple as))
-> (ByteString -> Maybe [ByteString])
-> ByteString
-> Maybe (Tuple as)
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< ByteString -> Maybe [ByteString]
decodeBSs
    where
      decodeBSs :: BS.ByteString -> Maybe [BS.ByteString]
      decodeBSs :: ByteString -> Maybe [ByteString]
decodeBSs ByteString
bsWhole = do
          [Int]
lengths <- (ByteString -> Maybe Int) -> [ByteString] -> Maybe [Int]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ByteString -> Maybe Int
forall val. Serializable val => ByteString -> Maybe val
fromBS ([ByteString] -> Maybe [Int]) -> [ByteString] -> Maybe [Int]
forall a b. (a -> b) -> a -> b
$ Char -> ByteString -> [ByteString]
BS.split Char
',' ByteString
bsLengths
          [Int] -> ByteString -> Maybe [ByteString]
splitLengths [Int]
lengths ByteString
bsData
        where
          -- bsData starts with a colon
          (ByteString
bsLengths, ByteString
bsData) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') ByteString
bsWhole

          splitLengths :: [Int] -> ByteString -> Maybe [ByteString]
splitLengths [] ByteString
"" = [ByteString] -> Maybe [ByteString]
forall a. a -> Maybe a
Just []
          splitLengths [] ByteString
_trailingGarbage = Maybe [ByteString]
forall a. Maybe a
Nothing
          splitLengths (Int
l:[Int]
ls) ByteString
bs = case ByteString -> Maybe (Char, ByteString)
BS.uncons ByteString
bs of
            Just (Char
':', ByteString
bsNoColon) ->
              let (ByteString
item, ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
l ByteString
bsNoColon
                in (ByteString
item ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
:) ([ByteString] -> [ByteString])
-> Maybe [ByteString] -> Maybe [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int] -> ByteString -> Maybe [ByteString]
splitLengths [Int]
ls ByteString
rest

            Maybe (Char, ByteString)
_ -> Maybe [ByteString]
forall a. Maybe a
Nothing
instance Serializables as => SimpleValue inst (Tuple as)

day :: TTL
day :: TTL
day = TTL
24 TTL -> TTL -> TTL
forall a. Num a => a -> a -> a
* TTL
hour

hour :: TTL
hour :: TTL
hour = TTL
60 TTL -> TTL -> TTL
forall a. Num a => a -> a -> a
* TTL
minute

minute :: TTL
minute :: TTL
minute = TTL
60 TTL -> TTL -> TTL
forall a. Num a => a -> a -> a
* TTL
second

second :: TTL
second :: TTL
second = Integer -> TTL
TTLSec Integer
1

-- | Redis lists.
instance Serializable a => Value inst [a] where
  type Identifier [a] = ByteString

  txValGet :: Identifier [a] -> Tx inst (Maybe [a])
txValGet Identifier [a]
keyBS =
    RedisTx (Queued [ByteString]) -> Tx inst [ByteString]
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (ByteString -> Integer -> Integer -> RedisTx (Queued [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [ByteString])
Hedis.lrange ByteString
Identifier [a]
keyBS Integer
0 (-Integer
1))
    Tx inst [ByteString]
-> (Tx inst [ByteString] -> Tx inst [a]) -> Tx inst [a]
forall a b. a -> (a -> b) -> b
& Tx inst [ByteString] -> Tx inst [a]
forall k val (inst :: k).
Serializable val =>
Tx inst [ByteString] -> Tx inst [val]
txFromBSMany
    Tx inst [a]
-> (Tx inst [a] -> Tx inst (Maybe [a])) -> Tx inst (Maybe [a])
forall a b. a -> (a -> b) -> b
& ([a] -> Maybe [a]) -> Tx inst [a] -> Tx inst (Maybe [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> Maybe [a]
forall a. a -> Maybe a
Just
  txValSet :: Identifier [a] -> [a] -> Tx inst ()
txValSet Identifier [a]
keyBS [a]
vs = Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ()) -> Tx inst Integer -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap ([ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier [a]
keyBS] RedisTx (Queued Integer)
-> RedisTx (Queued Integer) -> RedisTx (Queued Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.rpush ByteString
Identifier [a]
keyBS ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vs))
  txValDelete :: Identifier [a] -> Tx inst ()
txValDelete Identifier [a]
keyBS = Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ()) -> Tx inst Integer -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap ([ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier [a]
keyBS])
  txValSetTTLIfExists :: Identifier [a] -> TTL -> Tx inst Bool
txValSetTTLIfExists Identifier [a]
keyBS (TTLSec Integer
ttlSec) = RedisTx (Queued Bool) -> Tx inst Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (ByteString -> Integer -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier [a]
keyBS Integer
ttlSec)

  valGet :: Identifier [a] -> RedisM inst (Maybe [a])
valGet Identifier [a]
keyBS =
    Redis (Either Reply [ByteString])
-> RedisM inst (Either Reply [ByteString])
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString
-> Integer -> Integer -> Redis (Either Reply [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> Integer -> m (f [ByteString])
Hedis.lrange ByteString
Identifier [a]
keyBS Integer
0 (-Integer
1))
      RedisM inst (Either Reply [ByteString])
-> (Either Reply [ByteString] -> RedisM inst [ByteString])
-> RedisM inst [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply [ByteString] -> RedisM inst [ByteString]
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valGet/[a]"
      RedisM inst [ByteString]
-> ([ByteString] -> RedisM inst (Maybe [a]))
-> RedisM inst (Maybe [a])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([ByteString] -> Either ByteString [a]
forall val.
Serializable val =>
[ByteString] -> Either ByteString [val]
fromBSMany ([ByteString] -> Either ByteString [a])
-> (Either ByteString [a] -> RedisM inst (Maybe [a]))
-> [ByteString]
-> RedisM inst (Maybe [a])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Left ByteString
badBS -> RedisException -> RedisM inst (Maybe [a])
forall k (inst :: k) a. RedisException -> RedisM inst a
throw (RedisException -> RedisM inst (Maybe [a]))
-> RedisException -> RedisM inst (Maybe [a])
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> RedisException
CouldNotDecodeValue (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
badBS)
        Right [a]
vs -> Maybe [a] -> RedisM inst (Maybe [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> Maybe [a]
forall a. a -> Maybe a
Just [a]
vs))

  valSet :: Identifier [a] -> [a] -> RedisM inst ()
valSet Identifier [a]
keyBS [a]
vs =
    Redis (TxResult Integer) -> RedisM inst (TxResult Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (RedisTx (Queued Integer) -> Redis (TxResult Integer)
forall a. RedisTx (Queued a) -> Redis (TxResult a)
Hedis.multiExec ([ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier [a]
keyBS] RedisTx (Queued Integer)
-> RedisTx (Queued Integer) -> RedisTx (Queued Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.rpush ByteString
Identifier [a]
keyBS ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vs)))
      RedisM inst (TxResult Integer)
-> (TxResult Integer -> RedisM inst Integer) -> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxResult Integer -> RedisM inst Integer
forall k a (inst :: k). TxResult a -> RedisM inst a
expectTxSuccess
      RedisM inst Integer
-> (Integer -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer
  valDelete :: Identifier [a] -> RedisM inst ()
valDelete Identifier [a]
keyBS =
    Redis (Either Reply Integer) -> RedisM inst (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis ([ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier [a]
keyBS])
      RedisM inst (Either Reply Integer)
-> (Either Reply Integer -> RedisM inst Integer)
-> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM inst Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valDelete/[a]"
      RedisM inst Integer
-> (Integer -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer
  valSetTTLIfExists :: Identifier [a] -> TTL -> RedisM inst Bool
valSetTTLIfExists Identifier [a]
keyBS (TTLSec Integer
ttlSec) =
    Redis (Either Reply Bool) -> RedisM inst (Either Reply Bool)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Integer -> Redis (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier [a]
keyBS Integer
ttlSec)
      RedisM inst (Either Reply Bool)
-> (Either Reply Bool -> RedisM inst Bool) -> RedisM inst Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Bool -> RedisM inst Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valSetTTLIfExists/[a]"

-- | Append to a Redis list.
lAppend :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => ref -> [a] -> RedisM (RefInstance ref) ()
lAppend :: ref -> [a] -> RedisM (RefInstance ref) ()
lAppend (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) [a]
vals =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.rpush ByteString
Identifier (ValueType ref)
keyBS ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vals))
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"rpush"
    RedisM (RefInstance ref) Integer
-> (Integer -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall inst. Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

-- | Append to a Redis list in a transaction.
txLAppend :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => ref -> [a] -> Tx (RefInstance ref) ()
txLAppend :: ref -> [a] -> Tx (RefInstance ref) ()
txLAppend (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) [a]
vals =
  Tx (RefInstance ref) Integer -> Tx (RefInstance ref) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx (RefInstance ref) Integer -> Tx (RefInstance ref) ())
-> (RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer)
-> RedisTx (Queued Integer)
-> Tx (RefInstance ref) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Integer) -> Tx (RefInstance ref) ())
-> RedisTx (Queued Integer) -> Tx (RefInstance ref) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.rpush ByteString
Identifier (ValueType ref)
keyBS ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vals)

-- | Length of a Redis list
lLength :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => ref -> RedisM (RefInstance ref) Integer
lLength :: ref -> RedisM (RefInstance ref) Integer
lLength (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
Hedis.llen ByteString
Identifier (ValueType ref)
keyBS)
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"llen"

-- | Prepend to a Redis list.
lPushLeft :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => ref -> [a] -> RedisM (RefInstance ref) ()
lPushLeft :: ref -> [a] -> RedisM (RefInstance ref) ()
lPushLeft (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) [a]
vals =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.lpush ByteString
Identifier (ValueType ref)
keyBS ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vals))
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"lpush"
    RedisM (RefInstance ref) Integer
-> (Integer -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall inst. Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

-- | Pop from the right.
lPopRight :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => ref -> RedisM (RefInstance ref) (Maybe a)
lPopRight :: ref -> RedisM (RefInstance ref) (Maybe a)
lPopRight (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) =
  Redis (Either Reply (Maybe ByteString))
-> RedisM (RefInstance ref) (Either Reply (Maybe ByteString))
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Redis (Either Reply (Maybe ByteString))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f (Maybe ByteString))
Hedis.rpop ByteString
Identifier (ValueType ref)
keyBS)
  RedisM (RefInstance ref) (Either Reply (Maybe ByteString))
-> (Either Reply (Maybe ByteString)
    -> RedisM (RefInstance ref) (Maybe a))
-> RedisM (RefInstance ref) (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe ByteString -> Maybe a)
-> RedisM (RefInstance ref) (Maybe ByteString)
-> RedisM (RefInstance ref) (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Maybe a
forall val. Serializable val => ByteString -> Maybe val
fromBS (ByteString -> Maybe a) -> Maybe ByteString -> Maybe a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (RedisM (RefInstance ref) (Maybe ByteString)
 -> RedisM (RefInstance ref) (Maybe a))
-> (Either Reply (Maybe ByteString)
    -> RedisM (RefInstance ref) (Maybe ByteString))
-> Either Reply (Maybe ByteString)
-> RedisM (RefInstance ref) (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String
-> Either Reply (Maybe ByteString)
-> RedisM (RefInstance ref) (Maybe ByteString)
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"rpop"

-- | Pop from the right, blocking.
lPopRightBlocking :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => TTL -> ref -> RedisM (RefInstance ref) (Maybe a)
lPopRightBlocking :: TTL -> ref -> RedisM (RefInstance ref) (Maybe a)
lPopRightBlocking (TTLSec Integer
timeoutSec) (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) =
  Redis (Either Reply (Maybe (ByteString, ByteString)))
-> RedisM
     (RefInstance ref) (Either Reply (Maybe (ByteString, ByteString)))
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis ([ByteString]
-> Integer -> Redis (Either Reply (Maybe (ByteString, ByteString)))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> Integer -> m (f (Maybe (ByteString, ByteString)))
Hedis.brpop [ByteString
Identifier (ValueType ref)
keyBS] Integer
timeoutSec)
    RedisM
  (RefInstance ref) (Either Reply (Maybe (ByteString, ByteString)))
-> (Either Reply (Maybe (ByteString, ByteString))
    -> RedisM (RefInstance ref) (Maybe (ByteString, ByteString)))
-> RedisM (RefInstance ref) (Maybe (ByteString, ByteString))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either Reply (Maybe (ByteString, ByteString))
-> RedisM (RefInstance ref) (Maybe (ByteString, ByteString))
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"brpop"
    RedisM (RefInstance ref) (Maybe (ByteString, ByteString))
-> (Maybe (ByteString, ByteString)
    -> RedisM (RefInstance ref) (Maybe a))
-> RedisM (RefInstance ref) (Maybe a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe (ByteString, ByteString)
Nothing -> Maybe a -> RedisM (RefInstance ref) (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing -- timeout
      Just (ByteString
_listName, ByteString
valBS) ->
        case ByteString -> Maybe a
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
valBS of
          Just a
val -> Maybe a -> RedisM (RefInstance ref) (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> RedisM (RefInstance ref) (Maybe a))
-> Maybe a -> RedisM (RefInstance ref) (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
val
          Maybe a
Nothing -> RedisException -> RedisM (RefInstance ref) (Maybe a)
forall k (inst :: k) a. RedisException -> RedisM inst a
throw (RedisException -> RedisM (RefInstance ref) (Maybe a))
-> RedisException -> RedisM (RefInstance ref) (Maybe a)
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> RedisException
CouldNotDecodeValue (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
valBS)

-- | Delete from a Redis list
lRem :: forall ref a. (Ref ref, ValueType ref ~ [a], Serializable a) => ref -> Integer -> a -> RedisM (RefInstance ref) ()
lRem :: ref -> Integer -> a -> RedisM (RefInstance ref) ()
lRem (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) Integer
num a
val =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Integer -> ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> ByteString -> m (f Integer)
Hedis.lrem ByteString
Identifier (ValueType ref)
keyBS Integer
num (a -> ByteString
forall val. Serializable val => val -> ByteString
toBS a
val))
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"lrem"
    RedisM (RefInstance ref) Integer
-> (Integer -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall inst. Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer


-- | Redis sets.
instance (Serializable a, Ord a) => Value inst (Set a) where
  type Identifier (Set a) = ByteString

  txValGet :: Identifier (Set a) -> Tx inst (Maybe (Set a))
txValGet Identifier (Set a)
keyBS =
    RedisTx (Queued [ByteString]) -> Tx inst [ByteString]
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (ByteString -> RedisTx (Queued [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [ByteString])
Hedis.smembers ByteString
Identifier (Set a)
keyBS)
    Tx inst [ByteString]
-> (Tx inst [ByteString] -> Tx inst [a]) -> Tx inst [a]
forall a b. a -> (a -> b) -> b
& Tx inst [ByteString] -> Tx inst [a]
forall k val (inst :: k).
Serializable val =>
Tx inst [ByteString] -> Tx inst [val]
txFromBSMany
    Tx inst [a]
-> (Tx inst [a] -> Tx inst (Maybe (Set a)))
-> Tx inst (Maybe (Set a))
forall a b. a -> (a -> b) -> b
& ([a] -> Maybe (Set a)) -> Tx inst [a] -> Tx inst (Maybe (Set a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just (Set a -> Maybe (Set a)) -> ([a] -> Set a) -> [a] -> Maybe (Set a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList)

  txValSet :: Identifier (Set a) -> Set a -> Tx inst ()
txValSet Identifier (Set a)
keyBS Set a
vs =
    Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ()) -> Tx inst Integer -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (
      [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Set a)
keyBS]
      RedisTx (Queued Integer)
-> RedisTx (Queued Integer) -> RedisTx (Queued Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.sadd ByteString
Identifier (Set a)
keyBS ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS ([a] -> [ByteString]) -> [a] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
vs)
    )

  txValDelete :: Identifier (Set a) -> Tx inst ()
txValDelete Identifier (Set a)
keyBS = Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ()) -> Tx inst Integer -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap ([ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Set a)
keyBS])
  txValSetTTLIfExists :: Identifier (Set a) -> TTL -> Tx inst Bool
txValSetTTLIfExists Identifier (Set a)
keyBS (TTLSec Integer
ttlSec) = RedisTx (Queued Bool) -> Tx inst Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (ByteString -> Integer -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier (Set a)
keyBS Integer
ttlSec)

  valGet :: Identifier (Set a) -> RedisM inst (Maybe (Set a))
valGet Identifier (Set a)
keyBS =
    ByteString -> RedisM inst (Either Reply [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [ByteString])
Hedis.smembers ByteString
Identifier (Set a)
keyBS
      RedisM inst (Either Reply [ByteString])
-> (Either Reply [ByteString] -> RedisM inst [ByteString])
-> RedisM inst [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply [ByteString] -> RedisM inst [ByteString]
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valGet/Set a"
      RedisM inst [ByteString]
-> ([ByteString] -> RedisM inst (Maybe (Set a)))
-> RedisM inst (Maybe (Set a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ([ByteString] -> Either ByteString [a]
forall val.
Serializable val =>
[ByteString] -> Either ByteString [val]
fromBSMany ([ByteString] -> Either ByteString [a])
-> (Either ByteString [a] -> RedisM inst (Maybe (Set a)))
-> [ByteString]
-> RedisM inst (Maybe (Set a))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
        Left ByteString
badBS -> RedisException -> RedisM inst (Maybe (Set a))
forall k (inst :: k) a. RedisException -> RedisM inst a
throw (RedisException -> RedisM inst (Maybe (Set a)))
-> RedisException -> RedisM inst (Maybe (Set a))
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> RedisException
CouldNotDecodeValue (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
badBS)
        Right [a]
vs -> Maybe (Set a) -> RedisM inst (Maybe (Set a))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Set a -> Maybe (Set a)
forall a. a -> Maybe a
Just (Set a -> Maybe (Set a)) -> Set a -> Maybe (Set a)
forall a b. (a -> b) -> a -> b
$ [a] -> Set a
forall a. Ord a => [a] -> Set a
Set.fromList [a]
vs))

  valSet :: Identifier (Set a) -> Set a -> RedisM inst ()
valSet Identifier (Set a)
keyBS Set a
vs =
    Redis (TxResult Integer) -> RedisM inst (TxResult Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (RedisTx (Queued Integer) -> Redis (TxResult Integer)
forall a. RedisTx (Queued a) -> Redis (TxResult a)
Hedis.multiExec (
      [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Set a)
keyBS]
      RedisTx (Queued Integer)
-> RedisTx (Queued Integer) -> RedisTx (Queued Integer)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.sadd ByteString
Identifier (Set a)
keyBS ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS ([a] -> [ByteString]) -> [a] -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Set a -> [a]
forall a. Set a -> [a]
Set.toList Set a
vs)
    ))
      RedisM inst (TxResult Integer)
-> (TxResult Integer -> RedisM inst Integer) -> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxResult Integer -> RedisM inst Integer
forall k a (inst :: k). TxResult a -> RedisM inst a
expectTxSuccess
      RedisM inst Integer
-> (Integer -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

  valDelete :: Identifier (Set a) -> RedisM inst ()
valDelete Identifier (Set a)
keyBS = Redis (Either Reply Integer) -> RedisM inst (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis ([ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Set a)
keyBS])
    RedisM inst (Either Reply Integer)
-> (Either Reply Integer -> RedisM inst Integer)
-> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM inst Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valDelete/Set a"
    RedisM inst Integer
-> (Integer -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

  valSetTTLIfExists :: Identifier (Set a) -> TTL -> RedisM inst Bool
valSetTTLIfExists Identifier (Set a)
keyBS (TTLSec Integer
ttlSec) =
    Redis (Either Reply Bool) -> RedisM inst (Either Reply Bool)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Integer -> Redis (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier (Set a)
keyBS Integer
ttlSec)
      RedisM inst (Either Reply Bool)
-> (Either Reply Bool -> RedisM inst Bool) -> RedisM inst Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Bool -> RedisM inst Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valSetTTLIfExists/Set a"

-- | Insert into a Redis set.
sInsert :: forall ref a. (Ref ref, ValueType ref ~ Set a, Serializable a) => ref -> [a] -> RedisM (RefInstance ref) ()
sInsert :: ref -> [a] -> RedisM (RefInstance ref) ()
sInsert ref
ref [a]
vals =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.sadd (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref) ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vals))
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"setInsert"
    RedisM (RefInstance ref) Integer
-> (Integer -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall inst. Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

-- | Insert into a Redis set in a transaction.
txSInsert :: forall ref a. (Ref ref, ValueType ref ~ Set a, Serializable a) => ref -> [a] -> Tx (RefInstance ref) ()
txSInsert :: ref -> [a] -> Tx (RefInstance ref) ()
txSInsert ref
ref [a]
vals =
  Tx (RefInstance ref) Integer -> Tx (RefInstance ref) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx (RefInstance ref) Integer -> Tx (RefInstance ref) ())
-> (RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer)
-> RedisTx (Queued Integer)
-> Tx (RefInstance ref) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap
    (RedisTx (Queued Integer) -> Tx (RefInstance ref) ())
-> RedisTx (Queued Integer) -> Tx (RefInstance ref) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.sadd (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref) ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vals)

-- | Delete from a Redis set.
sDelete :: forall ref a. (Ref ref, ValueType ref ~ Set a, Serializable a) => ref -> [a] -> RedisM (RefInstance ref) ()
sDelete :: ref -> [a] -> RedisM (RefInstance ref) ()
sDelete ref
ref [a]
vals =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.srem (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref) ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vals))
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"hashSetDelete"
    RedisM (RefInstance ref) Integer
-> (Integer -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall inst. Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

-- | Delete from a Redis set in a transaction.
txSDelete :: forall ref a. (Ref ref, ValueType ref ~ Set a, Serializable a) => ref -> [a] -> Tx (RefInstance ref) ()
txSDelete :: ref -> [a] -> Tx (RefInstance ref) ()
txSDelete ref
ref [a]
vals =
  Tx (RefInstance ref) Integer -> Tx (RefInstance ref) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx (RefInstance ref) Integer -> Tx (RefInstance ref) ())
-> (RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer)
-> RedisTx (Queued Integer)
-> Tx (RefInstance ref) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap
    (RedisTx (Queued Integer) -> Tx (RefInstance ref) ())
-> RedisTx (Queued Integer) -> Tx (RefInstance ref) ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.srem (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref) ((a -> ByteString) -> [a] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map a -> ByteString
forall val. Serializable val => val -> ByteString
toBS [a]
vals)

-- | Check membership in a Redis set.
sContains :: forall ref a. (Ref ref, ValueType ref ~ Set a, Serializable a) => ref -> a -> RedisM (RefInstance ref) Bool
sContains :: ref -> a -> RedisM (RefInstance ref) Bool
sContains ref
ref a
val =
  Redis (Either Reply Bool)
-> RedisM (RefInstance ref) (Either Reply Bool)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> ByteString -> Redis (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Bool)
Hedis.sismember (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref) (a -> ByteString
forall val. Serializable val => val -> ByteString
toBS a
val))
    RedisM (RefInstance ref) (Either Reply Bool)
-> (Either Reply Bool -> RedisM (RefInstance ref) Bool)
-> RedisM (RefInstance ref) Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Bool -> RedisM (RefInstance ref) Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"setContains"

-- | Check membership in a Redis set, in a transaction.
txSContains :: forall ref a. (Ref ref, ValueType ref ~ Set a, Serializable a) => ref -> a -> Tx (RefInstance ref) Bool
txSContains :: ref -> a -> Tx (RefInstance ref) Bool
txSContains ref
ref a
val =
  RedisTx (Queued Bool) -> Tx (RefInstance ref) Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Bool) -> Tx (RefInstance ref) Bool)
-> RedisTx (Queued Bool) -> Tx (RefInstance ref) Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> ByteString -> m (f Bool)
Hedis.sismember (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref) (a -> ByteString
forall val. Serializable val => val -> ByteString
toBS a
val)

-- | Get set size.
sSize :: (Ref ref, ValueType ref ~ Set a) => ref -> RedisM (RefInstance ref) Integer
sSize :: ref -> RedisM (RefInstance ref) Integer
sSize ref
ref = Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
Hedis.scard (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref)) RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"setSize"

-- | Get set size, in a transaction.
txSSize :: (Ref ref, ValueType ref ~ Set a) => ref -> Tx (RefInstance ref) Integer
txSSize :: ref -> Tx (RefInstance ref) Integer
txSSize ref
ref = RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer)
-> RedisTx (Queued Integer) -> Tx (RefInstance ref) Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
Hedis.scard (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref)

-- | Priority for a sorted set
newtype Priority = Priority { Priority -> Double
unPriority :: Double }

instance Serializable Priority where
  fromBS :: ByteString -> Maybe Priority
fromBS = (Double -> Priority) -> Maybe Double -> Maybe Priority
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Priority
Priority (Maybe Double -> Maybe Priority)
-> (ByteString -> Maybe Double) -> ByteString -> Maybe Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Double
forall val. Serializable val => ByteString -> Maybe val
fromBS
  toBS :: Priority -> ByteString
toBS   = Double -> ByteString
forall val. Serializable val => val -> ByteString
toBS (Double -> ByteString)
-> (Priority -> Double) -> Priority -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Priority -> Double
unPriority

instance Bounded Priority where
  minBound :: Priority
minBound = Double -> Priority
Priority (-Double
forall a. RealFloat a => a
Numeric.Limits.maxValue)
  maxBound :: Priority
maxBound = Double -> Priority
Priority   Double
forall a. RealFloat a => a
Numeric.Limits.maxValue

-- | Add elements to a sorted set
zInsert :: forall ref a. (Ref ref, ValueType ref ~ [(Priority, a)], Serializable a) => ref -> [(Priority, a)] -> RedisM (RefInstance ref) ()
zInsert :: ref -> [(Priority, a)] -> RedisM (RefInstance ref) ()
zInsert (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) [(Priority, a)]
vals =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString
-> [(Double, ByteString)] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(Double, ByteString)] -> m (f Integer)
Hedis.zadd ByteString
Identifier (ValueType ref)
keyBS (((Priority, a) -> (Double, ByteString))
-> [(Priority, a)] -> [(Double, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (Priority -> Double
unPriority (Priority -> Double)
-> (a -> ByteString) -> (Priority, a) -> (Double, ByteString)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
Arrow.*** a -> ByteString
forall val. Serializable val => val -> ByteString
toBS) [(Priority, a)]
vals))
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"zadd"
    RedisM (RefInstance ref) Integer
-> (Integer -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall inst. Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

-- | Delete from a Redis sorted set
zDelete :: forall ref a. (Ref ref, ValueType ref ~ [(Priority, a)], Serializable a) => ref -> a -> RedisM (RefInstance ref) ()
zDelete :: ref -> a -> RedisM (RefInstance ref) ()
zDelete (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) a
val =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> [ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [ByteString] -> m (f Integer)
Hedis.zrem ByteString
Identifier (ValueType ref)
keyBS [a -> ByteString
forall val. Serializable val => val -> ByteString
toBS a
val])
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"zrem"
    RedisM (RefInstance ref) Integer
-> (Integer -> RedisM (RefInstance ref) ())
-> RedisM (RefInstance ref) ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall inst. Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

-- | Get the cardinality (number of elements) of a sorted set
zSize :: forall ref a. (Ref ref, ValueType ref ~ [(Priority, a)], Serializable a) => ref -> RedisM (RefInstance ref) Integer
zSize :: ref -> RedisM (RefInstance ref) Integer
zSize (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f Integer)
Hedis.zcard ByteString
Identifier (ValueType ref)
keyBS)
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"zcard"

-- | Returns the number of elements in the sorted set that have a score between minScore and
-- maxScore inclusive.
zCount :: forall ref a. (Ref ref, ValueType ref ~ [(Priority, a)], Serializable a) => ref -> Priority -> Priority -> RedisM (RefInstance ref) Integer
zCount :: ref -> Priority -> Priority -> RedisM (RefInstance ref) Integer
zCount (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) (Priority -> Double
unPriority -> Double
minScore) (Priority -> Double
unPriority -> Double
maxScore) =
  Redis (Either Reply Integer)
-> RedisM (RefInstance ref) (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Double -> Double -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Double -> Double -> m (f Integer)
Hedis.zcount ByteString
Identifier (ValueType ref)
keyBS Double
minScore Double
maxScore)
    RedisM (RefInstance ref) (Either Reply Integer)
-> (Either Reply Integer -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM (RefInstance ref) Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"zcount"

-- | Remove given number of smallest elements from a sorted set.
--   Available since Redis 5.0.0
zPopMin :: forall ref a. (Ref ref, ValueType ref ~ [(Priority, a)], Serializable a) => ref -> Integer -> RedisM (RefInstance ref) [(Priority, a)]
zPopMin :: ref -> Integer -> RedisM (RefInstance ref) [(Priority, a)]
zPopMin (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) Integer
cnt =
  Redis (Either Reply [(ByteString, Double)])
-> RedisM (RefInstance ref) (Either Reply [(ByteString, Double)])
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString
-> Integer -> Redis (Either Reply [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f [(ByteString, Double)])
zpopmin ByteString
Identifier (ValueType ref)
keyBS Integer
cnt)
  RedisM (RefInstance ref) (Either Reply [(ByteString, Double)])
-> (Either Reply [(ByteString, Double)]
    -> RedisM (RefInstance ref) [(ByteString, Double)])
-> RedisM (RefInstance ref) [(ByteString, Double)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either Reply [(ByteString, Double)]
-> RedisM (RefInstance ref) [(ByteString, Double)]
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"zpopmin call"
  RedisM (RefInstance ref) [(ByteString, Double)]
-> ([(ByteString, Double)]
    -> RedisM (RefInstance ref) [(Priority, a)])
-> RedisM (RefInstance ref) [(Priority, a)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either ByteString [(Priority, a)]
-> RedisM (RefInstance ref) [(Priority, a)]
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"zpopmin decode" (Either ByteString [(Priority, a)]
 -> RedisM (RefInstance ref) [(Priority, a)])
-> ([(ByteString, Double)] -> Either ByteString [(Priority, a)])
-> [(ByteString, Double)]
-> RedisM (RefInstance ref) [(Priority, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, Double)] -> Either ByteString [(Priority, a)]
fromBSMany'
  where fromBSMany' :: [(ByteString, Double)] -> Either ByteString [(Priority, a)]
fromBSMany' = ((ByteString, Double) -> Either ByteString (Priority, a))
-> [(ByteString, Double)] -> Either ByteString [(Priority, a)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((ByteString, Double) -> Either ByteString (Priority, a))
 -> [(ByteString, Double)] -> Either ByteString [(Priority, a)])
-> ((ByteString, Double) -> Either ByteString (Priority, a))
-> [(ByteString, Double)]
-> Either ByteString [(Priority, a)]
forall a b. (a -> b) -> a -> b
$ \(ByteString
valBS,Double
sc) -> Either ByteString (Priority, a)
-> (a -> Either ByteString (Priority, a))
-> Maybe a
-> Either ByteString (Priority, a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Either ByteString (Priority, a)
forall a b. a -> Either a b
Left ByteString
valBS) ((Priority, a) -> Either ByteString (Priority, a)
forall a b. b -> Either a b
Right ((Priority, a) -> Either ByteString (Priority, a))
-> (a -> (Priority, a)) -> a -> Either ByteString (Priority, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Priority
Priority Double
sc,)) (Maybe a -> Either ByteString (Priority, a))
-> Maybe a -> Either ByteString (Priority, a)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe a
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
valBS

-- | ZPOPMIN as it should be in the Hedis library (but it isn't yet)
--   Available since Redis 5.0.0
zpopmin :: Hedis.RedisCtx m f => ByteString -> Integer -> m (f [(ByteString, Double)])
zpopmin :: ByteString -> Integer -> m (f [(ByteString, Double)])
zpopmin ByteString
k Integer
c = [ByteString] -> m (f [(ByteString, Double)])
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
Hedis.sendRequest [ByteString
"ZPOPMIN", ByteString
k, Integer -> ByteString
forall val. Serializable val => val -> ByteString
toBS Integer
c]

-- | Remove the smallest element from a sorted set, and block for the given number of seconds when it is not there yet.
--   Available since Redis 5.0.0
bzPopMin :: forall ref a. (Ref ref, ValueType ref ~ [(Priority, a)], Serializable a)
         => ref -> Integer -> RedisM (RefInstance ref) (Maybe (Priority, a))
bzPopMin :: ref -> Integer -> RedisM (RefInstance ref) (Maybe (Priority, a))
bzPopMin (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) Integer
timeout =
  Redis (Either Reply (Maybe (ByteString, ByteString, Double)))
-> RedisM
     (RefInstance ref)
     (Either Reply (Maybe (ByteString, ByteString, Double)))
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString
-> Integer
-> Redis (Either Reply (Maybe (ByteString, ByteString, Double)))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Integer -> m (f (Maybe (ByteString, ByteString, Double)))
bzpopmin ByteString
Identifier (ValueType ref)
keyBS Integer
timeout)
  RedisM
  (RefInstance ref)
  (Either Reply (Maybe (ByteString, ByteString, Double)))
-> (Either Reply (Maybe (ByteString, ByteString, Double))
    -> RedisM
         (RefInstance ref) (Maybe (ByteString, ByteString, Double)))
-> RedisM
     (RefInstance ref) (Maybe (ByteString, ByteString, Double))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either Reply (Maybe (ByteString, ByteString, Double))
-> RedisM
     (RefInstance ref) (Maybe (ByteString, ByteString, Double))
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"bzPopMin call"
  RedisM (RefInstance ref) (Maybe (ByteString, ByteString, Double))
-> (Maybe (ByteString, ByteString, Double)
    -> RedisM (RefInstance ref) (Maybe (Priority, a)))
-> RedisM (RefInstance ref) (Maybe (Priority, a))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either ByteString (Maybe (Priority, a))
-> RedisM (RefInstance ref) (Maybe (Priority, a))
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"bzPopMin decode" (Either ByteString (Maybe (Priority, a))
 -> RedisM (RefInstance ref) (Maybe (Priority, a)))
-> (Maybe (ByteString, ByteString, Double)
    -> Either ByteString (Maybe (Priority, a)))
-> Maybe (ByteString, ByteString, Double)
-> RedisM (RefInstance ref) (Maybe (Priority, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (ByteString, ByteString, Double)
-> Either ByteString (Maybe (Priority, a))
forall a.
Maybe (a, ByteString, Double)
-> Either ByteString (Maybe (Priority, a))
fromBS'
  where
    fromBS' :: Maybe (a, ByteString, Double)
-> Either ByteString (Maybe (Priority, a))
fromBS' = Either ByteString (Maybe (Priority, a))
-> ((a, ByteString, Double)
    -> Either ByteString (Maybe (Priority, a)))
-> Maybe (a, ByteString, Double)
-> Either ByteString (Maybe (Priority, a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Maybe (Priority, a) -> Either ByteString (Maybe (Priority, a))
forall a b. b -> Either a b
Right Maybe (Priority, a)
forall a. Maybe a
Nothing) (\(a
_,ByteString
valBS,Double
sc) -> Either ByteString (Maybe (Priority, a))
-> (a -> Either ByteString (Maybe (Priority, a)))
-> Maybe a
-> Either ByteString (Maybe (Priority, a))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ByteString -> Either ByteString (Maybe (Priority, a))
forall a b. a -> Either a b
Left ByteString
valBS) (Maybe (Priority, a) -> Either ByteString (Maybe (Priority, a))
forall a b. b -> Either a b
Right (Maybe (Priority, a) -> Either ByteString (Maybe (Priority, a)))
-> (a -> Maybe (Priority, a))
-> a
-> Either ByteString (Maybe (Priority, a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Priority, a) -> Maybe (Priority, a)
forall a. a -> Maybe a
Just ((Priority, a) -> Maybe (Priority, a))
-> (a -> (Priority, a)) -> a -> Maybe (Priority, a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Priority
Priority Double
sc,)) (Maybe a -> Either ByteString (Maybe (Priority, a)))
-> Maybe a -> Either ByteString (Maybe (Priority, a))
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe a
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
valBS)

-- | BZPOPMIN as it should be in the Hedis library (but it isn't yet)
--   Available since Redis 5.0.0
bzpopmin :: Hedis.RedisCtx m f => ByteString -> Integer -> m (f (Maybe (ByteString, ByteString, Double)))
bzpopmin :: ByteString
-> Integer -> m (f (Maybe (ByteString, ByteString, Double)))
bzpopmin ByteString
k Integer
timeout = [ByteString] -> m (f (Maybe (ByteString, ByteString, Double)))
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
Hedis.sendRequest [ByteString
"BZPOPMIN", ByteString
k, Integer -> ByteString
forall val. Serializable val => val -> ByteString
toBS Integer
timeout]

-- Orphan instance, Hedis only implements this for 2-tuples, but BZPOPMIN gets 3 results
instance (Hedis.RedisResult a, Hedis.RedisResult b, Hedis.RedisResult c) => Hedis.RedisResult (a,b,c) where
  decode :: Reply -> Either Reply (a, b, c)
decode (Hedis.MultiBulk (Just [Reply
x,Reply
y,Reply
z])) = (,,) (a -> b -> c -> (a, b, c))
-> Either Reply a -> Either Reply (b -> c -> (a, b, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Reply -> Either Reply a
forall a. RedisResult a => Reply -> Either Reply a
Hedis.decode Reply
x Either Reply (b -> c -> (a, b, c))
-> Either Reply b -> Either Reply (c -> (a, b, c))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reply -> Either Reply b
forall a. RedisResult a => Reply -> Either Reply a
Hedis.decode Reply
y Either Reply (c -> (a, b, c))
-> Either Reply c -> Either Reply (a, b, c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Reply -> Either Reply c
forall a. RedisResult a => Reply -> Either Reply a
Hedis.decode Reply
z
  decode Reply
r                                = Reply -> Either Reply (a, b, c)
forall a b. a -> Either a b
Left Reply
r

-- | Get elements from a sorted set, between the given min and max values, and with the given offset and limit.
zRangeByScoreLimit :: forall ref a. (Ref ref, ValueType ref ~ [(Priority, a)], Serializable a)
                   => ref -> Priority -> Priority -> Integer -> Integer -> RedisM (RefInstance ref) [a]
zRangeByScoreLimit :: ref
-> Priority
-> Priority
-> Integer
-> Integer
-> RedisM (RefInstance ref) [a]
zRangeByScoreLimit (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) (Priority Double
minV) (Priority Double
maxV) Integer
offset Integer
limit =
  ByteString
-> Double
-> Double
-> Integer
-> Integer
-> RedisM (RefInstance ref) (Either Reply [ByteString])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString
-> Double -> Double -> Integer -> Integer -> m (f [ByteString])
Hedis.zrangebyscoreLimit ByteString
Identifier (ValueType ref)
keyBS Double
minV Double
maxV Integer
offset Integer
limit
  RedisM (RefInstance ref) (Either Reply [ByteString])
-> (Either Reply [ByteString]
    -> RedisM (RefInstance ref) [ByteString])
-> RedisM (RefInstance ref) [ByteString]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either Reply [ByteString]
-> RedisM (RefInstance ref) [ByteString]
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"zrangebyscoreLimit call"
  RedisM (RefInstance ref) [ByteString]
-> ([ByteString] -> RedisM (RefInstance ref) [a])
-> RedisM (RefInstance ref) [a]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either ByteString [a] -> RedisM (RefInstance ref) [a]
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"zrangebyscoreLimit decode" (Either ByteString [a] -> RedisM (RefInstance ref) [a])
-> ([ByteString] -> Either ByteString [a])
-> [ByteString]
-> RedisM (RefInstance ref) [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> Either ByteString [a]
forall val.
Serializable val =>
[ByteString] -> Either ByteString [val]
fromBSMany

parseMap :: (Ord k, Serializable k, Serializable v)
  => [(ByteString, ByteString)] -> Maybe (Map k v)
parseMap :: [(ByteString, ByteString)] -> Maybe (Map k v)
parseMap [(ByteString, ByteString)]
kvsBS = [(k, v)] -> Map k v
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(k, v)] -> Map k v) -> Maybe [(k, v)] -> Maybe (Map k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Maybe (k, v)] -> Maybe [(k, v)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
  [ (,) (k -> v -> (k, v)) -> Maybe k -> Maybe (v -> (k, v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe k
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
keyBS Maybe (v -> (k, v)) -> Maybe v -> Maybe (k, v)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Maybe v
forall val. Serializable val => ByteString -> Maybe val
fromBS ByteString
valBS
  | (ByteString
keyBS, ByteString
valBS) <- [(ByteString, ByteString)]
kvsBS
  ]

-- | Redis hashes.
instance (Ord k, Serializable k, Serializable v) => Value inst (Map k v) where
  type Identifier (Map k v) = ByteString

  txValGet :: Identifier (Map k v) -> Tx inst (Maybe (Map k v))
txValGet Identifier (Map k v)
keyBS =
    RedisTx (Queued [(ByteString, ByteString)])
-> Tx inst [(ByteString, ByteString)]
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (ByteString -> RedisTx (Queued [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
Hedis.hgetall ByteString
Identifier (Map k v)
keyBS)
      Tx inst [(ByteString, ByteString)]
-> (Tx inst [(ByteString, ByteString)]
    -> Tx inst (Maybe (Map k v)))
-> Tx inst (Maybe (Map k v))
forall a b. a -> (a -> b) -> b
& ([(ByteString, ByteString)]
 -> Either RedisException (Maybe (Map k v)))
-> Tx inst [(ByteString, ByteString)] -> Tx inst (Maybe (Map k v))
forall k a b (inst :: k).
(a -> Either RedisException b) -> Tx inst a -> Tx inst b
txCheckMap (
          Either RedisException (Maybe (Map k v))
-> (Map k v -> Either RedisException (Maybe (Map k v)))
-> Maybe (Map k v)
-> Either RedisException (Maybe (Map k v))
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (RedisException -> Either RedisException (Maybe (Map k v))
forall a b. a -> Either a b
Left (RedisException -> Either RedisException (Maybe (Map k v)))
-> RedisException -> Either RedisException (Maybe (Map k v))
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> RedisException
CouldNotDecodeValue Maybe ByteString
forall a. Maybe a
Nothing)
            (Maybe (Map k v) -> Either RedisException (Maybe (Map k v))
forall a b. b -> Either a b
Right (Maybe (Map k v) -> Either RedisException (Maybe (Map k v)))
-> (Map k v -> Maybe (Map k v))
-> Map k v
-> Either RedisException (Maybe (Map k v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k v -> Maybe (Map k v)
forall a. a -> Maybe a
Just)
          (Maybe (Map k v) -> Either RedisException (Maybe (Map k v)))
-> ([(ByteString, ByteString)] -> Maybe (Map k v))
-> [(ByteString, ByteString)]
-> Either RedisException (Maybe (Map k v))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ByteString, ByteString)] -> Maybe (Map k v)
forall k v.
(Ord k, Serializable k, Serializable v) =>
[(ByteString, ByteString)] -> Maybe (Map k v)
parseMap
        )

  txValSet :: Identifier (Map k v) -> Map k v -> Tx inst ()
txValSet Identifier (Map k v)
keyBS Map k v
m =
    Tx inst Status -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Status -> Tx inst ()) -> Tx inst Status -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ RedisTx (Queued Status) -> Tx inst Status
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (
      [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Map k v)
keyBS]
      RedisTx (Queued Integer)
-> RedisTx (Queued Status) -> RedisTx (Queued Status)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> [(ByteString, ByteString)] -> RedisTx (Queued Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, ByteString)] -> m (f Status)
Hedis.hmset ByteString
Identifier (Map k v)
keyBS
        [(k -> ByteString
forall val. Serializable val => val -> ByteString
toBS k
ref, v -> ByteString
forall val. Serializable val => val -> ByteString
toBS v
val) | (k
ref, v
val) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m]
    )

  txValDelete :: Identifier (Map k v) -> Tx inst ()
txValDelete Identifier (Map k v)
keyBS = Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ())
-> (RedisTx (Queued Integer) -> Tx inst Integer)
-> RedisTx (Queued Integer)
-> Tx inst ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Integer) -> Tx inst ())
-> RedisTx (Queued Integer) -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Map k v)
keyBS]
  txValSetTTLIfExists :: Identifier (Map k v) -> TTL -> Tx inst Bool
txValSetTTLIfExists Identifier (Map k v)
keyBS (TTLSec Integer
ttlSec) =
    RedisTx (Queued Bool) -> Tx inst Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Bool) -> Tx inst Bool)
-> RedisTx (Queued Bool) -> Tx inst Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier (Map k v)
keyBS Integer
ttlSec

  valGet :: Identifier (Map k v) -> RedisM inst (Maybe (Map k v))
valGet Identifier (Map k v)
keyBS =
    ByteString -> RedisM inst (Either Reply [(ByteString, ByteString)])
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> m (f [(ByteString, ByteString)])
Hedis.hgetall ByteString
Identifier (Map k v)
keyBS
      RedisM inst (Either Reply [(ByteString, ByteString)])
-> (Either Reply [(ByteString, ByteString)]
    -> RedisM inst [(ByteString, ByteString)])
-> RedisM inst [(ByteString, ByteString)]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> Either Reply [(ByteString, ByteString)]
-> RedisM inst [(ByteString, ByteString)]
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valGet/Map k v"
      RedisM inst [(ByteString, ByteString)]
-> ([(ByteString, ByteString)] -> RedisM inst (Maybe (Map k v)))
-> RedisM inst (Maybe (Map k v))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[(ByteString, ByteString)]
kvsBS -> case [(ByteString, ByteString)] -> Maybe (Map k v)
forall k v.
(Ord k, Serializable k, Serializable v) =>
[(ByteString, ByteString)] -> Maybe (Map k v)
parseMap [(ByteString, ByteString)]
kvsBS of
        Just Map k v
m -> Maybe (Map k v) -> RedisM inst (Maybe (Map k v))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map k v -> Maybe (Map k v)
forall a. a -> Maybe a
Just Map k v
m)
        Maybe (Map k v)
Nothing -> RedisException -> RedisM inst (Maybe (Map k v))
forall k (inst :: k) a. RedisException -> RedisM inst a
throw (RedisException -> RedisM inst (Maybe (Map k v)))
-> RedisException -> RedisM inst (Maybe (Map k v))
forall a b. (a -> b) -> a -> b
$ Maybe ByteString -> RedisException
CouldNotDecodeValue Maybe ByteString
forall a. Maybe a
Nothing

  valSet :: Identifier (Map k v) -> Map k v -> RedisM inst ()
valSet Identifier (Map k v)
keyBS Map k v
m =
    Redis (TxResult Status) -> RedisM inst (TxResult Status)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (RedisTx (Queued Status) -> Redis (TxResult Status)
forall a. RedisTx (Queued a) -> Redis (TxResult a)
Hedis.multiExec (
      [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Map k v)
keyBS]
      RedisTx (Queued Integer)
-> RedisTx (Queued Status) -> RedisTx (Queued Status)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ByteString -> [(ByteString, ByteString)] -> RedisTx (Queued Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> [(ByteString, ByteString)] -> m (f Status)
Hedis.hmset ByteString
Identifier (Map k v)
keyBS
        [(k -> ByteString
forall val. Serializable val => val -> ByteString
toBS k
ref, v -> ByteString
forall val. Serializable val => val -> ByteString
toBS v
val) | (k
ref, v
val) <- Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m]
    ))
      RedisM inst (TxResult Status)
-> (TxResult Status -> RedisM inst Status) -> RedisM inst Status
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TxResult Status -> RedisM inst Status
forall k a (inst :: k). TxResult a -> RedisM inst a
expectTxSuccess
      RedisM inst Status -> (Status -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Status -> Status -> RedisM inst ()
forall k a (inst :: k).
(Eq a, Show a) =>
String -> a -> a -> RedisM inst ()
expect String
"valSet/Map k v" Status
Hedis.Ok

  valDelete :: Identifier (Map k v) -> RedisM inst ()
valDelete Identifier (Map k v)
keyBS =
    Redis (Either Reply Integer) -> RedisM inst (Either Reply Integer)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis ([ByteString] -> Redis (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Map k v)
keyBS])
      RedisM inst (Either Reply Integer)
-> (Either Reply Integer -> RedisM inst Integer)
-> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM inst Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valDelete/Map k v"
      RedisM inst Integer
-> (Integer -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer

  valSetTTLIfExists :: Identifier (Map k v) -> TTL -> RedisM inst Bool
valSetTTLIfExists Identifier (Map k v)
keyBS (TTLSec Integer
ttlSec) =
    Redis (Either Reply Bool) -> RedisM inst (Either Reply Bool)
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (ByteString -> Integer -> Redis (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier (Map k v)
keyBS Integer
ttlSec)
      RedisM inst (Either Reply Bool)
-> (Either Reply Bool -> RedisM inst Bool) -> RedisM inst Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Bool -> RedisM inst Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"setTTLIfExists/Map k v"

infix 3 :/
-- | Map field addressing operator.
-- If @ref@ is a 'Ref' pointing to a @Map k v@,
-- then @(ref :/ k)@ is a ref with type @v@,
-- pointing to the entry in the map identified by @k@.
data MapItem :: Type -> Type -> Type -> Type where
  (:/) :: (Ref ref, ValueType ref ~ Map k v) => ref -> k -> MapItem ref k v

  -- Previously, 'MapItem' was defined simply as
  -- > data MapItem ref k v = (:/) ref k
  -- However, this caused GHC to choke on this because it provided no way
  -- to infer the value of 'v' from @ref :/ k@ alone -- 'v' is a phantom type,
  -- not mentioned in the expression.
  --
  -- This would block the instance resolution for @Ref (MapItem ref k v)@
  -- for any expression of the form @ref :/ k@, and cause more trouble down the line.
  --
  -- Hence I made 'MapItem' a GADT so that the type inference machine
  -- has clear instructions how to infer the correct value of 'v'.

instance
  ( Ref ref
  , ValueType ref ~ Map k v
  , Serializable k
  , SimpleValue (RefInstance ref) v
  ) => Ref (MapItem ref k v) where

  type ValueType (MapItem ref k v) = v
  type RefInstance (MapItem ref k v) = RefInstance ref
  toIdentifier :: MapItem ref k v -> Identifier (ValueType (MapItem ref k v))
toIdentifier (ref
mapRef :/ k
k) = ByteString -> ByteString -> SimpleValueIdentifier
SviHash (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
mapRef) (k -> ByteString
forall val. Serializable val => val -> ByteString
toBS k
k)

infix 3 :.
-- | Record item addressing operator.
-- If @ref@ is a ref pointing to a @Record fieldF@,
-- and @k :: fieldF v@ is a field of that record,
-- then @(ref :. k)@ is a ref with type @v@,
-- pointing to that field of that record.
data RecordItem ref fieldF val = (:.) ref (fieldF val)

-- | Class of record fields. See 'Record' for details.
class RecordField (fieldF :: Type -> Type) where
  rfToBS :: fieldF a -> ByteString

instance
  ( Ref ref
  , ValueType ref ~ Record fieldF
  , SimpleValue (RefInstance ref) val
  , RecordField fieldF
  ) => Ref (RecordItem ref fieldF val) where

  type ValueType (RecordItem ref fieldF val) = val
  type RefInstance (RecordItem ref fieldF val) = RefInstance ref
  toIdentifier :: RecordItem ref fieldF val
-> Identifier (ValueType (RecordItem ref fieldF val))
toIdentifier (ref
ref :. fieldF val
field) = ByteString -> ByteString -> SimpleValueIdentifier
SviHash (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier ref
ref) (fieldF val -> ByteString
forall (fieldF :: * -> *) a.
RecordField fieldF =>
fieldF a -> ByteString
rfToBS fieldF val
field)

-- | The value type for refs that point to records.
-- Can be deleted and SetTTLed.
-- Can't be read or written as a whole (at the moment).
--
-- The parameter @fieldF@ gives the field functor for this record.
-- This is usually a GADT indexed by the type of the corresponding record field.
--
-- 'Record' and 'Map' are related but different:
--
-- * 'Map' is a homogeneous variable-size collection of associations @k -> v@,
--   where all refs have the same type and all values have the same type,
--   just like a Haskell 'Map'.
--
--   'Map's can be read/written to Redis as whole entities out-of-the-box.
--
-- * 'Record' is a heterogeneous fixed-size record of items with different types,
--   just like Haskell records.
--
--   'Record's cannot be read/written whole at the moment.
--   There's no special reason for that, except that it would probably be
--   too much type-level code that noone needs at the moment.
--
--  See also: '(:.)'.
data Record (fieldF :: Type -> Type)

-- This is a bit of a hack. Records can't be written at the moment.
-- Maybe we should split the Value typeclass into ReadWriteValue and Value
instance Value inst (Record fieldF) where
  type Identifier (Record fieldF) = ByteString
  txValGet :: Identifier (Record fieldF) -> Tx inst (Maybe (Record fieldF))
txValGet Identifier (Record fieldF)
_ = String -> Tx inst (Maybe (Record fieldF))
forall a. HasCallStack => String -> a
error String
"Record is not meant to be read"
  txValSet :: Identifier (Record fieldF) -> Record fieldF -> Tx inst ()
txValSet Identifier (Record fieldF)
_ Record fieldF
_ = String -> Tx inst ()
forall a. HasCallStack => String -> a
error String
"Record is not meant to be written"
  txValDelete :: Identifier (Record fieldF) -> Tx inst ()
txValDelete Identifier (Record fieldF)
keyBS = Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ())
-> (RedisTx (Queued Integer) -> Tx inst Integer)
-> RedisTx (Queued Integer)
-> Tx inst ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Integer) -> Tx inst ())
-> RedisTx (Queued Integer) -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Record fieldF)
keyBS]
  txValSetTTLIfExists :: Identifier (Record fieldF) -> TTL -> Tx inst Bool
txValSetTTLIfExists Identifier (Record fieldF)
keyBS (TTLSec Integer
ttlSec) = RedisTx (Queued Bool) -> Tx inst Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Bool) -> Tx inst Bool)
-> RedisTx (Queued Bool) -> Tx inst Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier (Record fieldF)
keyBS Integer
ttlSec
  valGet :: Identifier (Record fieldF) -> RedisM inst (Maybe (Record fieldF))
valGet Identifier (Record fieldF)
_ = String -> RedisM inst (Maybe (Record fieldF))
forall a. HasCallStack => String -> a
error String
"Record is not meant to be read"
  valSet :: Identifier (Record fieldF) -> Record fieldF -> RedisM inst ()
valSet Identifier (Record fieldF)
_ Record fieldF
_ = String -> RedisM inst ()
forall a. HasCallStack => String -> a
error String
"Record is not meant to be written"
  valDelete :: Identifier (Record fieldF) -> RedisM inst ()
valDelete Identifier (Record fieldF)
keyBS = [ByteString] -> RedisM inst (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (Record fieldF)
keyBS]
    RedisM inst (Either Reply Integer)
-> (Either Reply Integer -> RedisM inst Integer)
-> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM inst Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valDelete/Record" RedisM inst Integer
-> (Integer -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer
  valSetTTLIfExists :: Identifier (Record fieldF) -> TTL -> RedisM inst Bool
valSetTTLIfExists Identifier (Record fieldF)
keyBS (TTLSec Integer
ttlSec) =
    ByteString -> Integer -> RedisM inst (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier (Record fieldF)
keyBS Integer
ttlSec RedisM inst (Either Reply Bool)
-> (Either Reply Bool -> RedisM inst Bool) -> RedisM inst Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Bool -> RedisM inst Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"setTTLIfExists/Record"

unliftIO :: ((forall a. RedisM inst a -> IO a) -> IO b) -> RedisM inst b
unliftIO :: ((forall a. RedisM inst a -> IO a) -> IO b) -> RedisM inst b
unliftIO (forall a. RedisM inst a -> IO a) -> IO b
action = Redis b -> RedisM inst b
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (Redis b -> RedisM inst b) -> Redis b -> RedisM inst b
forall a b. (a -> b) -> a -> b
$ ReaderT RedisEnv IO b -> Redis b
forall a. ReaderT RedisEnv IO a -> Redis a
Hedis.reRedis (ReaderT RedisEnv IO b -> Redis b)
-> ReaderT RedisEnv IO b -> Redis b
forall a b. (a -> b) -> a -> b
$ do
  RedisEnv
env <- ReaderT RedisEnv IO RedisEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO b -> ReaderT RedisEnv IO b
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO b -> ReaderT RedisEnv IO b) -> IO b -> ReaderT RedisEnv IO b
forall a b. (a -> b) -> a -> b
$ (forall a. RedisM inst a -> IO a) -> IO b
action ((forall a. RedisM inst a -> IO a) -> IO b)
-> (forall a. RedisM inst a -> IO a) -> IO b
forall a b. (a -> b) -> a -> b
$
    \(Redis Redis a
redisA) -> ReaderT RedisEnv IO a -> RedisEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Redis a -> ReaderT RedisEnv IO a
forall a. Redis a -> ReaderT RedisEnv IO a
Hedis.unRedis Redis a
redisA) RedisEnv
env

-- | PubSub channels.
data PubSub msg

instance Value inst (PubSub msg) where
  type Identifier (PubSub msg) = ByteString
  txValGet :: Identifier (PubSub msg) -> Tx inst (Maybe (PubSub msg))
txValGet Identifier (PubSub msg)
_ = String -> Tx inst (Maybe (PubSub msg))
forall a. HasCallStack => String -> a
error String
"PubSub is not meant to be read"
  txValSet :: Identifier (PubSub msg) -> PubSub msg -> Tx inst ()
txValSet Identifier (PubSub msg)
_ PubSub msg
_ = String -> Tx inst ()
forall a. HasCallStack => String -> a
error String
"PubSub is not meant to be written"
  txValDelete :: Identifier (PubSub msg) -> Tx inst ()
txValDelete Identifier (PubSub msg)
keyBS = Tx inst Integer -> Tx inst ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Tx inst Integer -> Tx inst ())
-> (RedisTx (Queued Integer) -> Tx inst Integer)
-> RedisTx (Queued Integer)
-> Tx inst ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisTx (Queued Integer) -> Tx inst Integer
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Integer) -> Tx inst ())
-> RedisTx (Queued Integer) -> Tx inst ()
forall a b. (a -> b) -> a -> b
$ [ByteString] -> RedisTx (Queued Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (PubSub msg)
keyBS]
  txValSetTTLIfExists :: Identifier (PubSub msg) -> TTL -> Tx inst Bool
txValSetTTLIfExists Identifier (PubSub msg)
keyBS (TTLSec Integer
ttlSec) = RedisTx (Queued Bool) -> Tx inst Bool
forall k a (inst :: k). RedisTx (Queued a) -> Tx inst a
txWrap (RedisTx (Queued Bool) -> Tx inst Bool)
-> RedisTx (Queued Bool) -> Tx inst Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Integer -> RedisTx (Queued Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier (PubSub msg)
keyBS Integer
ttlSec
  valGet :: Identifier (PubSub msg) -> RedisM inst (Maybe (PubSub msg))
valGet Identifier (PubSub msg)
_ = String -> RedisM inst (Maybe (PubSub msg))
forall a. HasCallStack => String -> a
error String
"PubSub is not meant to be read"
  valSet :: Identifier (PubSub msg) -> PubSub msg -> RedisM inst ()
valSet Identifier (PubSub msg)
_ PubSub msg
_ = String -> RedisM inst ()
forall a. HasCallStack => String -> a
error String
"PubSub is not meant to be written"
  valDelete :: Identifier (PubSub msg) -> RedisM inst ()
valDelete Identifier (PubSub msg)
keyBS = [ByteString] -> RedisM inst (Either Reply Integer)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
[ByteString] -> m (f Integer)
Hedis.del [ByteString
Identifier (PubSub msg)
keyBS]
    RedisM inst (Either Reply Integer)
-> (Either Reply Integer -> RedisM inst Integer)
-> RedisM inst Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Integer -> RedisM inst Integer
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"valDelete/PubSub" RedisM inst Integer
-> (Integer -> RedisM inst ()) -> RedisM inst ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (inst :: k). Integer -> RedisM inst ()
forall k a (inst :: k). a -> RedisM inst ()
ignore @Integer
  valSetTTLIfExists :: Identifier (PubSub msg) -> TTL -> RedisM inst Bool
valSetTTLIfExists Identifier (PubSub msg)
keyBS (TTLSec Integer
ttlSec) =
    ByteString -> Integer -> RedisM inst (Either Reply Bool)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
ByteString -> Integer -> m (f Bool)
Hedis.expire ByteString
Identifier (PubSub msg)
keyBS Integer
ttlSec RedisM inst (Either Reply Bool)
-> (Either Reply Bool -> RedisM inst Bool) -> RedisM inst Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Bool -> RedisM inst Bool
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"setTTLIfExists/PubSub"

pubSubListen :: (Ref ref, ValueType ref ~ PubSub msg, Serializable msg)
  => ref -> (Either RedisException msg -> IO Bool) -> RedisM (RefInstance ref) ()
pubSubListen :: ref
-> (Either RedisException msg -> IO Bool)
-> RedisM (RefInstance ref) ()
pubSubListen (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) Either RedisException msg -> IO Bool
process =
  Redis () -> RedisM (RefInstance ref) ()
forall k (inst :: k) a. Redis a -> RedisM inst a
Redis (Redis () -> RedisM (RefInstance ref) ())
-> Redis () -> RedisM (RefInstance ref) ()
forall a b. (a -> b) -> a -> b
$ PubSub -> (Message -> IO PubSub) -> Redis ()
Hedis.pubSub ([ByteString] -> PubSub
Hedis.subscribe [ByteString
Identifier (ValueType ref)
keyBS]) ((Message -> IO PubSub) -> Redis ())
-> (Message -> IO PubSub) -> Redis ()
forall a b. (a -> b) -> a -> b
$ \Message
rawMsg ->
    let msg :: Either RedisException msg
msg = case ByteString -> Maybe msg
forall val. Serializable val => ByteString -> Maybe val
fromBS (Message -> ByteString
Hedis.msgMessage Message
rawMsg) of
          Maybe msg
Nothing -> RedisException -> Either RedisException msg
forall a b. a -> Either a b
Left (Maybe ByteString -> RedisException
CouldNotDecodeValue (Maybe ByteString -> RedisException)
-> Maybe ByteString -> RedisException
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Message -> ByteString
Hedis.msgMessage Message
rawMsg))
          Just msg
msg' -> msg -> Either RedisException msg
forall a b. b -> Either a b
Right msg
msg'
    in IO Bool -> IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Either RedisException msg -> IO Bool
process Either RedisException msg
msg) IO Bool -> (Bool -> IO PubSub) -> IO PubSub
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> PubSub -> IO PubSub
forall (m :: * -> *) a. Monad m => a -> m a
return PubSub
forall a. Monoid a => a
mempty
      Bool
False -> PubSub -> IO PubSub
forall (m :: * -> *) a. Monad m => a -> m a
return ([ByteString] -> PubSub
Hedis.unsubscribe [ByteString
Identifier (ValueType ref)
keyBS])

pubSubCountSubs :: (Ref ref, ValueType ref ~ PubSub msg)
  => ref -> RedisM (RefInstance ref) Integer
pubSubCountSubs :: ref -> RedisM (RefInstance ref) Integer
pubSubCountSubs (ref -> Identifier (ValueType ref)
forall ref. Ref ref => ref -> Identifier (ValueType ref)
toIdentifier -> Identifier (ValueType ref)
keyBS) =
  [ByteString] -> RedisM (RefInstance ref) (Either Reply Reply)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
Hedis.sendRequest [ByteString
"PUBSUB", ByteString
"NUMSUB", ByteString
Identifier (ValueType ref)
keyBS]
    RedisM (RefInstance ref) (Either Reply Reply)
-> (Either Reply Reply -> RedisM (RefInstance ref) Reply)
-> RedisM (RefInstance ref) Reply
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> Either Reply Reply -> RedisM (RefInstance ref) Reply
forall k e a (inst :: k).
Show e =>
String -> Either e a -> RedisM inst a
expectRight String
"pubSubCountSubs" 
    RedisM (RefInstance ref) Reply
-> (Reply -> RedisM (RefInstance ref) Integer)
-> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Hedis.MultiBulk (Just [Reply
_, Hedis.Integer Integer
cnt]) -> Integer -> RedisM (RefInstance ref) Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
cnt
      Reply
_ -> String -> RedisM (RefInstance ref) Integer
forall a. HasCallStack => String -> a
error String
"pubSubCountSubs: unexpected reply"