797cc3a · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Use async exception mask in withTransaction

797cc3aJoey Adams15 years ago

postgresql-simple.cabal+3

compare with master

unifiedsplit

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

31-- Other-modules:

32 Database.PostgreSQL.Simple.Internal

34+ Other-modules:

35+ Database.PostgreSQL.Simple.Compat

36+

34 Build-depends:

37 Build-depends:

35 attoparsec >= 0.8.5.3,

38 attoparsec >= 0.8.5.3,

36 base < 5,

39 base < 5,

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

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

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

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

110import Control.Concurrent.MVar

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

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

112import Control.Monad (foldM)

113import Control.Monad.Fix (fix)

114import Data.ByteString (ByteString)

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

119import Data.Monoid (mappend, mconcat)

120import Data.Typeable (Typeable)

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

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

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

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

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

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

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

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

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

532

533

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

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

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

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

535−withTransactionMode mode conn act = do

536+withTransactionMode mode conn act =

537+ mask $ \restore -> do

536− beginMode mode conn

538+ beginMode mode conn

537− r <- act `onException` rollback conn

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

538− commit conn

540+ commit conn

539− return r

541+ return r

540

542

541-- | Rollback a transaction.

543-- | Rollback a transaction.

542rollback :: Connection -> IO ()

544rollback :: 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 #-}