hlrdb-core 0.1.6.2 → 0.2.0.0

raw patch · 4 files changed

+29/−88 lines, 4 filesdep ~bytestringdep ~hashabledep ~lensPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: bytestring, hashable, lens, mtl, random, time, unordered-containers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• hlrdb-core.cabal +5/−5
• src/HLRDB/Primitives/Aggregate.hs +10/−75
• src/HLRDB/Structures/Basic.hs +11/−8

@@ -1,3 +1,6 @@+# 0.2.0.0+- Query aggregation is now done via the `Q` Applicative, which can be reified into the `Redis` monad via `mget`. Using `ApplicativeDo`, querying via @Q@ is as ergonomic as executing individual `get` commands.+ # Fixed in 0.1.6.2 - Removed `undefined` in empty `mset` case 

@@ -1,5 +1,5 @@ name:                hlrdb-core-version:             0.1.6.2+version:             0.2.0.0 synopsis:            High-level Redis Database Core API description:         A library for type-driven interaction with Redis license:             MIT@@ -30,13 +30,13 @@     , HLRDB.Internal   build-depends: base >= 4.9 && < 5.0                , bytestring >= 0.10.8.2 && < 0.12-               , hashable >= 1.2.6.1 && < 1.4-               , hedis >= 0.14 && < 0.15-               , lens >= 4.16 && < 5.1+               , hashable >= 1.2.6.1 && < 1.5+               , hedis >= 0.14 && < 0.16+               , lens >= 4.16 && < 5.2                , mtl ^>= 2.2.2                , profunctors >= 5.2.2 && < 5.7                , random >= 1.1 && < 1.3-               , time >=1.6 && <1.12+               , time >=1.6 && <1.13                , unordered-containers >= 0.2.8.0 && < 0.2.14   hs-source-dirs:      src   default-language:    Haskell2010

@@ -1,91 +1,26 @@ {-# LANGUAGE BlockArguments #-} --- | Combinators that can be used for aggregating independent queries. See my <https://identicalsnowflake.github.io/QueryAggregation.html article> about aggregating mget queries for more information.- module HLRDB.Primitives.Aggregate-       (-         T(..)-       , type (⟿)-       , type (~~>)-       , type Query-       , aggregatePair-       , remember-       , bitraverse'-       , runT-+       ( Q(..)        -- | Aggregate, atomic multi-set query (as in setting multiple things in a single query)        , MSET        ) where -import Data.Bitraversable-import Data.Profunctor-import Data.Profunctor.Traversing-import Control.Lens hiding (Traversing)+import Control.Lens import Data.ByteString import HLRDB.Internal (MSET)  --- | Abstract representation for aggregation.-newtype T x y a b = T (Traversal a b x y) deriving (Functor)--instance Profunctor (T x y) where-  {-# INLINE lmap #-}-  lmap f (T t) = T \x -> t x . f-  {-# INLINE rmap #-}-  rmap g (T t) = T \x -> fmap g . t x-  {-# INLINE dimap #-}-  dimap f g (T t) = T \m -> fmap g . t m . f+-- | An applicative representing a single bulk query, reified into the Redis monad via @mget@.+newtype Q a = Q (Traversal () a ByteString (Maybe ByteString)) -instance Traversing (T x y) where-  {-# INLINE traverse' #-}-  traverse' (T t) = T (traverse . t)+instance Functor Q where+  {-# INLINE fmap #-}+  fmap f = \(Q g) -> Q \x -> fmap f . g x -instance Applicative (T x y a) where+instance Applicative Q where   {-# INLINE pure #-}-  pure x = T $ \_ _ -> pure x+  pure x = Q \_ _ -> pure x   {-# INLINE (<*>) #-}-  (<*>) (T f) (T x) = T \g a -> f g a <*> x g a---- | We can merge any two arbitrary mget queries.-{-# INLINE aggregatePair #-}-aggregatePair :: (Traversing p , Functor (p (a , a')) , Applicative (p (a , a'))) => p a b -> p a' b' -> p (a , a') (b , b')-aggregatePair x y =-  (,) <$> lmap (view _1) x <*> lmap (view _2) y---- Remember could probably be a Profunctor typeclass in general (is it?)--- | And we can remember the lookup-{-# INLINE remember #-}-remember :: T x y a b -> T x y a (a , b)-remember (T f) = T \x a -> (,) a <$> f x a--{-# INLINABLE bitraverse' #-}-bitraverse' :: Bitraversable t => a ~~> b -> c ~~> d -> t a c ~~> t b d-bitraverse' x y = rev' (bitraverse (flip lmap x . const) (flip lmap y . const))-      where-        rev' :: (a -> () ~~> b) -> a ~~> b-        rev' f = T \g v -> case f v of-          T m -> m g ()--instance Strong (T x y) where-  {-# INLINE first' #-}-  first' = firstTraversing--instance Choice (T x y) where-  {-# INLINE left' #-}-  left' = leftTraversing---- | Reify aggregation into a target functor.-{-# INLINE runT #-}-runT :: Functor f => ([x] -> f [y]) -> T x y a b -> a -> f b-runT i (T t) = unsafePartsOf t i----- | A query using input of type 'a' and yielding an output of type 'b'-type (⟿) a b = T ByteString (Maybe ByteString) a b---- | An ASCII version of ⟿-type (~~>) a b = T ByteString (Maybe ByteString) a b---- | Non-infix alias of ⟿-type Query a b = a ⟿ b+  (<*>) (Q f) (Q x) = Q \g a -> f g a <*> x g a 

@@ -1,7 +1,10 @@+{-# LANGUAGE BlockArguments #-}+ -- | Basic storage is simply a key-value lookup in Redis.  module HLRDB.Structures.Basic where +import Control.Lens (unsafePartsOf) import Database.Redis as Redis import HLRDB.Primitives.Aggregate import HLRDB.Primitives.Redis@@ -23,15 +26,15 @@   Left e -> fail (show e)   Right r -> pure (maybe mempty id r) --- | Construct a query to be used with @mget@. You may combine many of these together to create complex queries. Use @mget@ to execute the query back in the Redis monad. Works on @RedisBasic a b@ and @RedisIntegral a b@.-liftq :: RedisStructure (BASIC w) a b -> a ⟿ b-liftq (RKeyValue (E k _ d)) = T $ \f -> fmap d . f . k-liftq (RKeyValueInteger k _ d) = T $ \f -> fmap (d . fromIntegral . decodeMInteger) . f . k-liftq (RKeyValueByteString k) = T $ \f -> fmap (maybe mempty id) . f . k+-- | @Q@ is an @Applicative@ that can be used to aggregate many independent queries, all to be reified in a single bulk @mget@ request. Works on @RedisBasic a b@ and @RedisIntegral a b@.+liftq :: RedisStructure (BASIC w) a b -> a -> Q b+liftq (RKeyValue (E k _ d)) i = Q \f -> fmap d . f . const (k i)+liftq (RKeyValueInteger k _ d) i = Q \f -> fmap (d . fromIntegral . decodeMInteger) . f . const (k i)+liftq (RKeyValueByteString k) i = Q \f -> fmap (maybe mempty id) . f . const (k i) --- | Reify a (⟿) query into the Redis monad via a single mget command.-mget :: MonadRedis m => a ⟿ b -> a -> m b-mget = runT (liftRedis . mget')+-- | Reify from the @Q@ applicative into the @Redis@ monad using a single @mget@ command.+mget :: MonadRedis m => Q a -> m a+mget = \(Q f) -> unsafePartsOf f (liftRedis . mget') ()   where     mget' [] = pure []     mget' xs = Redis.mget xs >>= \case