postgresql-simple 0.3.2.0 → 0.3.3.0
raw patch · 3 files changed
+82/−18 lines, 3 files
Files
- postgresql-simple.cabal +2/−2
- src/Database/PostgreSQL/Simple.hs +25/−10
- test/Main.hs +55/−6
postgresql-simple.cabal view
@@ -1,5 +1,5 @@ Name: postgresql-simple-Version: 0.3.2.0+Version: 0.3.3.0 Synopsis: Mid-Level PostgreSQL client library Description: Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -75,7 +75,7 @@ source-repository this type: git location: http://github.com/lpsmith/postgresql-simple- tag: v0.3.2.0+ tag: v0.3.3.0 test-suite test type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs view
@@ -111,9 +111,9 @@ import Blaze.ByteString.Builder ( Builder, fromByteString, toByteString ) import Blaze.ByteString.Builder.Char8 (fromChar)+import Blaze.Text ( integral ) import Control.Applicative ((<$>), pure)-import Control.Exception- ( Exception, throw, throwIO, finally )+import Control.Exception as E import Control.Monad (foldM) import Data.ByteString (ByteString) import Data.Int (Int64)@@ -463,7 +463,7 @@ -> a -> (a -> row -> IO a) -> IO a-doFold FoldOptions{..} conn _template q a f = do+doFold FoldOptions{..} conn _template q a0 f = do stat <- withConnection conn PQ.transactionStatus case stat of PQ.TransIdle -> withTransactionMode transactionMode conn go@@ -481,11 +481,29 @@ 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 " <> q)- loop a `finally` execute_ conn "CLOSE fold"+ declare = do+ name <- newTempName conn+ _ <- execute_ conn $ mconcat + [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]+ return name+ fetch (Query name) = query_ conn $+ Query (toByteString (fromByteString "FETCH FORWARD " + <> integral chunkSize+ <> fromByteString " FROM "+ <> fromByteString name+ ))+ close name =+ (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->+ -- Don't throw exception if CLOSE failed because the transaction is+ -- aborted. Otherwise, it will throw away the original error.+ if isFailedTransactionError ex then return () else throwIO ex + go = bracket declare close $ \name ->+ let loop a = do+ rs <- fetch name+ if null rs then return a else foldM f a rs >>= loop+ in loop a0+ -- 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)@@ -495,9 +513,6 @@ 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 :: (ToRow q, FromRow r) =>
test/Main.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DoAndIfThenElse #-} {-# LANGUAGE ScopedTypeVariables #-} import Common import Database.PostgreSQL.Simple.FromField (FromField)@@ -8,6 +9,7 @@ import Control.Exception as E import Control.Monad import Data.ByteString (ByteString)+import Data.IORef import Data.Typeable import qualified Data.ByteString as B import qualified Data.Map as Map@@ -78,6 +80,48 @@ [] $ \xs (Only x) -> return (x:xs) reverse xs @?= ([1..10000] :: [Int]) + ref <- newIORef []+ forEach conn "SELECT * FROM generate_series(1,?) a, generate_series(1,?) b"+ (100 :: Int, 50 :: Int) $ \(a :: Int, b :: Int) -> do+ xs <- readIORef ref+ writeIORef ref $! (a,b):xs+ xs <- readIORef ref+ reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]++ -- Make sure fold propagates our exception.+ ref <- newIORef []+ True <- expectError (== TestException) $+ forEach_ conn "SELECT generate_series(1,10)" $ \(Only a) ->+ if a == 5 then do+ -- Cause a SQL error to trip up CLOSE.+ True <- expectError isSyntaxError $+ execute_ conn "asdf"+ True <- expectError ST.isFailedTransactionError $+ (query_ conn "SELECT 1" :: IO [(Only Int)])+ throwIO TestException+ else do+ xs <- readIORef ref+ writeIORef ref $! (a :: Int) : xs+ xs <- readIORef ref+ reverse xs @?= [1..4]++ withTransaction conn $ replicateM_ 2 $ do+ xs <- fold_ conn "VALUES (1), (2), (3), (4), (5)"+ [] $ \xs (Only x) -> return (x:xs)+ reverse xs @?= ([1..5] :: [Int])++ ref <- newIORef []+ forEach_ conn "SELECT generate_series(1,101)" $ \(Only a) ->+ forEach_ conn "SELECT generate_series(1,55)" $ \(Only b) -> do+ xs <- readIORef ref+ writeIORef ref $! (a :: Int, b :: Int) : xs+ xs <- readIORef ref+ reverse xs @?= [(a,b) | a <- [1..101], b <- [1..55]]++ xs <- fold_ conn "SELECT 1 WHERE FALSE"+ [] $ \xs (Only x) -> return (x:xs)+ xs @?= ([] :: [Int])+ -- TODO: add more complete tests, e.g.: -- -- * Fold in a transaction@@ -183,17 +227,22 @@ return () - where- expectError p io =- (io >> return False) `E.catch` \ex ->- if p ex then return True else throwIO ex- isUniqueViolation SqlError{..} = sqlState == "23505"- data TestException = TestException deriving (Eq, Show, Typeable) instance Exception TestException++expectError :: Exception e => (e -> Bool) -> IO a -> IO Bool+expectError p io =+ (io >> return False) `E.catch` \ex ->+ if p ex then return True else throwIO ex++isUniqueViolation :: SqlError -> Bool+isUniqueViolation SqlError{..} = sqlState == "23505"++isSyntaxError :: SqlError -> Bool+isSyntaxError SqlError{..} = sqlState == "42601" ------------------------------------------------------------------------