redis-resp-0.2: src/Data/Redis/Command.hs
-- This Source Code Form is subject to the terms of the Mozilla Public
-- License, v. 2.0. If a copy of the MPL was not distributed with this
-- file, You can obtain one at http://mozilla.org/MPL/2.0/.
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections #-}
module Data.Redis.Command
( -- * Types
Redis
, PubSub
, Command (..)
, PubSubCommand (..)
, PushMessage (..)
, Result
, RedisError (..)
, RedisType (..)
, TTL (..)
, Side (..)
, Choose (..)
, Aggregate (..)
, Min (..)
, Max (..)
, ScoreList (..)
, Seconds (..)
, Timestamp (..)
, Field
, Index
, Key (..)
-- ** Cursor
, Cursor
, zero
-- ** Non-empty lists
, one
-- ** Options
, Opts
, none
-- ** Bit
, BitStart
, BitEnd
, start
, end
-- * Commands
-- ** Connection
, auth
, echo
, ping
, quit
, select
-- ** Server
, bgrewriteaof
, bgsave
, dbsize
, flushall
, flushdb
, lastsave
, save
-- ** Transactions
, discard
, exec
, execRaw
, multi
, unwatch
, watch
-- ** Keys
, del
, dump
, exists
, expire
, expireat
, keys
, persist
, randomkey
, rename
, renamenx
, ttl
, typeof
-- ** Strings
, append
, decr
, decrby
, get
, getrange
, getset
, incr
, incrby
, incrbyfloat
, mget
, mset
, msetnx
, set, ex, px, xx, nx
, setrange
, strlen
-- ** Bits
, bitand
, bitcount, range
, bitnot
, bitor
, bitpos
, bitxor
, getbit
, setbit
-- ** Hashes
, hdel
, hexists
, hget
, hgetall
, hincrby
, hincrbyfloat
, hkeys
, hlen
, hmget
, hmset
, hset
, hsetnx
, hvals
-- ** Lists
, blpop
, brpop
, brpoplpush
, lindex
, linsert
, llen
, lpop
, lpush
, lpushx
, lrange
, lrem
, lset
, ltrim
, rpop
, rpoplpush
, rpush
, rpushx
-- ** Sets
, sadd
, scard
, sdiff
, sdiffstore
, sinter
, sinterstore
, sismember
, smembers
, smove
, spop
, srandmember
, srem
, sunion
, sunionstore
-- ** Sorted Sets
, zadd
, zcard
, zcount
, zincrby
, zinterstore
, zlexcount
, zrange
, zrangebylex
, zrangebyscore
, zrank
, zrem
, zremrangebylex
, zremrangebyrank
, zremrangebyscore
, zrevrangebyscore
, zrevrange
, zrevrank
, zscore
, zunionstore
-- ** HyperLogLog
, pfadd
, pfcount
, pfmerge
-- ** Scan
, scan, match, count
, hscan
, sscan
, zscan
-- ** Sort
, sort, by, limit, getkey, asc, desc, alpha, store
-- ** Pub/Sub
, publish
, subscribe
, psubscribe
, unsubscribe
, punsubscribe
-- * Response Reading
, readInt
, readInt'Null
, readBool
, readTTL
, readBulk'Null
, readBulk
, readListOfMaybes
, readList
, readScoreList
, readFields
, readKeyValue
, readBulk'Array
, readScan
, matchStr
, readType
, fromSet
, anyStr
, readPushMessage
-- * Re-exports
, NonEmpty (..)
, NE.nonEmpty
) where
import Control.Applicative
import Control.Exception (Exception)
import Control.Monad.Operational
import Data.ByteString.Builder (int64Dec)
import Data.ByteString.Builder.Extra
import Data.ByteString.Conversion
import Data.ByteString.Lazy (ByteString, fromStrict)
import Data.DList (DList, cons)
import Data.Double.Conversion.ByteString (toShortest)
import Data.Foldable (toList, foldr)
import Data.Int
import Data.List.NonEmpty (NonEmpty (..), (<|))
import Data.List.Split (chunksOf)
import Data.Maybe (maybeToList)
import Data.Monoid hiding (Sum)
import Data.Redis.Resp
import Data.String
import Data.Typeable
import GHC.TypeLits
import Prelude hiding (foldr, readList)
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.DList as DL
import qualified Data.List.NonEmpty as NE
-- | Redis error type.
data RedisError
= RedisError !ByteString
-- ^ General error case.
| InvalidResponse !String
-- ^ The received response is invalid or unexpected (e.g. a bulk
-- string instead of an integer).
| InvalidConversion !String
-- ^ ByteString conversion using 'FromByteString' failed.
deriving (Eq, Ord, Show, Typeable)
instance Exception RedisError
type Redis = ProgramT Command
type PubSub = ProgramT PubSubCommand
type Result = Either RedisError
-- | Redis commands.
data Command :: * -> * where
-- Connection
Ping :: Resp -> Command ()
Echo :: FromByteString a => Resp -> Command a
Auth :: Resp -> Command ()
Quit :: Resp -> Command ()
Select :: Resp -> Command ()
-- Server
BgRewriteAOF :: Resp -> Command ()
BgSave :: Resp -> Command ()
Save :: Resp -> Command ()
DbSize :: Resp -> Command Int64
FlushAll :: Resp -> Command ()
FlushDb :: Resp -> Command ()
LastSave :: Resp -> Command Int64
-- Transactions
Multi :: Resp -> Command ()
Watch :: Resp -> Command ()
Unwatch :: Resp -> Command ()
Discard :: Resp -> Command ()
Exec :: FromByteString a => Resp -> Command [a]
ExecRaw :: Resp -> Command Resp
-- Keys
Del :: Resp -> Command Int64
Dump :: Resp -> Command (Maybe ByteString)
Exists :: Resp -> Command Bool
Expire :: Resp -> Command Bool
ExpireAt :: Resp -> Command Bool
Persist :: Resp -> Command Bool
Keys :: Resp -> Command [Key]
RandomKey :: Resp -> Command (Maybe Key)
Rename :: Resp -> Command ()
RenameNx :: Resp -> Command Bool
Sort :: FromByteString a => Resp -> Command [a]
Ttl :: Resp -> Command (Maybe TTL)
Type :: Resp -> Command (Maybe RedisType)
Scan :: FromByteString a => Resp -> Command (Cursor, [a])
-- Strings
Append :: Resp -> Command Int64
Get :: FromByteString a => Resp -> Command (Maybe a)
GetRange :: FromByteString a => Resp -> Command a
GetSet :: FromByteString a => Resp -> Command (Maybe a)
MGet :: FromByteString a => Resp -> Command [Maybe a]
MSet :: Resp -> Command ()
MSetNx :: Resp -> Command Bool
Set :: Resp -> Command Bool
SetRange :: Resp -> Command Int64
StrLen :: Resp -> Command Int64
-- Bits
BitAnd :: Resp -> Command Int64
BitCount :: Resp -> Command Int64
BitNot :: Resp -> Command Int64
BitOr :: Resp -> Command Int64
BitPos :: Resp -> Command Int64
BitXOr :: Resp -> Command Int64
GetBit :: Resp -> Command Int64
SetBit :: Resp -> Command Int64
-- Numeric
Decr :: Resp -> Command Int64
DecrBy :: Resp -> Command Int64
Incr :: Resp -> Command Int64
IncrBy :: Resp -> Command Int64
IncrByFloat :: Resp -> Command Double
-- Hashes
HDel :: Resp -> Command Int64
HExists :: Resp -> Command Bool
HGet :: FromByteString a => Resp -> Command (Maybe a)
HGetAll :: FromByteString a => Resp -> Command [(Field, a)]
HIncrBy :: Resp -> Command Int64
HIncrByFloat :: Resp -> Command Double
HKeys :: Resp -> Command [Field]
HLen :: Resp -> Command Int64
HMGet :: FromByteString a => Resp -> Command [Maybe a]
HMSet :: Resp -> Command ()
HSet :: Resp -> Command Bool
HSetNx :: Resp -> Command Bool
HVals :: FromByteString a => Resp -> Command [a]
HScan :: FromByteString a => Resp -> Command (Cursor, [a])
-- Lists
BLPop :: FromByteString a => Int64 -> Resp -> Command (Maybe (Key, a))
BRPop :: FromByteString a => Int64 -> Resp -> Command (Maybe (Key, a))
BRPopLPush :: FromByteString a => Int64 -> Resp -> Command (Maybe a)
LIndex :: FromByteString a => Resp -> Command (Maybe a)
LInsert :: Resp -> Command Int64
LLen :: Resp -> Command Int64
LPop :: FromByteString a => Resp -> Command (Maybe a)
LPush :: Resp -> Command Int64
LPushX :: Resp -> Command Int64
LRange :: FromByteString a => Resp -> Command [a]
LRem :: Resp -> Command Int64
LSet :: Resp -> Command ()
LTrim :: Resp -> Command ()
RPop :: FromByteString a => Resp -> Command (Maybe a)
RPopLPush :: FromByteString a => Resp -> Command (Maybe a)
RPush :: Resp -> Command Int64
RPushX :: Resp -> Command Int64
-- Sets
SAdd :: Resp -> Command Int64
SCard :: Resp -> Command Int64
SDiff :: FromByteString a => Resp -> Command [a]
SDiffStore :: Resp -> Command Int64
SInter :: FromByteString a => Resp -> Command [a]
SInterStore :: Resp -> Command Int64
SIsMember :: Resp -> Command Bool
SMembers :: FromByteString a => Resp -> Command [a]
SMove :: Resp -> Command Bool
SPop :: FromByteString a => Resp -> Command (Maybe a)
SRandMember :: FromByteString a => Choose -> Resp -> Command [a]
SRem :: Resp -> Command Int64
SScan :: FromByteString a => Resp -> Command (Cursor, [a])
SUnion :: FromByteString a => Resp -> Command [a]
SUnionStore :: Resp -> Command Int64
-- Sorted Sets
ZAdd :: Resp -> Command Int64
ZCard :: Resp -> Command Int64
ZCount :: Resp -> Command Int64
ZIncrBy :: Resp -> Command Double
ZInterStore :: Resp -> Command Int64
ZLexCount :: Resp -> Command Int64
ZRange :: FromByteString a => Bool -> Resp -> Command (ScoreList a)
ZRangeByLex :: FromByteString a => Resp -> Command [a]
ZRangeByScore :: FromByteString a => Bool -> Resp -> Command (ScoreList a)
ZRank :: Resp -> Command (Maybe Int64)
ZRem :: Resp -> Command Int64
ZRemRangeByLex :: Resp -> Command Int64
ZRemRangeByRank :: Resp -> Command Int64
ZRemRangeByScore :: Resp -> Command Int64
ZRevRange :: FromByteString a => Bool -> Resp -> Command (ScoreList a)
ZRevRangeByScore :: FromByteString a => Bool -> Resp -> Command (ScoreList a)
ZRevRank :: Resp -> Command (Maybe Int64)
ZScan :: FromByteString a => Resp -> Command (Cursor, [a])
ZScore :: Resp -> Command (Maybe Double)
ZUnionStore :: Resp -> Command Int64
-- HyperLogLog
PfAdd :: Resp -> Command Bool
PfCount :: Resp -> Command Int64
PfMerge :: Resp -> Command ()
-- Pub/Sub
Publish :: Resp -> Command Int64
-- | Pub/Sub commands.
data PubSubCommand r where
Subscribe :: Resp -> PubSubCommand ()
Unsubscribe :: Resp -> PubSubCommand ()
PSubscribe :: Resp -> PubSubCommand ()
PUnsubscribe :: Resp -> PubSubCommand ()
-- | Messages which are published to subscribers.
data PushMessage
= SubscribeMessage
{ channel :: !ByteString
, subscriptions :: !Int64
}
| UnsubscribeMessage
{ channel :: !ByteString
, subscriptions :: !Int64
}
| Message
{ channel :: !ByteString
, message :: !ByteString
}
| PMessage
{ pattern :: !ByteString
, channel :: !ByteString
, message :: !ByteString
}
deriving (Eq, Ord, Show)
-- | The types redis reports via <http://redis.io/commands/type type>.
data RedisType
= RedisString
| RedisList
| RedisSet
| RedisZSet
| RedisHash
deriving (Eq, Ord, Show)
-- | A type representing time-to-live values.
data TTL = NoTTL | TTL !Int64
deriving (Eq, Ord, Show)
-- | Used in 'linsert' to specify the insertion point.
data Side = Before | After
deriving (Eq, Ord, Show)
data Choose
= One -- ^ Exactly one element
| Dist !Int64 -- ^ @n@ distint elements
| Arb !Int64 -- ^ @n@ arbitrary (i.e. potentially repeated) elements
deriving (Eq, Ord, Show)
data Aggregate
= None -- ^ no aggregation
| Min -- ^ take the minimum score
| Max -- ^ take the maximum score
| Sum -- ^ addition of scores
deriving (Eq, Ord, Show)
data Min
= MinIncl !ByteString -- ^ lower bound (inclusive)
| MinExcl !ByteString -- ^ lower bound (exclusive)
| MinInf -- ^ infinite lower bound
deriving (Eq, Ord, Show)
data Max
= MaxIncl !ByteString -- ^ upper bound (inclusive)
| MaxExcl !ByteString -- ^ upper bound (exclusive)
| MaxInf -- ^ infinite upper bound
deriving (Eq, Ord, Show)
data ScoreList a = ScoreList
{ scores :: [Double]
, elements :: [a]
} deriving (Eq, Ord, Show)
newtype Cursor = Cursor
{ cursor :: ByteString
} deriving (Eq, Ord, Show, FromByteString)
zero :: Cursor
zero = Cursor "0"
type Field = ByteString
type Index = Int64
-- | Redis key type
newtype Key = Key
{ key :: ByteString
} deriving (Eq, Ord, Show, FromByteString)
instance IsString Key where
fromString = Key . fromString
-- | Command options
data Opts (a :: Symbol) = Opts { len :: !Int, opts :: DList ByteString }
instance Monoid (Opts a) where
mempty = Opts 0 DL.empty
Opts x a `mappend` Opts y b = Opts (x + y) (a `DL.append` b)
none :: Monoid m => m
none = mempty
newtype Seconds = Seconds Int64
newtype Timestamp = Timestamp Int64
newtype BitStart = BitStart ByteString
newtype BitEnd = BitEnd ByteString
instance Monoid BitStart where
mempty = BitStart ""
_ `mappend` b = b
instance Monoid BitEnd where
mempty = BitEnd ""
_ `mappend` b = b
start :: Int64 -> BitStart
start = BitStart . int2bytes
end :: Int64 -> BitEnd
end = BitEnd . int2bytes
one :: a -> NonEmpty a
one a = a :| []
-----------------------------------------------------------------------------
-- Connection
ping :: Monad m => Redis m ()
ping = singleton $ Ping $ cmd 1 ["PING"]
echo :: (Monad m, ToByteString a, FromByteString a) => a -> Redis m a
echo x = singleton $ Echo $ cmd 2 ["ECHO", toByteString x]
auth :: Monad m => ByteString -> Redis m ()
auth x = singleton $ Auth $ cmd 2 ["AUTH", x]
quit :: Monad m => Redis m ()
quit = singleton $ Quit $ cmd 1 ["QUIT"]
select :: Monad m => Int64 -> Redis m ()
select x = singleton $ Select $ cmd 2 ["SELECT", int2bytes x]
-----------------------------------------------------------------------------
-- Server
bgrewriteaof :: Monad m => Redis m ()
bgrewriteaof = singleton $ BgRewriteAOF $ cmd 1 ["BGREWRITEAOF"]
bgsave :: Monad m => Redis m ()
bgsave = singleton $ BgSave $ cmd 1 ["BGSAVE"]
save :: Monad m => Redis m ()
save = singleton $ Save $ cmd 1 ["SAVE"]
flushall :: Monad m => Redis m ()
flushall = singleton $ FlushAll $ cmd 1 ["FLUSHALL"]
flushdb :: Monad m => Redis m ()
flushdb = singleton $ FlushDb $ cmd 1 ["FLUSHDB"]
lastsave :: Monad m => Redis m Int64
lastsave = singleton $ LastSave $ cmd 1 ["LASTSAVE"]
dbsize :: Monad m => Redis m Int64
dbsize = singleton $ DbSize $ cmd 1 ["DBSIZE"]
-----------------------------------------------------------------------------
-- Transactions
multi :: Monad m => Redis m ()
multi = singleton $ Multi $ cmd 1 ["MULTI"]
discard :: Monad m => Redis m ()
discard = singleton $ Discard $ cmd 1 ["DISCARD"]
unwatch :: Monad m => Redis m ()
unwatch = singleton $ Unwatch $ cmd 1 ["UNWATCH"]
watch :: Monad m => NonEmpty Key -> Redis m ()
watch kk = singleton $ Watch $ cmd (1 + NE.length kk) $ "WATCH" : map key (toList kk)
exec :: (Monad m, FromByteString a) => Redis m [a]
exec = singleton $ Exec $ cmd 1 ["EXEC"]
execRaw :: Monad m => Redis m Resp
execRaw = singleton $ ExecRaw $ cmd 1 ["EXEC"]
-----------------------------------------------------------------------------
-- Keys
dump :: Monad m => Key -> Redis m (Maybe ByteString)
dump k = singleton $ Dump $ cmd 2 ["DUMP", key k]
exists :: Monad m => Key -> Redis m Bool
exists k = singleton $ Exists $ cmd 2 ["EXISTS", key k]
del :: Monad m => NonEmpty Key -> Redis m Int64
del kk = singleton $ Del $ cmd (1 + NE.length kk) $ "DEL" : map key (toList kk)
expire :: Monad m => Key -> Seconds -> Redis m Bool
expire k (Seconds n) = singleton $ Expire $ cmd 3 ["EXPIRE", key k, int2bytes n]
expireat :: Monad m => Key -> Timestamp -> Redis m Bool
expireat k (Timestamp n) = singleton $ ExpireAt $ cmd 3 ["EXPIREAT", key k, int2bytes n]
persist :: Monad m => Key -> Redis m Bool
persist k = singleton $ Persist $ cmd 2 ["PERSIST", key k]
keys :: Monad m => ByteString -> Redis m [Key]
keys pat = singleton $ Keys $ cmd 2 ["KEYS", pat]
randomkey :: Monad m => Redis m (Maybe Key)
randomkey = singleton $ RandomKey $ cmd 1 ["RANDOMKEY"]
rename :: Monad m => Key -> Key -> Redis m ()
rename a b = singleton $ Rename $ cmd 3 ["RENAME", key a, key b]
renamenx :: Monad m => Key -> Key -> Redis m Bool
renamenx a b = singleton $ RenameNx $ cmd 3 ["RENAMENX", key a, key b]
ttl :: Monad m => Key -> Redis m (Maybe TTL)
ttl k = singleton $ Ttl $ cmd 2 ["TTL", key k]
typeof :: Monad m => Key -> Redis m (Maybe RedisType)
typeof k = singleton $ Type $ cmd 2 ["TYPE", key k]
-----------------------------------------------------------------------------
-- Strings
get :: (Monad m, FromByteString a) => Key -> Redis m (Maybe a)
get k = singleton $ Get $ cmd 2 ["GET", key k]
set :: (Monad m, ToByteString a) => Key -> a -> Opts "SET" -> Redis m Bool
set k v o = singleton $ Set $ cmd (3 + len o) $ "SET" : key k : toByteString v : toList (opts o)
ex :: Int64 -> Opts "SET"
ex i = Opts 2 $ "EX" `cons` DL.singleton (int2bytes i)
px :: Int64 -> Opts "SET"
px i = Opts 2 $ "PX" `cons` DL.singleton (int2bytes i)
xx :: Opts "SET"
xx = Opts 1 $ DL.singleton "XX"
nx :: Opts "SET"
nx = Opts 1 $ DL.singleton "NX"
getset :: (Monad m, ToByteString a, FromByteString b) => Key -> a -> Redis m (Maybe b)
getset k v = singleton $ GetSet $ cmd 3 ["GETSET", key k, toByteString v]
mget :: (Monad m, FromByteString a) => NonEmpty Key -> Redis m [Maybe a]
mget kk = singleton $ MGet $ cmd (1 + NE.length kk) $ "MGET" : map key (toList kk)
mset :: (Monad m, ToByteString a) => NonEmpty (Key, a) -> Redis m ()
mset kv = singleton $ MSet $ cmd (1 + 2 * NE.length kv) $ "MSET" : foldr f [] kv
where
f (k, v) acc = key k : toByteString v : acc
msetnx :: (Monad m, ToByteString a) => NonEmpty (Key, a) -> Redis m Bool
msetnx kv = singleton $ MSetNx $ cmd (1 + 2 * NE.length kv) $ "MSETNX" : foldr f [] kv
where
f (k, v) acc = key k : toByteString v : acc
getrange :: (Monad m, FromByteString a) => Key -> Int64 -> Int64 -> Redis m a
getrange k a b = singleton $ GetRange $ cmd 4 ["GETRANGE", key k, int2bytes a, int2bytes b]
setrange :: (Monad m, ToByteString a) => Key -> Int64 -> a -> Redis m Int64
setrange k i a = singleton $ SetRange $ cmd 4 ["SETRANGE", key k, int2bytes i, toByteString a]
append :: (Monad m, ToByteString a) => Key -> a -> Redis m Int64
append k v = singleton $ Append $ cmd 3 ["APPEND", key k, toByteString v]
strlen :: Monad m => Key -> Redis m Int64
strlen k = singleton $ StrLen $ cmd 2 ["STRLEN", key k]
decr :: Monad m => Key -> Redis m Int64
decr k = singleton $ Decr $ cmd 2 ["DECR", key k]
decrby :: Monad m => Key -> Int64 -> Redis m Int64
decrby k v = singleton $ DecrBy $ cmd 3 ["DECRBY", key k, int2bytes v]
incr :: Monad m => Key -> Redis m Int64
incr k = singleton $ Incr $ cmd 2 ["INCR", key k]
incrby :: Monad m => Key -> Int64 -> Redis m Int64
incrby k v = singleton $ IncrBy $ cmd 3 ["INCRBY", key k, int2bytes v]
incrbyfloat :: Monad m => Key -> Double -> Redis m Double
incrbyfloat k v = singleton $ IncrByFloat $ cmd 3 ["INCRBYFLOAT", key k, dbl2bytes v]
-----------------------------------------------------------------------------
-- Bits
bitcount :: Monad m => Key -> Opts "RANGE" -> Redis m Int64
bitcount k o = singleton $ BitCount $ cmd (2 + len o) $ "BITCOUNT" : key k : toList (opts o)
range :: Int64 -> Int64 -> Opts "RANGE"
range x y = Opts 2 $ int2bytes x `cons` DL.singleton (int2bytes y)
bitand :: Monad m => Key -> NonEmpty Key -> Redis m Int64
bitand k kk = singleton $ BitAnd $ bitop "AND" (k <| kk)
bitor :: Monad m => Key -> NonEmpty Key -> Redis m Int64
bitor k kk = singleton $ BitOr $ bitop "OR" (k <| kk)
bitxor :: Monad m => Key -> NonEmpty Key -> Redis m Int64
bitxor k kk = singleton $ BitXOr $ bitop "XOR" (k <| kk)
bitnot :: Monad m => Key -> Key -> Redis m Int64
bitnot k l = singleton $ BitNot $ bitop "NOT" (k :| [l])
bitop :: ByteString -> NonEmpty Key -> Resp
bitop o kk = cmd (2 + NE.length kk) $ "BITOP" : o : map key (toList kk)
{-# INLINE bitop #-}
bitpos :: Monad m => Key -> Bool -> BitStart -> BitEnd -> Redis m Int64
bitpos k b (BitStart s) (BitEnd e) =
let args = filter (not . Lazy.null) [s, e] in
singleton $ BitPos $ cmd (3 + length args) $ "BITPOS" : key k : toBit b : args
where
toBit True = "1"
toBit False = "0"
getbit :: Monad m => Key -> Int64 -> Redis m Int64
getbit k o = singleton $ GetBit $ cmd 3 ["GETBIT", key k, int2bytes o]
setbit :: Monad m => Key -> Int64 -> Bool -> Redis m Int64
setbit k o b = singleton $ SetBit $ cmd 4 ["SETBIT", key k, int2bytes o, toBit b]
where
toBit True = "1"
toBit False = "0"
-----------------------------------------------------------------------------
-- Hashes
hget :: (Monad m, FromByteString a) => Key -> Field -> Redis m (Maybe a)
hget h k = singleton $ HGet $ cmd 3 ["HGET", key h, k]
hgetall :: (Monad m, FromByteString a) => Key -> Redis m [(Field, a)]
hgetall h = singleton $ HGetAll $ cmd 2 ["HGETALL", key h]
hvals :: (Monad m, FromByteString a) => Key -> Redis m [a]
hvals h = singleton $ HVals $ cmd 2 ["HVALS", key h]
hmget :: (Monad m, FromByteString a) => Key -> NonEmpty Field -> Redis m [Maybe a]
hmget h kk = singleton $ HMGet $ cmd (2 + NE.length kk) $ "HMGET" : key h : toList kk
hmset :: (Monad m, ToByteString a) => Key -> NonEmpty (Field, a) -> Redis m ()
hmset h kv = singleton $ HMSet $ cmd (2 + 2 * NE.length kv) $ "HMSET" : key h : foldr f [] kv
where
f (k, v) acc = k : toByteString v : acc
hset :: (Monad m, ToByteString a) => Key -> Field -> a -> Redis m Bool
hset h k v = singleton $ HSet $ cmd 4 ["HSET", key h, k, toByteString v]
hsetnx :: (Monad m, ToByteString a) => Key -> Field -> a -> Redis m Bool
hsetnx h k v = singleton $ HSetNx $ cmd 4 ["HSETNX", key h, k, toByteString v]
hincrby :: Monad m => Key -> Field -> Int64 -> Redis m Int64
hincrby h k v = singleton $ HIncrBy $ cmd 4 ["HINCRBY", key h, k, int2bytes v]
hincrbyfloat :: Monad m => Key -> Field -> Double -> Redis m Double
hincrbyfloat h k v = singleton $ HIncrByFloat $ cmd 4 ["HINCRBYFLOAT", key h, k, dbl2bytes v]
hdel :: Monad m => Key -> NonEmpty Field -> Redis m Int64
hdel h kk = singleton $ HDel $ cmd (2 + NE.length kk) $ "HDEL" : key h : toList kk
hexists :: Monad m => Key -> Field -> Redis m Bool
hexists h k = singleton $ HExists $ cmd 3 ["HEXISTS", key h, k]
hkeys :: Monad m => Key -> Redis m [Field]
hkeys h = singleton $ HKeys $ cmd 2 ["HKEYS", key h]
hlen :: Monad m => Key -> Redis m Int64
hlen h = singleton $ HLen $ cmd 2 ["HLEN", key h]
-----------------------------------------------------------------------------
-- Lists
lindex :: (Monad m, FromByteString a) => Key -> Index -> Redis m (Maybe a)
lindex k i = singleton $ LIndex $ cmd 3 ["LINDEX", key k, int2bytes i]
lpop :: (Monad m, FromByteString a) => Key -> Redis m (Maybe a)
lpop k = singleton $ LPop $ cmd 2 ["LPOP", key k]
rpop :: (Monad m, FromByteString a) => Key -> Redis m (Maybe a)
rpop k = singleton $ RPop $ cmd 2 ["RPOP", key k]
rpoplpush :: (Monad m, FromByteString a) => Key -> Key -> Redis m (Maybe a)
rpoplpush a b = singleton $ RPopLPush $ cmd 3 ["RPOPLPUSH", key a, key b]
brpoplpush :: (Monad m, FromByteString a) => Key -> Key -> Seconds -> Redis m (Maybe a)
brpoplpush a b (Seconds t) = singleton $ BRPopLPush t $ cmd 4 ["BRPOPLPUSH", key a, key b, int2bytes t]
blpop :: (Monad m, FromByteString a) => NonEmpty Key -> Seconds -> Redis m (Maybe (Key, a))
blpop kk (Seconds t) = singleton $ BLPop t $ cmd (2 + NE.length kk) $
"BLPOP" : map key (toList kk) ++ [int2bytes t]
brpop :: (Monad m, FromByteString a) => NonEmpty Key -> Seconds -> Redis m (Maybe (Key, a))
brpop kk (Seconds t) = singleton $ BRPop t $ cmd (2 + NE.length kk) $
"BRPOP" : map key (toList kk) ++ [int2bytes t]
lrange :: (Monad m, FromByteString a) => Key -> Int64 -> Int64 -> Redis m [a]
lrange k a b = singleton $ LRange $ cmd 4 ["LRANGE", key k, int2bytes a, int2bytes b]
linsert :: (Monad m, ToByteString a) => Key -> Side -> a -> a -> Redis m Int64
linsert k s p v = singleton $ LInsert $ cmd 5 ["LINSERT", key k, side2bytes s, toByteString p, toByteString v]
lpush :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64
lpush k vv = singleton $ LPush $ cmd (2 + NE.length vv) $ "LPUSH" : key k : map toByteString (toList vv)
rpush :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64
rpush k vv = singleton $ RPush $ cmd (2 + NE.length vv) $ "RPUSH" : key k : map toByteString (toList vv)
lset :: (Monad m, ToByteString a) => Key -> Int64 -> a -> Redis m ()
lset k i v = singleton $ LSet $ cmd 4 ["LSET", key k, int2bytes i, toByteString v]
ltrim :: Monad m => Key -> Int64 -> Int64 -> Redis m ()
ltrim k i j = singleton $ LTrim $ cmd 4 ["LTRIM", key k, int2bytes i, int2bytes j]
lrem :: (Monad m, ToByteString a) => Key -> Int64 -> a -> Redis m Int64
lrem k c v = singleton $ LRem $ cmd 4 ["LREM", key k, int2bytes c, toByteString v]
lpushx :: (Monad m, ToByteString a) => Key -> a -> Redis m Int64
lpushx k v = singleton $ LPushX $ cmd 3 ["LPUSHX", key k, toByteString v]
rpushx :: (Monad m, ToByteString a) => Key -> a -> Redis m Int64
rpushx k v = singleton $ RPushX $ cmd 3 ["RPUSHX", key k, toByteString v]
llen :: Monad m => Key -> Redis m Int64
llen k = singleton $ LLen $ cmd 2 ["LLEN", key k]
-----------------------------------------------------------------------------
-- Sets
spop :: (Monad m, FromByteString a) => Key -> Redis m (Maybe a)
spop k = singleton $ SPop $ cmd 2 ["SPOP", key k]
sismember :: (Monad m, ToByteString a) => Key -> a -> Redis m Bool
sismember k v = singleton $ SIsMember $ cmd 3 ["SISMEMBER", key k, toByteString v]
smove :: (Monad m, ToByteString a) => Key -> Key -> a -> Redis m Bool
smove a b v = singleton $ SMove $ cmd 4 ["SMOVE", key a, key b, toByteString v]
sdiff :: (Monad m, FromByteString a) => NonEmpty Key -> Redis m [a]
sdiff kk = singleton $ SDiff $ cmd (1 + NE.length kk) $ "SDIFF" : map key (toList kk)
sinter :: (Monad m, FromByteString a) => NonEmpty Key -> Redis m [a]
sinter kk = singleton $ SInter $ cmd (1 + NE.length kk) $ "SINTER" : map key (toList kk)
smembers :: (Monad m, FromByteString a) => Key -> Redis m [a]
smembers k = singleton $ SMembers $ cmd 2 ["SMEMBERS", key k]
srandmember :: (Monad m, FromByteString a) => Key -> Choose -> Redis m [a]
srandmember k One = singleton $ SRandMember One $ cmd 2 ["SRANDMEMBER", key k]
srandmember k chs = singleton $ SRandMember chs $ cmd 3 ["SRANDMEMBER", key k, choose chs]
where
choose (Dist n) = int2bytes n
choose (Arb n) = int2bytes n
choose One = "1"
sdiffstore :: Monad m => Key -> NonEmpty Key -> Redis m Int64
sdiffstore k kk = singleton $ SDiffStore $ cmd (2 + NE.length kk) $
"SDIFFSTORE" : key k : map key (toList kk)
sinterstore :: Monad m => Key -> NonEmpty Key -> Redis m Int64
sinterstore k kk = singleton $ SInterStore $ cmd (2 + NE.length kk) $
"SINTERSTORE" : key k : map key (toList kk)
sunionstore :: Monad m => Key -> NonEmpty Key -> Redis m Int64
sunionstore k kk = singleton $ SUnionStore $ cmd (2 + NE.length kk) $
"SUNIONSTORE" : key k : map key (toList kk)
sadd :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64
sadd k v = singleton $ SAdd $ cmd (2 + NE.length v) $ "SADD" : key k : map toByteString (toList v)
srem :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64
srem k vv = singleton $ SRem $ cmd (2 + NE.length vv) $ "SREM" : key k : map toByteString (toList vv)
sunion :: (Monad m, FromByteString a) => NonEmpty Key -> Redis m [a]
sunion kk = singleton $ SUnion $ cmd (1 + NE.length kk) $ "SUNION" : map key (toList kk)
scard :: Monad m => Key -> Redis m Int64
scard k = singleton $ SCard $ cmd 2 ["SCARD", key k]
-----------------------------------------------------------------------------
-- Sorted Sets
zrange :: (Monad m, FromByteString a) => Key -> Int64 -> Int64 -> Bool -> Redis m (ScoreList a)
zrange k a b s =
let args = ["ZRANGE", key k, int2bytes a, int2bytes b, "WITHSCORES"]
in if s then singleton $ ZRange s $ cmd 5 args
else singleton $ ZRange s $ cmd 4 (init args)
zrevrange :: (Monad m, FromByteString a) => Key -> Int64 -> Int64 -> Bool -> Redis m (ScoreList a)
zrevrange k a b s =
let args = ["ZREVRANGE", key k, int2bytes a, int2bytes b, "WITHSCORES"]
in if s then singleton $ ZRevRange s $ cmd 5 args
else singleton $ ZRevRange s $ cmd 4 (init args)
zrangebyscore :: (Monad m, FromByteString a) => Key -> Double -> Double -> Bool -> Opts "LIMIT" -> Redis m (ScoreList a)
zrangebyscore k a b s o =
let args = ["ZRANGEBYSCORE", key k, dbl2bytes a, dbl2bytes b, "WITHSCORES"] in
if s then singleton $ ZRangeByScore s $ cmd (5 + len o) $ args ++ toList (opts o)
else singleton $ ZRangeByScore s $ cmd (4 + len o) $ init args ++ toList (opts o)
zrevrangebyscore :: (Monad m, FromByteString a) => Key -> Double -> Double -> Bool -> Opts "LIMIT" -> Redis m (ScoreList a)
zrevrangebyscore k a b s o =
let args = ["ZREVRANGEBYSCORE", key k, dbl2bytes a, dbl2bytes b, "WITHSCORES"] in
if s then singleton $ ZRevRangeByScore s $ cmd (5 + len o) $ args ++ toList (opts o)
else singleton $ ZRevRangeByScore s $ cmd (4 + len o) $ init args ++ toList (opts o)
zadd :: (Monad m, ToByteString a) => Key -> NonEmpty (Double, a) -> Redis m Int64
zadd k v = singleton $ ZAdd $ cmd (2 + 2 * NE.length v) $ "ZADD" : key k : foldr f [] v
where
f (i, x) acc = dbl2bytes i : toByteString x : acc
zinterstore :: Monad m => Key -> NonEmpty Key -> [Int64] -> Aggregate -> Redis m Int64
zinterstore = _interstore ZInterStore "ZINTERSTORE"
zunionstore :: Monad m => Key -> NonEmpty Key -> [Int64] -> Aggregate -> Redis m Int64
zunionstore = _interstore ZUnionStore "ZUNIONSTORE"
_interstore :: (Resp -> Command Int64)
-> ByteString
-> Key
-> NonEmpty Key
-> [Int64]
-> Aggregate
-> Redis m Int64
_interstore c n k kk ww a =
let ww' = map int2bytes ww ++ repeat "1"
aggr = aggr2bytes a
nkeys = NE.length kk
ntotal = 3 + 2 * nkeys + 1 + length aggr
keys' = map key (toList kk)
weights = "WEIGHTS" : take nkeys ww'
in singleton $ c $ cmd ntotal $ toList $ n
`cons` key k
`cons` int2bytes (fromIntegral nkeys)
`cons` DL.fromList keys'
<> DL.fromList weights
<> DL.fromList aggr
where
aggr2bytes :: Aggregate -> [ByteString]
aggr2bytes None = []
aggr2bytes Min = ["AGGREGATE", "MIN"]
aggr2bytes Max = ["AGGREGATE", "MAX"]
aggr2bytes Sum = ["AGGREGATE", "SUM"]
{-# INLINE _interstore #-}
zlexcount :: Monad m => Key -> Min -> Max -> Redis m Int64
zlexcount k a b = singleton $ ZLexCount $ cmd 4 ["ZLEXCOUNT", key k, min2bytes a, max2bytes b]
min2bytes :: Min -> ByteString
min2bytes MinInf = "-"
min2bytes (MinIncl x) = "[" <> x
min2bytes (MinExcl x) = "(" <> x
max2bytes :: Max -> ByteString
max2bytes MaxInf = "+"
max2bytes (MaxIncl x) = "[" <> x
max2bytes (MaxExcl x) = "(" <> x
zrangebylex :: (Monad m, FromByteString a) => Key -> Min -> Max -> Opts "LIMIT" -> Redis m [a]
zrangebylex k a b o = singleton $ ZRangeByLex $ cmd (4 + len o) $
"ZRANGEBYLEX" : key k : min2bytes a : max2bytes b : toList (opts o)
zremrangebylex :: Monad m => Key -> Min -> Max -> Redis m Int64
zremrangebylex k a b = singleton $ ZRemRangeByLex $ cmd 4
["ZREMRANGEBYLEX", key k, min2bytes a, max2bytes b]
zremrangebyrank :: Monad m => Key -> Int64 -> Int64 -> Redis m Int64
zremrangebyrank k a b = singleton $ ZRemRangeByRank $ cmd 4
["ZREMRANGEBYRANK", key k, int2bytes a, int2bytes b]
zremrangebyscore :: Monad m => Key -> Double -> Double -> Redis m Int64
zremrangebyscore k a b = singleton $ ZRemRangeByScore $ cmd 4
["ZREMRANGEBYSCORE", key k, dbl2bytes a, dbl2bytes b]
zrem :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Int64
zrem k vv = singleton $ ZRem $ cmd (2 + NE.length vv) $ "ZREM" : key k : map toByteString (toList vv)
zincrby :: (Monad m, ToByteString a) => Key -> Double -> a -> Redis m Double
zincrby k i v = singleton $ ZIncrBy $ cmd 4 ["ZINCRBY", key k, dbl2bytes i, toByteString v]
zscore :: (Monad m, ToByteString a) => Key -> a -> Redis m (Maybe Double)
zscore k v = singleton $ ZScore $ cmd 3 ["ZSCORE", key k, toByteString v]
zcard :: Monad m => Key -> Redis m Int64
zcard k = singleton $ ZCard $ cmd 2 ["ZCARD", key k]
zcount :: Monad m => Key -> Double -> Double -> Redis m Int64
zcount k a b = singleton $ ZCount $ cmd 4 ["ZCOUNT", key k, dbl2bytes a, dbl2bytes b]
zrank :: (Monad m, ToByteString a) => Key -> a -> Redis m (Maybe Int64)
zrank k a = singleton $ ZRank $ cmd 3 ["ZRANK", key k, toByteString a]
zrevrank :: (Monad m, ToByteString a) => Key -> a -> Redis m (Maybe Int64)
zrevrank k a = singleton $ ZRevRank $ cmd 3 ["ZREVRANK", key k, toByteString a]
-----------------------------------------------------------------------------
-- HyperLogLog
pfadd :: (Monad m, ToByteString a) => Key -> NonEmpty a -> Redis m Bool
pfadd k v = singleton $ PfAdd $ cmd (2 + NE.length v) $ "PFADD" : key k : map toByteString (toList v)
pfcount :: Monad m => NonEmpty Key -> Redis m Int64
pfcount kk = singleton $ PfCount $ cmd (1 + NE.length kk) $ "PFCOUNT" : map key (toList kk)
pfmerge :: Monad m => Key -> NonEmpty Key -> Redis m ()
pfmerge k kk = singleton $ PfMerge $ cmd (2 + NE.length kk) $ "PFMERGE" : key k : map key (toList kk)
-----------------------------------------------------------------------------
-- Scan
scan :: (Monad m, FromByteString a) => Cursor -> Opts "SCAN" -> Redis m (Cursor, [a])
scan c o = singleton $ Scan $ cmd (2 + len o) $ "SCAN" : cursor c : toList (opts o)
hscan :: (Monad m, FromByteString a) => Key -> Cursor -> Opts "SCAN" -> Redis m (Cursor, [a])
hscan h c o = singleton $ HScan $ cmd (3 + len o) $ "HSCAN" : key h : cursor c : toList (opts o)
sscan :: (Monad m, FromByteString a) => Key -> Cursor -> Opts "SCAN" -> Redis m (Cursor, [a])
sscan h c o = singleton $ SScan $ cmd (3 + len o) $ "SSCAN" : key h : cursor c : toList (opts o)
zscan :: (Monad m, FromByteString a) => Key -> Cursor -> Opts "SCAN" -> Redis m (Cursor, [a])
zscan h c o = singleton $ ZScan $ cmd (3 + len o) $ "ZSCAN" : key h : cursor c : toList (opts o)
match :: ByteString -> Opts "SCAN"
match pat = Opts 2 $ "MATCH" `cons` DL.singleton pat
count :: Int64 -> Opts "SCAN"
count n = Opts 2 $ "COUNT" `cons` DL.singleton (int2bytes n)
-----------------------------------------------------------------------------
-- Sort
sort :: (Monad m, FromByteString a) => Key -> Opts "SORT" -> Redis m [a]
sort k o = singleton $ Sort $ cmd (2 + len o) $ "SORT" : key k : toList (opts o)
by :: ByteString -> Opts "SORT"
by pat = Opts 2 $ "BY" `cons` DL.singleton pat
limit :: Int64 -> Int64 -> Opts o
limit off cnt = Opts 3 $ DL.fromList ["LIMIT", int2bytes off, int2bytes cnt]
getkey :: NonEmpty ByteString -> Opts "SORT"
getkey pats = foldr f none (toList pats)
where
f p acc = Opts 2 ("GET" `cons` DL.singleton p) <> acc
asc :: Opts "SORT"
asc = Opts 1 $ DL.singleton "ASC"
desc :: Opts "SORT"
desc = Opts 1 $ DL.singleton "DESC"
alpha :: Opts "SORT"
alpha = Opts 1 $ DL.singleton "ALPHA"
store :: Key -> Opts "SORT"
store k = Opts 2 $ "STORE" `cons` DL.singleton (key k)
-----------------------------------------------------------------------------
-- Pub/Sub
publish :: (Monad m, ToByteString a) => ByteString -> a -> Redis m Int64
publish c m = singleton $ Publish $ cmd 3 $ ["PUBLISH", c, toByteString m]
subscribe :: Monad m => NonEmpty ByteString -> PubSub m ()
subscribe cs = singleton $ Subscribe $ cmd (1 + NE.length cs) $ "SUBSCRIBE" : toList cs
psubscribe :: Monad m => NonEmpty ByteString -> PubSub m ()
psubscribe cs = singleton $ PSubscribe $ cmd (1 + NE.length cs) $ "PSUBSCRIBE" : toList cs
unsubscribe :: Monad m => [ByteString] -> PubSub m ()
unsubscribe cs = singleton $ Unsubscribe $ cmd (1 + length cs) $ "UNSUBSCRIBE" : toList cs
punsubscribe :: Monad m => [ByteString] -> PubSub m ()
punsubscribe cs = singleton $ PUnsubscribe $ cmd (1 + length cs) $ "PUNSUBSCRIBE" : toList cs
-----------------------------------------------------------------------------
-- Responses
readInt'Null :: String -> Resp -> Result (Maybe Int64)
readInt'Null _ (Int i) = Right $ Just i
readInt'Null _ NullBulk = Right Nothing
readInt'Null s _ = Left $ InvalidResponse s
readInt :: String -> Resp -> Result Int64
readInt _ (Int i) = Right i
readInt s _ = Left $ InvalidResponse s
readTTL :: String -> Resp -> Result (Maybe TTL)
readTTL s r = toTTL <$> readInt s r
where
toTTL (-2) = Nothing
toTTL (-1) = Just NoTTL
toTTL n = Just $ TTL n
readBool :: String -> Resp -> Result Bool
readBool s r = readInt s r >>= toBool
where
toBool 0 = Right False
toBool 1 = Right True
toBool _ = Left $ InvalidResponse s
readListOfMaybes :: FromByteString a => String -> Resp -> Result [Maybe a]
readListOfMaybes n (Array _ r) = foldr f (Right []) r
where
f _ x@(Left _) = x
f NullBulk (Right acc) = Right $ Nothing : acc
f (Bulk s) (Right acc) = (:acc) . Just <$> readStr s
f (Str s) (Right acc) = (:acc) . Just <$> readStr s
f _ _ = Left $ InvalidResponse n
readListOfMaybes n _ = Left $ InvalidResponse n
readList :: FromByteString a => String -> Resp -> Result [a]
readList r (Array _ v) = foldr f (Right []) v
where
f _ x@(Left _) = x
f (Bulk s) (Right acc) = (:acc) <$> readStr s
f (Str s) (Right acc) = (:acc) <$> readStr s
f _ _ = Left $ InvalidResponse r
readList r _ = Left $ InvalidResponse r
readScoreList :: FromByteString a => String -> Bool -> Resp -> Result (ScoreList a)
readScoreList r False a = ScoreList [] <$> readList r a
readScoreList r True (Array _ v) = toScoreList . unzip <$> foldr f (Right []) (chunksOf 2 v)
where
f _ x@(Left _) = x
f [Bulk x, Bulk d] (Right acc) = (\a b -> (a, b):acc) <$> readStr x <*> readStr d
f _ _ = Left $ InvalidResponse r
toScoreList (a, s) = ScoreList s a
readScoreList r _ _ = Left $ InvalidResponse r
readFields :: FromByteString a => String -> Resp -> Result [(Field, a)]
readFields r (Array _ v) = foldr f (Right []) (chunksOf 2 v)
where
f _ x@(Left _) = x
f [Bulk k, Bulk x] (Right acc) = (:acc) . (k,) <$> readStr x
f _ _ = Left $ InvalidResponse r
readFields r _ = Left $ InvalidResponse r
readKeyValue :: FromByteString a => String -> Resp -> Result (Maybe (Key, a))
readKeyValue _ NullArray = return Nothing
readKeyValue _ (Array _ [Bulk k, Bulk v]) = Just . (Key k,) <$> readStr v
readKeyValue r _ = Left $ InvalidResponse r
readBulk'Null :: FromByteString a => String -> Resp -> Result (Maybe a)
readBulk'Null _ NullBulk = Right Nothing
readBulk'Null _ (Bulk s) = Just <$> readStr s
readBulk'Null n _ = Left $ InvalidResponse n
readBulk :: FromByteString a => String -> Resp -> Result a
readBulk _ (Bulk s) = readStr s
readBulk n _ = Left $ InvalidResponse n
readBulk'Array :: FromByteString a => String -> Choose -> Resp -> Result [a]
readBulk'Array n One r = maybeToList <$> readBulk'Null n r
readBulk'Array n _ r = readList n r
readScan :: FromByteString a => String -> Resp -> Result (Cursor, [a])
readScan n (Array 2 (Bulk c:v:[])) = (Cursor c,) <$> readList n v
readScan n _ = Left $ InvalidResponse n
matchStr :: String -> ByteString -> Resp -> Result ()
matchStr n x (Str s)
| x == s = Right ()
| otherwise = Left $ InvalidResponse n
matchStr n _ _ = Left $ InvalidResponse n
anyStr :: String -> Resp -> Result ()
anyStr _ (Str _) = Right ()
anyStr n _ = Left $ InvalidResponse n
readType :: String -> Resp -> Result (Maybe RedisType)
readType _ (Str s) = case s of
"string" -> return $ Just RedisString
"hash" -> return $ Just RedisHash
"list" -> return $ Just RedisList
"set" -> return $ Just RedisSet
"zset" -> return $ Just RedisZSet
"none" -> return Nothing
_ -> Left $ InvalidConversion ("unknown redis type: " ++ show s)
readType n _ = Left $ InvalidResponse n
fromSet :: Resp -> Result Bool
fromSet (Str "OK") = Right True
fromSet NullBulk = Right False
fromSet _ = Left $ InvalidResponse "SET"
readPushMessage :: Resp -> Result PushMessage
readPushMessage (Array 3 (Bulk "message":Bulk c:Bulk m:[])) =
Right $ Message c m
readPushMessage (Array 4 (Bulk "pmessage":Bulk p:Bulk c:Bulk m:[])) =
Right $ PMessage p c m
readPushMessage (Array 3 (Bulk "subscribe":Bulk c:Int n:[])) =
Right $ SubscribeMessage c n
readPushMessage (Array 3 (Bulk "unsubscribe":Bulk c:Int n:[])) =
Right $ UnsubscribeMessage c n
readPushMessage (Array 3 (Bulk "psubscribe":Bulk c:Int n:[])) =
Right $ SubscribeMessage c n
readPushMessage (Array 3 (Bulk "punsubscribe":Bulk c:Int n:[])) =
Right $ UnsubscribeMessage c n
readPushMessage _ = Left $ InvalidResponse "pub/sub"
-----------------------------------------------------------------------------
-- Helpers
cmd :: Int -> [ByteString] -> Resp
cmd n a = Array n (map Bulk a)
{-# INLINE cmd #-}
int2bytes :: Int64 -> ByteString
int2bytes = toLazyByteStringWith (safeStrategy 20 8) mempty . int64Dec
{-# INLINE int2bytes #-}
dbl2bytes :: Double -> ByteString
dbl2bytes = fromStrict . toShortest
{-# INLINE dbl2bytes #-}
side2bytes :: Side -> ByteString
side2bytes Before = "BEFORE"
side2bytes After = "AFTER"
{-# INLINE side2bytes #-}
readStr :: FromByteString a => ByteString -> Result a
readStr s = either (Left . InvalidConversion) Right $ runParser' parser s
{-# INLINE readStr #-}