    {-# LANGUAGE DeriveGeneric #-}
    {-# LANGUAGE CPP, OverloadedStrings, FlexibleInstances, MultiParamTypeClasses,
        GeneralizedNewtypeDeriving #-}

    module Database.Redis.Transactions (
        watch, unwatch, multiExec,
        Queued(), TxResult(..), RedisTx(),
    ) where

    #if __GLASGOW_HASKELL__ < 710
    import Control.Applicative
    #endif
    import Control.Monad.State.Strict
    import Control.DeepSeq
    import GHC.Generics
    import Data.ByteString (ByteString)
    import Data.Vector (Vector, fromList, (!))

    import Database.Redis.Core
    import Database.Redis.Protocol
    import Database.Redis.Types

    -- |Command-context inside of MULTI\/EXEC transactions. Use 'multiExec' to run
    --  actions of this type.
    --
    --  In the 'RedisTx' context, all commands return a 'Queued' value. It is a
    --  proxy object for the /actual/ result, which will only be available after
    --  finishing the transaction.
    newtype RedisTx a = RedisTx (StateT Int Redis a)
        deriving (Applicative RedisTx
    Applicative RedisTx
    -> (forall a b. RedisTx a -> (a -> RedisTx b) -> RedisTx b)
    -> (forall a b. RedisTx a -> RedisTx b -> RedisTx b)
    -> (forall a. a -> RedisTx a)
    -> Monad RedisTx
    forall a. a -> RedisTx a
    forall a b. RedisTx a -> RedisTx b -> RedisTx b
    forall a b. RedisTx a -> (a -> RedisTx b) -> RedisTx b
    forall (m :: * -> *).
    Applicative m
    -> (forall a b. m a -> (a -> m b) -> m b)
    -> (forall a b. m a -> m b -> m b)
    -> (forall a. a -> m a)
    -> Monad m
    $c>>= :: forall a b. RedisTx a -> (a -> RedisTx b) -> RedisTx b
    >>= :: forall a b. RedisTx a -> (a -> RedisTx b) -> RedisTx b
    $c>> :: forall a b. RedisTx a -> RedisTx b -> RedisTx b
    >> :: forall a b. RedisTx a -> RedisTx b -> RedisTx b
    $creturn :: forall a. a -> RedisTx a
    return :: forall a. a -> RedisTx a
    Monad, Monad RedisTx
    Monad RedisTx -> (forall a. IO a -> RedisTx a) -> MonadIO RedisTx
    forall a. IO a -> RedisTx a
    forall (m :: * -> *).
    Monad m -> (forall a. IO a -> m a) -> MonadIO m
    $cliftIO :: forall a. IO a -> RedisTx a
    liftIO :: forall a. IO a -> RedisTx a
    MonadIO, (forall a b. (a -> b) -> RedisTx a -> RedisTx b)
    -> (forall a b. a -> RedisTx b -> RedisTx a) -> Functor RedisTx
    forall a b. a -> RedisTx b -> RedisTx a
    forall a b. (a -> b) -> RedisTx a -> RedisTx b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> RedisTx a -> RedisTx b
    fmap :: forall a b. (a -> b) -> RedisTx a -> RedisTx b
    $c<$ :: forall a b. a -> RedisTx b -> RedisTx a
    <$ :: forall a b. a -> RedisTx b -> RedisTx a
    Functor, Functor RedisTx
    Functor RedisTx
    -> (forall a. a -> RedisTx a)
    -> (forall a b. RedisTx (a -> b) -> RedisTx a -> RedisTx b)
    -> (forall a b c.
        (a -> b -> c) -> RedisTx a -> RedisTx b -> RedisTx c)
    -> (forall a b. RedisTx a -> RedisTx b -> RedisTx b)
    -> (forall a b. RedisTx a -> RedisTx b -> RedisTx a)
    -> Applicative RedisTx
    forall a. a -> RedisTx a
    forall a b. RedisTx a -> RedisTx b -> RedisTx a
    forall a b. RedisTx a -> RedisTx b -> RedisTx b
    forall a b. RedisTx (a -> b) -> RedisTx a -> RedisTx b
    forall a b c. (a -> b -> c) -> RedisTx a -> RedisTx b -> RedisTx c
    forall (f :: * -> *).
    Functor f
    -> (forall a. a -> f a)
    -> (forall a b. f (a -> b) -> f a -> f b)
    -> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
    -> (forall a b. f a -> f b -> f b)
    -> (forall a b. f a -> f b -> f a)
    -> Applicative f
    $cpure :: forall a. a -> RedisTx a
    pure :: forall a. a -> RedisTx a
    $c<*> :: forall a b. RedisTx (a -> b) -> RedisTx a -> RedisTx b
    <*> :: forall a b. RedisTx (a -> b) -> RedisTx a -> RedisTx b
    $cliftA2 :: forall a b c. (a -> b -> c) -> RedisTx a -> RedisTx b -> RedisTx c
    liftA2 :: forall a b c. (a -> b -> c) -> RedisTx a -> RedisTx b -> RedisTx c
    $c*> :: forall a b. RedisTx a -> RedisTx b -> RedisTx b
    *> :: forall a b. RedisTx a -> RedisTx b -> RedisTx b
    $c<* :: forall a b. RedisTx a -> RedisTx b -> RedisTx a
    <* :: forall a b. RedisTx a -> RedisTx b -> RedisTx a
    Applicative)

    runRedisTx :: RedisTx a -> Redis a
    runRedisTx :: forall a. RedisTx a -> Redis a
    runRedisTx (RedisTx StateT Int Redis a
    r) = StateT Int Redis a -> Int -> Redis a
    forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
    evalStateT StateT Int Redis a
    r Int
    0

    instance MonadRedis RedisTx where
        liftRedis :: forall a. Redis a -> RedisTx a
    liftRedis = StateT Int Redis a -> RedisTx a
    forall a. StateT Int Redis a -> RedisTx a
    RedisTx (StateT Int Redis a -> RedisTx a)
    -> (Redis a -> StateT Int Redis a) -> Redis a -> RedisTx a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Redis a -> StateT Int Redis a
    forall (m :: * -> *) a. Monad m => m a -> StateT Int m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift

    instance RedisCtx RedisTx Queued where
        returnDecode :: forall a. RedisResult a => Reply -> RedisTx (Queued a)
    returnDecode Reply
    _queued = StateT Int Redis (Queued a) -> RedisTx (Queued a)
    forall a. StateT Int Redis a -> RedisTx a
    RedisTx (StateT Int Redis (Queued a) -> RedisTx (Queued a))
    -> StateT Int Redis (Queued a) -> RedisTx (Queued a)
    forall a b. (a -> b) -> a -> b
    $ do
            -- future index in EXEC result list
            Int
    i <- StateT Int Redis Int
    forall s (m :: * -> *). MonadState s m => m s
    get
            Int -> StateT Int Redis ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1)
            Queued a -> StateT Int Redis (Queued a)
    forall a. a -> StateT Int Redis a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Queued a -> StateT Int Redis (Queued a))
    -> Queued a -> StateT Int Redis (Queued a)
    forall a b. (a -> b) -> a -> b
    $ (Vector Reply -> Either Reply a) -> Queued a
    forall a. (Vector Reply -> Either Reply a) -> Queued a
    Queued (Reply -> Either Reply a
    forall a. RedisResult a => Reply -> Either Reply a
    decode (Reply -> Either Reply a)
    -> (Vector Reply -> Reply) -> Vector Reply -> Either Reply a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Vector Reply -> Int -> Reply
    forall a. Vector a -> Int -> a
    ! Int
    i))

    -- |A 'Queued' value represents the result of a command inside a transaction. It
    --  is a proxy object for the /actual/ result, which will only be available
    --  after returning from a 'multiExec' transaction.
    --
    --  'Queued' values are composable by utilizing the 'Functor', 'Applicative' or
    --  'Monad' interfaces.
    data Queued a = Queued (Vector Reply -> Either Reply a)

    instance Functor Queued where
        fmap :: forall a b. (a -> b) -> Queued a -> Queued b
    fmap a -> b
    f (Queued Vector Reply -> Either Reply a
    g) = (Vector Reply -> Either Reply b) -> Queued b
    forall a. (Vector Reply -> Either Reply a) -> Queued a
    Queued ((a -> b) -> Either Reply a -> Either Reply b
    forall a b. (a -> b) -> Either Reply a -> Either Reply b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f (Either Reply a -> Either Reply b)
    -> (Vector Reply -> Either Reply a)
    -> Vector Reply
    -> Either Reply b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Reply -> Either Reply a
    g)

    instance Applicative Queued where
        pure :: forall a. a -> Queued a
    pure a
    x                = (Vector Reply -> Either Reply a) -> Queued a
    forall a. (Vector Reply -> Either Reply a) -> Queued a
    Queued (Either Reply a -> Vector Reply -> Either Reply a
    forall a b. a -> b -> a
    const (Either Reply a -> Vector Reply -> Either Reply a)
    -> Either Reply a -> Vector Reply -> Either Reply a
    forall a b. (a -> b) -> a -> b
    $ a -> Either Reply a
    forall a b. b -> Either a b
    Right a
    x)
        Queued Vector Reply -> Either Reply (a -> b)
    f <*> :: forall a b. Queued (a -> b) -> Queued a -> Queued b
    <*> Queued Vector Reply -> Either Reply a
    x = (Vector Reply -> Either Reply b) -> Queued b
    forall a. (Vector Reply -> Either Reply a) -> Queued a
    Queued ((Vector Reply -> Either Reply b) -> Queued b)
    -> (Vector Reply -> Either Reply b) -> Queued b
    forall a b. (a -> b) -> a -> b
    $ \Vector Reply
    rs -> do
                                            a -> b
    f' <- Vector Reply -> Either Reply (a -> b)
    f Vector Reply
    rs
                                            a
    x' <- Vector Reply -> Either Reply a
    x Vector Reply
    rs
                                            b -> Either Reply b
    forall a. a -> Either Reply a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> b
    f' a
    x')

    instance Monad Queued where
        return :: forall a. a -> Queued a
    return         = a -> Queued a
    forall a. a -> Queued a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        Queued Vector Reply -> Either Reply a
    x >>= :: forall a b. Queued a -> (a -> Queued b) -> Queued b
    >>= a -> Queued b
    f = (Vector Reply -> Either Reply b) -> Queued b
    forall a. (Vector Reply -> Either Reply a) -> Queued a
    Queued ((Vector Reply -> Either Reply b) -> Queued b)
    -> (Vector Reply -> Either Reply b) -> Queued b
    forall a b. (a -> b) -> a -> b
    $ \Vector Reply
    rs -> do
                                    a
    x' <- Vector Reply -> Either Reply a
    x Vector Reply
    rs
                                    let Queued Vector Reply -> Either Reply b
    f' = a -> Queued b
    f a
    x'
                                    Vector Reply -> Either Reply b
    f' Vector Reply
    rs

    -- | Result of a 'multiExec' transaction.
    data TxResult a
        = TxSuccess a
        -- ^ Transaction completed successfully. The wrapped value corresponds to
        --   the 'Queued' value returned from the 'multiExec' argument action.
        | TxAborted
        -- ^ Transaction aborted due to an earlier 'watch' command.
        | TxError String
        -- ^ At least one of the commands returned an 'Error' reply.
        deriving (Int -> TxResult a -> ShowS
    [TxResult a] -> ShowS
    TxResult a -> String
    (Int -> TxResult a -> ShowS)
    -> (TxResult a -> String)
    -> ([TxResult a] -> ShowS)
    -> Show (TxResult a)
    forall a. Show a => Int -> TxResult a -> ShowS
    forall a. Show a => [TxResult a] -> ShowS
    forall a. Show a => TxResult a -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: forall a. Show a => Int -> TxResult a -> ShowS
    showsPrec :: Int -> TxResult a -> ShowS
    $cshow :: forall a. Show a => TxResult a -> String
    show :: TxResult a -> String
    $cshowList :: forall a. Show a => [TxResult a] -> ShowS
    showList :: [TxResult a] -> ShowS
    Show, TxResult a -> TxResult a -> Bool
    (TxResult a -> TxResult a -> Bool)
    -> (TxResult a -> TxResult a -> Bool) -> Eq (TxResult a)
    forall a. Eq a => TxResult a -> TxResult a -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: forall a. Eq a => TxResult a -> TxResult a -> Bool
    == :: TxResult a -> TxResult a -> Bool
    $c/= :: forall a. Eq a => TxResult a -> TxResult a -> Bool
    /= :: TxResult a -> TxResult a -> Bool
    Eq, (forall x. TxResult a -> Rep (TxResult a) x)
    -> (forall x. Rep (TxResult a) x -> TxResult a)
    -> Generic (TxResult a)
    forall x. Rep (TxResult a) x -> TxResult a
    forall x. TxResult a -> Rep (TxResult a) x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    forall a x. Rep (TxResult a) x -> TxResult a
    forall a x. TxResult a -> Rep (TxResult a) x
    $cfrom :: forall a x. TxResult a -> Rep (TxResult a) x
    from :: forall x. TxResult a -> Rep (TxResult a) x
    $cto :: forall a x. Rep (TxResult a) x -> TxResult a
    to :: forall x. Rep (TxResult a) x -> TxResult a
    Generic)

    instance NFData a => NFData (TxResult a)

    -- |Watch the given keys to determine execution of the MULTI\/EXEC block
    --  (<http://redis.io/commands/watch>).
    watch
        :: [ByteString] -- ^ key
        -> Redis (Either Reply Status)
    watch :: [ByteString] -> Redis (Either Reply Status)
    watch [ByteString]
    key = [ByteString] -> Redis (Either Reply Status)
    forall (m :: * -> *) (f :: * -> *) a.
    (RedisCtx m f, RedisResult a) =>
    [ByteString] -> m (f a)
    sendRequest (ByteString
    "WATCH" ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    : [ByteString]
    key)

    -- |Forget about all watched keys (<http://redis.io/commands/unwatch>).
    unwatch :: Redis (Either Reply Status)
    unwatch :: Redis (Either Reply Status)
    unwatch  = [ByteString] -> Redis (Either Reply Status)
    forall (m :: * -> *) (f :: * -> *) a.
    (RedisCtx m f, RedisResult a) =>
    [ByteString] -> m (f a)
    sendRequest [ByteString
    "UNWATCH"]

    -- |Run commands inside a transaction. For documentation on the semantics of
    --  Redis transaction see <http://redis.io/topics/transactions>.
    --
    --  Inside the transaction block, command functions return their result wrapped
    --  in a 'Queued'. The 'Queued' result is a proxy object for the actual
    --  command\'s result, which will only be available after @EXEC@ing the
    --  transaction.
    --
    --  Example usage (note how 'Queued' \'s 'Applicative' instance is used to
    --  combine the two individual results):
    --
    --  @
    --  runRedis conn $ do
    --      set \"hello\" \"hello\"
    --      set \"world\" \"world\"
    --      helloworld <- 'multiExec' $ do
    --          hello <- get \"hello\"
    --          world <- get \"world\"
    --          return $ (,) \<$\> hello \<*\> world
    --      liftIO (print helloworld)
    --  @
    multiExec :: RedisTx (Queued a) -> Redis (TxResult a)
    multiExec :: forall a. RedisTx (Queued a) -> Redis (TxResult a)
    multiExec RedisTx (Queued a)
    rtx = do
        -- We don't need to catch exceptions and call DISCARD. The pool will close
        -- the connection anyway.
        Either Reply Status
    _        <- Redis (Either Reply Status)
    multi
        Queued Vector Reply -> Either Reply a
    f <- RedisTx (Queued a) -> Redis (Queued a)
    forall a. RedisTx a -> Redis a
    runRedisTx RedisTx (Queued a)
    rtx
        Reply
    r        <- Redis Reply
    exec
        case Reply
    r of
            MultiBulk Maybe [Reply]
    rs ->
                TxResult a -> Redis (TxResult a)
    forall a. a -> Redis a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TxResult a -> Redis (TxResult a))
    -> TxResult a -> Redis (TxResult a)
    forall a b. (a -> b) -> a -> b
    $ TxResult a
    -> ([Reply] -> TxResult a) -> Maybe [Reply] -> TxResult a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe
                    TxResult a
    forall a. TxResult a
    TxAborted
                    ((Reply -> TxResult a)
    -> (a -> TxResult a) -> Either Reply a -> TxResult a
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (String -> TxResult a
    forall a. String -> TxResult a
    TxError (String -> TxResult a) -> (Reply -> String) -> Reply -> TxResult a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Reply -> String
    forall a. Show a => a -> String
    show) a -> TxResult a
    forall a. a -> TxResult a
    TxSuccess (Either Reply a -> TxResult a)
    -> ([Reply] -> Either Reply a) -> [Reply] -> TxResult a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Vector Reply -> Either Reply a
    f (Vector Reply -> Either Reply a)
    -> ([Reply] -> Vector Reply) -> [Reply] -> Either Reply a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Reply] -> Vector Reply
    forall a. [a] -> Vector a
    fromList)
                    Maybe [Reply]
    rs
            Reply
    _ -> String -> Redis (TxResult a)
    forall a. HasCallStack => String -> a
    error (String -> Redis (TxResult a)) -> String -> Redis (TxResult a)
    forall a b. (a -> b) -> a -> b
    $ String
    "hedis: EXEC returned " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Reply -> String
    forall a. Show a => a -> String
    show Reply
    r

    multi :: Redis (Either Reply Status)
    multi :: Redis (Either Reply Status)
    multi = [ByteString] -> Redis (Either Reply Status)
    forall (m :: * -> *) (f :: * -> *) a.
    (RedisCtx m f, RedisResult a) =>
    [ByteString] -> m (f a)
    sendRequest [ByteString
    "MULTI"]

    exec :: Redis Reply
    exec :: Redis Reply
    exec = (Reply -> Reply) -> (Reply -> Reply) -> Either Reply Reply -> Reply
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either Reply -> Reply
    forall a. a -> a
    id Reply -> Reply
    forall a. a -> a
    id (Either Reply Reply -> Reply)
    -> Redis (Either Reply Reply) -> Redis Reply
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [ByteString] -> Redis (Either Reply Reply)
    forall (m :: * -> *) (f :: * -> *) a.
    (RedisCtx m f, RedisResult a) =>
    [ByteString] -> m (f a)
    sendRequest [ByteString
    "EXEC"]