fdf85c4 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

Merge pull request #13 from joeyadams/master

Use exception mask in withTransactionMode, and compile with -Wall

commitfdf85c4c046a3e6c53dda616c008b1c5ef40c533 authorLeon P Smith <leon.p.smith+github@gmail.com> dateThu 8 Mar 2012, 11:41 (15 years ago) parentc576a8c 8fa277a

8 files changed+51−17

compare with master

unifiedsplit

postgresql-simple.cabal+5 src/Database/PostgreSQL/Simple.hs+13−9 src/Database/PostgreSQL/Simple/Compat.hs+25 src/Database/PostgreSQL/Simple/Internal.hs+1 src/Database/PostgreSQL/Simple/LargeObjects.hs−1 src/Database/PostgreSQL/Simple/Notification.hs+1 src/Database/PostgreSQL/Simple/QueryResults.hs+2−2 src/Database/PostgreSQL/Simple/Result.hs+4−5

postgresql-simple.cabal+5

@@ -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,

@@ -46,6 +49,8 @@ Library

4649 text >= 0.11.1,

4750 time

4851

52+ ghc-options: -Wall -fno-warn-name-shadowing

53+

4954source-repository head

5055 type: git

5156 location: http://github.com/lpsmith/postgresql-simple

src/Database/PostgreSQL/Simple.hs+13−9

@@ -108,9 +108,8 @@ 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)

113−import Control.Monad.Fix (fix)

114113import Data.ByteString (ByteString)

115114import Data.Char(ord)

116115import Data.Int (Int64)

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

119118import Data.Monoid (mappend, mconcat)

120119import Data.Typeable (Typeable)

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

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

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

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

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

@@ -194,6 +194,7 @@ formatMany conn q@(Query template) qs = do

194194 \([^?]*)$"

195195 [caseless]

196196

197+escapeStringConn :: Connection -> ByteString -> IO (Maybe ByteString)

197198escapeStringConn conn s = withConnection conn $ \c -> do

198199 PQ.escapeStringConn c s

199200

@@ -241,7 +242,7 @@ executeMany conn q qs = do

241242 finishExecute conn q result

242243

243244finishExecute :: Connection -> Query -> PQ.Result -> IO Int64

244−finishExecute conn q result = do

245+finishExecute _conn q result = do

245246 status <- PQ.resultStatus result

246247 case status of

247248 PQ.CommandOk -> do

@@ -343,6 +344,7 @@ data FoldOptions

343344 transactionMode :: !TransactionMode

344345 }

345346

347+defaultFoldOptions :: FoldOptions

346348defaultFoldOptions = FoldOptions {

347349 fetchQuantity = Automatic,

348350 transactionMode = TransactionMode ReadCommitted ReadOnly

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

532534

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

534536withTransactionMode :: 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

537+withTransactionMode mode conn act =

538+ mask $ \restore -> do

539+ beginMode mode conn

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

541+ commit conn

542+ return r

540543

541544-- | Rollback a transaction.

542545rollback :: Connection -> IO ()

@@ -557,7 +560,8 @@ beginLevel lvl = beginMode defaultTransactionMode { isolationLevel = lvl }

557560-- | Begin a transaction with a given transaction mode

558561beginMode :: TransactionMode -> Connection -> IO ()

559562beginMode mode conn = do

560− execute_ conn $! case mode of

563+ _ <- execute_ conn $!

564+ case mode of

561565 TransactionMode ReadCommitted ReadWrite ->

562566 "BEGIN"

563567 TransactionMode ReadCommitted ReadOnly ->

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 #-}

src/Database/PostgreSQL/Simple/Internal.hs+1

@@ -195,6 +195,7 @@ exec conn sql =

195195 Just res -> do

196196 return res

197197

198+disconnectedError :: SqlError

198199disconnectedError = SqlError {

199200 sqlNativeError = -1,

200201 sqlErrorMsg = "connection disconnected",

src/Database/PostgreSQL/Simple/LargeObjects.hs−1

@@ -36,7 +36,6 @@ import qualified Data.ByteString as B

3636import Database.PostgreSQL.LibPQ (Oid(..),LoFd(..))

3737import qualified Database.PostgreSQL.LibPQ as PQ

3838import Database.PostgreSQL.Simple.Internal

39−import Foreign.C.Types (CInt)

4039import System.IO (IOMode(..),SeekMode(..))

4140

4241liftPQ :: B.ByteString -> Connection -> (PQ.Connection -> IO (Maybe a)) -> IO a

src/Database/PostgreSQL/Simple/Notification.hs+1

@@ -29,6 +29,7 @@ data Notification = Notification

2929 , notificationData :: B.ByteString

3030 }

3131

32+errfd :: String

3233errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \

3334 \failed to fetch file descriptor"

3435

src/Database/PostgreSQL/Simple/QueryResults.hs+2−2

@@ -24,14 +24,13 @@ module Database.PostgreSQL.Simple.QueryResults

2424 ) where

