Permalink
Browse files

Tweak API of withTransactionSerializable

Namely, drop the ReadWriteMode argument, and add a more general
withTransactionModeRetry.
  • Loading branch information...
1 parent 8342dcb commit a27114081498f5c9e009cb78948e686419794242 @joeyadams joeyadams committed Aug 22, 2012
Showing with 38 additions and 33 deletions.
  1. +31 −26 src/Database/PostgreSQL/Simple.hs
  2. +7 −7 test/Serializable.hs
@@ -106,6 +106,7 @@ module Database.PostgreSQL.Simple
, defaultReadWriteMode
, withTransactionLevel
, withTransactionMode
+ , withTransactionModeRetry
-- , Base.autocommit
, begin
, beginLevel
@@ -649,19 +650,42 @@ withTransaction = withTransactionMode defaultTransactionMode
-- serialization failure occurs, roll back the transaction and try again.
-- Be warned that this may execute the IO action multiple times.
--
--- More precisely, if a 'SqlError' arises whose 'sqlState' is @\"40001\"@
--- (@serialization_failure@), this will issue a @ROLLBACK@, then try the action
--- again. If any other exception arises, this will issue a @ROLLBACK@, but
--- will propagate the exception instead of retrying.
---
-- 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.
--
-- Think of it as STM, but without @retry@.
-withTransactionSerializable :: ReadWriteMode -> Connection -> IO a -> IO a
-withTransactionSerializable readWriteMode conn act =
+withTransactionSerializable :: Connection -> IO a -> IO a
+withTransactionSerializable =
+ withTransactionModeRetry
+ TransactionMode
+ { isolationLevel = Serializable
+ , readWriteMode = ReadWrite
+ }
+
+-- | Execute an action inside a SQL transaction with a given isolation level.
+withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a
+withTransactionLevel lvl
+ = withTransactionMode defaultTransactionMode { isolationLevel = lvl }
+
+-- | Execute an action inside a SQL transaction with a given transaction mode.
+withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
+withTransactionMode mode conn act =
+ mask $ \restore -> do
+ beginMode mode conn
+ r <- restore act `onException` rollback conn
+ commit conn
+ return r
+
+-- | Like 'withTransactionMode', but if a 'SqlError' arises whose 'sqlState' is
+-- @\"40001\"@ (@serialization_failure@), this will issue a @ROLLBACK@, then
+-- try the action again. If any other exception arises, this will issue a
+-- @ROLLBACK@, but will propagate the exception instead of retrying.
+--
+-- This is used to implement 'withTransactionSerializable'.
+withTransactionModeRetry :: TransactionMode -> Connection -> IO a -> IO a
+withTransactionModeRetry mode conn act =
mask $ \restore ->
retryLoop $ try $ do
a <- restore act
@@ -682,28 +706,9 @@ withTransactionSerializable readWriteMode conn act =
Right a ->
return a
- mode = TransactionMode
- { isolationLevel = Serializable
- , readWriteMode
- }
-
-- http://www.postgresql.org/docs/current/static/errcodes-appendix.html
serialization_failure = "40001"
--- | Execute an action inside a SQL transaction with a given isolation level.
-withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a
-withTransactionLevel lvl
- = withTransactionMode defaultTransactionMode { isolationLevel = lvl }
-
--- | Execute an action inside a SQL transaction with a given transaction mode.
-withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
-withTransactionMode mode conn act =
- mask $ \restore -> do
- beginMode mode conn
- r <- restore act `onException` rollback conn
- commit conn
- return r
-
-- | Rollback a transaction.
rollback :: Connection -> IO ()
rollback conn = execute_ conn "ABORT" >> return ()
View
@@ -6,9 +6,6 @@ import Control.Concurrent
import Control.Exception as E
import Data.IORef
-atomic :: Connection -> IO a -> IO a
-atomic = withTransactionSerializable ReadWrite
-
initCounter :: Connection -> IO ()
initCounter conn = do
0 <- execute_ conn "DROP TABLE IF EXISTS testSerializableCounter;\
@@ -38,7 +35,7 @@ testSerializable TestEnv{..} =
finished <- newEmptyMVar
_ <- forkIO $ do
- atomic conn2 $ do
+ withTransactionSerializable conn2 $ do
modifyIORef attemptCounter (+1)
n <- getCounter conn2
True <- tryPutMVar readyToBother ()
@@ -47,7 +44,7 @@ testSerializable TestEnv{..} =
putMVar finished ()
takeMVar readyToBother
- atomic conn $ do
+ withTransactionSerializable conn $ do
n <- getCounter conn
putCounter conn (n+1)
True <- tryPutMVar bothered ()
@@ -57,9 +54,12 @@ testSerializable TestEnv{..} =
ac <- readIORef attemptCounter
assertEqual "attemptCounter" 2 ac
- ok <- E.catch (atomic conn (fail "Whoops") >> return False)
+ ok <- E.catch (do withTransactionSerializable conn (fail "Whoops")
+ return False)
(\(_ :: IOException) -> return True)
- assertBool "Exceptions (besides serialization failure) should be propagated through atomic" ok
+ assertBool "Exceptions (besides serialization failure) should be\
+ \ propagated through withTransactionSerializable"
+ ok
-- Make sure transaction isn't dangling
1 <- execute_ conn "UPDATE testSerializableCounter SET n=12345"

0 comments on commit a271140

Please sign in to comment.