3f4912b · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

Add savepoint support

3f4912bJoey Adams13 years ago

src/Database/PostgreSQL/Simple.hs+1

compare with master

unifiedsplit

@@ -98,6 +98,7 @@ module Database.PostgreSQL.Simple

98-- , Base.insertID

99 -- * Transaction handling

100 , withTransaction

101+ , withSavepoint

101-- , Base.autocommit

102-- , Base.autocommit

102 , begin

103 , begin

103 , commit

104 , commit

src/Database/PostgreSQL/Simple/Transaction.hs+89−19

@@ -8,7 +8,6 @@ module Database.PostgreSQL.Simple.Transaction

8 , withTransactionMode

9 , withTransactionModeRetry

10 , withTransactionSerializable

11− , isSerializationError

12 , TransactionMode(..)

11 , TransactionMode(..)

13 , IsolationLevel(..)

12 , IsolationLevel(..)

14 , ReadWriteMode(..)

13 , ReadWriteMode(..)

@@ -21,13 +20,27 @@ module Database.PostgreSQL.Simple.Transaction

21 , beginMode

20 , beginMode

22 , commit

21 , commit

23 , rollback

22 , rollback

23+

24+ -- * Savepoint

25+ , withSavepoint

26+ , Savepoint

27+ , newSavepoint

28+ , releaseSavepoint

29+ , rollbackToSavepoint

30+ , rollbackToAndReleaseSavepoint

31+

32+ -- * Error predicates

33+ , isSerializationError

34+ , isNoActiveTransactionError

35+ , isFailedTransactionError

24 ) where

36 ) where

26−import Control.Exception hiding (mask)

38+import qualified Control.Exception as E

39+import Data.ByteString (ByteString)

27import qualified Data.ByteString as B

40import qualified Data.ByteString as B

28import Database.PostgreSQL.Simple.Internal

41import Database.PostgreSQL.Simple.Internal

29import Database.PostgreSQL.Simple.Types

42import Database.PostgreSQL.Simple.Types

30−import Database.PostgreSQL.Simple.Compat(mask)

43+import Database.PostgreSQL.Simple.Compat (mask, (<>))

33-- | Of the four isolation levels defined by the SQL standard,

46-- | Of the four isolation levels defined by the SQL standard,

@@ -85,6 +98,8 @@ defaultReadWriteMode = DefaultReadWriteMode

85-- If the action throws /any/ kind of exception (not just a

98-- If the action throws /any/ kind of exception (not just a

86-- PostgreSQL-related exception), the transaction will be rolled back using

99-- PostgreSQL-related exception), the transaction will be rolled back using

87-- 'rollback', then the exception will be rethrown.

100-- 'rollback', then the exception will be rethrown.

101+--

102+-- For nesting transactions, see 'withSavepoint'.

88withTransaction :: Connection -> IO a -> IO a

103withTransaction :: Connection -> IO a -> IO a

89withTransaction = withTransactionMode defaultTransactionMode

104withTransaction = withTransactionMode defaultTransactionMode

105

@@ -107,17 +122,6 @@ withTransactionSerializable =

107 }

122 }

108 isSerializationError

123 isSerializationError

109

124

110−

111−isSerializationError :: SqlError -> Bool

112−isSerializationError exception =

113− case exception of

114− SqlError{..} | sqlState == serialization_failure

115− -> True

116− _ -> False

117− where

118− -- http://www.postgresql.org/docs/current/static/errcodes-appendix.html

119− serialization_failure = "40001"

120−

121-- | Execute an action inside a SQL transaction with a given isolation level.

125-- | Execute an action inside a SQL transaction with a given isolation level.

122withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a

126withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a

123withTransactionLevel lvl

127withTransactionLevel lvl

@@ -128,7 +132,7 @@ withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a

128withTransactionMode mode conn act =

132withTransactionMode mode conn act =

129 mask $ \restore -> do

133 mask $ \restore -> do

130 beginMode mode conn

134 beginMode mode conn

131− r <- restore act `onException` rollback conn

135+ r <- restore act `E.onException` rollback conn

132 commit conn

136 commit conn

133 return r

137 return r

134

138

@@ -142,21 +146,21 @@ withTransactionMode mode conn act =

142withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

146withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

143withTransactionModeRetry mode shouldRetry conn act =

147withTransactionModeRetry mode shouldRetry conn act =

144 mask $ \restore ->

148 mask $ \restore ->

145− retryLoop $ try $ do

149+ retryLoop $ E.try $ do

146 a <- restore act

150 a <- restore act

147 commit conn

151 commit conn

148 return a

152 return a

149 where

153 where

150− retryLoop :: IO (Either SomeException a) -> IO a

154+ retryLoop :: IO (Either E.SomeException a) -> IO a

151 retryLoop act' = do

155 retryLoop act' = do

