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

    -- * Creating a redis API
    makeApi,
    Api,

    -- * Creating redis queries
    del,
    exists,
    expire,
    ping,
    get,
    incr,
    incrby,
    set,

    -- * Running Redis queries
    Internal.query,
    Internal.transaction,
    Internal.Query,
    Internal.Error (..),
    Internal.map,
    Internal.map2,
    Internal.map3,
    Internal.sequence,
  )
where

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 Prelude

-- | a API type can be used to help enforce a consistent key usage.
-- Without an API type, it can be easy to naiively change key serialization.
data Api key = Api
  { -- | Removes the specified keys. A key is ignored if it does not exist.
    --
    -- https://redis.io/commands/del
    Api key -> NonEmpty key -> Query Int
del :: NonEmpty key -> Internal.Query Int,
    -- | Returns if key exists.
    --
    -- https://redis.io/commands/exists
    Api key -> 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 -> 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 -> Query ()
ping :: 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 -> key -> Query (Maybe Int)
get :: key -> Internal.Query (Maybe Int),
    -- | Increments the number stored at key by one. If the key does not
    -- exist, it is set to 0 before performing the operation. An error is
    -- returned if the key contains a value of the wrong type or contains a
    -- string that can not be represented as integer. This operation is
    -- limited to 64 bit signed integers.
    --
    -- https://redis.io/commands/incr
    Api key -> key -> Query Int
incr :: key -> Internal.Query Int,
    -- | Increments the number stored at key by increment. If the key does
    -- not exist, it is set to 0 before performing the operation. An error
    -- is returned if the key contains a value of the wrong type or
    -- contains a string that can not be represented as integer. This
    -- operation is limited to 64 bit signed integers.
    --
    -- https://redis.io/commands/incrby
    Api key -> key -> Int -> Query Int
incrby :: key -> Int -> Internal.Query Int,
    -- | 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 -> key -> Int -> Query ()
set :: key -> Int -> Internal.Query ()
  }

-- | Creates a Redis API to help enforce consistent key serialization
--
-- > myJsonApi :: Redis.Counter.Api Key
-- > myJsonApi = Redis.counter.makeApi (\Key {fieldA, fieldB}-> Text.join "-" [fieldA, fieldB, "v1"])
makeApi ::
  (key -> Text) ->
  Api key
makeApi :: (key -> Text) -> Api key
makeApi key -> Text
toKey =
  Api :: forall key.
(NonEmpty key -> Query Int)
-> (key -> Query Bool)
-> (key -> Int -> Query ())
-> Query ()
-> (key -> Query (Maybe Int))
-> (key -> Query Int)
-> (key -> Int -> Query Int)
-> (key -> Int -> Query ())
-> Api key
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
_ -> ()),
      get :: key -> Query (Maybe Int)
get = \key
key ->
        Text -> Query (Maybe ByteString)
Internal.Get (key -> Text
toKey key
key)
          Query (Maybe ByteString)
-> (Query (Maybe ByteString) -> Query (Maybe Int))
-> Query (Maybe Int)
forall a b. a -> (a -> b) -> b
|> (Maybe ByteString -> Result Error (Maybe Int))
-> Query (Maybe ByteString) -> Query (Maybe Int)
forall a b. (a -> Result Error b) -> Query a -> Query b
Internal.WithResult ((ByteString -> Result Error Int)
-> Maybe ByteString -> Result Error (Maybe Int)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
Prelude.traverse (Codec Int -> ByteString -> Result Error Int
forall a. Codec a -> Decoder a
Codec.codecDecoder Codec Int
forall a. (FromJSON a, ToJSON a) => Codec a
Codec.jsonCodec)),
      incr :: key -> Query Int
incr = \key
key -> Text -> Query Int
Internal.Incr (key -> Text
toKey key
key),
      incrby :: key -> Int -> Query Int
incrby = \key
key Int
amount -> Text -> Int -> Query Int
Internal.Incrby (key -> Text
toKey key
key) Int
amount,
      set :: key -> Int -> Query ()
set = \key
key Int
val -> Text -> ByteString -> Query ()
Internal.Set (key -> Text
toKey key
key) (Codec Int -> Encoder Int
forall a. Codec a -> Encoder a
Codec.codecEncoder Codec Int
forall a. (FromJSON a, ToJSON a) => Codec a
Codec.jsonCodec Int
val)
    }