{-# LANGUAGE OverloadedStrings #-}
module Database.Bolt.Transaction
  ( transact
  ) where

import           Control.Monad                  ( void )
import           Control.Monad.Reader           ( ask )
import           Control.Monad.Trans            ( MonadIO(..) )
import           Control.Monad.Except           ( MonadError(..) )

import           Database.Bolt.Connection       ( BoltActionT
                                                , query', sendRawRequest
                                                )
import           Database.Bolt.Connection.Type  ( Request(..)
                                                , pipe_version
                                                )
import           Database.Bolt.Value.Helpers    ( isNewVersion )

-- |Runs a sequence of actions as transaction. All queries would be rolled back
-- in case of any exception inside the block.
transact :: MonadIO m => BoltActionT m a -> BoltActionT m a
transact :: forall (m :: * -> *) a.
MonadIO m =>
BoltActionT m a -> BoltActionT m a
transact BoltActionT m a
actions = do
    forall (m :: * -> *). MonadIO m => BoltActionT m ()
txBegin
    let processErrors :: BoltActionT m a -> BoltActionT m a
processErrors = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError forall a b. (a -> b) -> a -> b
$ \BoltError
e -> forall (m :: * -> *). MonadIO m => BoltActionT m ()
txRollback forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError BoltError
e
    a
result <- forall {a}. BoltActionT m a -> BoltActionT m a
processErrors BoltActionT m a
actions
    forall (m :: * -> *). MonadIO m => BoltActionT m ()
txCommit
    forall (f :: * -> *) a. Applicative f => a -> f a
pure a
result

txBegin :: MonadIO m => BoltActionT m ()
txBegin :: forall (m :: * -> *). MonadIO m => BoltActionT m ()
txBegin = do
  Pipe
pipe <- forall r (m :: * -> *). MonadReader r m => m r
ask
  if Word32 -> Bool
isNewVersion forall a b. (a -> b) -> a -> b
$ Pipe -> Word32
pipe_version Pipe
pipe
     then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Request -> BoltActionT m Response
sendRawRequest forall a b. (a -> b) -> a -> b
$ Map Text Value -> Request
RequestBegin forall a. Monoid a => a
mempty
     else forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> BoltActionT m [Map Text Value]
query' Text
"BEGIN"

txCommit :: MonadIO m => BoltActionT m ()
txCommit :: forall (m :: * -> *). MonadIO m => BoltActionT m ()
txCommit = do
  Pipe
pipe <- forall r (m :: * -> *). MonadReader r m => m r
ask
  if Word32 -> Bool
isNewVersion forall a b. (a -> b) -> a -> b
$ Pipe -> Word32
pipe_version Pipe
pipe
     then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Request -> BoltActionT m Response
sendRawRequest Request
RequestCommit
     else forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> BoltActionT m [Map Text Value]
query' Text
"COMMIT"

txRollback :: MonadIO m => BoltActionT m ()
txRollback :: forall (m :: * -> *). MonadIO m => BoltActionT m ()
txRollback = do
  Pipe
pipe <- forall r (m :: * -> *). MonadReader r m => m r
ask
  if Word32 -> Bool
isNewVersion forall a b. (a -> b) -> a -> b
$ Pipe -> Word32
pipe_version Pipe
pipe
     then forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Request -> BoltActionT m Response
sendRawRequest Request
RequestRollback
     else forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> BoltActionT m [Map Text Value]
query' Text
"ROLLBACK"