Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
First attempt at a fold combinator
Untested at this point,  and I know it has a few bugs and possible bugs:

1.  If the correct OID/typenames aren't in the cache,  getTypename will
    attempt to fetch the OID from the database when libpq is busy.

    There are a couple possible fixes:
        A.  Fetch all oids at connection startup.

        B.  Buffer results until the connection becomes available, then
            fetch oids.  This breaks the resource usage of fold, though.

            Resource usage might be moot at this stage anyway.  I believe
            that the database backend sends results eagerly,  i.e.
            potentially faster than the fold can consume them.  Maybe I
            should study Takusen.  Does it create a cursor for fetching
            results incrementally?

        C.  establish another connection to fetch the typename/oid pairs

2.  There likely problems with exceptions,  that might cause a connection
    to be rendered unusable.
  • Loading branch information
lpsmith committed Jan 3, 2012
1 parent e9f8aad commit bce0d38
Showing 1 changed file with 63 additions and 30 deletions.
93 changes: 63 additions & 30 deletions src/Database/PostgreSQL/Simple.hs
Expand Up @@ -68,13 +68,11 @@ module Database.PostgreSQL.Simple
-- * Queries that return results
, query
, query_
{--
-- * Queries that stream results
, fold
, fold_
, forEach
, forEach_
--}
-- * Statements that do not return results
, execute
, execute_
Expand All @@ -96,30 +94,25 @@ import Blaze.ByteString.Builder.Char8 (fromChar)
import Control.Applicative ((<$>), pure)
import Control.Concurrent.MVar
import Control.Exception (Exception, bracket, onException, throw, throwIO)
import Control.Monad (forM)
import Control.Monad (foldM)
import Control.Monad.Fix (fix)
import Data.ByteString (ByteString)
-- import qualified Data.ByteString as B (unpack)
import Data.Char(ord)
import Data.Int (Int64)
import qualified Data.IntMap as IntMap
import Data.List (intersperse)
import Data.Monoid (mappend, mconcat)
import Data.Typeable (Typeable)
--import Database.MySQL.Base (Connection, Result)
--import Database.MySQL.Base.Types (Field)
import Database.PostgreSQL.Simple.BuiltinTypes (oid2builtin, builtin2typname)
import Database.PostgreSQL.Simple.Param (Action(..), inQuotes)
import Database.PostgreSQL.Simple.QueryParams (QueryParams(..))
import Database.PostgreSQL.Simple.Result (ResultError(..))
import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))
-- import Database.PostgreSQL.Simple.Result (ResultError(..))
import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Only(..), Query(..))
import Database.PostgreSQL.Simple.Internal as Base
import qualified Database.PostgreSQL.LibPQ as PQ
import Text.Regex.PCRE.Light (compile, caseless, match)
import qualified Data.ByteString.Char8 as B
--import qualified Database.MySQL.Base as Base

-- | Exception thrown if a 'Query' could not be formatted correctly.
-- This may occur if the number of \'@?@\' characters in the query
Expand Down Expand Up @@ -296,7 +289,7 @@ query_ :: (QueryResults r) => Connection -> Query -> IO [r]
query_ conn q@(Query que) = do
result <- exec conn que
finishQuery conn q result
{--

-- | Perform a @SELECT@ or other SQL query that is expected to return
-- results. Results are streamed incrementally from the server, and
-- consumed via a left fold.
Expand Down Expand Up @@ -327,23 +320,33 @@ fold :: (QueryParams q, QueryResults r) =>
-> a -- ^ Initial state for result consumer.
-> (a -> r -> IO a) -- ^ Result consumer.
-> IO a
fold conn template qs z f = do
Base.query conn =<< formatQuery conn template qs
finishFold conn template z f
--}
{--
fold conn template qs z f = withConnection conn $ \c -> do
success <- PQ.sendQuery c =<< formatQuery conn template qs
if success
then finishFold conn c template z f
else do
msg <- maybe "fold error" id <$> PQ.errorMessage c
throwIO $ SqlError { sqlNativeError = -1
, sqlErrorMsg = msg
, sqlState = "" }

-- | A version of 'fold' that does not perform query substitution.
fold_ :: (QueryResults r) =>
Connection
-> Query -- ^ Query.
-> a -- ^ Initial state for result consumer.
-> (a -> r -> IO a) -- ^ Result consumer.
-> IO a
fold_ conn q@(Query que) z f = do
Base.query conn que
finishFold conn q z f
--}
{--
fold_ conn q@(Query que) z f = withConnection conn $ \c -> do
success <- PQ.sendQuery c que
if success
then finishFold conn c q z f
else do
msg <- maybe "fold_ error" id <$> PQ.errorMessage c
throwIO $ SqlError { sqlNativeError = -1
, sqlErrorMsg = msg
, sqlState = "" }

-- | A version of 'fold' that does not transform a state value.
forEach :: (QueryParams q, QueryResults r) =>
Connection
Expand All @@ -362,7 +365,6 @@ forEach_ :: (QueryResults r) =>
-> IO ()
forEach_ conn template = fold_ conn template () . const
{-# INLINE forEach_ #-}
--}

forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]
forM' lo hi m = loop hi []
Expand Down Expand Up @@ -402,16 +404,47 @@ finishQuery conn q result = do
, sqlErrorMsg = B.concat [ "query: ", statusmsg
, ": ", errormsg ]}

{--
withResult (Base.storeResult conn) q $ \r fs -> do
status <-
/ flip fix [] $ \loop acc -> do
row <- Base.fetchRow r
case row of
[] -> return (reverse acc)
_ -> let !c = convertResults fs row
in loop (c:acc)
--}

finishFold :: (QueryResults r) =>
Connection
-> PQ.Connection
-> Query -- ^ Query.
-> a -- ^ Initial state for result consumer.
-> (a -> r -> IO a) -- ^ Result consumer.
-> IO a
finishFold conn c q a_ f = loop a_
where
loop a = do
mres <- PQ.getResult c
case mres of
Nothing -> return a
Just result -> do
stat <- PQ.resultStatus result
case stat of
PQ.TuplesOk -> do
ncols <- PQ.nfields result
fields <- forM' 0 (ncols-1) $ \column -> do
type_oid <- PQ.ftype result column
typename <- getTypename conn type_oid
return Field{..}
nrows <- PQ.ntuples result
a' <- foldM (\a row -> do
values <- forM' 0 (ncols-1) (PQ.getvalue result row)
case convertResults fields values of
Left err -> clear c >> throwIO err
Right r -> f a r)
a [0..nrows-1]
loop a'
_ -> clear c >> fail "FIXME: finishFold not PQ.TuplesOk"

clear c = do
mres <- PQ.getResult c
case mres of
Nothing -> return ()
Just _ -> clear c



{--
finishFold :: (QueryResults r) =>
Connection -> Query -> a -> (a -> r -> IO a) -> IO a
Expand Down

1 comment on commit bce0d38

@lpsmith
Copy link
Owner Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Another thought: using a database cursor to implement a fold would also have the benefit of solving the type oid conundrum, as well as it wouldn't leave libpq in the wrong state when the function passed to fold throws an exception. Also, Takusen does in fact use cursors to implement its enumerators.

Please sign in to comment.