{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | 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
  ( -- * Creating a redis handler
    Real.handler,
    Internal.Handler,
    Settings.Settings (..),
    Settings.decoder,
    Settings.decoderWithEnvVarPrefix,

    -- * Creating a redis API
    jsonApi,
    textApi,
    byteStringApi,
    Api,

    -- * Creating redis queries
    del,
    exists,
    expire,
    get,
    getset,
    mget,
    mset,
    ping,
    set,
    setex,
    setnx,

    -- * 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 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 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 a = Api
  { -- | Removes the specified keys. A key is ignored if it does not exist.
    --
    -- https://redis.io/commands/del
    Api key a -> NonEmpty key -> Query Int
del :: NonEmpty key -> Internal.Query Int,
    -- | Returns if key exists.
    --
    -- https://redis.io/commands/exists
    Api key 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 a -> key -> Int -> Query ()
expire :: key -> Int -> Internal.Query (),
    -- | Get the value of key. If the key does not exist the special value Nothing
    -- is returned. An error is returned if the value stored at key is not a
    -- string, because GET only handles string values.
    --
    -- https://redis.io/commands/get
    Api key a -> key -> Query (Maybe a)
get :: key -> Internal.Query (Maybe a),
    -- | Atomically sets key to value and returns the old value stored at key.
    -- Returns an error when key exists but does not hold a string value.
    --
    -- https://redis.io/commands/getset
    Api key a -> key -> a -> Query (Maybe a)
getset :: key -> a -> Internal.Query (Maybe a),
    -- | Returns the values of all specified keys. For every key that does not hold
    -- a string value or does not exist, no value is returned. Because of this, the
    -- operation never fails.
    --
    -- https://redis.io/commands/mget
    Api key a -> Ord key => NonEmpty key -> Query (Dict key a)
mget :: Ord key => NonEmpty key -> Internal.Query (Dict.Dict key a),
    -- | Sets the given keys to their respective values. MSET replaces existing
    -- values with new values, just as regular SET. See MSETNX if you don't want to
    -- overwrite existing values.
    --
    -- MSET is atomic, so all given keys are set at once. It is not possible for
    -- clients to see that some of the keys were updated while others are
    -- unchanged.
    --
    -- https://redis.io/commands/mset
    Api key a -> NonEmptyDict key a -> Query ()
mset :: NonEmptyDict.NonEmptyDict key a -> 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 a -> Query ()
ping :: Internal.Query (),
    -- | Set key to hold the string value. If key already holds a value, it is
    -- overwritten, regardless of its type. Any previous time to live associated
    -- with the key is discarded on successful SET operation.
    --
    -- https://redis.io/commands/set
    Api key a -> key -> a -> Query ()
set :: key -> a -> Internal.Query (),
    -- | Set key to hold the string value and set key to timeout after a given
    -- number of seconds.
    --
    -- https://redis.io/commands/setex
    Api key a -> key -> Int -> a -> Query ()
setex :: key -> Int -> a -> Internal.Query (),
    -- Set key to hold string value if key does not exist. In that case, it
    -- is equal to SET. When key already holds a value, no operation is
    -- performed. SETNX is short for "SET if Not eXists".
    --
    -- https://redis.io/commands/setnx
    Api key a -> key -> a -> Query Bool
setnx :: key -> 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, fieldB}-> Text.join "-" [fieldA, fieldB, "v1"])
-- @
jsonApi :: (Aeson.ToJSON a, Aeson.FromJSON a) => (key -> Text) -> Api key a
jsonApi :: (key -> Text) -> Api key a
jsonApi = Codec a -> (key -> Text) -> Api key a
forall a key. Codec a -> (key -> Text) -> Api key a
makeApi Codec a
forall a. (FromJSON a, ToJSON a) => Codec a
Codec.jsonCodec

-- | Creates a Redis API mapping a 'key' to Text
textApi :: (key -> Text) -> Api key Text
textApi :: (key -> Text) -> Api key Text
textApi = Codec Text -> (key -> Text) -> Api key Text
forall a key. Codec a -> (key -> Text) -> Api key a
makeApi Codec Text
Codec.textCodec

-- | Creates a Redis API mapping a 'key' to a ByteString
byteStringApi :: (key -> Text) -> Api key ByteString.ByteString
byteStringApi :: (key -> Text) -> Api key ByteString
byteStringApi = Codec ByteString -> (key -> Text) -> Api key ByteString
forall a key. Codec a -> (key -> Text) -> Api key a
makeApi Codec ByteString
Codec.byteStringCodec

-- | Private API used to make an API
makeApi :: Codec.Codec a -> (key -> Text) -> Api key a
makeApi :: Codec a -> (key -> Text) -> Api key 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 =
  Api :: forall key a.
(NonEmpty key -> Query Int)
-> (key -> Query Bool)
-> (key -> Int -> Query ())
-> (key -> Query (Maybe a))
-> (key -> a -> Query (Maybe a))
-> (Ord key => NonEmpty key -> Query (Dict key a))
-> (NonEmptyDict key a -> Query ())
-> Query ()
-> (key -> a -> Query ())
-> (key -> Int -> a -> Query ())
-> (key -> a -> Query Bool)
-> Api key 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,
      get :: key -> Query (Maybe a)
get = \key
key -> (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 -> Query (Maybe ByteString)
Internal.Get (key -> Text
toKey key
key)),
      getset :: key -> a -> Query (Maybe a)
getset = \key
key a
value -> (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 -> ByteString -> Query (Maybe ByteString)
Internal.Getset (key -> Text
toKey key
key) (Encoder a
codecEncoder a
value)),
      mget :: Ord key => NonEmpty key -> Query (Dict key a)
mget = \NonEmpty key
keys ->
        (key -> Text) -> NonEmpty key -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map key -> Text
toKey NonEmpty key
keys
          NonEmpty Text
-> (NonEmpty Text -> Query [Maybe ByteString])
-> Query [Maybe ByteString]
forall a b. a -> (a -> b) -> b
|> NonEmpty Text -> Query [Maybe ByteString]
Internal.Mget
          Query [Maybe ByteString]
-> (Query [Maybe ByteString] -> Query (Dict key ByteString))
-> Query (Dict key ByteString)
forall a b. a -> (a -> b) -> b
|> ([Maybe ByteString] -> Dict key ByteString)
-> Query [Maybe ByteString] -> Query (Dict key ByteString)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (List key -> [Maybe ByteString] -> Dict key ByteString
forall key a. Ord key => List key -> List (Maybe a) -> Dict key a
Internal.maybesToDict (NonEmpty key -> List key
forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty key
keys))
          Query (Dict key ByteString)
-> (Query (Dict key ByteString) -> Query (Dict key a))
-> Query (Dict key a)
forall a b. a -> (a -> b) -> b
|> (Dict key ByteString -> Result Error (Dict key a))
-> Query (Dict key ByteString) -> Query (Dict key a)
forall a b. (a -> Result Error b) -> Query a -> Query b
Internal.WithResult (Decoder a -> Dict key ByteString -> Result Error (Dict key a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse Decoder a
codecDecoder),
      mset :: NonEmptyDict key a -> Query ()
mset = \NonEmptyDict key a
vals ->
        NonEmptyDict key a -> NonEmpty (key, a)
forall k v. NonEmptyDict k v -> NonEmpty (k, v)
NonEmptyDict.toNonEmptyList NonEmptyDict key a
vals
          NonEmpty (key, a)
-> (NonEmpty (key, a) -> NonEmpty (Text, ByteString))
-> NonEmpty (Text, ByteString)
forall a b. a -> (a -> b) -> b
|> ((key, a) -> (Text, ByteString))
-> NonEmpty (key, a) -> NonEmpty (Text, ByteString)
forall (m :: * -> *) a value.
Functor m =>
(a -> value) -> m a -> m value
map (\(key
k, a
v) -> (key -> Text
toKey key
k, Encoder a
codecEncoder a
v))
          NonEmpty (Text, ByteString)
-> (NonEmpty (Text, ByteString) -> Query ()) -> Query ()
forall a b. a -> (a -> b) -> b
|> NonEmpty (Text, ByteString) -> Query ()
Internal.Mset,
      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
_ -> ()),
      set :: key -> a -> Query ()
set = \key
key a
value -> Text -> ByteString -> Query ()
Internal.Set (key -> Text
toKey key
key) (Encoder a
codecEncoder a
value),
      setex :: key -> Int -> a -> Query ()
setex = \key
key Int
seconds a
value -> Text -> Int -> ByteString -> Query ()
Internal.Setex (key -> Text
toKey key
key) Int
seconds (Encoder a
codecEncoder a
value),
      setnx :: key -> a -> Query Bool
setnx = \key
key a
value -> Text -> ByteString -> Query Bool
Internal.Setnx (key -> Text
toKey key
key) (Encoder a
codecEncoder a
value)
    }