Skip to content
This repository
Browse code

Tweak API of withTransactionSerializable

Namely, drop the ReadWriteMode argument, and add a more general
withTransactionModeRetry.
  • Loading branch information...
commit a27114081498f5c9e009cb78948e686419794242 1 parent 8342dcb
joeyadams authored August 21, 2012
57  src/Database/PostgreSQL/Simple.hs
@@ -106,6 +106,7 @@ module Database.PostgreSQL.Simple
106 106
     , defaultReadWriteMode
107 107
     , withTransactionLevel
108 108
     , withTransactionMode
  109
+    , withTransactionModeRetry
109 110
 --    , Base.autocommit
110 111
     , begin
111 112
     , beginLevel
@@ -649,19 +650,42 @@ withTransaction = withTransactionMode defaultTransactionMode
649 650
 -- serialization failure occurs, roll back the transaction and try again.
650 651
 -- Be warned that this may execute the IO action multiple times.
651 652
 --
652  
--- More precisely, if a 'SqlError' arises whose 'sqlState' is @\"40001\"@
653  
--- (@serialization_failure@), this will issue a @ROLLBACK@, then try the action
654  
--- again.  If any other exception arises, this will issue a @ROLLBACK@, but
655  
--- will propagate the exception instead of retrying.
656  
---
657 653
 -- A 'Serializable' transaction creates the illusion that your program has
658 654
 -- exclusive access to the database.  This means that, even in a concurrent
659 655
 -- setting, you can perform queries in sequence without having to worry about
660 656
 -- what might happen between one statement and the next.
661 657
 --
662 658
 -- Think of it as STM, but without @retry@.
663  
-withTransactionSerializable :: ReadWriteMode -> Connection -> IO a -> IO a
664  
-withTransactionSerializable readWriteMode conn act =
  659
+withTransactionSerializable :: Connection -> IO a -> IO a
  660
+withTransactionSerializable =
  661
+    withTransactionModeRetry
  662
+        TransactionMode
  663
+        { isolationLevel = Serializable
  664
+        , readWriteMode  = ReadWrite
  665
+        }
  666
+
  667
+-- | Execute an action inside a SQL transaction with a given isolation level.
  668
+withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a
  669
+withTransactionLevel lvl
  670
+    = withTransactionMode defaultTransactionMode { isolationLevel = lvl }
  671
+
  672
+-- | Execute an action inside a SQL transaction with a given transaction mode.
  673
+withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
  674
+withTransactionMode mode conn act =
  675
+  mask $ \restore -> do
  676
+    beginMode mode conn
  677
+    r <- restore act `onException` rollback conn
  678
+    commit conn
  679
+    return r
  680
+
  681
+-- | Like 'withTransactionMode', but if a 'SqlError' arises whose 'sqlState' is
  682
+-- @\"40001\"@ (@serialization_failure@), this will issue a @ROLLBACK@, then
  683
+-- try the action again.  If any other exception arises, this will issue a
  684
+-- @ROLLBACK@, but will propagate the exception instead of retrying.
  685
+--
  686
+-- This is used to implement 'withTransactionSerializable'.
  687
+withTransactionModeRetry :: TransactionMode -> Connection -> IO a -> IO a
  688
+withTransactionModeRetry mode conn act =
665 689
     mask $ \restore ->
666 690
         retryLoop $ try $ do
667 691
             a <- restore act
@@ -682,28 +706,9 @@ withTransactionSerializable readWriteMode conn act =
682 706
             Right a ->
683 707
                 return a
684 708
 
685  
-    mode = TransactionMode
686  
-        { isolationLevel = Serializable
687  
-        , readWriteMode
688  
-        }
689  
-
690 709
     -- http://www.postgresql.org/docs/current/static/errcodes-appendix.html
691 710
     serialization_failure = "40001"
692 711
 
693  
--- | Execute an action inside a SQL transaction with a given isolation level.
694  
-withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a
695  
-withTransactionLevel lvl
696  
-    = withTransactionMode defaultTransactionMode { isolationLevel = lvl }
697  
-
698  
--- | Execute an action inside a SQL transaction with a given transaction mode.
699  
-withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
700  
-withTransactionMode mode conn act =
701  
-  mask $ \restore -> do
702  
-    beginMode mode conn
703  
-    r <- restore act `onException` rollback conn
704  
-    commit conn
705  
-    return r
706  
-
707 712
 -- | Rollback a transaction.
708 713
 rollback :: Connection -> IO ()
709 714
 rollback conn = execute_ conn "ABORT" >> return ()
14  test/Serializable.hs
@@ -6,9 +6,6 @@ import Control.Concurrent
6 6
 import Control.Exception as E
7 7
 import Data.IORef
8 8
 
9  
-atomic :: Connection -> IO a -> IO a
10  
-atomic = withTransactionSerializable ReadWrite
11  
-
12 9
 initCounter :: Connection -> IO ()
13 10
 initCounter conn = do
14 11
     0 <- execute_ conn "DROP TABLE IF EXISTS testSerializableCounter;\
@@ -38,7 +35,7 @@ testSerializable TestEnv{..} =
38 35
         finished        <- newEmptyMVar
39 36
 
40 37
         _ <- forkIO $ do
41  
-            atomic conn2 $ do
  38
+            withTransactionSerializable conn2 $ do
42 39
                 modifyIORef attemptCounter (+1)
43 40
                 n <- getCounter conn2
44 41
                 True <- tryPutMVar readyToBother ()
@@ -47,7 +44,7 @@ testSerializable TestEnv{..} =
47 44
             putMVar finished ()
48 45
 
49 46
         takeMVar readyToBother
50  
-        atomic conn $ do
  47
+        withTransactionSerializable conn $ do
51 48
             n <- getCounter conn
52 49
             putCounter conn (n+1)
53 50
         True <- tryPutMVar bothered ()
@@ -57,9 +54,12 @@ testSerializable TestEnv{..} =
57 54
         ac <- readIORef attemptCounter
58 55
         assertEqual "attemptCounter" 2 ac
59 56
 
60  
-        ok <- E.catch (atomic conn (fail "Whoops") >> return False)
  57
+        ok <- E.catch (do withTransactionSerializable conn (fail "Whoops")
  58
+                          return False)
61 59
                       (\(_ :: IOException) -> return True)
62  
-        assertBool "Exceptions (besides serialization failure) should be propagated through atomic" ok
  60
+        assertBool "Exceptions (besides serialization failure) should be\
  61
+                   \ propagated through withTransactionSerializable"
  62
+                   ok
63 63
 
64 64
         -- Make sure transaction isn't dangling
65 65
         1 <- execute_ conn "UPDATE testSerializableCounter SET n=12345"

0 notes on commit a271140

Please sign in to comment.
Something went wrong with that request. Please try again.