{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_GHC -fno-warn-redundant-constraints #-} -- | A simple Redis library providing high level access to Redis features we -- use here at NoRedInk -- -- As with our Ruby Redis access, we enforce working within a "namespace". module Redis.Hash ( -- * Creating a redis handler Handler.handler, Handler.handlerAutoExtendExpire, Internal.Handler, Internal.HandlerAutoExtendExpire, Settings.Settings (..), Settings.decoder, -- * Creating a redis API jsonApi, textApi, byteStringApi, Api, -- * Creating redis queries del, exists, expire, ping, hdel, hget, hgetall, hkeys, hmget, hmset, hset, hsetnx, -- * Running Redis queries Internal.query, Internal.transaction, Internal.Query, Internal.Error (..), Internal.map, Internal.map2, Internal.map3, Internal.sequence, ) where import qualified Data.Aeson as Aeson import Data.ByteString (ByteString) import qualified Data.ByteString as ByteString import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import qualified Dict import qualified NonEmptyDict import qualified Redis.Codec as Codec import qualified Redis.Handler as Handler import qualified Redis.Internal as Internal import qualified Redis.Settings as Settings import qualified Result import qualified Prelude -- | a API type can be used to enforce a mapping of keys to values. -- without an API type, it can be easy to naiively serialize the wrong type -- into a redis key. -- -- Out of the box, we have helpers to support -- - 'jsonApi' for json-encodable and decodable values -- - 'textApi' for 'Text' values -- - 'byteStringApi' for 'ByteString' values data Api key field a = Api { -- | Removes the specified keys. A key is ignored if it does not exist. -- -- https://redis.io/commands/del del :: NonEmpty key -> Internal.Query Int, -- | Returns if key exists. -- -- https://redis.io/commands/exists exists :: key -> Internal.Query Bool, -- | Set a timeout on key. After the timeout has expired, the key will -- automatically be deleted. A key with an associated timeout is often said to -- be volatile in Redis terminology. -- -- https://redis.io/commands/expire expire :: key -> Int -> Internal.Query (), -- | Returns PONG if no argument is provided, otherwise return a copy of the -- argument as a bulk. This command is often used to test if a connection is -- still alive, or to measure latency. -- -- https://redis.io/commands/ping ping :: Internal.Query (), -- | Removes the specified fields from the hash stored at key. Specified fields -- that do not exist within this hash are ignored. If key does not exist, it is -- treated as an empty hash and this command returns 0. -- -- https://redis.io/commands/hdel hdel :: key -> NonEmpty field -> Internal.Query Int, -- | Get the value of the field of a hash at key. If the key does not exist, -- or the field in the hash does not exis the special value Nothing is returned -- An error is returned if the value stored at key is not a -- hash, because HGET only handles string values. -- -- https://redis.io/commands/hget hget :: key -> field -> Internal.Query (Maybe a), -- | Returns all fields and values of the hash stored at key. In the returned value, every field name is followed by its value, so the length of the reply is twice the size of the hash. -- Nothing in the returned value means failed utf8 decoding, not that it doesn't exist -- -- https://redis.io/commands/hgetall hgetall :: key -> Internal.Query (Dict.Dict field a), -- | Returns all field names in the hash stored at key. -- Empty list means key doesn't exist -- -- https://redis.io/commands/hkeys hkeys :: key -> Internal.Query (List field), -- | Returns the values associated with the specified fields in the hash stored at key.-- -- -- equivalent to modern hget -- https://redis.io/commands/hmget hmget :: key -> NonEmpty field -> Internal.Query (Dict.Dict field a), -- | Sets fields in the hash stored at key to values. If key does not exist, a new key holding a hash is created. If any fields exists, they are overwritten. -- -- equivalent to modern hset -- https://redis.io/commands/hmset hmset :: key -> NonEmptyDict.NonEmptyDict field a -> Internal.Query (), -- | Sets field in the hash stored at key to value. If key does not exist, a new key holding a hash is created. If field already exists in the hash, it is overwritten. -- -- https://redis.io/commands/hset hset :: key -> field -> a -> Internal.Query (), -- | Sets field in the hash stored at key to value, only if field does not yet -- exist. If key does not exist, a new key holding a hash is created. If field -- already exists, this operation has no effect. -- -- https://redis.io/commands/hsetnx hsetnx :: key -> field -> a -> Internal.Query Bool } -- | Creates a json API mapping a 'key' to a json-encodable-decodable type -- -- > data Key = Key { fieldA: Text, fieldB: Text } -- > data Val = Val { ... } -- > -- > myJsonApi :: Redis.Api Key Val -- > myJsonApi = Redis.jsonApi (\Key {fieldA, jsonApi :: forall a field key. (Aeson.ToJSON a, Aeson.FromJSON a, Ord field) => (key -> Text) -> (field -> Text) -> (Text -> Maybe field) -> Api key field a jsonApi = makeApi Codec.jsonCodec -- | Creates a Redis API mapping a 'key' to Text textApi :: Ord field => (key -> Text) -> (field -> Text) -> (Text -> Maybe field) -> Api key field Text textApi = makeApi Codec.textCodec -- | Creates a Redis API mapping a 'key' to a ByteString byteStringApi :: Ord field => (key -> Text) -> (field -> Text) -> (Text -> Maybe field) -> Api key field ByteString.ByteString byteStringApi = makeApi Codec.byteStringCodec makeApi :: Ord field => Codec.Codec a -> (key -> Text) -> (field -> Text) -> (Text -> Maybe field) -> Api key field a makeApi Codec.Codec {Codec.codecEncoder, Codec.codecDecoder} toKey toField fromField = Api { del = Internal.Del << NonEmpty.map toKey, exists = Internal.Exists << toKey, expire = \key secs -> Internal.Expire (toKey key) secs, ping = Internal.Ping |> map (\_ -> ()), hdel = \key fields -> Internal.Hdel (toKey key) (NonEmpty.map toField fields), hget = \key field -> Internal.WithResult (Prelude.traverse codecDecoder) (Internal.Hget (toKey key) (toField field)), hgetall = Internal.WithResult (toDict fromField codecDecoder) << Internal.Hgetall << toKey, hkeys = \key -> Internal.Hkeys (toKey key) |> Internal.WithResult ( Prelude.traverse ( \field -> case fromField field of Just field' -> Result.Ok field' Nothing -> Result.Err (Internal.DecodingFieldError field) ) ), hmget = \key fields -> fields |> NonEmpty.map toField |> Internal.Hmget (toKey key) |> map (Internal.maybesToDict (NonEmpty.toList fields)) |> Internal.WithResult (Prelude.traverse codecDecoder), hmset = \key vals -> vals |> NonEmptyDict.toNonEmptyList |> NonEmpty.map (\(k, v) -> (toField k, codecEncoder v)) |> Internal.Hmset (toKey key), hset = \key field val -> Internal.Hset (toKey key) (toField field) (codecEncoder val), hsetnx = \key field val -> Internal.Hsetnx (toKey key) (toField field) (codecEncoder val) } toDict :: Ord field => (Text -> Maybe field) -> Codec.Decoder a -> List (Text, ByteString) -> Result Internal.Error (Dict.Dict field a) toDict fromField decode = Result.map Dict.fromList << Prelude.traverse ( \(k, v) -> Result.andThen ( \v' -> case fromField k of Just k' -> Result.Ok (k', v') Nothing -> Result.Err (Internal.DecodingFieldError k) ) (decode v) )