{-# 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.SortedSet
  ( -- * 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,
    zadd,
    zrange,
    zrangeByScoreWithScores,
    zrank,
    zrevrank,

    -- * 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 Data.Map.Strict
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 Prelude

data Api key a = Api
  { -- | Removes the specified keys. A key is ignored if it does not exist.
    --
    -- https://redis.io/commands/del
    forall key a. Api key a -> NonEmpty key -> Query Int
del :: NonEmpty key -> Internal.Query Int,
    -- | Returns if key exists.
    --
    -- https://redis.io/commands/exists
    forall key a. 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
    forall key a. 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
    forall key a. Api key a -> Query ()
ping :: Internal.Query (),
    -- | Adds all the specified members with the specified scores to the sorted
    -- set. If a specified member is already a member of the sorted set, the
    -- score is updated and the element reinserted at the right position to
    -- ensure the correct ordering.
    --
    -- https://redis.io/commands/zadd
    forall key a. Api key a -> key -> NonEmptyDict a Float -> Query Int
zadd :: key -> NonEmptyDict.NonEmptyDict a Float -> Internal.Query Int,
    -- | Returns the specified range of elements in the sorted set. The order of
    -- elements is from the lowest to the highest score. Elements with the same
    -- score are ordered lexicographically. The <start> and <stop> arguments
    -- represent zero-based indexes, where 0 is the first element, 1 is the next
    -- element, and so on. These arguments specify an inclusive range, so for
    -- example, ZRANGE myzset 0 1 will return both the first and the second
    -- element of the sorted set.
    --
    -- The indexes can also be negative numbers indicating offsets from the end
    -- of the sorted set, with -1 being the last element of the sorted set, -2
    -- the penultimate element, and so on.
    --
    -- Out of range indexes do not produce an error.
    --
    -- https://redis.io/commands/zrange
    forall key a. Api key a -> key -> Int -> Int -> Query (List a)
zrange :: key -> Int -> Int -> Internal.Query (List a),
    -- | Like `zrange`, but with the bounds being scores rather than offsets,
    -- and with the result including the scores for each returned result.
    forall key a.
Api key a -> key -> Float -> Float -> Query [(a, Float)]
zrangeByScoreWithScores :: key -> Float -> Float -> Internal.Query [(a, Float)],
    -- | Returns the rank of member in the sorted set stored at key, with the
    -- scores ordered from low to high. The rank (or index) is 0-based, which
    -- means that the member with the lowest score has rank 0.
    --
    -- https://redis.io/commands/zrank
    forall key a. Api key a -> key -> a -> Query (Maybe Int)
zrank :: key -> a -> Internal.Query (Maybe Int),
    -- | Returns the rank of member in the sorted set stored at key, with the
    -- scores ordered from high to low. The rank (or index) is 0-based, which
    -- means that the member with the highest score has rank 0.
    --
    -- https://redis.io/commands/zrevrank
    forall key a. Api key a -> key -> a -> Query (Maybe Int)
zrevrank :: key -> a -> Internal.Query (Maybe Int)
  }

-- | 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 :: forall a key.
(ToJSON a, FromJSON a, Ord a) =>
(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 :: forall key. (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 :: forall key. (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 :: forall a key. Ord a => Codec a -> (key -> Text) -> Api key a
makeApi Codec.Codec {Encoder a
codecEncoder :: Encoder a
codecEncoder :: forall a. Codec a -> Encoder a
Codec.codecEncoder, Decoder a
codecDecoder :: Decoder a
codecDecoder :: forall a. Codec a -> Decoder a
Codec.codecDecoder} key -> Text
toKey =
  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
_ -> ()),
      zadd :: key -> NonEmptyDict a Float -> Query Int
zadd = \key
key NonEmptyDict a Float
vals ->
        Text -> Dict ByteString Float -> Query Int
Internal.Zadd (key -> Text
toKey key
key) (Encoder a -> Map a Float -> Dict ByteString Float
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Data.Map.Strict.mapKeys Encoder a
codecEncoder (NonEmptyDict a Float -> Map a Float
forall k v. Ord k => NonEmptyDict k v -> Dict k v
NonEmptyDict.toDict NonEmptyDict a Float
vals)),
      zrange :: key -> Int -> Int -> Query (List a)
zrange = \key
key Int
start Int
stop ->
        Text -> Int -> Int -> Query [ByteString]
Internal.Zrange (key -> Text
toKey key
key) Int
start Int
stop
          Query [ByteString]
-> (Query [ByteString] -> Query (List a)) -> Query (List a)
forall a b. a -> (a -> b) -> b
|> ([ByteString] -> Result Error (List a))
-> Query [ByteString] -> Query (List a)
forall a1 a. (a1 -> Result Error a) -> Query a1 -> Query a
Internal.WithResult (Decoder a -> [ByteString] -> Result Error (List a)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
Prelude.traverse Decoder a
codecDecoder),
      zrangeByScoreWithScores :: key -> Float -> Float -> Query [(a, Float)]
zrangeByScoreWithScores = \key
key Float
start Float
stop ->
        Text -> Float -> Float -> Query [(ByteString, Float)]
Internal.ZrangeByScoreWithScores (key -> Text
toKey key
key) Float
start Float
stop
          Query [(ByteString, Float)]
-> (Query [(ByteString, Float)] -> Query [(a, Float)])
-> Query [(a, Float)]
forall a b. a -> (a -> b) -> b
|> ([(ByteString, Float)] -> Result Error [(a, Float)])
-> Query [(ByteString, Float)] -> Query [(a, Float)]
forall a1 a. (a1 -> Result Error a) -> Query a1 -> Query a
Internal.WithResult
            ( ((ByteString, Float) -> Result Error (a, Float))
-> [(ByteString, Float)] -> Result Error [(a, Float)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
Prelude.traverse
                ( \(ByteString
v, Float
score) ->
                    Decoder a
codecDecoder ByteString
v Result Error a
-> (Result Error a -> Result Error (a, Float))
-> Result Error (a, Float)
forall a b. a -> (a -> b) -> b
|> (a -> (a, Float)) -> Result Error a -> Result Error (a, Float)
forall a value x. (a -> value) -> Result x a -> Result x value
Result.map (\a
val -> (a
val, Float
score))
                )
            ),
      zrank :: key -> a -> Query (Maybe Int)
zrank = \key
key a
member -> Text -> ByteString -> Query (Maybe Int)
Internal.Zrank (key -> Text
toKey key
key) (Encoder a
codecEncoder a
member),
      zrevrank :: key -> a -> Query (Maybe Int)
zrevrank = \key
key a
member -> Text -> ByteString -> Query (Maybe Int)
Internal.Zrevrank (key -> Text
toKey key
key) (Encoder a
codecEncoder a
member)
    }