152 beginMode mode conn

156 beginMode mode conn

153 r <- act'

157 r <- act'

154 case r of

158 case r of

155 Left e -> do

159 Left e -> do

156 rollback conn

160 rollback conn

157− case fmap shouldRetry (fromException e) of

161+ case fmap shouldRetry (E.fromException e) of

158 Just True -> retryLoop act'

162 Just True -> retryLoop act'

159− _ -> throwIO e

163+ _ -> E.throwIO e

160 Right a ->

164 Right a ->

161 return a

165 return a

162

166

@@ -191,3 +195,69 @@ beginMode mode conn = do

191 DefaultReadWriteMode -> ""

195 DefaultReadWriteMode -> ""

192 ReadWrite -> " READ WRITE"

196 ReadWrite -> " READ WRITE"

193 ReadOnly -> " READ ONLY"

197 ReadOnly -> " READ ONLY"

198+

199+------------------------------------------------------------------------

200+-- Savepoint

201+

202+-- | Create a savepoint, and roll back to it if an error occurs. This may only

203+-- be used inside of a transaction, and provides a sort of

204+-- \"nested transaction\".

205+--

206+-- See <http://www.postgresql.org/docs/current/static/sql-savepoint.html>

207+withSavepoint :: Connection -> IO a -> IO a

208+withSavepoint conn body =

209+ mask $ \restore -> do

210+ sp <- newSavepoint conn

211+ r <- restore body `E.onException` rollbackToAndReleaseSavepoint conn sp

212+ releaseSavepoint conn sp `E.catch` \err ->

213+ if isFailedTransactionError err

214+ then rollbackToAndReleaseSavepoint conn sp

215+ else E.throwIO err

216+ return r

217+

218+-- | Create a new savepoint. This may only be used inside of a transaction.

219+newSavepoint :: Connection -> IO Savepoint

220+newSavepoint conn = do

221+ name <- newTempName conn

222+ _ <- execute_ conn ("SAVEPOINT " <> name)

223+ return (Savepoint name)

224+

225+-- | Destroy a savepoint, but retain its effects.

226+--

227+-- Warning: this will throw a 'SqlError' matching 'isFailedTransactionError' if

228+-- the transaction is aborted due to an error. 'commit' would merely warn and

229+-- roll back.

230+releaseSavepoint :: Connection -> Savepoint -> IO ()

231+releaseSavepoint conn (Savepoint name) =

232+ execute_ conn ("RELEASE SAVEPOINT " <> name) >> return ()

233+

234+-- | Roll back to a savepoint. This will not release the savepoint.

235+rollbackToSavepoint :: Connection -> Savepoint -> IO ()

236+rollbackToSavepoint conn (Savepoint name) =

237+ execute_ conn ("ROLLBACK TO SAVEPOINT " <> name) >> return ()

238+

239+-- | Roll back to a savepoint and release it. This is like calling

240+-- 'rollbackToSavepoint' followed by 'releaseSavepoint', but avoids a

241+-- round trip to the database server.

242+rollbackToAndReleaseSavepoint :: Connection -> Savepoint -> IO ()

243+rollbackToAndReleaseSavepoint conn (Savepoint name) =

244+ execute_ conn sql >> return ()

245+ where

246+ sql = "ROLLBACK TO SAVEPOINT " <> name <> "; RELEASE SAVEPOINT " <> name

247+

248+------------------------------------------------------------------------

249+-- Error predicates

250+--

251+-- http://www.postgresql.org/docs/current/static/errcodes-appendix.html

252+

253+isSerializationError :: SqlError -> Bool

254+isSerializationError = isSqlState "40001"

255+

256+isNoActiveTransactionError :: SqlError -> Bool

257+isNoActiveTransactionError = isSqlState "25P01"

258+

259+isFailedTransactionError :: SqlError -> Bool

260+isFailedTransactionError = isSqlState "25P02"

261+

262+isSqlState :: ByteString -> SqlError -> Bool

263+isSqlState s SqlError{..} = sqlState == s

src/Database/PostgreSQL/Simple/Types.hs+4

@@ -23,6 +23,7 @@ module Database.PostgreSQL.Simple.Types

23 , Query(..)

24 , Oid(..)

25 , (:.)(..)

26+ , Savepoint(..)

26 ) where

27 ) where

28import Blaze.ByteString.Builder (toByteString)

29import Blaze.ByteString.Builder (toByteString)

@@ -130,3 +131,6 @@ newtype Binary a = Binary a

130data h :. t = h :. t deriving (Eq,Ord,Show,Read,Typeable)

131data h :. t = h :. t deriving (Eq,Ord,Show,Read,Typeable)

131

132

132infixr 3 :.

133infixr 3 :.

134+

135+newtype Savepoint = Savepoint Query

136+ deriving (Eq, Ord, Show, Read, Typeable)