{-# 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 )
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"