Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP

Comparing changes

Choose two branches to see what's changed or to start a new pull request. If you need to, you can also compare across forks.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also compare across forks.
...
Checking mergeability… Don't worry, you can still create the pull request.
  • 3 commits
  • 8 files changed
  • 0 commit comments
  • 2 contributors
View
5 postgresql-simple.cabal
@@ -31,6 +31,9 @@ Library
-- Other-modules:
Database.PostgreSQL.Simple.Internal
+ Other-modules:
+ Database.PostgreSQL.Simple.Compat
+
Build-depends:
attoparsec >= 0.8.5.3,
base < 5,
@@ -46,6 +49,8 @@ Library
text >= 0.11.1,
time
+ ghc-options: -Wall -fno-warn-name-shadowing
+
source-repository head
type: git
location: http://github.com/lpsmith/postgresql-simple
View
22 src/Database/PostgreSQL/Simple.hs
@@ -108,9 +108,8 @@ import Blaze.ByteString.Builder (Builder, fromByteString, toByteString)
import Blaze.ByteString.Builder.Char8 (fromChar)
import Control.Applicative ((<$>), pure)
import Control.Concurrent.MVar
-import Control.Exception (Exception, bracket, onException, throw, throwIO, finally)
+import Control.Exception (Exception, onException, throw, throwIO, finally)
import Control.Monad (foldM)
-import Control.Monad.Fix (fix)
import Data.ByteString (ByteString)
import Data.Char(ord)
import Data.Int (Int64)
@@ -119,6 +118,7 @@ import Data.List (intersperse)
import Data.Monoid (mappend, mconcat)
import Data.Typeable (Typeable)
import Database.PostgreSQL.Simple.BuiltinTypes (oid2builtin, builtin2typname)
+import Database.PostgreSQL.Simple.Compat (mask)
import Database.PostgreSQL.Simple.Param (Action(..), inQuotes)
import Database.PostgreSQL.Simple.QueryParams (QueryParams(..))
import Database.PostgreSQL.Simple.Result (ResultError(..))
@@ -194,6 +194,7 @@ formatMany conn q@(Query template) qs = do
\([^?]*)$"
[caseless]
+escapeStringConn :: Connection -> ByteString -> IO (Maybe ByteString)
escapeStringConn conn s = withConnection conn $ \c -> do
PQ.escapeStringConn c s
@@ -241,7 +242,7 @@ executeMany conn q qs = do
finishExecute conn q result
finishExecute :: Connection -> Query -> PQ.Result -> IO Int64
-finishExecute conn q result = do
+finishExecute _conn q result = do
status <- PQ.resultStatus result
case status of
PQ.CommandOk -> do
@@ -343,6 +344,7 @@ data FoldOptions
transactionMode :: !TransactionMode
}
+defaultFoldOptions :: FoldOptions
defaultFoldOptions = FoldOptions {
fetchQuantity = Automatic,
transactionMode = TransactionMode ReadCommitted ReadOnly
@@ -532,11 +534,12 @@ withTransactionLevel lvl
-- | Execute an action inside a SQL transaction with a given transaction mode.
withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
-withTransactionMode mode conn act = do
- beginMode mode conn
- r <- act `onException` rollback conn
- commit conn
- return r
+withTransactionMode mode conn act =
+ mask $ \restore -> do
+ beginMode mode conn
+ r <- restore act `onException` rollback conn
+ commit conn
+ return r
-- | Rollback a transaction.
rollback :: Connection -> IO ()
@@ -557,7 +560,8 @@ beginLevel lvl = beginMode defaultTransactionMode { isolationLevel = lvl }
-- | Begin a transaction with a given transaction mode
beginMode :: TransactionMode -> Connection -> IO ()
beginMode mode conn = do
- execute_ conn $! case mode of
+ _ <- execute_ conn $!
+ case mode of
TransactionMode ReadCommitted ReadWrite ->
"BEGIN"
TransactionMode ReadCommitted ReadOnly ->
View
25 src/Database/PostgreSQL/Simple/Compat.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE CPP #-}
+-- | This is a module of its own, because it uses the CPP extension, which
+-- doesn't play well with the regex string literal in Simple.hs .
+module Database.PostgreSQL.Simple.Compat
+ ( mask
+ ) where
+
+import qualified Control.Exception as E
+
+-- | Like 'E.mask', but backported to base before version 4.3.0.
+--
+-- Note that the restore callback is monomorphic, unlike in 'E.mask'. This
+-- could be fixed by changing the type signature, but it would require us to
+-- enable the RankNTypes extension (since 'E.mask' has a rank-3 type). The
+-- 'withTransactionMode' function calls the restore callback only once, so we
+-- don't need that polymorphism.
+mask :: ((IO a -> IO a) -> IO b) -> IO b
+#if MIN_VERSION_base(4,3,0)
+mask io = E.mask $ \restore -> io restore
+#else
+mask io = do
+ b <- E.blocked
+ E.block $ io $ \m -> if b then m else E.unblock m
+#endif
+{-# INLINE mask #-}
View
1  src/Database/PostgreSQL/Simple/Internal.hs
@@ -195,6 +195,7 @@ exec conn sql =
Just res -> do
return res
+disconnectedError :: SqlError
disconnectedError = SqlError {
sqlNativeError = -1,
sqlErrorMsg = "connection disconnected",
View
1  src/Database/PostgreSQL/Simple/LargeObjects.hs
@@ -36,7 +36,6 @@ import qualified Data.ByteString as B
import Database.PostgreSQL.LibPQ (Oid(..),LoFd(..))
import qualified Database.PostgreSQL.LibPQ as PQ
import Database.PostgreSQL.Simple.Internal
-import Foreign.C.Types (CInt)
import System.IO (IOMode(..),SeekMode(..))
liftPQ :: B.ByteString -> Connection -> (PQ.Connection -> IO (Maybe a)) -> IO a
View
1  src/Database/PostgreSQL/Simple/Notification.hs
@@ -29,6 +29,7 @@ data Notification = Notification
, notificationData :: B.ByteString
}
+errfd :: String
errfd = "Database.PostgreSQL.Simple.Notification.getNotification: \
\failed to fetch file descriptor"
View
4 src/Database/PostgreSQL/Simple/QueryResults.hs
@@ -24,14 +24,13 @@ module Database.PostgreSQL.Simple.QueryResults
) where
import Control.Applicative (Applicative(..), (<$>))
-import Control.Exception (SomeException(..), throw)
+import Control.Exception (SomeException(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Either()
import Database.PostgreSQL.Simple.Internal
import Database.PostgreSQL.Simple.Result (ResultError(..), Result(..))
import Database.PostgreSQL.Simple.Types (Only(..))
-import qualified Database.PostgreSQL.LibPQ as LibPQ (Result)
-- | A collection type that can be converted from a list of strings.
--
@@ -212,6 +211,7 @@ instance (Result a, Result b, Result c, Result d, Result e, Result f,
return (a,b,c,d,e,f,g,h,i,j)
convertResults fs vs = convertError fs vs 10
+(<$!>) :: Functor f => (a -> b) -> f a -> f b
f <$!> (!x) = f <$> x
infixl 4 <$!>
View
9 src/Database/PostgreSQL/Simple/Result.hs
@@ -32,7 +32,7 @@ module Database.PostgreSQL.Simple.Result
#include "MachDeps.h"
import Control.Applicative (Applicative, (<$>), (<*>), (<*), pure)
-import Control.Exception (SomeException(..), Exception, throw)
+import Control.Exception (SomeException(..), Exception)
import Data.Attoparsec.Char8 hiding (Result)
import Data.Bits ((.&.), (.|.), shiftL)
import Data.ByteString (ByteString)
@@ -44,10 +44,9 @@ import Data.Time.Calendar (Day, fromGregorian)
import Data.Time.Clock (UTCTime)
import Data.Time.Format (parseTime)
import Data.Time.LocalTime (TimeOfDay, makeTimeOfDayValid)
-import Data.Typeable (TypeRep, Typeable, typeOf)
+import Data.Typeable (Typeable, typeOf)
import Data.Word (Word64)
import Database.PostgreSQL.Simple.Internal
-import Database.PostgreSQL.Simple.Field (Field(..), RawResult(..))
import Database.PostgreSQL.Simple.BuiltinTypes
import Database.PostgreSQL.Simple.Types (Binary(..), Null(..))
import qualified Database.PostgreSQL.LibPQ as PQ
@@ -58,7 +57,6 @@ import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as LB
import qualified Data.Text as ST
import qualified Data.Text.Encoding as ST
-import qualified Data.Text.Encoding.Error (UnicodeException)
import qualified Data.Text.Lazy as LT
-- | Exception thrown if conversion from a SQL value to a Haskell
@@ -140,6 +138,7 @@ instance Result (Ratio Integer) where
convert = atto ok rational
where ok = mkCompats [Float4,Float8,Int2,Int4,Numeric]
+unBinary :: Binary t -> t
unBinary (Binary x) = x
instance Result SB.ByteString where
@@ -228,7 +227,7 @@ mkCompat = Compat . shiftL 1 . fromEnum
compat :: Compat -> Compat -> Bool
compat (Compat a) (Compat b) = a .&. b /= 0
-okText, okText', ok16, ok32, ok64 :: Compat
+okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat
okText = mkCompats [Name,Text,Char,Bpchar,Varchar]
okText' = mkCompats [Name,Text,Char,Bpchar,Varchar,Unknown]
okBinary = mkCompats [Bytea]

No commit comments for this range

Something went wrong with that request. Please try again.