@@ -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 Control.Monad.IO.Class (liftIO)
146145
147146
148147-- | Format a query string.
@@ -581,24 +580,20 @@ doFold FoldOptions{..} parser conn _template q a0 f = do
581580 <> byteString name
582581 )
583582 loop a = do
584− result <- liftIO (exec conn q)
585− status <- liftIO (PQ.resultStatus result)
583+ result <- exec conn q
584+ status <- PQ.resultStatus result
586585 case status of
587586 PQ.TuplesOk -> do
588− nrows <- liftIO (PQ.ntuples result)
589− ncols <- liftIO (PQ.nfields result)
587+ nrows <- PQ.ntuples result
588+ ncols <- PQ.nfields result
590589 if nrows > 0
591590 then do
592− a' <- innerLoop 0 nrows ncols result a
593− loop a'
591+ let inner a row = do
592+ x <- getRowWith parser row ncols conn result
593+ f a x
594+ foldM' inner a 0 (nrows - 1) >>= loop
594595 else return a
595− _ -> liftIO (throwResultError "fold" result status)
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
596+ _ -> throwResultError "fold" result status
602597 in loop a0
603598
604599-- FIXME: choose the Automatic chunkSize more intelligently
@@ -657,9 +652,17 @@ forM' lo hi m = loop hi []
657652 | otherwise = do
658653 a <- m n
659654 loop (n-1) (a:as)
655+{-# INLINE forM' #-}
660656
661−finishQuery :: FromRow r => Connection -> Query -> PQ.Result -> IO [r]
662−finishQuery = finishQueryWith fromRow
657+foldM' :: (Ord n, Num n) => (a -> n -> IO a) -> a -> n -> n -> IO a
658+foldM' f a lo hi = loop a lo
659+ where
660+ loop a !n
661+ | n > hi = return a
662+ | otherwise = do
663+ a' <- f a n
664+ loop a' (n+1)
665+{-# INLINE foldM' #-}
663666
664667finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]
665668finishQueryWith parser conn q result = do