module HLRDB
(
Identifier
, IsIdentifier(..)
, genId
, genId'
, identifierTimestamp
, declareBasic
, declareIntegral
, declareByteString
, declareBasicZero
, declareList
, declareSet
, declareHSet
, declareSSet
, declareGlobalBasic
, declareGlobalIntegral
, declareGlobalByteString
, declareGlobalBasicZero
, declareGlobalList
, declareGlobalSet
, declareGlobalHSet
, declareGlobalSSet
, encodePath
, foldPath
, zstd
, Store
, module HLRDB.Core
) where
import qualified Codec.Compression.Zstd as Z
import Control.Monad
import qualified Crypto.Hash as H
import Data.Bits
import qualified Data.ByteArray as H
import qualified Data.ByteString
import Data.ByteString (ByteString,take,drop,unpack)
import qualified Data.ByteString.Base64 as B64
import Data.Hashable (Hashable)
import Data.String (IsString(fromString))
import Data.Store
import Data.Time
import Data.Time.Clock.POSIX
import Database.Redis
import GHC.Int
import GHC.Generics
import GHC.Word
import HLRDB.Core
import HLRDB.Internal
import System.Random
newtype Identifier =
Identifier (Int32,Word32,Word16,Word8)
deriving ((forall x. Identifier -> Rep Identifier x)
-> (forall x. Rep Identifier x -> Identifier) -> Generic Identifier
forall x. Rep Identifier x -> Identifier
forall x. Identifier -> Rep Identifier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Identifier x -> Identifier
$cfrom :: forall x. Identifier -> Rep Identifier x
Generic,Identifier -> Identifier -> Bool
(Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool) -> Eq Identifier
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Identifier -> Identifier -> Bool
$c/= :: Identifier -> Identifier -> Bool
== :: Identifier -> Identifier -> Bool
$c== :: Identifier -> Identifier -> Bool
Eq,Eq Identifier
Eq Identifier
-> (Identifier -> Identifier -> Ordering)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Bool)
-> (Identifier -> Identifier -> Identifier)
-> (Identifier -> Identifier -> Identifier)
-> Ord Identifier
Identifier -> Identifier -> Bool
Identifier -> Identifier -> Ordering
Identifier -> Identifier -> Identifier
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 :: Identifier -> Identifier -> Identifier
$cmin :: Identifier -> Identifier -> Identifier
max :: Identifier -> Identifier -> Identifier
$cmax :: Identifier -> Identifier -> Identifier
>= :: Identifier -> Identifier -> Bool
$c>= :: Identifier -> Identifier -> Bool
> :: Identifier -> Identifier -> Bool
$c> :: Identifier -> Identifier -> Bool
<= :: Identifier -> Identifier -> Bool
$c<= :: Identifier -> Identifier -> Bool
< :: Identifier -> Identifier -> Bool
$c< :: Identifier -> Identifier -> Bool
compare :: Identifier -> Identifier -> Ordering
$ccompare :: Identifier -> Identifier -> Ordering
$cp1Ord :: Eq Identifier
Ord,Int -> Identifier -> Int
Identifier -> Int
(Int -> Identifier -> Int)
-> (Identifier -> Int) -> Hashable Identifier
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Identifier -> Int
$chash :: Identifier -> Int
hashWithSalt :: Int -> Identifier -> Int
$chashWithSalt :: Int -> Identifier -> Int
Hashable)
instance Show Identifier where
show :: Identifier -> String
show = Text -> String
forall a. Show a => a -> String
show (Text -> String) -> (Identifier -> Text) -> Identifier -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
B64.encodeBase64 (ByteString -> Text)
-> (Identifier -> ByteString) -> Identifier -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> ByteString
forall a. Store a => a -> ByteString
encode
class IsIdentifier a where
toIdentifier :: a -> Identifier
fromIdentifier :: Identifier -> a
instance IsIdentifier Identifier where
toIdentifier :: Identifier -> Identifier
toIdentifier = Identifier -> Identifier
forall a. a -> a
id
fromIdentifier :: Identifier -> Identifier
fromIdentifier = Identifier -> Identifier
forall a. a -> a
id
instance Store Identifier where
size :: Size Identifier
size = Int -> Size Identifier
forall a. Int -> Size a
ConstSize Int
11
peek :: Peek Identifier
peek = ((Int32, Word32, Word16, Word8) -> Identifier)
-> Peek (Int32, Word32, Word16, Word8) -> Peek Identifier
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int32, Word32, Word16, Word8) -> Identifier
Identifier
(Peek (Int32, Word32, Word16, Word8) -> Peek Identifier)
-> Peek (Int32, Word32, Word16, Word8) -> Peek Identifier
forall a b. (a -> b) -> a -> b
$ (,,,) (Int32
-> Word32 -> Word16 -> Word8 -> (Int32, Word32, Word16, Word8))
-> Peek Int32
-> Peek
(Word32 -> Word16 -> Word8 -> (Int32, Word32, Word16, Word8))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Peek Int32
forall a. Store a => Peek a
peek Peek (Word32 -> Word16 -> Word8 -> (Int32, Word32, Word16, Word8))
-> Peek Word32
-> Peek (Word16 -> Word8 -> (Int32, Word32, Word16, Word8))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peek Word32
forall a. Store a => Peek a
peek Peek (Word16 -> Word8 -> (Int32, Word32, Word16, Word8))
-> Peek Word16 -> Peek (Word8 -> (Int32, Word32, Word16, Word8))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peek Word16
forall a. Store a => Peek a
peek Peek (Word8 -> (Int32, Word32, Word16, Word8))
-> Peek Word8 -> Peek (Int32, Word32, Word16, Word8)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Peek Word8
forall a. Store a => Peek a
peek
poke :: Identifier -> Poke ()
poke (Identifier (Int32
a,Word32
b,Word16
c,Word8
d)) =
Int32 -> Poke ()
forall a. Store a => a -> Poke ()
poke Int32
a Poke () -> Poke () -> Poke ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word32 -> Poke ()
forall a. Store a => a -> Poke ()
poke Word32
b Poke () -> Poke () -> Poke ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word16 -> Poke ()
forall a. Store a => a -> Poke ()
poke Word16
c Poke () -> Poke () -> Poke ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Poke ()
forall a. Store a => a -> Poke ()
poke Word8
d
{-# INLINE genId #-}
genId :: IsIdentifier a => IO a
genId :: IO a
genId = IO POSIXTime
getPOSIXTime IO POSIXTime -> (POSIXTime -> IO a) -> IO a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= POSIXTime -> IO a
forall a. IsIdentifier a => POSIXTime -> IO a
genIdPOSIX
{-# INLINE offset #-}
offset :: Int64
offset :: Int64
offset = Int64
2524608000
genId' :: IsIdentifier a => UTCTime -> IO a
genId' :: UTCTime -> IO a
genId' =
POSIXTime -> IO a
forall a. IsIdentifier a => POSIXTime -> IO a
genIdPOSIX (POSIXTime -> IO a) -> (UTCTime -> POSIXTime) -> UTCTime -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> POSIXTime
utcTimeToPOSIXSeconds
genIdPOSIX :: IsIdentifier a => POSIXTime -> IO a
genIdPOSIX :: POSIXTime -> IO a
genIdPOSIX POSIXTime
posix = do
let Int32
t :: Int32 = Int64 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round POSIXTime
posix Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
offset)
Word64
w64 :: Word64 <- IO Word64
forall a (m :: * -> *). (Random a, MonadIO m) => m a
randomIO
let (Word32
a,Word32
w32) = Word64 -> (Word32, Word32)
w64tow32w32 Word64
w64
let (Word16
b,Word16
x) = Word32 -> (Word16, Word16)
w32tow16w16 Word32
w32
let (Word8
c,Word8
_) = Word16 -> (Word8, Word8)
w16tow8w8 Word16
x
a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> IO a) -> a -> IO a
forall a b. (a -> b) -> a -> b
$ Identifier -> a
forall a. IsIdentifier a => Identifier -> a
fromIdentifier (Identifier -> a) -> Identifier -> a
forall a b. (a -> b) -> a -> b
$ (Int32, Word32, Word16, Word8) -> Identifier
Identifier (Int32
t , Word32
a , Word16
b , Word8
c)
where
w64tow32w32 :: Word64 -> (Word32, Word32)
w64tow32w32 :: Word64 -> (Word32, Word32)
w64tow32w32 Word64
i = (Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i , Word64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
rotate Word64
i Int
32))
w32tow16w16 :: Word32 -> (Word16, Word16)
w32tow16w16 :: Word32 -> (Word16, Word16)
w32tow16w16 Word32
i = (Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
i , Word32 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
rotate Word32
i Int
16))
w16tow8w8 :: Word16 -> (Word8,Word8)
w16tow8w8 :: Word16 -> (Word8, Word8)
w16tow8w8 Word16
i = (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
i , Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
rotate Word16
i Int
8))
{-# INLINABLE identifierTimestamp #-}
identifierTimestamp :: IsIdentifier a => a -> UTCTime
identifierTimestamp :: a -> UTCTime
identifierTimestamp a
i =
let (Identifier (Int32
t,Word32
_,Word16
_,Word8
_)) = a -> Identifier
forall a. IsIdentifier a => a -> Identifier
toIdentifier a
i in
POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime) -> POSIXTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Int64 -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> POSIXTime) -> Int64 -> POSIXTime
forall a b. (a -> b) -> a -> b
$ Int64
offset Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
t
newtype PathName = PathName ByteString
instance IsString PathName where
fromString :: String -> PathName
fromString =
ByteString -> PathName
PathName
(ByteString -> PathName)
-> (String -> ByteString) -> String -> PathName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
Data.ByteString.take Int
5
(ByteString -> ByteString)
-> (String -> ByteString) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
H.convert (Digest MD5 -> ByteString)
-> (String -> Digest MD5) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context MD5 -> Digest MD5
forall a. HashAlgorithm a => Context a -> Digest a
H.hashFinalize
(Context MD5 -> Digest MD5)
-> (String -> Context MD5) -> String -> Digest MD5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Context MD5 -> ByteString -> Context MD5
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
Context a -> ba -> Context a
H.hashUpdate (Context MD5
forall a. HashAlgorithm a => Context a
H.hashInit :: H.Context H.MD5) :: ByteString -> H.Context H.MD5)
(ByteString -> Context MD5)
-> (String -> ByteString) -> String -> Context MD5
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
forall a. IsString a => String -> a
fromString
encodePath :: Store a => PathName -> a -> ByteString
encodePath :: PathName -> a -> ByteString
encodePath (PathName ByteString
n) =
ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
(<>) ByteString
n (ByteString -> ByteString) -> (a -> ByteString) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. Store a => a -> ByteString
encode
failDecode :: PeekException -> a
failDecode :: PeekException -> a
failDecode PeekException
e = String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"Unexpected data encoding from Redis: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> PeekException -> String
forall a. Show a => a -> String
show PeekException
e
{-# INLINE decode' #-}
decode' :: Store a => ByteString -> a
decode' :: ByteString -> a
decode' ByteString
bs = case ByteString -> Either PeekException a
forall a. Store a => ByteString -> Either PeekException a
Data.Store.decode ByteString
bs of
Left PeekException
e -> PeekException -> a
forall a. PeekException -> a
failDecode PeekException
e
Right a
a -> a
a
{-# INLINE declareBasic #-}
declareBasic :: (Store i, Store v) => PathName -> RedisBasic i (Maybe v)
declareBasic :: PathName -> RedisBasic i (Maybe v)
declareBasic PathName
pathName = E Maybe i (Maybe v) -> RedisBasic i (Maybe v)
forall a b. E Maybe a b -> RedisStructure (BASIC ()) a b
RKeyValue (E Maybe i (Maybe v) -> RedisBasic i (Maybe v))
-> E Maybe i (Maybe v) -> RedisBasic i (Maybe v)
forall a b. (a -> b) -> a -> b
$
(i -> ByteString)
-> (Maybe v -> Maybe ByteString)
-> (Maybe ByteString -> Maybe v)
-> E Maybe i (Maybe v)
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (PathName -> i -> ByteString
forall a. Store a => PathName -> a -> ByteString
encodePath PathName
pathName)
((v -> ByteString) -> Maybe v -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> ByteString
forall a. Store a => a -> ByteString
encode)
((Maybe ByteString -> Maybe v) -> E Maybe i (Maybe v))
-> ((Either PeekException v -> Maybe v)
-> Maybe ByteString -> Maybe v)
-> (Either PeekException v -> Maybe v)
-> E Maybe i (Maybe v)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Maybe v) -> Maybe ByteString -> Maybe v
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
(=<<)
((ByteString -> Maybe v) -> Maybe ByteString -> Maybe v)
-> ((Either PeekException v -> Maybe v) -> ByteString -> Maybe v)
-> (Either PeekException v -> Maybe v)
-> Maybe ByteString
-> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Either PeekException v -> Maybe v)
-> (ByteString -> Either PeekException v) -> ByteString -> Maybe v)
-> (ByteString -> Either PeekException v)
-> (Either PeekException v -> Maybe v)
-> ByteString
-> Maybe v
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Either PeekException v -> Maybe v)
-> (ByteString -> Either PeekException v) -> ByteString -> Maybe v
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ByteString -> Either PeekException v
forall a. Store a => ByteString -> Either PeekException a
Data.Store.decode ((Either PeekException v -> Maybe v) -> E Maybe i (Maybe v))
-> (Either PeekException v -> Maybe v) -> E Maybe i (Maybe v)
forall a b. (a -> b) -> a -> b
$ \case
Left PeekException
_ -> Maybe v
forall a. Maybe a
Nothing
Right v
x -> v -> Maybe v
forall a. a -> Maybe a
Just v
x
{-# INLINE declareIntegral #-}
declareIntegral :: (Store i, Integral b) => PathName -> RedisIntegral i b
declareIntegral :: PathName -> RedisIntegral i b
declareIntegral PathName
p =
(i -> ByteString)
-> (b -> Integer) -> (Integer -> b) -> RedisIntegral i b
forall a b.
(a -> ByteString)
-> (b -> Integer)
-> (Integer -> b)
-> RedisStructure (BASIC Integer) a b
RKeyValueInteger (PathName -> i -> ByteString
forall a. Store a => PathName -> a -> ByteString
encodePath PathName
p) b -> Integer
forall a. Integral a => a -> Integer
toInteger Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE declareByteString #-}
declareByteString :: Store i => PathName -> RedisByteString i ByteString
declareByteString :: PathName -> RedisByteString i ByteString
declareByteString PathName
p =
(i -> ByteString) -> RedisByteString i ByteString
forall a.
(a -> ByteString) -> RedisStructure (BASIC ByteString) a ByteString
RKeyValueByteString (PathName -> i -> ByteString
forall a. Store a => PathName -> a -> ByteString
encodePath PathName
p)
{-# INLINE declareBasicZero #-}
declareBasicZero :: (Store i, Store v) => PathName -> v -> RedisBasic i v
declareBasicZero :: PathName -> v -> RedisBasic i v
declareBasicZero PathName
pathName v
zero = E Maybe i v -> RedisBasic i v
forall a b. E Maybe a b -> RedisStructure (BASIC ()) a b
RKeyValue (E Maybe i v -> RedisBasic i v) -> E Maybe i v -> RedisBasic i v
forall a b. (a -> b) -> a -> b
$
(i -> ByteString)
-> (v -> Maybe ByteString)
-> (Maybe ByteString -> v)
-> E Maybe i v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (PathName -> i -> ByteString
forall a. Store a => PathName -> a -> ByteString
encodePath PathName
pathName)
(ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (v -> ByteString) -> v -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode)
((Maybe ByteString -> v) -> E Maybe i v)
-> (Maybe ByteString -> v) -> E Maybe i v
forall a b. (a -> b) -> a -> b
$ \case
Maybe ByteString
Nothing -> v
zero
Just ByteString
bs -> case ByteString -> Either PeekException v
forall a. Store a => ByteString -> Either PeekException a
Data.Store.decode ByteString
bs of
Left PeekException
_ -> v
zero
Right v
x -> v
x
{-# INLINE zstd #-}
zstd :: Maybe Z.Dict -> Int -> RedisStructure v a b -> RedisStructure v a b
zstd :: Maybe Dict -> Int -> RedisStructure v a b -> RedisStructure v a b
zstd = \Maybe Dict
md Int
cl -> do
let cmp :: ByteString -> ByteString
cmp = Maybe Dict -> Int -> ByteString -> ByteString
cmpr Maybe Dict
md Int
cl
dcp :: ByteString -> ByteString
dcp = Maybe Dict -> ByteString -> ByteString
dcmpr Maybe Dict
md
\case
RKeyValue (E a -> ByteString
e b -> Maybe ByteString
enc Maybe ByteString -> b
dec) -> E Maybe a b -> RedisStructure (BASIC ()) a b
forall a b. E Maybe a b -> RedisStructure (BASIC ()) a b
RKeyValue ((a -> ByteString)
-> (b -> Maybe ByteString)
-> (Maybe ByteString -> b)
-> E Maybe a b
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E a -> ByteString
e ((ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
cmp (Maybe ByteString -> Maybe ByteString)
-> (b -> Maybe ByteString) -> b -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe ByteString
enc) (Maybe ByteString -> b
dec (Maybe ByteString -> b)
-> (Maybe ByteString -> Maybe ByteString) -> Maybe ByteString -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> Maybe ByteString -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
dcp))
RKeyValueInteger a -> ByteString
e b -> Integer
enc Integer -> b
dec -> (a -> ByteString)
-> (b -> Integer)
-> (Integer -> b)
-> RedisStructure (BASIC Integer) a b
forall a b.
(a -> ByteString)
-> (b -> Integer)
-> (Integer -> b)
-> RedisStructure (BASIC Integer) a b
RKeyValueInteger a -> ByteString
e b -> Integer
enc Integer -> b
dec
RKeyValueByteString a -> ByteString
e -> (a -> ByteString) -> RedisStructure (BASIC ByteString) a ByteString
forall a.
(a -> ByteString) -> RedisStructure (BASIC ByteString) a ByteString
RKeyValueByteString a -> ByteString
e
RList (E a -> ByteString
e b -> Identity ByteString
enc Identity ByteString -> b
dec) Maybe TrimScheme
ts -> E Identity a b -> Maybe TrimScheme -> RedisStructure LIST a b
forall a b. RE a b -> Maybe TrimScheme -> RedisStructure LIST a b
RList ((a -> ByteString)
-> (b -> Identity ByteString)
-> (Identity ByteString -> b)
-> E Identity a b
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E a -> ByteString
e ((ByteString -> ByteString)
-> Identity ByteString -> Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
cmp (Identity ByteString -> Identity ByteString)
-> (b -> Identity ByteString) -> b -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
enc) (Identity ByteString -> b
dec (Identity ByteString -> b)
-> (Identity ByteString -> Identity ByteString)
-> Identity ByteString
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> Identity ByteString -> Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
dcp)) Maybe TrimScheme
ts
RHSet E Identity a b
e (HSET v -> ByteString
enc ByteString -> v
dec) -> E Identity a b -> HSET v -> RedisStructure (HSET v) a b
forall a b v. RE a b -> HSET v -> RedisStructure (HSET v) a b
RHSet E Identity a b
e ((v -> ByteString) -> (ByteString -> v) -> HSET v
forall k. (k -> ByteString) -> (ByteString -> k) -> HSET k
HSET (ByteString -> ByteString
cmp (ByteString -> ByteString) -> (v -> ByteString) -> v -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
enc) (ByteString -> v
dec (ByteString -> v) -> (ByteString -> ByteString) -> ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
dcp))
RSet (E a -> ByteString
e b -> Identity ByteString
enc Identity ByteString -> b
dec) -> E Identity a b -> RedisStructure SET a b
forall a b. RE a b -> RedisStructure SET a b
RSet ((a -> ByteString)
-> (b -> Identity ByteString)
-> (Identity ByteString -> b)
-> E Identity a b
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E a -> ByteString
e ((ByteString -> ByteString)
-> Identity ByteString -> Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
cmp (Identity ByteString -> Identity ByteString)
-> (b -> Identity ByteString) -> b -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
enc) (Identity ByteString -> b
dec (Identity ByteString -> b)
-> (Identity ByteString -> Identity ByteString)
-> Identity ByteString
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> Identity ByteString -> Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
dcp))
RSortedSet (E a -> ByteString
e b -> Identity ByteString
enc Identity ByteString -> b
dec) Maybe TrimScheme
ts -> E Identity a b -> Maybe TrimScheme -> RedisStructure SORTEDSET a b
forall a b.
RE a b -> Maybe TrimScheme -> RedisStructure SORTEDSET a b
RSortedSet ((a -> ByteString)
-> (b -> Identity ByteString)
-> (Identity ByteString -> b)
-> E Identity a b
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E a -> ByteString
e ((ByteString -> ByteString)
-> Identity ByteString -> Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
cmp (Identity ByteString -> Identity ByteString)
-> (b -> Identity ByteString) -> b -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Identity ByteString
enc) (Identity ByteString -> b
dec (Identity ByteString -> b)
-> (Identity ByteString -> Identity ByteString)
-> Identity ByteString
-> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> Identity ByteString -> Identity ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
dcp)) Maybe TrimScheme
ts
where
cmpr :: Maybe Z.Dict -> Int -> ByteString -> ByteString
cmpr :: Maybe Dict -> Int -> ByteString -> ByteString
cmpr (Just Dict
d) Int
cl = Dict -> Int -> ByteString -> ByteString
Z.compressUsingDict Dict
d Int
cl
cmpr Maybe Dict
Nothing Int
cl = Int -> ByteString -> ByteString
Z.compress Int
cl
dcmpr :: Maybe Z.Dict -> ByteString -> ByteString
dcmpr :: Maybe Dict -> ByteString -> ByteString
dcmpr Maybe Dict
Nothing = Decompress -> ByteString
f (Decompress -> ByteString)
-> (ByteString -> Decompress) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Decompress
Z.decompress
dcmpr (Just Dict
d) = Decompress -> ByteString
f (Decompress -> ByteString)
-> (ByteString -> Decompress) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> ByteString -> Decompress
Z.decompressUsingDict Dict
d
f :: Z.Decompress -> ByteString
f :: Decompress -> ByteString
f (Z.Decompress ByteString
r) = ByteString
r
f Decompress
Z.Skip = ByteString
""
f (Z.Error String
e) = String -> ByteString
forall a. HasCallStack => String -> a
error (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String
"Invalid zstd compression: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ShowS
forall a. Show a => a -> String
show String
e
{-# INLINE declareList #-}
declareList :: (Store i, Store v) => PathName -> Maybe TrimScheme -> RedisList i v
declareList :: PathName -> Maybe TrimScheme -> RedisList i v
declareList PathName
pathName = RE i v -> Maybe TrimScheme -> RedisList i v
forall a b. RE a b -> Maybe TrimScheme -> RedisStructure LIST a b
RList (RE i v -> Maybe TrimScheme -> RedisList i v)
-> RE i v -> Maybe TrimScheme -> RedisList i v
forall a b. (a -> b) -> a -> b
$ (i -> ByteString)
-> (v -> Identity ByteString)
-> (Identity ByteString -> v)
-> RE i v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (PathName -> i -> ByteString
forall a. Store a => PathName -> a -> ByteString
encodePath PathName
pathName) (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Identity ByteString)
-> (v -> ByteString) -> v -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode) (ByteString -> v
forall a. Store a => ByteString -> a
decode' (ByteString -> v)
-> (Identity ByteString -> ByteString) -> Identity ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity)
{-# INLINE declareHSet #-}
declareHSet :: (Store i, Store s, Store v) => PathName -> RedisHSet i s v
declareHSet :: PathName -> RedisHSet i s v
declareHSet PathName
pathName =
RE i v -> HSET s -> RedisHSet i s v
forall a b v. RE a b -> HSET v -> RedisStructure (HSET v) a b
RHSet ((i -> ByteString)
-> (v -> Identity ByteString)
-> (Identity ByteString -> v)
-> RE i v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (PathName -> i -> ByteString
forall a. Store a => PathName -> a -> ByteString
encodePath PathName
pathName) (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Identity ByteString)
-> (v -> ByteString) -> v -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode) (ByteString -> v
forall a. Store a => ByteString -> a
decode' (ByteString -> v)
-> (Identity ByteString -> ByteString) -> Identity ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity)) ((s -> ByteString) -> (ByteString -> s) -> HSET s
forall k. (k -> ByteString) -> (ByteString -> k) -> HSET k
HSET s -> ByteString
forall a. Store a => a -> ByteString
encode ByteString -> s
forall a. Store a => ByteString -> a
decode')
{-# INLINE declareSet #-}
declareSet :: (Store i, Store v) => PathName -> RedisSet i v
declareSet :: PathName -> RedisSet i v
declareSet PathName
pathName =
RE i v -> RedisSet i v
forall a b. RE a b -> RedisStructure SET a b
RSet (RE i v -> RedisSet i v) -> RE i v -> RedisSet i v
forall a b. (a -> b) -> a -> b
$ (i -> ByteString)
-> (v -> Identity ByteString)
-> (Identity ByteString -> v)
-> RE i v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (PathName -> i -> ByteString
forall a. Store a => PathName -> a -> ByteString
encodePath PathName
pathName) (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Identity ByteString)
-> (v -> ByteString) -> v -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode) (ByteString -> v
forall a. Store a => ByteString -> a
decode' (ByteString -> v)
-> (Identity ByteString -> ByteString) -> Identity ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity)
{-# INLINE declareSSet #-}
declareSSet :: (Store i, Store v) => PathName -> Maybe TrimScheme -> RedisSSet i v
declareSSet :: PathName -> Maybe TrimScheme -> RedisSSet i v
declareSSet PathName
pathName =
RE i v -> Maybe TrimScheme -> RedisSSet i v
forall a b.
RE a b -> Maybe TrimScheme -> RedisStructure SORTEDSET a b
RSortedSet (RE i v -> Maybe TrimScheme -> RedisSSet i v)
-> RE i v -> Maybe TrimScheme -> RedisSSet i v
forall a b. (a -> b) -> a -> b
$ (i -> ByteString)
-> (v -> Identity ByteString)
-> (Identity ByteString -> v)
-> RE i v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (PathName -> i -> ByteString
forall a. Store a => PathName -> a -> ByteString
encodePath PathName
pathName) (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Identity ByteString)
-> (v -> ByteString) -> v -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode) (ByteString -> v
forall a. Store a => ByteString -> a
decode' (ByteString -> v)
-> (Identity ByteString -> ByteString) -> Identity ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity)
{-# INLINE declareGlobalBasic #-}
declareGlobalBasic :: Store v => PathName -> RedisBasic () (Maybe v)
declareGlobalBasic :: PathName -> RedisBasic () (Maybe v)
declareGlobalBasic (PathName ByteString
p) = E Maybe () (Maybe v) -> RedisBasic () (Maybe v)
forall a b. E Maybe a b -> RedisStructure (BASIC ()) a b
RKeyValue (E Maybe () (Maybe v) -> RedisBasic () (Maybe v))
-> E Maybe () (Maybe v) -> RedisBasic () (Maybe v)
forall a b. (a -> b) -> a -> b
$ (() -> ByteString)
-> (Maybe v -> Maybe ByteString)
-> (Maybe ByteString -> Maybe v)
-> E Maybe () (Maybe v)
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
p) ((v -> ByteString) -> Maybe v -> Maybe ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v -> ByteString
forall a. Store a => a -> ByteString
encode) ((Maybe ByteString -> Maybe v) -> E Maybe () (Maybe v))
-> (Maybe ByteString -> Maybe v) -> E Maybe () (Maybe v)
forall a b. (a -> b) -> a -> b
$ \case
Just ByteString
bs -> case ByteString -> Either PeekException v
forall a. Store a => ByteString -> Either PeekException a
Data.Store.decode ByteString
bs of
Left PeekException
_ -> Maybe v
forall a. Maybe a
Nothing
Right v
x -> v -> Maybe v
forall a. a -> Maybe a
Just v
x
Maybe ByteString
Nothing -> Maybe v
forall a. Maybe a
Nothing
{-# INLINE declareGlobalIntegral #-}
declareGlobalIntegral :: Integral b => PathName -> RedisIntegral () b
declareGlobalIntegral :: PathName -> RedisIntegral () b
declareGlobalIntegral (PathName ByteString
p) = (() -> ByteString)
-> (b -> Integer) -> (Integer -> b) -> RedisIntegral () b
forall a b.
(a -> ByteString)
-> (b -> Integer)
-> (Integer -> b)
-> RedisStructure (BASIC Integer) a b
RKeyValueInteger (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
p) b -> Integer
forall a. Integral a => a -> Integer
toInteger Integer -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE declareGlobalByteString #-}
declareGlobalByteString :: PathName -> RedisByteString () ByteString
declareGlobalByteString :: PathName -> RedisByteString () ByteString
declareGlobalByteString (PathName ByteString
p) = (() -> ByteString) -> RedisByteString () ByteString
forall a.
(a -> ByteString) -> RedisStructure (BASIC ByteString) a ByteString
RKeyValueByteString (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
p)
{-# INLINE declareGlobalBasicZero #-}
declareGlobalBasicZero :: Store v => PathName -> v -> RedisBasic () v
declareGlobalBasicZero :: PathName -> v -> RedisBasic () v
declareGlobalBasicZero (PathName ByteString
p) v
zero = E Maybe () v -> RedisBasic () v
forall a b. E Maybe a b -> RedisStructure (BASIC ()) a b
RKeyValue (E Maybe () v -> RedisBasic () v)
-> E Maybe () v -> RedisBasic () v
forall a b. (a -> b) -> a -> b
$
(() -> ByteString)
-> (v -> Maybe ByteString)
-> (Maybe ByteString -> v)
-> E Maybe () v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
p)
(ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (v -> ByteString) -> v -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode)
((Maybe ByteString -> v) -> E Maybe () v)
-> (Maybe ByteString -> v) -> E Maybe () v
forall a b. (a -> b) -> a -> b
$ \case
Maybe ByteString
Nothing -> v
zero
Just ByteString
bs -> case ByteString -> Either PeekException v
forall a. Store a => ByteString -> Either PeekException a
Data.Store.decode ByteString
bs of
Left PeekException
_ -> v
zero
Right v
x -> v
x
{-# INLINE declareGlobalList #-}
declareGlobalList :: Store v => PathName -> Maybe TrimScheme -> RedisList () v
declareGlobalList :: PathName -> Maybe TrimScheme -> RedisList () v
declareGlobalList (PathName ByteString
p) = RE () v -> Maybe TrimScheme -> RedisList () v
forall a b. RE a b -> Maybe TrimScheme -> RedisStructure LIST a b
RList (RE () v -> Maybe TrimScheme -> RedisList () v)
-> RE () v -> Maybe TrimScheme -> RedisList () v
forall a b. (a -> b) -> a -> b
$ (() -> ByteString)
-> (v -> Identity ByteString)
-> (Identity ByteString -> v)
-> RE () v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
p) (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Identity ByteString)
-> (v -> ByteString) -> v -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode) (ByteString -> v
forall a. Store a => ByteString -> a
decode' (ByteString -> v)
-> (Identity ByteString -> ByteString) -> Identity ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity)
{-# INLINE declareGlobalHSet #-}
declareGlobalHSet :: (Store s , Store v) => PathName -> RedisHSet () s v
declareGlobalHSet :: PathName -> RedisHSet () s v
declareGlobalHSet (PathName ByteString
p) =
RE () v -> HSET s -> RedisHSet () s v
forall a b v. RE a b -> HSET v -> RedisStructure (HSET v) a b
RHSet ((() -> ByteString)
-> (v -> Identity ByteString)
-> (Identity ByteString -> v)
-> RE () v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
p) (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Identity ByteString)
-> (v -> ByteString) -> v -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode) (ByteString -> v
forall a. Store a => ByteString -> a
decode' (ByteString -> v)
-> (Identity ByteString -> ByteString) -> Identity ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity)) ((s -> ByteString) -> (ByteString -> s) -> HSET s
forall k. (k -> ByteString) -> (ByteString -> k) -> HSET k
HSET s -> ByteString
forall a. Store a => a -> ByteString
encode ByteString -> s
forall a. Store a => ByteString -> a
decode')
{-# INLINE declareGlobalSet #-}
declareGlobalSet :: Store v => PathName -> RedisSet () v
declareGlobalSet :: PathName -> RedisSet () v
declareGlobalSet (PathName ByteString
p) =
RE () v -> RedisSet () v
forall a b. RE a b -> RedisStructure SET a b
RSet (RE () v -> RedisSet () v) -> RE () v -> RedisSet () v
forall a b. (a -> b) -> a -> b
$ (() -> ByteString)
-> (v -> Identity ByteString)
-> (Identity ByteString -> v)
-> RE () v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
p) (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Identity ByteString)
-> (v -> ByteString) -> v -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode) (ByteString -> v
forall a. Store a => ByteString -> a
decode' (ByteString -> v)
-> (Identity ByteString -> ByteString) -> Identity ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity)
{-# INLINE declareGlobalSSet #-}
declareGlobalSSet :: Store v => PathName -> Maybe TrimScheme -> RedisSSet () v
declareGlobalSSet :: PathName -> Maybe TrimScheme -> RedisSSet () v
declareGlobalSSet (PathName ByteString
p) =
RE () v -> Maybe TrimScheme -> RedisSSet () v
forall a b.
RE a b -> Maybe TrimScheme -> RedisStructure SORTEDSET a b
RSortedSet (RE () v -> Maybe TrimScheme -> RedisSSet () v)
-> RE () v -> Maybe TrimScheme -> RedisSSet () v
forall a b. (a -> b) -> a -> b
$ (() -> ByteString)
-> (v -> Identity ByteString)
-> (Identity ByteString -> v)
-> RE () v
forall (f :: * -> *) a b.
(a -> ByteString)
-> (b -> f ByteString) -> (f ByteString -> b) -> E f a b
E (ByteString -> () -> ByteString
forall a b. a -> b -> a
const ByteString
p) (ByteString -> Identity ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Identity ByteString)
-> (v -> ByteString) -> v -> Identity ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> ByteString
forall a. Store a => a -> ByteString
encode) (ByteString -> v
forall a. Store a => ByteString -> a
decode' (ByteString -> v)
-> (Identity ByteString -> ByteString) -> Identity ByteString -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity ByteString -> ByteString
forall a. Identity a -> a
runIdentity)
scanGlob :: IsIdentifier i => RedisStructure s i v -> ByteString
scanGlob :: RedisStructure s i v -> ByteString
scanGlob = ByteString -> ByteString
pathGlob (ByteString -> ByteString)
-> (RedisStructure s i v -> ByteString)
-> RedisStructure s i v
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RedisStructure s i v -> ByteString
forall i s v. IsIdentifier i => RedisStructure s i v -> ByteString
extractPathName
where
pathGlob :: ByteString -> ByteString
pathGlob :: ByteString -> ByteString
pathGlob ByteString
p =
let [Word8]
bs :: [ Word8 ] = ByteString -> [Word8]
unpack ByteString
p in
(Word8 -> ByteString -> ByteString)
-> ByteString -> [Word8] -> ByteString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\Word8
c ByteString
a -> Word8 -> ByteString
enc Word8
c ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
a) ByteString
"*" [Word8]
bs
where
enc :: Word8 -> ByteString
enc :: Word8 -> ByteString
enc Word8
42 = ByteString
"\\*"
enc Word8
63 = ByteString
"\\?"
enc Word8
91 = ByteString
"\\["
enc Word8
w = [Word8] -> ByteString
Data.ByteString.pack [ Word8
w ]
extractPathName :: (IsIdentifier i) => RedisStructure s i v -> ByteString
extractPathName :: RedisStructure s i v -> ByteString
extractPathName RedisStructure s i v
p = Int -> ByteString -> ByteString
Data.ByteString.take Int
5 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ RedisStructure s i v -> i -> ByteString
forall v a b. RedisStructure v a b -> a -> ByteString
primKey RedisStructure s i v
p i
forall i. IsIdentifier i => i
zeroIdentifier
where
zeroIdentifier :: (IsIdentifier i) => i
zeroIdentifier :: i
zeroIdentifier = Identifier -> i
forall a. IsIdentifier a => Identifier -> a
fromIdentifier (Identifier -> i) -> Identifier -> i
forall a b. (a -> b) -> a -> b
$ (Int32, Word32, Word16, Word8) -> Identifier
Identifier (Int32
0,Word32
0,Word16
0,Word8
0)
foldPath :: (MonadRedis m , IsIdentifier i , Store v) => RedisStructure s i v -> (a -> i -> m a) -> a -> m a
foldPath :: RedisStructure s i v -> (a -> i -> m a) -> a -> m a
foldPath RedisStructure s i v
p a -> i -> m a
f a
z = (Cursor, a) -> m a
go (Cursor
cursor0,a
z)
where
go :: (Cursor, a) -> m a
go (Cursor
c,a
a) = do
(Cursor
c', [ByteString]
bs) <- Redis (Either Reply (Cursor, [ByteString]))
-> m (Cursor, [ByteString])
forall (m :: * -> *) a.
MonadRedis m =>
Redis (Either Reply a) -> m a
unwrap (Redis (Either Reply (Cursor, [ByteString]))
-> m (Cursor, [ByteString]))
-> Redis (Either Reply (Cursor, [ByteString]))
-> m (Cursor, [ByteString])
forall a b. (a -> b) -> a -> b
$ Cursor -> ScanOpts -> Redis (Either Reply (Cursor, [ByteString]))
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Cursor -> ScanOpts -> m (f (Cursor, [ByteString]))
scanOpts Cursor
c ScanOpts
defaultScanOpts { scanMatch :: Maybe ByteString
scanMatch = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
m }
!a
a' <- (a -> ByteString -> m a) -> a -> [ByteString] -> m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
Control.Monad.foldM (\a
x -> a -> i -> m a
f a
x (i -> m a) -> (ByteString -> i) -> ByteString -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> i
forall a. IsIdentifier a => Identifier -> a
fromIdentifier (Identifier -> i) -> (ByteString -> Identifier) -> ByteString -> i
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Identifier
forall a. Store a => ByteString -> a
decodeEx (ByteString -> Identifier)
-> (ByteString -> ByteString) -> ByteString -> Identifier
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ByteString
Data.ByteString.drop Int
5) a
a [ByteString]
bs
if Cursor
c' Cursor -> Cursor -> Bool
forall a. Eq a => a -> a -> Bool
== Cursor
cursor0
then a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a'
else (Cursor, a) -> m a
go (Cursor
c',a
a')
m :: ByteString
m = RedisStructure s i v -> ByteString
forall i s v. IsIdentifier i => RedisStructure s i v -> ByteString
scanGlob RedisStructure s i v
p