Hello community,
here is the log from the commit of package ghc-postgresql-simple for openSUSE:Factory checked in at 2017-06-04 01:58:32
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-postgresql-simple (Old)
and /work/SRC/openSUSE:Factory/.ghc-postgresql-simple.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-postgresql-simple"
Sun Jun 4 01:58:32 2017 rev:2 rq:499722 version:0.5.3.0
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-postgresql-simple/ghc-postgresql-simple.changes 2016-10-22 13:17:56.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-postgresql-simple.new/ghc-postgresql-simple.changes 2017-06-04 01:58:33.686945015 +0200
@@ -1,0 +2,5 @@
+Thu May 18 09:52:17 UTC 2017 - psimons@suse.com
+
+- Update to version 0.5.3.0 with cabal2obs.
+
+-------------------------------------------------------------------
Old:
----
postgresql-simple-0.5.2.1.tar.gz
New:
----
postgresql-simple-0.5.3.0.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-postgresql-simple.spec ++++++
--- /var/tmp/diff_new_pack.tO8Tso/_old 2017-06-04 01:58:35.386704883 +0200
+++ /var/tmp/diff_new_pack.tO8Tso/_new 2017-06-04 01:58:35.390704318 +0200
@@ -1,7 +1,7 @@
#
# spec file for package ghc-postgresql-simple
#
-# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany.
+# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany.
#
# All modifications and additions to the file contributed by third parties
# remain the property of their copyright owners, unless otherwise agreed
@@ -19,15 +19,14 @@
%global pkg_name postgresql-simple
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.5.2.1
+Version: 0.5.3.0
Release: 0
Summary: Mid-Level PostgreSQL client library
License: BSD-3-Clause
-Group: System/Libraries
+Group: Development/Languages/Other
Url: https://hackage.haskell.org/package/%{pkg_name}
Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
BuildRequires: ghc-Cabal-devel
-# Begin cabal-rpm deps:
BuildRequires: ghc-aeson-devel
BuildRequires: ghc-attoparsec-devel
BuildRequires: ghc-bytestring-builder-devel
@@ -54,7 +53,6 @@
BuildRequires: ghc-tasty-golden-devel
BuildRequires: ghc-tasty-hunit-devel
%endif
-# End cabal-rpm deps
%description
Mid-Level PostgreSQL client library, forked from mysql-simple.
@@ -74,20 +72,14 @@
%prep
%setup -q -n %{pkg_name}-%{version}
-
%build
%ghc_lib_build
-
%install
%ghc_lib_install
-
%check
-%if %{with tests}
-%{cabal} test
-%endif
-
+%cabal_test
%post devel
%ghc_pkg_recache
@@ -101,6 +93,6 @@
%files devel -f %{name}-devel.files
%defattr(-,root,root,-)
-%doc CHANGELOG.md
+%doc CHANGELOG.md CONTRIBUTORS
%changelog
++++++ postgresql-simple-0.5.2.1.tar.gz -> postgresql-simple-0.5.3.0.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/CHANGELOG.md new/postgresql-simple-0.5.3.0/CHANGELOG.md
--- old/postgresql-simple-0.5.2.1/CHANGELOG.md 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/CHANGELOG.md 2017-05-15 07:29:53.000000000 +0200
@@ -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.
-
- * Added an `Eq` instance for `SqlError`, thanks to Chris Allen
-
- * 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.
-
- * 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.
-
- * Added the `testTimeout` regression test for the problem above.
+### 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.
+
+ * Made the `FromField` instance for `Char` compatible with
+ postgresql's `bpchar` type. Thanks to Ivan Lazar Miljenovic for
+ reporting the issue.
+
+ * Added `Show` and `Eq` instances for `Notification`, thanks to
+ Matvey Aksenov.
+
+ * Fixed some example code, thanks to Matvey Aksenov.
+
+ * 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.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/CONTRIBUTORS new/postgresql-simple-0.5.3.0/CONTRIBUTORS
--- old/postgresql-simple-0.5.2.1/CONTRIBUTORS 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/CONTRIBUTORS 2017-05-15 07:29:53.000000000 +0200
@@ -33,3 +33,4 @@
Ben Gamari
Edgar Gomes Araujo
Erik Hesselink
+Matvey Aksenov
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/postgresql-simple.cabal new/postgresql-simple-0.5.3.0/postgresql-simple.cabal
--- old/postgresql-simple-0.5.2.1/postgresql-simple.cabal 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/postgresql-simple.cabal 2017-05-15 07:29:53.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Copy.hs new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Copy.hs
--- old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Copy.hs 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Copy.hs 2017-05-15 07:29:53.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Cursor.hs new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Cursor.hs
--- old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Cursor.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Cursor.hs 2017-05-15 07:29:53.000000000 +0200
@@ -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
+--
+------------------------------------------------------------------------------
+
+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' #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Errors.hs new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Errors.hs
--- old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Errors.hs 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Errors.hs 2017-05-15 07:29:53.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/FromField.hs new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/FromField.hs
--- old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/FromField.hs 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/FromField.hs 2017-05-15 07:29:53.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs
--- old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs 1970-01-01 01:00:00.000000000 +0100
+++ new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs 2017-05-15 07:29:53.000000000 +0200
@@ -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
+-- 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' #-}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Internal.hs new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Internal.hs
--- old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Internal.hs 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Internal.hs 2017-05-15 07:29:53.000000000 +0200
@@ -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
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Notification.hs new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Notification.hs
--- old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple/Notification.hs 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple/Notification.hs 2017-05-15 07:29:53.000000000 +0200
@@ -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{..}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple.hs new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple.hs
--- old/postgresql-simple-0.5.2.1/src/Database/PostgreSQL/Simple.hs 2016-06-29 21:24:32.000000000 +0200
+++ new/postgresql-simple-0.5.3.0/src/Database/PostgreSQL/Simple.hs 2017-05-15 07:29:53.000000000 +0200
@@ -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
-
- 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
+ declare =
+ declareCursor conn q
+ fetch cursor a =
+ foldForwardWithParser cursor parser chunkSize f a
+
+ 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
@@ -644,76 +618,6 @@
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
--