git.iko.soy/typeable/postgresql-simple
on master help sign in
Minor cleanups mostly related to #163
4ec19dfLeon P Smith
src/Database/PostgreSQL/Simple.hs+19−16
compare with master
unifiedsplit
@@ -142,7 +142,6 @@ import qualified Database.PostgreSQL.LibPQ as PQ
142import qualified Data.ByteString.Char8 as B
142import qualified Data.ByteString.Char8 as B
143import Control.Monad.Trans.Reader
143import Control.Monad.Trans.Reader
144import Control.Monad.Trans.State.Strict
144import Control.Monad.Trans.State.Strict
145−import Control.Monad.IO.Class (liftIO)
146
145
147
146
148-- | Format a query string.
147-- | Format a query string.
@@ -581,24 +580,20 @@ doFold FoldOptions{..} parser conn _template q a0 f = do
581 <> byteString name
580 <> byteString name
582 )
581 )
583 loop a = do
582 loop a = do
584− result <- liftIO (exec conn q)
583+ result <- exec conn q
585− status <- liftIO (PQ.resultStatus result)
584+ status <- PQ.resultStatus result
586 case status of
585 case status of
587 PQ.TuplesOk -> do
586 PQ.TuplesOk -> do
588− nrows <- liftIO (PQ.ntuples result)
587+ nrows <- PQ.ntuples result
589− ncols <- liftIO (PQ.nfields result)
588+ ncols <- PQ.nfields result
590 if nrows > 0
589 if nrows > 0
591 then do
590 then do
592− a' <- innerLoop 0 nrows ncols result a
591+ let inner a row = do
593− loop a'
592+ x <- getRowWith parser row ncols conn result
593+ f a x
594+ foldM' inner a 0 (nrows - 1) >>= loop
594 else return a
595 else return a
595− _ -> liftIO (throwResultError "fold" result status)
596+ _ -> 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
602 in loop a0
597 in loop a0
603
598
604-- FIXME: choose the Automatic chunkSize more intelligently
599-- FIXME: choose the Automatic chunkSize more intelligently
@@ -657,9 +652,17 @@ forM' lo hi m = loop hi []
657 | otherwise = do
652 | otherwise = do
658 a <- m n
653 a <- m n
659 loop (n-1) (a:as)
654 loop (n-1) (a:as)
655+{-# INLINE forM' #-}
660
656
661−finishQuery :: FromRow r => Connection -> Query -> PQ.Result -> IO [r]
657+foldM' :: (Ord n, Num n) => (a -> n -> IO a) -> a -> n -> n -> IO a
662−finishQuery = finishQueryWith fromRow
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' #-}
663
666
664finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]
667finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]
665finishQueryWith parser conn q result = do
668finishQueryWith parser conn q result = do