add pgWithTransactionMode and friends

Author: s9gf4ult

Diff for: src/Database/PostgreSQL/Query/Functions.hs

@@ -6,6 +6,9 @@ module Database.PostgreSQL.Query.Functions
          -- * Transactions
        , pgWithTransaction
        , pgWithSavepoint
+       , pgWithTransactionMode
+       , pgWithTransactionModeRetry
+       , pgWithTransactionSerializable
          -- * Work with entities
        , pgInsertEntity
        , pgInsertManyEntities
@@ -49,12 +52,14 @@ import Database.PostgreSQL.Query.Types
     ( FN, HasPostgres(..), TransactionSafe,
       ToMarkedRow(..), MarkedRow(..), mrToBuilder )
 import Database.PostgreSQL.Simple
-    ( ToRow, FromRow, execute_, query_,
-      withTransaction, withSavepoint )
+    ( ToRow, FromRow, execute_, query_, )
 import Database.PostgreSQL.Simple.FromField
     ( FromField )
+import Database.PostgreSQL.Simple.Internal
+    ( SqlError )
 import Database.PostgreSQL.Simple.ToField
     ( ToField )
+import Database.PostgreSQL.Simple.Transaction
 import Database.PostgreSQL.Simple.Types
     ( Query(..), Only(..), (:.)(..) )
 
@@ -76,6 +81,48 @@ pgWithSavepoint action = withPGConnection $ \con -> do
     control $ \runInIO -> do
         withSavepoint con $ runInIO action
 
+-- | Wrapper for 'withTransactionMode': Execute an action inside a SQL
+-- transaction with a given transaction mode.
+pgWithTransactionMode :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)
+                       => TransactionMode
+                       -> m a
+                       -> m a
+pgWithTransactionMode tmode ma = withPGConnection $ \con -> do
+    control $ \runInIO -> do
+        withTransactionMode tmode con $ runInIO ma
+
+-- | Wrapper for 'withTransactionModeRetry': Like 'pgWithTransactionMode',
+-- but also takes a custom callback to determine if a transaction
+-- should be retried if an SqlError occurs. If the callback returns
+-- True, then the transaction will be retried. If the callback returns
+-- False, or an exception other than an SqlError occurs then the
+-- transaction will be rolled back and the exception rethrown.
+pgWithTransactionModeRetry :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)
+                           => TransactionMode
+                           -> (SqlError -> Bool)
+                           -> m a
+                           -> m a
+pgWithTransactionModeRetry tmode epred ma = withPGConnection $ \con -> do
+    control $ \runInIO -> do
+        withTransactionModeRetry tmode epred con $ runInIO ma
+
+-- | Wrapper for 'withTransactionSerializable': Execute an action
+-- inside of a 'Serializable' transaction. If a serialization failure
+-- occurs, roll back the transaction and try again. Be warned that
+-- this may execute the IO action multiple times.
+--
+-- A Serializable transaction creates the illusion that your program
+-- has exclusive access to the database. This means that, even in a
+-- concurrent setting, you can perform queries in sequence without
+-- having to worry about what might happen between one statement and
+-- the next.
+pgWithTransactionSerializable :: (HasPostgres m, MonadBaseControl IO m, TransactionSafe m)
+                              => m a
+                              -> m a
+pgWithTransactionSerializable ma = withPGConnection $ \con -> do
+    control $ \runInIO -> do
+        withTransactionSerializable con $ runInIO ma
+
 {- | Execute query generated by 'SqlBuilder'. Typical use case:
 
 @