{-# 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
    Real.handler,
    Internal.Handler,
    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.Internal as Internal
import qualified Redis.Real as Real
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
    Api key field a -> NonEmpty key -> Query Int
del :: NonEmpty key -> Internal.Query Int,
    -- | Returns if key exists.
    --
    -- https://redis.io/commands/exists
    Api key field a -> key -> Query Bool
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
    Api key field a -> key -> Int -> Query ()
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
    Api key field a -> Query ()
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
    Api key field a -> key -> NonEmpty field -> Query Int
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
    Api key field a -> key -> field -> Query (Maybe a)
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
    Api key field a -> key -> Query (Dict field a)
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
    Api key field a -> key -> Query (List field)
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
    Api key field a -> key -> NonEmpty field -> Query (Dict field a)
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
    Api key field a -> key -> NonEmptyDict field a -> Query ()
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
    Api key field a -> key -> field -> a -> Query ()
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
    Api key field a -> key -> field -> a -> Query Bool
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 :: (key -> Text)
-> (field -> Text) -> (Text -> Maybe field) -> Api key field a
jsonApi = Codec a
-> (key -> Text)
-> (field -> Text)
-> (Text -> Maybe field)
-> Api key field a
forall field a key.
Ord field =>
Codec a
-> (key -> Text)
-> (field -> Text)
-> (Text -> Maybe field)
-> Api key field a
makeApi Codec a
forall a. (FromJSON a, ToJSON a) => Codec a
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 :: (key -> Text)
-> (field -> Text) -> (Text -> Maybe field) -> Api key field Text
textApi = Codec Text
-> (key -> Text)
-> (field -> Text)
-> (Text -> Maybe field)
-> Api key field Text
forall field a key.
Ord field =>
Codec a
-> (key -> Text)
-> (field -> Text)
-> (Text -> Maybe field)
-> Api key field a
makeApi Codec Text
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 :: (key -> Text)
-> (field -> Text)
-> (Text -> Maybe field)
-> Api key field ByteString
byteStringApi = Codec ByteString
-> (key -> Text)
-> (field -> Text)
-> (Text -> Maybe field)
-> Api key field ByteString
forall field a key.
Ord field =>
Codec a
-> (key -> Text)
-> (field -> Text)
-> (Text -> Maybe field)
-> Api key field a
makeApi Codec ByteString
Codec.byteStringCodec

makeApi ::
  Ord field =>
  Codec.Codec a ->
  (key -> Text) ->
  (field -> Text) ->
  (Text -> Maybe field) ->
  Api key field a
makeApi :: Codec a
-> (key -> Text)
-> (field -> Text)
-> (Text -> Maybe field)
-> Api key field a
makeApi Codec.Codec {Encoder a
codecEncoder :: forall a. Codec a -> Encoder a
codecEncoder :: Encoder a
Codec.codecEncoder, Decoder a
codecDecoder :: forall a. Codec a -> Decoder a
codecDecoder :: Decoder a
Codec.codecDecoder} key -> Text
toKey field -> Text
toField Text -> Maybe field
fromField =
  Api :: forall key field a.
(NonEmpty key -> Query Int)
-> (key -> Query Bool)
-> (key -> Int -> Query ())
-> Query ()
-> (key -> NonEmpty field -> Query Int)
-> (key -> field -> Query (Maybe a))
-> (key -> Query (Dict field a))
-> (key -> Query (List field))
-> (key -> NonEmpty field -> Query (Dict field a))
-> (key -> NonEmptyDict field a -> Query ())
-> (key -> field -> a -> Query ())
-> (key -> field -> a -> Query Bool)
-> Api key field a
Api
    { del :: NonEmpty key -> Query Int
del = NonEmpty Text -> Query Int
Internal.Del (NonEmpty Text -> Query Int)
-> (NonEmpty key -> NonEmpty Text) -> NonEmpty key -> Query Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< (key -> Text) -> NonEmpty key -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map key -> Text
toKey,
      exists :: key -> Query Bool
exists = Text -> Query Bool
Internal.Exists (Text -> Query Bool) -> (key -> Text) -> key -> Query Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< key -> Text
toKey,
      expire :: key -> Int -> Query ()
expire = \key
key Int
secs -> Text -> Int -> Query ()
Internal.Expire (key -> Text
toKey key
key) Int
secs,
      ping :: Query ()
ping = Query Status
Internal.Ping Query Status -> (Query Status -> Query ()) -> Query ()
forall a b. a -> (a -> b) -> b
|> (Status -> ()) -> Query Status -> Query ()
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\Status
_ -> ()),
      hdel :: key -> NonEmpty field -> Query Int
hdel = \key
key NonEmpty field
fields -> Text -> NonEmpty Text -> Query Int
Internal.Hdel (key -> Text
toKey key
key) ((field -> Text) -> NonEmpty field -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map field -> Text
toField NonEmpty field
fields),
      hget :: key -> field -> Query (Maybe a)
hget = \key
key field
field -> (Maybe ByteString -> Result Error (Maybe a))
-> Query (Maybe ByteString) -> Query (Maybe a)
forall a b. (a -> Result Error b) -> Query a -> Query b
Internal.WithResult (Decoder a -> Maybe ByteString -> Result Error (Maybe a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse Decoder a
codecDecoder) (Text -> Text -> Query (Maybe ByteString)
Internal.Hget (key -> Text
toKey key
key) (field -> Text
toField field
field)),
      hgetall :: key -> Query (Dict field a)
hgetall = (List (Text, ByteString) -> Result Error (Dict field a))
-> Query (List (Text, ByteString)) -> Query (Dict field a)
forall a b. (a -> Result Error b) -> Query a -> Query b
Internal.WithResult ((Text -> Maybe field)
-> Decoder a
-> List (Text, ByteString)
-> Result Error (Dict field a)
forall field a.
Ord field =>
(Text -> Maybe field)
-> Decoder a
-> List (Text, ByteString)
-> Result Error (Dict field a)
toDict Text -> Maybe field
fromField Decoder a
codecDecoder) (Query (List (Text, ByteString)) -> Query (Dict field a))
-> (Text -> Query (List (Text, ByteString)))
-> Text
-> Query (Dict field a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< Text -> Query (List (Text, ByteString))
Internal.Hgetall (Text -> Query (Dict field a))
-> (key -> Text) -> key -> Query (Dict field a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< key -> Text
toKey,
      hkeys :: key -> Query (List field)
hkeys = \key
key ->
        Text -> Query [Text]
Internal.Hkeys (key -> Text
toKey key
key)
          Query [Text]
-> (Query [Text] -> Query (List field)) -> Query (List field)
forall a b. a -> (a -> b) -> b
|> ([Text] -> Result Error (List field))
-> Query [Text] -> Query (List field)
forall a b. (a -> Result Error b) -> Query a -> Query b
Internal.WithResult
            ( (Text -> Result Error field) -> [Text] -> Result Error (List field)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse
                ( \Text
field -> case Text -> Maybe field
fromField Text
field of
                    Just field
field' -> field -> Result Error field
forall error value. value -> Result error value
Result.Ok field
field'
                    Maybe field
Nothing -> Error -> Result Error field
forall error value. error -> Result error value
Result.Err (Text -> Error
Internal.DecodingFieldError Text
field)
                )
            ),
      hmget :: key -> NonEmpty field -> Query (Dict field a)
hmget = \key
key NonEmpty field
fields ->
        NonEmpty field
fields
          NonEmpty field
-> (NonEmpty field -> NonEmpty Text) -> NonEmpty Text
forall a b. a -> (a -> b) -> b
|> (field -> Text) -> NonEmpty field -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map field -> Text
toField
          NonEmpty Text
-> (NonEmpty Text -> Query [Maybe ByteString])
-> Query [Maybe ByteString]
forall a b. a -> (a -> b) -> b
|> Text -> NonEmpty Text -> Query [Maybe ByteString]
Internal.Hmget (key -> Text
toKey key
key)
          Query [Maybe ByteString]
-> (Query [Maybe ByteString] -> Query (Dict field ByteString))
-> Query (Dict field ByteString)
forall a b. a -> (a -> b) -> b
|> ([Maybe ByteString] -> Dict field ByteString)
-> Query [Maybe ByteString] -> Query (Dict field ByteString)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (List field -> [Maybe ByteString] -> Dict field ByteString
forall key a. Ord key => List key -> List (Maybe a) -> Dict key a
Internal.maybesToDict (NonEmpty field -> List field
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty field
fields))
          Query (Dict field ByteString)
-> (Query (Dict field ByteString) -> Query (Dict field a))
-> Query (Dict field a)
forall a b. a -> (a -> b) -> b
|> (Dict field ByteString -> Result Error (Dict field a))
-> Query (Dict field ByteString) -> Query (Dict field a)
forall a b. (a -> Result Error b) -> Query a -> Query b
Internal.WithResult (Decoder a -> Dict field ByteString -> Result Error (Dict field a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse Decoder a
codecDecoder),
      hmset :: key -> NonEmptyDict field a -> Query ()
hmset = \key
key NonEmptyDict field a
vals ->
        NonEmptyDict field a
vals
          NonEmptyDict field a
-> (NonEmptyDict field a -> NonEmpty (field, a))
-> NonEmpty (field, a)
forall a b. a -> (a -> b) -> b
|> NonEmptyDict field a -> NonEmpty (field, a)
forall k v. NonEmptyDict k v -> NonEmpty (k, v)
NonEmptyDict.toNonEmptyList
          NonEmpty (field, a)
-> (NonEmpty (field, a) -> NonEmpty (Text, ByteString))
-> NonEmpty (Text, ByteString)
forall a b. a -> (a -> b) -> b
|> ((field, a) -> (Text, ByteString))
-> NonEmpty (field, a) -> NonEmpty (Text, ByteString)
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map (\(field
k, a
v) -> (field -> Text
toField field
k, Encoder a
codecEncoder a
v))
          NonEmpty (Text, ByteString)
-> (NonEmpty (Text, ByteString) -> Query ()) -> Query ()
forall a b. a -> (a -> b) -> b
|> Text -> NonEmpty (Text, ByteString) -> Query ()
Internal.Hmset (key -> Text
toKey key
key),
      hset :: key -> field -> a -> Query ()
hset = \key
key field
field a
val ->
        Text -> Text -> ByteString -> Query ()
Internal.Hset (key -> Text
toKey key
key) (field -> Text
toField field
field) (Encoder a
codecEncoder a
val),
      hsetnx :: key -> field -> a -> Query Bool
hsetnx = \key
key field
field a
val ->
        Text -> Text -> ByteString -> Query Bool
Internal.Hsetnx (key -> Text
toKey key
key) (field -> Text
toField field
field) (Encoder a
codecEncoder a
val)
    }

toDict :: Ord field => (Text -> Maybe field) -> Codec.Decoder a -> List (Text, ByteString) -> Result Internal.Error (Dict.Dict field a)
toDict :: (Text -> Maybe field)
-> Decoder a
-> List (Text, ByteString)
-> Result Error (Dict field a)
toDict Text -> Maybe field
fromField Decoder a
decode =
  (List (field, a) -> Dict field a)
-> Result Error (List (field, a)) -> Result Error (Dict field a)
forall a value x. (a -> value) -> Result x a -> Result x value
Result.map List (field, a) -> Dict field a
forall comparable v.
Ord comparable =>
List (comparable, v) -> Dict comparable v
Dict.fromList
    (Result Error (List (field, a)) -> Result Error (Dict field a))
-> (List (Text, ByteString) -> Result Error (List (field, a)))
-> List (Text, ByteString)
-> Result Error (Dict field a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
<< ((Text, ByteString) -> Result Error (field, a))
-> List (Text, ByteString) -> Result Error (List (field, a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse
      ( \(Text
k, ByteString
v) ->
          (a -> Result Error (field, a))
-> Result Error a -> Result Error (field, a)
forall a c b. (a -> Result c b) -> Result c a -> Result c b
Result.andThen
            ( \a
v' ->
                case Text -> Maybe field
fromField Text
k of
                  Just field
k' -> (field, a) -> Result Error (field, a)
forall error value. value -> Result error value
Result.Ok (field
k', a
v')
                  Maybe field
Nothing -> Error -> Result Error (field, a)
forall error value. error -> Result error value
Result.Err (Text -> Error
Internal.DecodingFieldError Text
k)
            )
            (Decoder a
decode ByteString
v)
      )