postgresql-simple 0.5.2.1 → 0.5.3.0
raw patch · 11 files changed
+248/−141 lines, 11 files
Files
- CHANGELOG.md +14/−14
- CONTRIBUTORS +1/−0
- postgresql-simple.cabal +4/−2
- src/Database/PostgreSQL/Simple.hs +14/−110
- src/Database/PostgreSQL/Simple/Copy.hs +9/−2
- src/Database/PostgreSQL/Simple/Cursor.hs +98/−0
- src/Database/PostgreSQL/Simple/Errors.hs +7/−7
- src/Database/PostgreSQL/Simple/FromField.hs +4/−4
- src/Database/PostgreSQL/Simple/Internal.hs +3/−1
- src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs +93/−0
- src/Database/PostgreSQL/Simple/Notification.hs +1/−1
CHANGELOG.md view
@@ -1,22 +1,22 @@ For the full changelog, see <https://github.com/lpsmith/postgresql-simple/blob/master/CHANGES.md> -### Version 0.5.2.1 (2016-06-29)- * Bumped the lower bound for `base` to 4.6. Thanks to Herbert- Valerio Riedel for reporting the issue.+### Version 0.5.3.0 (2017-05-15)+ * Refactored some rudimentary cursor handling code out of the+ implementation of the fold operators, into a new+ `Database.PostgreSQL.Simple.Cursor` module, thanks to Bardur Arantsson. - * Added an `Eq` instance for `SqlError`, thanks to Chris Allen+ * Made the `FromField` instance for `Char` compatible with+ postgresql's `bpchar` type. Thanks to Ivan Lazar Miljenovic for+ reporting the issue. - * Fixed a bug where a all-caps `"NULL"` text value inside a- postgresql array would get parsed as the SQL null value. Thanks- goes to Edgar Gomes and Silk for finding and fixing this mistake.+ * Added `Show` and `Eq` instances for `Notification`, thanks to+ Matvey Aksenov. - * Modified `withTransaction` and friends to ignore `IOError`s when- attempting to roll back the transaction. This fixes a buggy- interaction between `withTransaction` and async exceptions (e.g.- `System.Timeout`) on unix platforms. Thanks goes to Erik- Hesselink and Silk for providing the test case that exposed this- issue.+ * Fixed some example code, thanks to Matvey Aksenov. - * Added the `testTimeout` regression test for the problem above.+ * Fixed a problem with using `conversionError` to throw exceptions+ of type `SomeException`. Previously, the exception would be+ wrapped in a second `SomeException` dynamic constructor which+ would cause normal GHC typecase idioms over `SomeException` to fail.
CONTRIBUTORS view
@@ -33,3 +33,4 @@ Ben Gamari <ben@smart-cactus.org> Edgar Gomes Araujo <talktoedgar@gmail.com> Erik Hesselink <hesselink@gmail.com>+Matvey Aksenov <matvey.aksenov@gmail.com>
postgresql-simple.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-simple-Version: 0.5.2.1+Version: 0.5.3.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -24,6 +24,7 @@ Database.PostgreSQL.Simple Database.PostgreSQL.Simple.Arrays Database.PostgreSQL.Simple.Copy+ Database.PostgreSQL.Simple.Cursor Database.PostgreSQL.Simple.FromField Database.PostgreSQL.Simple.FromRow Database.PostgreSQL.Simple.LargeObjects@@ -49,6 +50,7 @@ Other-modules: Database.PostgreSQL.Simple.Compat Database.PostgreSQL.Simple.HStore.Implementation+ Database.PostgreSQL.Simple.Internal.PQResultUtils Database.PostgreSQL.Simple.Time.Implementation Database.PostgreSQL.Simple.Time.Internal.Parser Database.PostgreSQL.Simple.Time.Internal.Printer@@ -88,7 +90,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple- tag: v0.5.2.1+ tag: v0.5.3.0 test-suite test type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs view
@@ -118,30 +118,26 @@ , formatQuery ) where -import Data.ByteString.Builder- ( Builder, byteString, char8, intDec )+import Data.ByteString.Builder (Builder, byteString, char8) import Control.Applicative ((<$>)) import Control.Exception as E-import Control.Monad (unless) import Data.ByteString (ByteString) import Data.Int (Int64) import Data.List (intersperse) import Data.Monoid (mconcat)-import Database.PostgreSQL.Simple.Compat ( (<>), toByteString )+import Database.PostgreSQL.Simple.Compat ((<>), toByteString)+import Database.PostgreSQL.Simple.Cursor import Database.PostgreSQL.Simple.FromField (ResultError(..)) import Database.PostgreSQL.Simple.FromRow (FromRow(..))-import Database.PostgreSQL.Simple.Ok import Database.PostgreSQL.Simple.ToField (Action(..)) import Database.PostgreSQL.Simple.ToRow (ToRow(..)) import Database.PostgreSQL.Simple.Types ( Binary(..), In(..), Only(..), Query(..), (:.)(..) ) import Database.PostgreSQL.Simple.Internal as Base+import Database.PostgreSQL.Simple.Internal.PQResultUtils import Database.PostgreSQL.Simple.Transaction-import Database.PostgreSQL.Simple.TypeInfo import qualified Database.PostgreSQL.LibPQ as PQ import qualified Data.ByteString.Char8 as B-import Control.Monad.Trans.Reader-import Control.Monad.Trans.State.Strict -- | Format a query string.@@ -562,39 +558,17 @@ PQ.TransUnknown -> fail "foldWithOpts FIXME: PQ.TransUnknown" -- Not sure what this means. where- declare = do- name <- newTempName conn- _ <- execute_ conn $ mconcat- [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]- return name- close name =- (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->- -- Don't throw exception if CLOSE failed because the transaction is- -- aborted. Otherwise, it will throw away the original error.- unless (isFailedTransactionError ex) $ throwIO ex+ declare =+ declareCursor conn q+ fetch cursor a =+ foldForwardWithParser cursor parser chunkSize f a - go = bracket declare close $ \(Query name) ->- let q = toByteString (byteString "FETCH FORWARD "- <> intDec chunkSize- <> byteString " FROM "- <> byteString name- )- loop a = do- result <- exec conn q- status <- PQ.resultStatus result- case status of- PQ.TuplesOk -> do- nrows <- PQ.ntuples result- ncols <- PQ.nfields result- if nrows > 0- then do- let inner a row = do- x <- getRowWith parser row ncols conn result- f a x- foldM' inner a 0 (nrows - 1) >>= loop- else return a- _ -> throwResultError "fold" result status- in loop a0+ go = bracket declare closeCursor $ \cursor ->+ let loop a = fetch cursor a >>=+ \r -> case r of+ Left a -> return a+ Right a -> loop a+ in loop a0 -- FIXME: choose the Automatic chunkSize more intelligently -- One possibility is to use the type of the results, although this@@ -643,76 +617,6 @@ -> IO () forEachWith_ parser conn template = foldWith_ parser conn template () . const {-# INLINE forEachWith_ #-}--forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]-forM' lo hi m = loop hi []- where- loop !n !as- | n < lo = return as- | otherwise = do- a <- m n- loop (n-1) (a:as)-{-# INLINE forM' #-}--foldM' :: (Ord n, Num n) => (a -> n -> IO a) -> a -> n -> n -> IO a-foldM' f a lo hi = loop a lo- where- loop a !n- | n > hi = return a- | otherwise = do- a' <- f a n- loop a' (n+1)-{-# INLINE foldM' #-}--finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]-finishQueryWith parser conn q result = do- status <- PQ.resultStatus result- case status of- PQ.EmptyQuery ->- throwIO $ QueryError "query: Empty query" q- PQ.CommandOk ->- throwIO $ QueryError "query resulted in a command response" q- PQ.TuplesOk -> do- nrows <- PQ.ntuples result- ncols <- PQ.nfields result- forM' 0 (nrows-1) $ \row ->- getRowWith parser row ncols conn result- PQ.CopyOut ->- throwIO $ QueryError "query: COPY TO is not supported" q- PQ.CopyIn ->- throwIO $ QueryError "query: COPY FROM is not supported" q- PQ.BadResponse -> throwResultError "query" result status- PQ.NonfatalError -> throwResultError "query" result status- PQ.FatalError -> throwResultError "query" result status--getRowWith :: RowParser r -> PQ.Row -> PQ.Column -> Connection -> PQ.Result -> IO r-getRowWith parser row ncols conn result = do- let rw = Row row result- let unCol (PQ.Col x) = fromIntegral x :: Int- okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn- case okvc of- Ok (val,col) | col == ncols -> return val- | otherwise -> do- vals <- forM' 0 (ncols-1) $ \c -> do- tinfo <- getTypeInfo conn =<< PQ.ftype result c- v <- PQ.getvalue result row c- return ( tinfo- , fmap ellipsis v )- throw (ConversionFailed- (show (unCol ncols) ++ " values: " ++ show vals)- Nothing- ""- (show (unCol col) ++ " slots in target type")- "mismatch between number of columns to \- \convert and number in target type")- Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"- Errors [x] -> throwIO x- Errors xs -> throwIO $ ManyErrors xs--ellipsis :: ByteString -> ByteString-ellipsis bs- | B.length bs > 15 = B.take 10 bs `B.append` "[...]"- | otherwise = bs -- $use
src/Database/PostgreSQL/Simple/Copy.hs view
@@ -75,15 +75,22 @@ doCopy funcName conn template q = do result <- exec conn q status <- PQ.resultStatus result- let err = throwIO $ QueryError- (B.unpack funcName ++ " " ++ show status)+ let errMsg msg = throwIO $ QueryError+ (B.unpack funcName ++ " " ++ msg) template+ let err = errMsg $ show status case status of PQ.EmptyQuery -> err PQ.CommandOk -> err PQ.TuplesOk -> err PQ.CopyOut -> return () PQ.CopyIn -> return ()+#if MIN_VERSION_postgresql_libpq(0,9,3)+ PQ.CopyBoth -> errMsg "COPY BOTH is not supported"+#endif+#if MIN_VERSION_postgresql_libpq(0,9,2)+ PQ.SingleTuple -> errMsg "single-row mode is not supported"+#endif PQ.BadResponse -> throwResultError funcName result status PQ.NonfatalError -> throwResultError funcName result status PQ.FatalError -> throwResultError funcName result status
+ src/Database/PostgreSQL/Simple/Cursor.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE OverloadedStrings #-}++------------------------------------------------------------------------------+-- |+-- Module: Database.PostgreSQL.Simple.Cursor+-- Copyright: (c) 2011-2012 Leon P Smith+-- (c) 2017 Bardur Arantsson+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+--+------------------------------------------------------------------------------++module Database.PostgreSQL.Simple.Cursor+ (+ -- * Types+ Cursor+ -- * Cursor management+ , declareCursor+ , closeCursor+ -- * Folding over rows from a cursor+ , foldForward+ , foldForwardWithParser+ ) where++import Data.ByteString.Builder (intDec)+import Control.Applicative ((<$>))+import Control.Exception as E+import Control.Monad (unless, void)+import Data.Monoid (mconcat)+import Database.PostgreSQL.Simple.Compat ((<>), toByteString)+import Database.PostgreSQL.Simple.FromRow (FromRow(..))+import Database.PostgreSQL.Simple.Types (Query(..))+import Database.PostgreSQL.Simple.Internal as Base+import Database.PostgreSQL.Simple.Internal.PQResultUtils+import Database.PostgreSQL.Simple.Transaction+import qualified Database.PostgreSQL.LibPQ as PQ++-- | Cursor within a transaction.+data Cursor = Cursor !Query !Connection++-- | Declare a temporary cursor. The cursor is given a+-- unique name for the given connection.+declareCursor :: Connection -> Query -> IO Cursor+declareCursor conn q = do+ name <- newTempName conn+ void $ execute_ conn $ mconcat ["DECLARE ", name, " NO SCROLL CURSOR FOR ", q]+ return $ Cursor name conn++-- | Close the given cursor.+closeCursor :: Cursor -> IO ()+closeCursor (Cursor name conn) =+ (void $ execute_ conn ("CLOSE " <> name)) `E.catch` \ex ->+ -- Don't throw exception if CLOSE failed because the transaction is+ -- aborted. Otherwise, it will throw away the original error.+ unless (isFailedTransactionError ex) $ throwIO ex++-- | Fold over a chunk of rows from the given cursor, calling the+-- supplied fold-like function on each row as it is received. In case+-- the cursor is exhausted, a 'Left' value is returned, otherwise a+-- 'Right' value is returned.+foldForwardWithParser :: Cursor -> RowParser r -> Int -> (a -> r -> IO a) -> a -> IO (Either a a)+foldForwardWithParser (Cursor name conn) parser chunkSize f a0 = do+ let q = "FETCH FORWARD "+ <> (toByteString $ intDec chunkSize)+ <> " FROM "+ <> fromQuery name+ result <- exec conn q+ status <- PQ.resultStatus result+ case status of+ PQ.TuplesOk -> do+ nrows <- PQ.ntuples result+ ncols <- PQ.nfields result+ if nrows > 0+ then do+ let inner a row = do+ x <- getRowWith parser row ncols conn result+ f a x+ Right <$> foldM' inner a0 0 (nrows - 1)+ else+ return $ Left a0+ _ -> throwResultError "foldForwardWithParser" result status++-- | Fold over a chunk of rows, calling the supplied fold-like function+-- on each row as it is received. In case the cursor is exhausted,+-- a 'Left' value is returned, otherwise a 'Right' value is returned.+foldForward :: FromRow r => Cursor -> Int -> (a -> r -> IO a) -> a -> IO (Either a a)+foldForward cursor = foldForwardWithParser cursor fromRow+++foldM' :: (Ord n, Num n) => (a -> n -> IO a) -> a -> n -> n -> IO a+foldM' f a lo hi = loop a lo+ where+ loop a !n+ | n > hi = return a+ | otherwise = do+ a' <- f a n+ loop a' (n+1)+{-# INLINE foldM' #-}
src/Database/PostgreSQL/Simple/Errors.hs view
@@ -66,10 +66,10 @@ -- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and -- succeedes only if able to parse sqlErrorMsg. ----- > createUser = catchJust constraintViolation catcher $ execute conn ...+-- > createUser = handleJust constraintViolation handler $ execute conn ... -- > where--- > catcher UniqueViolation "user_login_key" = ...--- > catcher _ = ...+-- > handler (UniqueViolation "user_login_key") = ...+-- > handler _ = ... constraintViolation :: SqlError -> Maybe ConstraintViolation constraintViolation e = case sqlState e of@@ -84,16 +84,16 @@ -- | Like constraintViolation, but also packs original SqlError. ----- > createUser = catchJust constraintViolationE catcher $ execute conn ...+-- > createUser = handleJust constraintViolationE handler $ execute conn ... -- > where--- > catcher (_, UniqueViolation "user_login_key") = ...--- > catcher (e, _) = throwIO e+-- > handler (_, UniqueViolation "user_login_key") = ...+-- > handler (e, _) = throwIO e -- constraintViolationE :: SqlError -> Maybe (SqlError, ConstraintViolation) constraintViolationE e = fmap ((,) e) $ constraintViolation e -- | Catches SqlError, tries to convert to ConstraintViolation, re-throws--- on fail. Provides alternative interface to catchJust+-- on fail. Provides alternative interface to 'E.handleJust' -- -- > createUser = catchViolation catcher $ execute conn ... -- > where
src/Database/PostgreSQL/Simple/FromField.hs view
@@ -298,16 +298,16 @@ | bs == Just "f" = pure False | otherwise = returnError ConversionFailed f "" --- | \"char\"+-- | \"char\", bpchar instance FromField Char where fromField f bs =- if typeOid f /= $(inlineTypoid TI.char)- then returnError Incompatible f ""- else case bs of+ if $(mkCompats [TI.char,TI.bpchar]) (typeOid f)+ then case bs of Nothing -> returnError UnexpectedNull f "" Just bs -> if B.length bs /= 1 then returnError ConversionFailed f "length not 1" else return $! (B.head bs)+ else returnError Incompatible f "" -- | int2 instance FromField Int16 where
src/Database/PostgreSQL/Simple/Internal.hs view
@@ -351,6 +351,7 @@ Just res -> do status <- PQ.resultStatus res case status of+ -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple PQ.EmptyQuery -> getResult h mres' PQ.CommandOk -> getResult h mres' PQ.TuplesOk -> getResult h mres'@@ -371,6 +372,7 @@ finishExecute _conn q result = do status <- PQ.resultStatus result case status of+ -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple PQ.EmptyQuery -> throwIO $ QueryError "execute: Empty query" q PQ.CommandOk -> do ncols <- PQ.nfields result@@ -496,7 +498,7 @@ conversionMap f m = Conversion $ \conn -> f <$> runConversion m conn conversionError :: Exception err => err -> Conversion a-conversionError err = Conversion $ \_ -> return (Errors [SomeException err])+conversionError err = Conversion $ \_ -> return (Errors [toException err]) newTempName :: Connection -> IO Query newTempName Connection{..} = do
+ src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs view
@@ -0,0 +1,93 @@+{-# LANGUAGE CPP #-}++------------------------------------------------------------------------------+-- |+-- Module: Database.PostgreSQL.Simple.Internal.PQResultUtils+-- Copyright: (c) 2011 MailRank, Inc.+-- (c) 2011-2012 Leon P Smith+-- License: BSD3+-- Maintainer: Leon P Smith <leon@melding-monads.com>+-- Stability: experimental+--+------------------------------------------------------------------------------+++module Database.PostgreSQL.Simple.Internal.PQResultUtils+ ( finishQueryWith+ , getRowWith+ ) where++import Control.Exception as E+import Data.ByteString (ByteString)+import Database.PostgreSQL.Simple.FromField (ResultError(..))+import Database.PostgreSQL.Simple.Ok+import Database.PostgreSQL.Simple.Types (Query(..))+import Database.PostgreSQL.Simple.Internal as Base+import Database.PostgreSQL.Simple.TypeInfo+import qualified Database.PostgreSQL.LibPQ as PQ+import qualified Data.ByteString.Char8 as B+import Control.Monad.Trans.Reader+import Control.Monad.Trans.State.Strict++finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]+finishQueryWith parser conn q result = do+ status <- PQ.resultStatus result+ case status of+ PQ.TuplesOk -> do+ nrows <- PQ.ntuples result+ ncols <- PQ.nfields result+ forM' 0 (nrows-1) $ \row ->+ getRowWith parser row ncols conn result+ PQ.EmptyQuery -> queryErr "query: Empty query"+ PQ.CommandOk -> queryErr "query resulted in a command response"+ PQ.CopyOut -> queryErr "query: COPY TO is not supported"+ PQ.CopyIn -> queryErr "query: COPY FROM is not supported"+#if MIN_VERSION_postgresql_libpq(0,9,3)+ PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"+#endif+#if MIN_VERSION_postgresql_libpq(0,9,2)+ PQ.SingleTuple -> queryErr "query: single-row mode is not supported"+#endif+ PQ.BadResponse -> throwResultError "query" result status+ PQ.NonfatalError -> throwResultError "query" result status+ PQ.FatalError -> throwResultError "query" result status+ where+ queryErr msg = throwIO $ QueryError msg q++getRowWith :: RowParser r -> PQ.Row -> PQ.Column -> Connection -> PQ.Result -> IO r+getRowWith parser row ncols conn result = do+ let rw = Row row result+ let unCol (PQ.Col x) = fromIntegral x :: Int+ okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn+ case okvc of+ Ok (val,col) | col == ncols -> return val+ | otherwise -> do+ vals <- forM' 0 (ncols-1) $ \c -> do+ tinfo <- getTypeInfo conn =<< PQ.ftype result c+ v <- PQ.getvalue result row c+ return ( tinfo+ , fmap ellipsis v )+ throw (ConversionFailed+ (show (unCol ncols) ++ " values: " ++ show vals)+ Nothing+ ""+ (show (unCol col) ++ " slots in target type")+ "mismatch between number of columns to convert and number in target type")+ Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"+ Errors [x] -> throwIO x+ Errors xs -> throwIO $ ManyErrors xs++ellipsis :: ByteString -> ByteString+ellipsis bs+ | B.length bs > 15 = B.take 10 bs `B.append` "[...]"+ | otherwise = bs++forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]+forM' lo hi m = loop hi []+ where+ loop !n !as+ | n < lo = return as+ | otherwise = do+ a <- m n+ loop (n-1) (a:as)+{-# INLINE forM' #-}
src/Database/PostgreSQL/Simple/Notification.hs view
@@ -58,7 +58,7 @@ { notificationPid :: {-# UNPACK #-} !CPid , notificationChannel :: {-# UNPACK #-} !B.ByteString , notificationData :: {-# UNPACK #-} !B.ByteString- }+ } deriving (Show, Eq) convertNotice :: PQ.Notify -> Notification convertNotice PQ.Notify{..}