@@ -68,13 +68,11 @@ module Database.PostgreSQL.Simple
6868 -- * Queries that return results
6969 , query
7070 , query_
71−{--
7271 -- * Queries that stream results
7372 , fold
7473 , fold_
7574 , forEach
7675 , forEach_
77−--}
7876 -- * Statements that do not return results
7977 , execute
8078 , execute_
@@ -96,30 +94,25 @@ import Blaze.ByteString.Builder.Char8 (fromChar)
9694import Control.Applicative ((<$>), pure)
9795import Control.Concurrent.MVar
9896import Control.Exception (Exception, bracket, onException, throw, throwIO)
99−import Control.Monad (forM)
97+import Control.Monad (foldM)
10098import Control.Monad.Fix (fix)
10199import Data.ByteString (ByteString)
102−-- import qualified Data.ByteString as B (unpack)
103100import Data.Char(ord)
104101import Data.Int (Int64)
105102import qualified Data.IntMap as IntMap
106103import Data.List (intersperse)
107104import Data.Monoid (mappend, mconcat)
108105import Data.Typeable (Typeable)
109−--import Database.MySQL.Base (Connection, Result)
110−--import Database.MySQL.Base.Types (Field)
111106import Database.PostgreSQL.Simple.BuiltinTypes (oid2builtin, builtin2typname)
112107import Database.PostgreSQL.Simple.Param (Action(..), inQuotes)
113108import Database.PostgreSQL.Simple.QueryParams (QueryParams(..))
114109import Database.PostgreSQL.Simple.Result (ResultError(..))
115110import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))
116−-- import Database.PostgreSQL.Simple.Result (ResultError(..))
117111import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Only(..), Query(..))
118112import Database.PostgreSQL.Simple.Internal as Base
119113import qualified Database.PostgreSQL.LibPQ as PQ
120114import Text.Regex.PCRE.Light (compile, caseless, match)
121115import qualified Data.ByteString.Char8 as B
122−--import qualified Database.MySQL.Base as Base
123116
124117-- | Exception thrown if a 'Query' could not be formatted correctly.
125118-- This may occur if the number of \'@?@\' characters in the query
@@ -296,7 +289,7 @@ query_ :: (QueryResults r) => Connection -> Query -> IO [r]
296289query_ conn q@(Query que) = do
297290 result <- exec conn que
298291 finishQuery conn q result
299−{--
292+
300293-- | Perform a @SELECT@ or other SQL query that is expected to return
301294-- results. Results are streamed incrementally from the server, and
302295-- consumed via a left fold.
@@ -327,11 +320,16 @@ fold :: (QueryParams q, QueryResults r) =>
327320 -> a -- ^ Initial state for result consumer.
328321 -> (a -> r -> IO a) -- ^ Result consumer.
329322 -> IO a
330−fold conn template qs z f = do
331− Base.query conn =<< formatQuery conn template qs
332− finishFold conn template z f
333−--}
334−{--
323+fold conn template qs z f = withConnection conn $ \c -> do
324+ success <- PQ.sendQuery c =<< formatQuery conn template qs
325+ if success
326+ then finishFold conn c template z f
327+ else do
328+ msg <- maybe "fold error" id <$> PQ.errorMessage c
329+ throwIO $ SqlError { sqlNativeError = -1
330+ , sqlErrorMsg = msg
331+ , sqlState = "" }
332+
335333-- | A version of 'fold' that does not perform query substitution.
336334fold_ :: (QueryResults r) =>
337335 Connection
@@ -339,11 +337,16 @@ fold_ :: (QueryResults r) =>
339337 -> a -- ^ Initial state for result consumer.
340338 -> (a -> r -> IO a) -- ^ Result consumer.
341339 -> IO a
342−fold_ conn q@(Query que) z f = do
343− Base.query conn que
344− finishFold conn q z f
345−--}
346−{--
340+fold_ conn q@(Query que) z f = withConnection conn $ \c -> do
341+ success <- PQ.sendQuery c que
342+ if success
343+ then finishFold conn c q z f
344+ else do
345+ msg <- maybe "fold_ error" id <$> PQ.errorMessage c
346+ throwIO $ SqlError { sqlNativeError = -1
347+ , sqlErrorMsg = msg
348+ , sqlState = "" }
349+
347350-- | A version of 'fold' that does not transform a state value.
348351forEach :: (QueryParams q, QueryResults r) =>
349352 Connection
@@ -362,7 +365,6 @@ forEach_ :: (QueryResults r) =>
362365 -> IO ()
363366forEach_ conn template = fold_ conn template () . const
364367{-# INLINE forEach_ #-}
365−--}
366368
367369forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]
368370forM' lo hi m = loop hi []
@@ -402,16 +404,47 @@ finishQuery conn q result = do
402404 , sqlErrorMsg = B.concat [ "query: ", statusmsg
403405 , ": ", errormsg ]}
404406
405−{--
406−withResult (Base.storeResult conn) q $ \r fs -> do
407− status <-
408−/ flip fix [] $ \loop acc -> do
409− row <- Base.fetchRow r
410− case row of
411− [] -> return (reverse acc)
412− _ -> let !c = convertResults fs row
413− in loop (c:acc)
414−--}
407+
408+finishFold :: (QueryResults r) =>
409+ Connection
410+ -> PQ.Connection
411+ -> Query -- ^ Query.
412+ -> a -- ^ Initial state for result consumer.
413+ -> (a -> r -> IO a) -- ^ Result consumer.
414+ -> IO a
415+finishFold conn c q a_ f = loop a_
416+ where
417+ loop a = do
418+ mres <- PQ.getResult c
419+ case mres of
420+ Nothing -> return a
421+ Just result -> do
422+ stat <- PQ.resultStatus result
423+ case stat of
424+ PQ.TuplesOk -> do
425+ ncols <- PQ.nfields result
426+ fields <- forM' 0 (ncols-1) $ \column -> do
427+ type_oid <- PQ.ftype result column
428+ typename <- getTypename conn type_oid
429+ return Field{..}
430+ nrows <- PQ.ntuples result
431+ a' <- foldM (\a row -> do
432+ values <- forM' 0 (ncols-1) (PQ.getvalue result row)
433+ case convertResults fields values of
434+ Left err -> clear c >> throwIO err
435+ Right r -> f a r)
436+ a [0..nrows-1]
437+ loop a'
438+ _ -> clear c >> fail "FIXME: finishFold not PQ.TuplesOk"
439+
440+ clear c = do
441+ mres <- PQ.getResult c
442+ case mres of
443+ Nothing -> return ()
444+ Just _ -> clear c
445+
446+
447+
415448{--
416449finishFold :: (QueryResults r) =>
417450 Connection -> Query -> a -> (a -> r -> IO a) -> IO a