797cc3a · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Use async exception mask in withTransaction

commit797cc3ad1ab7ec0c46ea021c7c8078e8523b542b authorJoey Adams <joeyadams3.14159@gmail.com> dateWed 7 Mar 2012, 23:21 (15 years ago) parentc576a8c

3 files changed+36−6

compare with master

unifiedsplit

postgresql-simple.cabal+3 src/Database/PostgreSQL/Simple.hs+8−6 src/Database/PostgreSQL/Simple/Compat.hs+25

postgresql-simple.cabal+3

@@ -31,6 +31,9 @@ Library

3131-- Other-modules:

3232 Database.PostgreSQL.Simple.Internal

3333

34+ Other-modules:

35+ Database.PostgreSQL.Simple.Compat

36+

3437 Build-depends:

3538 attoparsec >= 0.8.5.3,

3639 base < 5,

src/Database/PostgreSQL/Simple.hs+8−6

@@ -108,7 +108,7 @@ import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)

108108import Blaze.ByteString.Builder.Char8 (fromChar)

109109import Control.Applicative ((<$>), pure)

110110import Control.Concurrent.MVar

111−import Control.Exception (Exception, bracket, onException, throw, throwIO, finally)

111+import Control.Exception (Exception, onException, throw, throwIO, finally)

112112import Control.Monad (foldM)

113113import Control.Monad.Fix (fix)

114114import Data.ByteString (ByteString)

@@ -119,6 +119,7 @@ import Data.List (intersperse)

119119import Data.Monoid (mappend, mconcat)

120120import Data.Typeable (Typeable)

121121import Database.PostgreSQL.Simple.BuiltinTypes (oid2builtin, builtin2typname)

122+import Database.PostgreSQL.Simple.Compat (mask)

122123import Database.PostgreSQL.Simple.Param (Action(..), inQuotes)

123124import Database.PostgreSQL.Simple.QueryParams (QueryParams(..))

124125import Database.PostgreSQL.Simple.Result (ResultError(..))

@@ -532,11 +533,12 @@ withTransactionLevel lvl

532533

533534-- | Execute an action inside a SQL transaction with a given transaction mode.

534535withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a

535−withTransactionMode mode conn act = do

536− beginMode mode conn

537− r <- act `onException` rollback conn

538− commit conn

539− return r

536+withTransactionMode mode conn act =

537+ mask $ \restore -> do

538+ beginMode mode conn

539+ r <- restore act `onException` rollback conn

540+ commit conn

541+ return r

540542

541543-- | Rollback a transaction.

542544rollback :: Connection -> IO ()

src/Database/PostgreSQL/Simple/Compat.hsnew file+25

@@ -0,0 +1,25 @@

1+{-# LANGUAGE CPP #-}

2+-- | This is a module of its own, because it uses the CPP extension, which

3+-- doesn't play well with the regex string literal in Simple.hs .

4+module Database.PostgreSQL.Simple.Compat

5+ ( mask

6+ ) where

8+import qualified Control.Exception as E

10+-- | Like 'E.mask', but backported to base before version 4.3.0.

11+--

12+-- Note that the restore callback is monomorphic, unlike in 'E.mask'. This

13+-- could be fixed by changing the type signature, but it would require us to

14+-- enable the RankNTypes extension (since 'E.mask' has a rank-3 type). The

15+-- 'withTransactionMode' function calls the restore callback only once, so we

16+-- don't need that polymorphism.

17+mask :: ((IO a -> IO a) -> IO b) -> IO b

18+#if MIN_VERSION_base(4,3,0)

19+mask io = E.mask $ \restore -> io restore

20+#else

21+mask io = do

22+ b <- E.blocked

23+ E.block $ io $ \m -> if b then m else E.unblock m

24+#endif

25+{-# INLINE mask #-}