2525

2626import Control.Applicative (Applicative(..), (<$>))

27−import Control.Exception (SomeException(..), throw)

27+import Control.Exception (SomeException(..))

2828import Data.ByteString (ByteString)

2929import qualified Data.ByteString.Char8 as B

3030import Data.Either()

3131import Database.PostgreSQL.Simple.Internal

3232import Database.PostgreSQL.Simple.Result (ResultError(..), Result(..))

3333import Database.PostgreSQL.Simple.Types (Only(..))

34−import qualified Database.PostgreSQL.LibPQ as LibPQ (Result)

3534

3635-- | A collection type that can be converted from a list of strings.

3736--

@@ -212,6 +211,7 @@ instance (Result a, Result b, Result c, Result d, Result e, Result f,

212211 return (a,b,c,d,e,f,g,h,i,j)

213212 convertResults fs vs = convertError fs vs 10

214213

214+(<$!>) :: Functor f => (a -> b) -> f a -> f b

215215f <$!> (!x) = f <$> x

216216infixl 4 <$!>

217217

src/Database/PostgreSQL/Simple/Result.hs+4−5

@@ -32,7 +32,7 @@ module Database.PostgreSQL.Simple.Result

3232#include "MachDeps.h"

3333

3434import Control.Applicative (Applicative, (<$>), (<*>), (<*), pure)

35−import Control.Exception (SomeException(..), Exception, throw)

35+import Control.Exception (SomeException(..), Exception)

3636import Data.Attoparsec.Char8 hiding (Result)

3737import Data.Bits ((.&.), (.|.), shiftL)

3838import Data.ByteString (ByteString)

@@ -44,10 +44,9 @@ import Data.Time.Calendar (Day, fromGregorian)

4444import Data.Time.Clock (UTCTime)

4545import Data.Time.Format (parseTime)

4646import Data.Time.LocalTime (TimeOfDay, makeTimeOfDayValid)

47−import Data.Typeable (TypeRep, Typeable, typeOf)

47+import Data.Typeable (Typeable, typeOf)

4848import Data.Word (Word64)

4949import Database.PostgreSQL.Simple.Internal

50−import Database.PostgreSQL.Simple.Field (Field(..), RawResult(..))

5150import Database.PostgreSQL.Simple.BuiltinTypes

5251import Database.PostgreSQL.Simple.Types (Binary(..), Null(..))

5352import qualified Database.PostgreSQL.LibPQ as PQ

@@ -58,7 +57,6 @@ import qualified Data.ByteString.Char8 as B8

5857import qualified Data.ByteString.Lazy as LB

5958import qualified Data.Text as ST

6059import qualified Data.Text.Encoding as ST

61−import qualified Data.Text.Encoding.Error (UnicodeException)

6260import qualified Data.Text.Lazy as LT

6361

6462-- | Exception thrown if conversion from a SQL value to a Haskell

@@ -140,6 +138,7 @@ instance Result (Ratio Integer) where

140138 convert = atto ok rational

141139 where ok = mkCompats [Float4,Float8,Int2,Int4,Numeric]

142140

141+unBinary :: Binary t -> t

143142unBinary (Binary x) = x

144143

145144instance Result SB.ByteString where

@@ -228,7 +227,7 @@ mkCompat = Compat . shiftL 1 . fromEnum

228227compat :: Compat -> Compat -> Bool

229228compat (Compat a) (Compat b) = a .&. b /= 0

230229

231−okText, okText', ok16, ok32, ok64 :: Compat

230+okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat

232231okText = mkCompats [Name,Text,Char,Bpchar,Varchar]

233232okText' = mkCompats [Name,Text,Char,Bpchar,Varchar,Unknown]

234233okBinary = mkCompats [Bytea]