-- | HLRDB is an opinionated, high-level, type-driven library for modeling Redis-backed database architecture.
-- 
-- This package provides an easy API for you to declare your data paths in Redis, but in doing so makes many decisions for you about how to serialize and deserialize values, construct identifiers, and define path names. If you want more control over these aspects, you may instead use the HLRDB Core package, which simply defines the commands and the abstract API without opining on these matters.
--
-- There is a <https://github.com/identicalsnowflake/hlrdb-demo simple demo project> that shows how to get started.
--
-- Finally, make sure that your Eq instances always respect the induced equality via Store serialization, since obviously Redis commands will be comparing serialized values.
-- 
-- = Minimal example
-- @
-- import Data.Store
-- import Database.Redis (checkedConnect,defaultConnectInfo,runRedis)
-- import HLRDB
-- 
-- newtype CommentId = CommentId Identifier deriving (Eq,Ord,Show,Store,IsIdentifier)
-- newtype Comment = Comment String deriving (Eq,Ord,Show,Store)
-- 
-- cidToComment :: RedisBasic CommentId (Maybe Comment)
-- cidToComment = declareBasic "canonical mapping from CommentId to Comment"
-- 
-- main :: IO ()
-- main = do
--   -- connect to Redis
--   rconn <- checkedConnect defaultConnectInfo
-- 
--   cid :: CommentId <- genId
-- 
--   c :: Maybe Comment <- runRedis rconn $ do
--     -- create a comment
--     set' cidToComment cid $ Comment "hi"
--     -- read it back
--     get cidToComment cid
-- 
--   print c
-- @
-- 
-- = Commands
-- The commands are located in the core package.
--

module HLRDB
       ( -- * Identifiers
         Identifier
       , IsIdentifier(..)
       , genId
       , genId'
       , identifierTimestamp
         -- * Indexed path declaration
       , declareBasic
       , declareIntegral
       , declareByteString
       , declareBasicZero
       , declareList
       , declareSet
       , declareHSet
       , declareSSet
         -- * Global path declaration
       , declareGlobalBasic
       , declareGlobalIntegral
       , declareGlobalByteString
       , declareGlobalBasicZero
       , declareGlobalList
       , declareGlobalSet
       , declareGlobalHSet
       , declareGlobalSSet
         -- * Other commands
       , 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.Monoid ((<>))
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


-- | Use the following newtype pattern to declare your identifiers
-- 
-- @
-- newtype CommentId = CommentId Identifier deriving (Eq,Ord,Show,Store,IsIdentifier)
-- @
-- 
-- You may generate a new random identifier using @genId@
-- 
-- @
-- example :: IO CommentId
-- example = genId
-- @
-- 
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 = ByteString -> String
forall a. Show a => a -> String
show (ByteString -> String)
-> (Identifier -> ByteString) -> Identifier -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
B64.encode (ByteString -> ByteString)
-> (Identifier -> ByteString) -> Identifier -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier -> ByteString
forall a. Store a => a -> ByteString
encode

-- | IsIdentifier means that @a@ is isomorphic to Identifier, usually via newtype. This enables to use @genId :: IsIdentifier a => IO a@, declared below. It is required that not only is it isomorphic; it must respect the Store instance as well (you get this for free with a newtype anyway).
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


-- | Generate a new identifier using the current time as the timestamp
{-# 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

-- use an offset to make 32-bit timestamps last another 100 years
{-# INLINE offset #-}
offset :: Int64
offset :: Int64
offset = Int64
2524608000 -- January 1, 2050

-- | Generate a new identifier for the given timestamp
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))

-- | Extract the timestamp from an identifier
{-# 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

-- Primitive redis key encoding scheme (16 bytes total):
-- 
-- 1. 5 bytes - 40-bit prefix of MD5 pathname hash;
--              note that this is a birthday problem - prob collision = birthday (2^5) (# of path names you use)
-- 2. 11-byte Identifier (including 32-bit timestamp)
-- This paradigm allows the following:
-- 1. iterating all indexes in a particular path
-- 2. efficiently discriminating which data is fresh
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

-- | If for some reason you need the actual, raw key name (which you may use with the low-level commands in hedis), you may obtain it via @encodePath@.
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

-- there should never be an incorrect encoding stored in Redis
{-# 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

-- structure declaration API

-- | Declare your paths by choosing the declaration for the Redis structure you want to use. You must provide a unique description, which not only serves to document your architecture, but the hash of which is used to distinguish between otherwise identical paths of the same type.
--
-- @
-- cidToComment :: RedisBasic CommentId (Maybe Comment)
-- cidToComment = declareBasic "canonical mapping from CommentId to Comment"
-- @
-- 
{-# 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

-- | Standard key-value store, but backed by a primitive integer in Redis, enabling extra commands like @incr@
{-# 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

-- | Standard key-value store, but backed by no encoding, thus permitting bitwise operations like @getrange@, @setrange@, @getbit@, and @setbit@.
{-# 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)

-- | Allows defining your own "zero" value. An example might be RoseTree, where a non-existant value in Redis can be mapped to a sensible empty value in Haskell.
{-# 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 #-}
-- | Transparently compress values before storage using zstd at the specified compression level and optional compression dictionary.
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

-- | Standard Redis list, supporting prepends, appends, and range access. If a @TrimScheme@ is provided, operations will automatically trim the list to the specified length.
{-# 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)

-- | A sub-hash table, using the sub-index type @s@. @s@ here is only required to be Storable rather than IsIdentifier, but in practice you'll probably use identifiers for @s@, too.
{-# 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')

-- | A set in Redis.
{-# 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)

-- | A sorted set in Redis. You may optionally provide a trim scheme, which will automatically manage the sorted set's size for you.
{-# 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)

-- | A global version of @declareBasic@
{-# 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

-- | A global version of @declareIntegral@
{-# 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

-- | A global version of @declareByteString@
{-# 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)

-- | A global version of @declareZero@
{-# 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

-- | A global version of @declareList@
{-# 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)

-- | A global version of @declareHSet@
{-# 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')

-- | A global version of @declareSet@
{-# 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)

-- | A global version of @declareSSet@
{-# 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
        -- Redis matches via glob-style patterns, so need to be
        -- careful to escape the special characters
        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)

-- | Note that despite the pretty type signature, the actual implementation of @foldPath@ in Redis is slow (it uses the global scan command, so its run time is proportional to the number of total keys in Redis, *not* the number of keys specifically related to the given path). You should only use @foldPath@ for administrative tasks, and never for any public API. Further, this method is only guaranteed to work if you've declared your @RedisStructure@s using the declarative tools in this module: if you declared a path yourself, please ensure it is compatible with the pathing convention in this module (namely, a 5-byte prefix).

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