@@ -122,7 +122,7 @@ import Data.ByteString.Builder
122122 ( Builder, byteString, char8, intDec )
123123import Control.Applicative ((<$>))
124124import Control.Exception as E
125−import Control.Monad (foldM, unless, when, forM_)
125+import Control.Monad (unless)
126126import Data.ByteString (ByteString)
127127import Data.Int (Int64)
128128import Data.List (intersperse)
@@ -142,7 +142,6 @@ import qualified Database.PostgreSQL.LibPQ as PQ
142142import qualified Data.ByteString.Char8 as B
143143import Control.Monad.Trans.Reader
144144import Control.Monad.Trans.State.Strict
145−import qualified Control.Monad.Trans.State.Strict as SL
146145import Control.Monad.IO.Class (liftIO)
147146
148147
@@ -581,22 +580,26 @@ doFold FoldOptions{..} parser conn _template q a0 f = do
581580 <> byteString " FROM "
582581 <> byteString name
583582 )
584− loop = do
583+ loop a = do
585584 result <- liftIO (exec conn q)
586585 status <- liftIO (PQ.resultStatus result)
587586 case status of
588587 PQ.TuplesOk -> do
589588 nrows <- liftIO (PQ.ntuples result)
590589 ncols <- liftIO (PQ.nfields result)
591− when (nrows > 0) $ do
592− forM_ [0..(nrows-1)] $ \row -> do
593− x <- liftIO (getRowWith parser row ncols conn (Query q) result)
594− a <- get
595− a' <- liftIO (f a x)
596− put a'
597− loop
590+ if nrows > 0
591+ then do
592+ a' <- innerLoop 0 nrows ncols result a
593+ loop a'
594+ else return a
598595 _ -> liftIO (throwResultError "fold" result status)
599− in SL.execStateT loop a0
596+ innerLoop row nrows ncols result a
597+ | row < nrows = do
598+ x <- getRowWith parser row ncols conn result
599+ a' <- f a x
600+ innerLoop (row+1) nrows ncols result a'
601+ | otherwise = return a
602+ in loop a0
600603
601604-- FIXME: choose the Automatic chunkSize more intelligently
602605-- One possibility is to use the type of the results, although this
@@ -670,7 +673,7 @@ finishQueryWith parser conn q result = do
670673 nrows <- PQ.ntuples result
671674 ncols <- PQ.nfields result
672675 forM' 0 (nrows-1) $ \row ->
673− getRowWith parser row ncols conn q result
676+ getRowWith parser row ncols conn result
674677 PQ.CopyOut ->
675678 throwIO $ QueryError "query: COPY TO is not supported" q
676679 PQ.CopyIn ->
@@ -679,8 +682,8 @@ finishQueryWith parser conn q result = do
679682 PQ.NonfatalError -> throwResultError "query" result status
680683 PQ.FatalError -> throwResultError "query" result status
681684
682−getRowWith :: RowParser r -> PQ.Row -> PQ.Column -> Connection -> Query -> PQ.Result -> IO r
683−getRowWith parser row ncols conn q result = do
685+getRowWith :: RowParser r -> PQ.Row -> PQ.Column -> Connection -> PQ.Result -> IO r
686+getRowWith parser row ncols conn result = do
684687 let rw = Row row result
685688 let unCol (PQ.Col x) = fromIntegral x :: Int
686689 okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn