{-# 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.Set
  ( -- * 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,
    sadd,
    scard,
    srem,
    smembers,

    -- * 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 Redis.Codec as Codec
import qualified Redis.Internal as Internal
import qualified Redis.Real as Real
import qualified Redis.Settings as Settings
import qualified Set
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 (),
    -- | 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 (),
    -- | Add the specified members to the set stored at key. Specified members
    -- that are already a member of this set are ignored. If key does not
    -- exist, a new set is created before adding the specified members.
    --
    -- https://redis.io/commands/sadd
    Api key a -> key -> NonEmpty a -> Query Int
sadd :: key -> NonEmpty a -> Internal.Query Int,
    -- | Returns the set cardinality (number of elements) of the set stored at
    -- key.
    --
    -- https://redis.io/commands/scard
    Api key a -> key -> Query Int
scard :: key -> Internal.Query Int,
    -- | remove the specified members from the set stored at key. specified
    -- members that are not a member of this set are ignored. if key does not
    -- exist, it is treated as an empty set and this command returns 0.
    --
    -- https://redis.io/commands/srem
    Api key a -> key -> NonEmpty a -> Query Int
srem :: key -> NonEmpty a -> Internal.Query Int,
    -- | Returns all the members of the set value stored at key.
    --
    -- https://redis.io/commands/smembers
    Api key a -> key -> Query (Set a)
smembers :: key -> Internal.Query (Set.Set a)
  }

-- | 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 key.
  (Aeson.ToJSON a, Aeson.FromJSON a, Ord a) =>
  (key -> Text) ->
  Api key a
jsonApi :: (key -> Text) -> Api key a
jsonApi = Codec a -> (key -> Text) -> Api key a
forall a key. Ord a => 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. Ord a => 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. Ord a => Codec a -> (key -> Text) -> Api key a
makeApi Codec ByteString
Codec.byteStringCodec

makeApi ::
  Ord a =>
  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 ())
-> Query ()
-> (key -> NonEmpty a -> Query Int)
-> (key -> Query Int)
-> (key -> NonEmpty a -> Query Int)
-> (key -> Query (Set a))
-> 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,
      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
_ -> ()),
      sadd :: key -> NonEmpty a -> Query Int
sadd = \key
key NonEmpty a
vals ->
        Text -> NonEmpty ByteString -> Query Int
Internal.Sadd (key -> Text
toKey key
key) (Encoder a -> NonEmpty a -> NonEmpty ByteString
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map Encoder a
codecEncoder NonEmpty a
vals),
      scard :: key -> Query Int
scard = \key
key ->
        Text -> Query Int
Internal.Scard (key -> Text
toKey key
key),
      srem :: key -> NonEmpty a -> Query Int
srem = \key
key NonEmpty a
vals ->
        Text -> NonEmpty ByteString -> Query Int
Internal.Srem (key -> Text
toKey key
key) (Encoder a -> NonEmpty a -> NonEmpty ByteString
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NonEmpty.map Encoder a
codecEncoder NonEmpty a
vals),
      smembers :: key -> Query (Set a)
smembers = \key
key ->
        Text -> Query (List ByteString)
Internal.Smembers (key -> Text
toKey key
key)
          Query (List ByteString)
-> (Query (List ByteString) -> Query [a]) -> Query [a]
forall a b. a -> (a -> b) -> b
|> (List ByteString -> Result Error [a])
-> Query (List ByteString) -> Query [a]
forall a b. (a -> Result Error b) -> Query a -> Query b
Internal.WithResult (Decoder a -> List ByteString -> Result Error [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse Decoder a
codecDecoder)
          Query [a] -> (Query [a] -> Query (Set a)) -> Query (Set a)
forall a b. a -> (a -> b) -> b
|> ([a] -> Set a) -> Query [a] -> Query (Set a)
forall a b. (a -> b) -> Query a -> Query b
Internal.map [a] -> Set a
forall comparable.
Ord comparable =>
List comparable -> Set comparable
Set.fromList
    }