    {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, RecordWildCards,
        MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP,
        DeriveDataTypeable, StandaloneDeriving #-}

    module Database.Redis.Core (
        Redis(), unRedis, reRedis,
        RedisCtx(..), MonadRedis(..),
        send, recv, sendRequest,
        runRedisInternal,
        runRedisClusteredInternal,
        RedisEnv(..),
    ) where

    import Prelude
    #if __GLASGOW_HASKELL__ < 710
    import Control.Applicative
    #endif
    import Control.Monad.Reader
    import qualified Data.ByteString as B
    import Data.IORef
    import Database.Redis.Core.Internal
    import Database.Redis.Protocol
    import qualified Database.Redis.ProtocolPipelining as PP
    import Database.Redis.Types
    import Database.Redis.Cluster(ShardMap)
    import qualified Database.Redis.Cluster as Cluster

    --------------------------------------------------------------------------------
    -- The Redis Monad
    --

    -- |This class captures the following behaviour: In a context @m@, a command
    --  will return its result wrapped in a \"container\" of type @f@.
    --
    --  Please refer to the Command Type Signatures section of this page for more
    --  information.
    class (MonadRedis m) => RedisCtx m f | m -> f where
        returnDecode :: RedisResult a => Reply -> m (f a)

    class (Monad m) => MonadRedis m where
        liftRedis :: Redis a -> m a

    instance RedisCtx Redis (Either Reply) where
        returnDecode :: forall a. RedisResult a => Reply -> Redis (Either Reply a)
    returnDecode = Either Reply a -> Redis (Either Reply a)
    forall a. a -> Redis a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either Reply a -> Redis (Either Reply a))
    -> (Reply -> Either Reply a) -> Reply -> Redis (Either Reply a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Reply -> Either Reply a
    forall a. RedisResult a => Reply -> Either Reply a
    decode

    instance MonadRedis Redis where
        liftRedis :: forall a. Redis a -> Redis a
    liftRedis = Redis a -> Redis a
    forall a. a -> a
    id

    -- |Deconstruct Redis constructor.
    --
    --  'unRedis' and 'reRedis' can be used to define instances for
    --  arbitrary typeclasses.
    --
    --  WARNING! These functions are considered internal and no guarantee
    --  is given at this point that they will not break in future.
    unRedis :: Redis a -> ReaderT RedisEnv IO a
    unRedis :: forall a. Redis a -> ReaderT RedisEnv IO a
    unRedis (Redis ReaderT RedisEnv IO a
    r) = ReaderT RedisEnv IO a
    r

    -- |Reconstruct Redis constructor.
    reRedis :: ReaderT RedisEnv IO a -> Redis a
    reRedis :: forall a. ReaderT RedisEnv IO a -> Redis a
    reRedis ReaderT RedisEnv IO a
    r = ReaderT RedisEnv IO a -> Redis a
    forall a. ReaderT RedisEnv IO a -> Redis a
    Redis ReaderT RedisEnv IO a
    r

    -- |Internal version of 'runRedis' that does not depend on the 'Connection'
    --  abstraction. Used to run the AUTH command when connecting.
    runRedisInternal :: PP.Connection -> Redis a -> IO a
    runRedisInternal :: forall a. Connection -> Redis a -> IO a
    runRedisInternal Connection
    conn (Redis ReaderT RedisEnv IO a
    redis) = do
      -- Dummy reply in case no request is sent.
      ref <- Reply -> IO (IORef Reply)
    forall a. a -> IO (IORef a)
    newIORef (ByteString -> Reply
    SingleLine ByteString
    "nobody will ever see this")
      r <- runReaderT redis (NonClusteredEnv conn ref)
      -- Evaluate last reply to keep lazy IO inside runRedis.
      readIORef ref >>= (`seq` return ())
      return r

    runRedisClusteredInternal :: Cluster.Connection -> IO ShardMap -> Redis a -> IO a
    runRedisClusteredInternal :: forall a. Connection -> IO ShardMap -> Redis a -> IO a
    runRedisClusteredInternal Connection
    connection IO ShardMap
    refreshShardmapAction (Redis ReaderT RedisEnv IO a
    redis) = do
        r <- ReaderT RedisEnv IO a -> RedisEnv -> IO a
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ReaderT RedisEnv IO a
    redis (IO ShardMap -> Connection -> RedisEnv
    ClusteredEnv IO ShardMap
    refreshShardmapAction Connection
    connection)
        r `seq` return ()
        return r

    setLastReply :: Reply -> ReaderT RedisEnv IO ()
    setLastReply :: Reply -> ReaderT RedisEnv IO ()
    setLastReply Reply
    r = do
      ref <- (RedisEnv -> IORef Reply) -> ReaderT RedisEnv IO (IORef Reply)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks RedisEnv -> IORef Reply
    envLastReply
      lift (writeIORef ref r)

    recv :: (MonadRedis m) => m Reply
    recv :: forall (m :: * -> *). MonadRedis m => m Reply
    recv = Redis Reply -> m Reply
    forall a. Redis a -> m a
    forall (m :: * -> *) a. MonadRedis m => Redis a -> m a
    liftRedis (Redis Reply -> m Reply) -> Redis Reply -> m Reply
    forall a b. (a -> b) -> a -> b
    $ ReaderT RedisEnv IO Reply -> Redis Reply
    forall a. ReaderT RedisEnv IO a -> Redis a
    Redis (ReaderT RedisEnv IO Reply -> Redis Reply)
    -> ReaderT RedisEnv IO Reply -> Redis Reply
    forall a b. (a -> b) -> a -> b
    $ do
      conn <- (RedisEnv -> Connection) -> ReaderT RedisEnv IO Connection
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks RedisEnv -> Connection
    envConn
      r <- liftIO (PP.recv conn)
      setLastReply r
      return r

    send :: (MonadRedis m) => [B.ByteString] -> m ()
    send :: forall (m :: * -> *). MonadRedis m => [ByteString] -> m ()
    send [ByteString]
    req = Redis () -> m ()
    forall a. Redis a -> m a
    forall (m :: * -> *) a. MonadRedis m => Redis a -> m a
    liftRedis (Redis () -> m ()) -> Redis () -> m ()
    forall a b. (a -> b) -> a -> b
    $ ReaderT RedisEnv IO () -> Redis ()
    forall a. ReaderT RedisEnv IO a -> Redis a
    Redis (ReaderT RedisEnv IO () -> Redis ())
    -> ReaderT RedisEnv IO () -> Redis ()
    forall a b. (a -> b) -> a -> b
    $ do
        conn <- (RedisEnv -> Connection) -> ReaderT RedisEnv IO Connection
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks RedisEnv -> Connection
    envConn
        liftIO $ PP.send conn (renderRequest req)

    -- |'sendRequest' can be used to implement commands from experimental
    --  versions of Redis. An example of how to implement a command is given
    --  below.
    --
    -- @
    -- -- |Redis DEBUG OBJECT command
    -- debugObject :: ByteString -> 'Redis' (Either 'Reply' ByteString)
    -- debugObject key = 'sendRequest' [\"DEBUG\", \"OBJECT\", key]
    -- @
    --
    sendRequest :: (RedisCtx m f, RedisResult a)
        => [B.ByteString] -> m (f a)
    sendRequest :: forall (m :: * -> *) (f :: * -> *) a.
    (RedisCtx m f, RedisResult a) =>
    [ByteString] -> m (f a)
    sendRequest [ByteString]
    req = do
        r' <- Redis Reply -> m Reply
    forall a. Redis a -> m a
    forall (m :: * -> *) a. MonadRedis m => Redis a -> m a
    liftRedis (Redis Reply -> m Reply) -> Redis Reply -> m Reply
    forall a b. (a -> b) -> a -> b
    $ ReaderT RedisEnv IO Reply -> Redis Reply
    forall a. ReaderT RedisEnv IO a -> Redis a
    Redis (ReaderT RedisEnv IO Reply -> Redis Reply)
    -> ReaderT RedisEnv IO Reply -> Redis Reply
    forall a b. (a -> b) -> a -> b
    $ do
            env <- ReaderT RedisEnv IO RedisEnv
    forall r (m :: * -> *). MonadReader r m => m r
    ask
            case env of
                NonClusteredEnv{IORef Reply
    Connection
    envLastReply :: RedisEnv -> IORef Reply
    envConn :: RedisEnv -> Connection
    envConn :: Connection
    envLastReply :: IORef Reply
    ..} -> do
                    r <- IO Reply -> ReaderT RedisEnv IO Reply
    forall a. IO a -> ReaderT RedisEnv IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Reply -> ReaderT RedisEnv IO Reply)
    -> IO Reply -> ReaderT RedisEnv IO Reply
    forall a b. (a -> b) -> a -> b
    $ Connection -> ByteString -> IO Reply
    PP.request Connection
    envConn ([ByteString] -> ByteString
    renderRequest [ByteString]
    req)
                    setLastReply r
                    return r
                ClusteredEnv{IO ShardMap
    Connection
    refreshAction :: IO ShardMap
    connection :: Connection
    connection :: RedisEnv -> Connection
    refreshAction :: RedisEnv -> IO ShardMap
    ..} -> IO Reply -> ReaderT RedisEnv IO Reply
    forall a. IO a -> ReaderT RedisEnv IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Reply -> ReaderT RedisEnv IO Reply)
    -> IO Reply -> ReaderT RedisEnv IO Reply
    forall a b. (a -> b) -> a -> b
    $ IO ShardMap -> Connection -> [ByteString] -> IO Reply
    Cluster.requestPipelined IO ShardMap
    refreshAction Connection
    connection [ByteString]
    req
        returnDecode r'