{-# 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
    BoltActionT m ()
forall (m :: * -> *). MonadIO m => BoltActionT m ()
txBegin
    let processErrors :: BoltActionT m a -> BoltActionT m a
processErrors = (BoltActionT m a
 -> (BoltError -> BoltActionT m a) -> BoltActionT m a)
-> (BoltError -> BoltActionT m a)
-> BoltActionT m a
-> BoltActionT m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip BoltActionT m a
-> (BoltError -> BoltActionT m a) -> BoltActionT m a
forall a.
BoltActionT m a
-> (BoltError -> BoltActionT m a) -> BoltActionT m a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError ((BoltError -> BoltActionT m a)
 -> BoltActionT m a -> BoltActionT m a)
-> (BoltError -> BoltActionT m a)
-> BoltActionT m a
-> BoltActionT m a
forall a b. (a -> b) -> a -> b
$ \BoltError
e -> BoltActionT m ()
forall (m :: * -> *). MonadIO m => BoltActionT m ()
txRollback BoltActionT m () -> BoltActionT m a -> BoltActionT m a
forall a b. BoltActionT m a -> BoltActionT m b -> BoltActionT m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BoltError -> BoltActionT m a
forall a. BoltError -> BoltActionT m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError BoltError
e
    a
result <- BoltActionT m a -> BoltActionT m a
forall {a}. BoltActionT m a -> BoltActionT m a
processErrors BoltActionT m a
actions
    BoltActionT m ()
forall (m :: * -> *). MonadIO m => BoltActionT m ()
txCommit
    a -> BoltActionT m a
forall a. a -> BoltActionT m a
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 <- BoltActionT m Pipe
forall r (m :: * -> *). MonadReader r m => m r
ask
  if Word32 -> Bool
isNewVersion (Word32 -> Bool) -> Word32 -> Bool
forall a b. (a -> b) -> a -> b
$ Pipe -> Word32
pipe_version Pipe
pipe
     then BoltActionT m Response -> BoltActionT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BoltActionT m Response -> BoltActionT m ())
-> BoltActionT m Response -> BoltActionT m ()
forall a b. (a -> b) -> a -> b
$ Request -> BoltActionT m Response
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Request -> BoltActionT m Response
sendRawRequest (Request -> BoltActionT m Response)
-> Request -> BoltActionT m Response
forall a b. (a -> b) -> a -> b
$ Map Text Value -> Request
RequestBegin Map Text Value
forall a. Monoid a => a
mempty
     else BoltActionT m [Map Text Value] -> BoltActionT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BoltActionT m [Map Text Value] -> BoltActionT m ())
-> BoltActionT m [Map Text Value] -> BoltActionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> BoltActionT m [Map Text Value]
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 <- BoltActionT m Pipe
forall r (m :: * -> *). MonadReader r m => m r
ask
  if Word32 -> Bool
isNewVersion (Word32 -> Bool) -> Word32 -> Bool
forall a b. (a -> b) -> a -> b
$ Pipe -> Word32
pipe_version Pipe
pipe
     then BoltActionT m Response -> BoltActionT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BoltActionT m Response -> BoltActionT m ())
-> BoltActionT m Response -> BoltActionT m ()
forall a b. (a -> b) -> a -> b
$ Request -> BoltActionT m Response
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Request -> BoltActionT m Response
sendRawRequest Request
RequestCommit
     else BoltActionT m [Map Text Value] -> BoltActionT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BoltActionT m [Map Text Value] -> BoltActionT m ())
-> BoltActionT m [Map Text Value] -> BoltActionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> BoltActionT m [Map Text Value]
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 <- BoltActionT m Pipe
forall r (m :: * -> *). MonadReader r m => m r
ask
  if Word32 -> Bool
isNewVersion (Word32 -> Bool) -> Word32 -> Bool
forall a b. (a -> b) -> a -> b
$ Pipe -> Word32
pipe_version Pipe
pipe
     then BoltActionT m Response -> BoltActionT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BoltActionT m Response -> BoltActionT m ())
-> BoltActionT m Response -> BoltActionT m ()
forall a b. (a -> b) -> a -> b
$ Request -> BoltActionT m Response
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Request -> BoltActionT m Response
sendRawRequest Request
RequestRollback
     else BoltActionT m [Map Text Value] -> BoltActionT m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (BoltActionT m [Map Text Value] -> BoltActionT m ())
-> BoltActionT m [Map Text Value] -> BoltActionT m ()
forall a b. (a -> b) -> a -> b
$ Text -> BoltActionT m [Map Text Value]
forall (m :: * -> *).
(MonadIO m, HasCallStack) =>
Text -> BoltActionT m [Map Text Value]
query' Text
"ROLLBACK"