bce0d38 · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

First attempt at a fold combinator

bce0d38Leon P Smith15 years ago

src/Database/PostgreSQL/Simple.hs+63−30

compare with master

unifiedsplit

@@ -68,13 +68,11 @@ module Database.PostgreSQL.Simple

68 -- * Queries that return results

69 , query

70 , query_

71−{--

72 -- * Queries that stream results

71 -- * Queries that stream results

73 , fold

72 , fold

74 , fold_

73 , fold_

75 , forEach

74 , forEach

76 , forEach_

75 , forEach_

77−--}

78 -- * Statements that do not return results

76 -- * Statements that do not return results

79 , execute

77 , execute

80 , execute_

78 , execute_

@@ -96,30 +94,25 @@ import Blaze.ByteString.Builder.Char8 (fromChar)

96import Control.Applicative ((<$>), pure)

94import Control.Applicative ((<$>), pure)

97import Control.Concurrent.MVar

95import Control.Concurrent.MVar

98import Control.Exception (Exception, bracket, onException, throw, throwIO)

96import Control.Exception (Exception, bracket, onException, throw, throwIO)

99−import Control.Monad (forM)

97+import Control.Monad (foldM)

100import Control.Monad.Fix (fix)

98import Control.Monad.Fix (fix)

101import Data.ByteString (ByteString)

99import Data.ByteString (ByteString)

102−-- import qualified Data.ByteString as B (unpack)

103import Data.Char(ord)

100import Data.Char(ord)

104import Data.Int (Int64)

101import Data.Int (Int64)

105import qualified Data.IntMap as IntMap

102import qualified Data.IntMap as IntMap

106import Data.List (intersperse)

103import Data.List (intersperse)

107import Data.Monoid (mappend, mconcat)

104import Data.Monoid (mappend, mconcat)

108import Data.Typeable (Typeable)

105import Data.Typeable (Typeable)

109−--import Database.MySQL.Base (Connection, Result)

110−--import Database.MySQL.Base.Types (Field)

111import Database.PostgreSQL.Simple.BuiltinTypes (oid2builtin, builtin2typname)

106import Database.PostgreSQL.Simple.BuiltinTypes (oid2builtin, builtin2typname)

112import Database.PostgreSQL.Simple.Param (Action(..), inQuotes)

107import Database.PostgreSQL.Simple.Param (Action(..), inQuotes)

113import Database.PostgreSQL.Simple.QueryParams (QueryParams(..))

108import Database.PostgreSQL.Simple.QueryParams (QueryParams(..))

114import Database.PostgreSQL.Simple.Result (ResultError(..))

109import Database.PostgreSQL.Simple.Result (ResultError(..))

115import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))

110import Database.PostgreSQL.Simple.QueryResults (QueryResults(..))

116−-- import Database.PostgreSQL.Simple.Result (ResultError(..))

117import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Only(..), Query(..))

111import Database.PostgreSQL.Simple.Types (Binary(..), In(..), Only(..), Query(..))

118import Database.PostgreSQL.Simple.Internal as Base

112import Database.PostgreSQL.Simple.Internal as Base

119import qualified Database.PostgreSQL.LibPQ as PQ

113import qualified Database.PostgreSQL.LibPQ as PQ

120import Text.Regex.PCRE.Light (compile, caseless, match)

114import Text.Regex.PCRE.Light (compile, caseless, match)

121import qualified Data.ByteString.Char8 as B

115import qualified Data.ByteString.Char8 as B

122−--import qualified Database.MySQL.Base as Base

123

116

124-- | Exception thrown if a 'Query' could not be formatted correctly.

117-- | Exception thrown if a 'Query' could not be formatted correctly.

125-- This may occur if the number of \'@?@\' characters in the query

118-- This may occur if the number of \'@?@\' characters in the query

@@ -296,7 +289,7 @@ query_ :: (QueryResults r) => Connection -> Query -> IO [r]

296query_ conn q@(Query que) = do

289query_ conn q@(Query que) = do

297 result <- exec conn que

290 result <- exec conn que

298 finishQuery conn q result

291 finishQuery conn q result

