@@ -112,8 +112,7 @@ import Blaze.ByteString.Builder
112112 ( Builder, fromByteString, toByteString )
113113import Blaze.ByteString.Builder.Char8 (fromChar)
114114import Control.Applicative ((<$>), pure)
115−import Control.Exception
116− ( Exception, throw, throwIO, finally )
115+import Control.Exception as E
117116import Control.Monad (foldM)
118117import Data.ByteString (ByteString)
119118import Data.Int (Int64)
@@ -463,7 +462,7 @@ doFold :: ( FromRow row )
463462 -> a
464463 -> (a -> row -> IO a)
465464 -> IO a
466−doFold FoldOptions{..} conn _template q a f = do
465+doFold FoldOptions{..} conn _template q a0 f = do
467466 stat <- withConnection conn PQ.transactionStatus
468467 case stat of
469468 PQ.TransIdle -> withTransactionMode transactionMode conn go
@@ -481,10 +480,23 @@ doFold FoldOptions{..} conn _template q a f = do
481480 PQ.TransUnknown -> fail "foldWithOpts FIXME: PQ.TransUnknown"
482481 -- Not sure what this means.
483482 where
484− go = do
485− -- FIXME: what about name clashes with already-declared cursors?
486− _ <- execute_ conn ("DECLARE fold NO SCROLL CURSOR FOR " <> q)
487− loop a `finally` execute_ conn "CLOSE fold"
483+ declare = do
484+ name <- newTempName conn
485+ _ <- execute_ conn $ "DECLARE " <> name <> " NO SCROLL CURSOR FOR " <> q
486+ return name
487+ fetch name = query_ conn $
488+ "FETCH FORWARD " <> (Query . B.pack . show) chunkSize <> " FROM " <> name
489+ close name =
490+ (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->
491+ -- Don't throw exception if CLOSE failed because the transaction is
492+ -- aborted. Otherwise, it will throw away the original error.
493+ if isFailedTransactionError ex then return () else throwIO ex
494+
495+ go = bracket declare close $ \name ->
496+ let loop a = do
497+ rs <- fetch name
498+ if null rs then return a else foldM f a rs >>= loop
499+ in loop a0
488500
489501-- FIXME: choose the Automatic chunkSize more intelligently
490502-- One possibility is to use the type of the results, although this
@@ -495,9 +507,6 @@ doFold FoldOptions{..} conn _template q a f = do
495507 chunkSize = case fetchQuantity of
496508 Automatic -> 256
497509 Fixed n -> n
498− loop a = do
499− rs <- query conn "FETCH FORWARD ? FROM fold" (Only chunkSize)
500− if null rs then return a else foldM f a rs >>= loop
501510
502511-- | A version of 'fold' that does not transform a state value.
503512forEach :: (ToRow q, FromRow r) =>