postgresql-simple 0.0.3 → 0.0.4
raw patch · 6 files changed
+254/−119 lines, 6 files
Files
- postgresql-simple.cabal +2/−2
- src/Database/PostgreSQL/Simple.hs +172/−89
- src/Database/PostgreSQL/Simple/Param.hs +2/−2
- src/Database/PostgreSQL/Simple/QueryResults.hs +42/−19
- src/Database/PostgreSQL/Simple/Result.hs +6/−1
- src/Database/PostgreSQL/Simple/SqlQQ.hs +30/−6
postgresql-simple.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-simple-Version: 0.0.3+Version: 0.0.4 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -53,4 +53,4 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple- tag: v0.0.3+ tag: v0.0.4
src/Database/PostgreSQL/Simple.hs view
@@ -69,8 +69,13 @@ , query , query_ -- * Queries that stream results+ , FoldOptions(..)+ , FetchQuantity(..)+ , defaultFoldOptions , fold+ , foldWithOptions , fold_+ , foldWithOptions_ , forEach , forEach_ -- * Statements that do not return results@@ -80,8 +85,18 @@ -- , Base.insertID -- * Transaction handling , withTransaction+ , TransactionMode(..)+ , IsolationLevel(..)+ , ReadWriteMode(..)+ , defaultTransactionMode+ , defaultIsolationLevel+ , defaultReadWriteMode+ , withTransactionLevel+ , withTransactionMode -- , Base.autocommit , begin+ , beginLevel+ , beginMode , commit , rollback -- * Helper functions@@ -93,7 +108,7 @@ import Blaze.ByteString.Builder.Char8 (fromChar) import Control.Applicative ((<$>), pure) import Control.Concurrent.MVar-import Control.Exception (Exception, bracket, onException, throw, throwIO)+import Control.Exception (Exception, bracket, onException, throw, throwIO, finally) import Control.Monad (foldM) import Control.Monad.Fix (fix) import Data.ByteString (ByteString)@@ -294,11 +309,6 @@ -- results. Results are streamed incrementally from the server, and -- consumed via a left fold. ----- The result consumer must be carefully written to execute--- quickly. If the consumer is slow, server resources will be tied up,--- and other clients may not be able to update the tables from which--- the results are being streamed.--- -- When dealing with small results, it may be simpler (and perhaps -- faster) to use 'query' instead. --@@ -313,23 +323,43 @@ -- using 'execute' instead of 'query'). -- -- * 'ResultError': result conversion failed.-fold :: (QueryParams q, QueryResults r) =>- Connection- -> Query -- ^ Query template.- -> q -- ^ Query parameters.- -> a -- ^ Initial state for result consumer.- -> (a -> r -> IO a) -- ^ Result consumer.- -> IO a-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 = "" } +fold :: ( QueryResults row, QueryParams params )+ => Connection+ -> Query+ -> params+ -> a+ -> (a -> row -> IO a)+ -> IO a+fold = foldWithOptions defaultFoldOptions++data FetchQuantity+ = Automatic+ | Fixed !Int++data FoldOptions+ = FoldOptions {+ fetchQuantity :: !FetchQuantity,+ transactionMode :: !TransactionMode+ }++defaultFoldOptions = FoldOptions {+ fetchQuantity = Automatic,+ transactionMode = TransactionMode ReadCommitted ReadOnly+ }++foldWithOptions :: ( QueryResults row, QueryParams params )+ => FoldOptions+ -> Connection+ -> Query+ -> params+ -> a+ -> (a -> row -> IO a)+ -> IO a+foldWithOptions opts conn template qs a f = do+ q <- formatQuery conn template qs+ doFold opts conn template (Query q) a f+ -- | A version of 'fold' that does not perform query substitution. fold_ :: (QueryResults r) => Connection@@ -337,16 +367,64 @@ -> a -- ^ Initial state for result consumer. -> (a -> r -> IO a) -- ^ Result consumer. -> IO a-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 = "" }+fold_ = foldWithOptions_ defaultFoldOptions ++foldWithOptions_ :: (QueryResults r) =>+ FoldOptions+ -> Connection+ -> Query -- ^ Query.+ -> a -- ^ Initial state for result consumer.+ -> (a -> r -> IO a) -- ^ Result consumer.+ -> IO a+foldWithOptions_ opts conn query a f = doFold opts conn query query a f+++doFold :: ( QueryResults row )+ => FoldOptions+ -> Connection+ -> Query+ -> Query+ -> a+ -> (a -> row -> IO a)+ -> IO a+doFold FoldOptions{..} conn _template q a f = do+ stat <- withConnection conn PQ.transactionStatus+ case stat of+ PQ.TransIdle -> withTransactionMode transactionMode conn go+ PQ.TransInTrans -> go+ PQ.TransActive -> fail "foldWithOpts FIXME: PQ.TransActive"+ -- This _shouldn't_ occur in the current incarnation of+ -- the library, as we aren't using libpq asynchronously.+ -- However, it could occur in future incarnations of+ -- this library or if client code uses the Internal module+ -- to use raw libpq commands on postgresql-simple connections.+ PQ.TransInError -> fail "foldWithOpts FIXME: PQ.TransInError"+ -- This should be turned into a better error message.+ -- It is probably a bad idea to automatically roll+ -- back the transaction and start another.+ PQ.TransUnknown -> fail "foldWithOpts FIXME: PQ.TransUnknown"+ -- Not sure what this means.+ where+ go = do+ -- FIXME: what about name clashes with already-declared cursors?+ _ <- execute_ conn ("DECLARE fold NO SCROLL CURSOR FOR "+ `mappend` q)+ loop a `finally` execute_ conn "CLOSE fold"++-- FIXME: choose the Automatic chunkSize more intelligently+-- One possibility is to use the type of the results, although this+-- still isn't a perfect solution, given that common types (e.g. text)+-- are of highly variable size.+-- A refinement of this technique is to pick this number adaptively+-- as results are read in from the database.+ chunkSize = case fetchQuantity of+ Automatic -> 256+ Fixed n -> n+ loop a = do+ rs <- query conn "FETCH FORWARD ? FROM fold" (Only chunkSize)+ if null rs then return a else foldM f a rs >>= loop+ -- | A version of 'fold' that does not transform a state value. forEach :: (QueryParams q, QueryResults r) => Connection@@ -404,53 +482,36 @@ , sqlErrorMsg = B.concat [ "query: ", statusmsg , ": ", errormsg ]} +-- | Of the four isolation levels defined by the SQL standard,+-- these are the three levels distinguished by PostgreSQL as of version 9.0.+-- See <http://www.postgresql.org/docs/9.1/static/transaction-iso.html>+-- for more information. -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'- _ -> do- errormsg <- maybe "" id <$> PQ.resultErrorMessage result- statusmsg <- PQ.resStatus stat- state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate- clear c- throwIO $ SqlError {- sqlState = state,- sqlNativeError = fromEnum stat,- sqlErrorMsg = B.concat [ "fold: ", statusmsg- , ": ", errormsg ]}- clear c = do- mres <- PQ.getResult c- case mres of- Nothing -> return ()- Just _ -> clear c+data IsolationLevel+ = ReadCommitted+ | RepeatableRead+ | Serializable+ deriving (Show, Eq, Ord, Enum, Bounded) +data ReadWriteMode+ = ReadWrite+ | ReadOnly+ deriving (Show, Eq, Ord, Enum, Bounded)++data TransactionMode = TransactionMode {+ isolationLevel :: !IsolationLevel,+ readWriteMode :: !ReadWriteMode+ } deriving (Show, Eq)++defaultTransactionMode :: TransactionMode+defaultTransactionMode = TransactionMode ReadCommitted ReadWrite++defaultIsolationLevel :: IsolationLevel+defaultIsolationLevel = ReadCommitted++defaultReadWriteMode :: ReadWriteMode+defaultReadWriteMode = ReadWrite+ -- | Execute an action inside a SQL transaction. -- -- This function initiates a transaction with a \"@begin@@ -462,31 +523,53 @@ -- PostgreSQL-related exception), the transaction will be rolled back using -- 'rollback', then the exception will be rethrown. withTransaction :: Connection -> IO a -> IO a-withTransaction conn act = do- _ <- begin conn+withTransaction = withTransactionMode defaultTransactionMode++-- | Execute an action inside a SQL transaction with a given isolation level.+withTransactionLevel :: IsolationLevel -> Connection -> IO a -> IO a+withTransactionLevel lvl+ = withTransactionMode defaultTransactionMode { isolationLevel = lvl }++-- | Execute an action inside a SQL transaction with a given transaction mode.+withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a+withTransactionMode mode conn act = do+ beginMode mode conn r <- act `onException` rollback conn commit conn return r -- | Rollback a transaction.--- rollback :: (MonadCatchIO m,MonadIO m) => Connection -> m () rollback :: Connection -> IO ()-rollback conn = do- _ <- execute_ conn "ABORT"- return ()+rollback conn = execute_ conn "ABORT" >> return () -- | Commit a transaction.--- commit :: (MonadCatchIO m,MonadIO m) => Connection -> m () commit :: Connection -> IO ()-commit conn = do- _ <- execute_ conn "COMMIT"- return ()+commit conn = execute_ conn "COMMIT" >> return () -- | Begin a transaction.--- begin :: (MonadCatchIO m,MonadIO m) => Connection -> m () begin :: Connection -> IO ()-begin conn = do- _ <- execute_ conn "BEGIN"+begin = beginMode defaultTransactionMode++-- | Begin a transaction with a given isolation level+beginLevel :: IsolationLevel -> Connection -> IO ()+beginLevel lvl = beginMode defaultTransactionMode { isolationLevel = lvl }++-- | Begin a transaction with a given transaction mode+beginMode :: TransactionMode -> Connection -> IO ()+beginMode mode conn = do+ execute_ conn $! case mode of+ TransactionMode ReadCommitted ReadWrite ->+ "BEGIN"+ TransactionMode ReadCommitted ReadOnly ->+ "BEGIN READ ONLY"+ TransactionMode RepeatableRead ReadWrite ->+ "BEGIN ISOLATION LEVEL REPEATABLE READ"+ TransactionMode RepeatableRead ReadOnly ->+ "BEGIN ISOLATION LEVEL REPEATABLE READ READ ONLY"+ TransactionMode Serializable ReadWrite ->+ "BEGIN ISOLATION LEVEL SERIALIZABLE"+ TransactionMode Serializable ReadOnly ->+ "BEGIN ISOLATION LEVEL SERIALIZABLE READ ONLY" return () fmtError :: String -> Query -> [Action] -> a
src/Database/PostgreSQL/Simple/Param.hs view
@@ -157,12 +157,12 @@ {-# INLINE render #-} instance Param Float where- render v | isNaN v || isInfinite v = renderNull+ render v | isNaN v || isInfinite v = Plain (inQuotes (float v)) | otherwise = Plain (float v) {-# INLINE render #-} instance Param Double where- render v | isNaN v || isInfinite v = renderNull+ render v | isNaN v || isInfinite v = Plain (inQuotes (double v)) | otherwise = Plain (double v) {-# INLINE render #-}
src/Database/PostgreSQL/Simple/QueryResults.hs view
@@ -23,6 +23,7 @@ , convertError ) where +import Control.Applicative (Applicative(..), (<$>)) import Control.Exception (SomeException(..), throw) import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B@@ -30,6 +31,7 @@ import Database.PostgreSQL.Simple.Internal import Database.PostgreSQL.Simple.Result (ResultError(..), Result(..)) import Database.PostgreSQL.Simple.Types (Only(..))+import qualified Database.PostgreSQL.LibPQ as LibPQ (Result) -- | A collection type that can be converted from a list of strings. --@@ -42,41 +44,53 @@ -- -- @ -- instance ('Result' a, 'Result' b) => 'QueryResults' (a,b) where--- 'convertResults' [fa,fb] [va,vb] = (a,b)--- where !a = 'convert' fa va--- !b = 'convert' fb vb+-- 'convertResults' [fa,fb] [va,vb] = do+-- !a <- 'convert' fa va+-- !b <- 'convert' fb vb+-- 'return' (a,b) -- 'convertResults' fs vs = 'convertError' fs vs 2 -- @ -- -- Notice that this instance evaluates each element to WHNF before--- constructing the pair. By doing this, we guarantee two important--- properties:+-- constructing the pair. This property is important enough that its+-- a rule all 'QueryResult' instances should follow: ----- * Keep resource usage under control by preventing the construction--- of potentially long-lived thunks.+-- * Evaluate every 'Result' value to WHNF before constructing+-- the result ----- * Ensure that any 'ResultError' that might arise is thrown--- immediately, rather than some place later in application code--- that cannot handle it.+-- Doing so keeps resource usage under local control by preventing the+-- construction of potentially long-lived thunks that are forced+-- (or not) by the consumer. ----- You can also declare Haskell types of your own to be instances of--- 'QueryResults'.+-- This is important to postgresql-simple-0.0.4 because a wayward thunk+-- causes the entire LibPQ.'LibPQ.Result' to be retained. This could lead+-- to a memory leak, depending on how the thunk is consumed. --+-- Note that instances can be defined outside of postgresql-simple,+-- which is often useful. For example, here is an attempt at an+-- instance for a user-defined pair:+-- -- @---data User { firstName :: String, lastName :: String }+-- data User = User { firstName :: String, lastName :: String } -----instance 'QueryResults' User where--- 'convertResults' [fa,fb] [va,vb] = User a b--- where !a = 'convert' fa va--- !b = 'convert' fb vb--- 'convertResults' fs vs = 'convertError' fs vs+-- instance 'QueryResults' User where+-- 'convertResults' [fa,qfb] [va,vb] = User \<$\> a \<*\> b+-- where !a = 'convert' fa va+-- !b = 'convert' fb vb+-- 'convertResults' fs vs = 'convertError' fs vs 2 -- @+--+-- In this example, the bang patterns are not used correctly. They force+-- the data constructors of the 'Either' type, and are not forcing the+-- 'Result' values we need to force. This gives the consumer of the+-- 'QueryResult' the ability to cause the memory leak, which is an+-- undesirable state of affairs. class QueryResults a where convertResults :: [Field] -> [Maybe ByteString] -> Either SomeException a -- ^ Convert values from a row into a Haskell collection. --- -- This function will throw a 'ResultError' if conversion of the+ -- This function will return a 'ResultError' if conversion of the -- collection fails. instance (Result a) => QueryResults (Only a) where@@ -198,6 +212,14 @@ return (a,b,c,d,e,f,g,h,i,j) convertResults fs vs = convertError fs vs 10 +f <$!> (!x) = f <$> x+infixl 4 <$!>++instance Result a => QueryResults [a] where+ convertResults fs vs = foldr convert' (pure []) (zip fs vs)+ where convert' (f,v) as = (:) <$!> convert f v <*> as+ {-# INLINE convertResults #-}+ -- | Throw a 'ConversionFailed' exception, indicating a mismatch -- between the number of columns in the 'Field' and row, and the -- number in the collection to be converted to.@@ -220,3 +242,4 @@ ellipsis bs | B.length bs > 15 = B.take 10 bs `B.append` "[...]" | otherwise = bs+
src/Database/PostgreSQL/Simple/Result.hs view
@@ -26,6 +26,7 @@ ( Result(..) , ResultError(..)+ , returnError ) where #include "MachDeps.h"@@ -250,9 +251,13 @@ doConvert f _ _ _ = returnError UnexpectedNull f "" +-- | Given one of the constructors from 'ResultError', the field,+-- and an 'errMessage', this fills in the other fields in the+-- exception value and returns it in a 'Left . SomeException'+-- constructor. returnError :: forall a err . (Typeable a, Exception err) => (String -> String -> String -> err)- -> Field -> String -> Status a+ -> Field -> String -> Either SomeException a returnError mkErr f = left . mkErr (B.unpack (typename f)) (show (typeOf (undefined :: a)))
src/Database/PostgreSQL/Simple/SqlQQ.hs view
@@ -15,12 +15,36 @@ import Data.Char -- | 'sql' is a quasiquoter that eases the syntactic burden--- of writing big sql statements in Haskell source code. It attempts--- to minimize whitespace. Note that this implementation is incomplete--- and can mess up your syntax; it only really understands standard--- sql string literals (default in PostgreSQL 9) and not the extended--- escape syntax or other situations where white space should be--- preserved as is.+-- of writing big sql statements in Haskell source code. For example:+--+-- > {-# LANGUAGE QuasiQuotes #-}+-- >+-- > query conn [sql| SELECT column_a, column_b+-- > FROM table1 NATURAL JOIN table2+-- > WHERE ? <= time AND time < ?+-- > AND name LIKE ?+-- > ORDER BY size DESC+-- > LIMIT 100 |]+-- > (beginTime,endTime,string)+--+-- This quasiquoter attempts to mimimize whitespace; otherwise the+-- above query would consist of approximately half whitespace when sent+-- to the database backend.+--+-- The implementation of the whitespace reducer is currently incomplete.+-- Thus it can mess up your syntax in cases where whitespace should be+-- preserved as-is. It does preserve whitespace inside standard SQL string+-- literals. But it can get confused by the non-standard PostgreSQL string+-- literal syntax (which is the default setting in PostgreSQL 8 and below),+-- the extended escape string syntax, and other similar constructs.+--+-- Of course, this caveat only applies to text written inside the SQL+-- quasiquoter; whitespace reduction is a compile-time computation and+-- thus will not touch the @string@ parameter above, which is a run-time+-- value.+--+-- Also note that this will not work if the substring @|]@ is contained+-- in the query. sql :: QuasiQuoter sql = QuasiQuoter