299−{--

292+

300-- | Perform a @SELECT@ or other SQL query that is expected to return

293-- | Perform a @SELECT@ or other SQL query that is expected to return

301-- results. Results are streamed incrementally from the server, and

294-- results. Results are streamed incrementally from the server, and

302-- consumed via a left fold.

295-- consumed via a left fold.

@@ -327,11 +320,16 @@ fold :: (QueryParams q, QueryResults r) =>

327 -> a -- ^ Initial state for result consumer.

320 -> a -- ^ Initial state for result consumer.

328 -> (a -> r -> IO a) -- ^ Result consumer.

321 -> (a -> r -> IO a) -- ^ Result consumer.

329 -> IO a

322 -> IO a

330−fold conn template qs z f = do

323+fold conn template qs z f = withConnection conn $ \c -> do

331− Base.query conn =<< formatQuery conn template qs

324+ success <- PQ.sendQuery c =<< formatQuery conn template qs

325+ if success

332− finishFold conn template z f

326+ then finishFold conn c template z f

333−--}

327+ else do

334−{--

328+ msg <- maybe "fold error" id <$> PQ.errorMessage c

329+ throwIO $ SqlError { sqlNativeError = -1

330+ , sqlErrorMsg = msg

331+ , sqlState = "" }

332+

335-- | A version of 'fold' that does not perform query substitution.

333-- | A version of 'fold' that does not perform query substitution.

336fold_ :: (QueryResults r) =>

334fold_ :: (QueryResults r) =>

337 Connection

335 Connection

@@ -339,11 +337,16 @@ fold_ :: (QueryResults r) =>

339 -> a -- ^ Initial state for result consumer.

337 -> a -- ^ Initial state for result consumer.

340 -> (a -> r -> IO a) -- ^ Result consumer.

338 -> (a -> r -> IO a) -- ^ Result consumer.

341 -> IO a

339 -> IO a

342−fold_ conn q@(Query que) z f = do

340+fold_ conn q@(Query que) z f = withConnection conn $ \c -> do

343− Base.query conn que

341+ success <- PQ.sendQuery c que

342+ if success

344− finishFold conn q z f

343+ then finishFold conn c q z f

345−--}

344+ else do

346−{--

345+ msg <- maybe "fold_ error" id <$> PQ.errorMessage c

346+ throwIO $ SqlError { sqlNativeError = -1

347+ , sqlErrorMsg = msg

348+ , sqlState = "" }

349+

347-- | A version of 'fold' that does not transform a state value.

350-- | A version of 'fold' that does not transform a state value.

348forEach :: (QueryParams q, QueryResults r) =>

351forEach :: (QueryParams q, QueryResults r) =>

349 Connection

352 Connection

@@ -362,7 +365,6 @@ forEach_ :: (QueryResults r) =>

362 -> IO ()

365 -> IO ()

363forEach_ conn template = fold_ conn template () . const

366forEach_ conn template = fold_ conn template () . const

364{-# INLINE forEach_ #-}

367{-# INLINE forEach_ #-}

365−--}

366

368

367forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]

369forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]

368forM' lo hi m = loop hi []

370forM' lo hi m = loop hi []

@@ -402,16 +404,47 @@ finishQuery conn q result = do

402 , sqlErrorMsg = B.concat [ "query: ", statusmsg

404 , sqlErrorMsg = B.concat [ "query: ", statusmsg

403 , ": ", errormsg ]}

405 , ": ", errormsg ]}

404

406

405−{--

407+

406−withResult (Base.storeResult conn) q $ \r fs -> do

408+finishFold :: (QueryResults r) =>

407− status <-

409+ Connection

408−/ flip fix [] $ \loop acc -> do

410+ -> PQ.Connection

409− row <- Base.fetchRow r

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

410− case row of

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

411− [] -> return (reverse acc)

429+ return Field{..}

430+ nrows <- PQ.ntuples result

431+ a' <- foldM (\a row -> do

432+ values <- forM' 0 (ncols-1) (PQ.getvalue result row)

412− _ -> let !c = convertResults fs 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]

413− in loop (c:acc)

437+ loop a'

414−--}

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+

415{--

448{--

416finishFold :: (QueryResults r) =>

449finishFold :: (QueryResults r) =>

417 Connection -> Query -> a -> (a -> r -> IO a) -> IO a

450 Connection -> Query -> a -> (a -> r -> IO a) -> IO a