postgresql-simple 0.5.1.3 → 0.5.2.0

raw patch · 18 files changed

+206/−100 lines, 18 filesdep +filepathdep +tastydep +tasty-golden

Dependencies added: filepath, tasty, tasty-golden, tasty-hunit

Files

• CHANGELOG.md +18/−0
• CONTRIBUTORS +1/−0
• postgresql-simple.cabal +7/−2
• src/Database/PostgreSQL/Simple/Copy.hs +4/−2
• src/Database/PostgreSQL/Simple/Errors.hs +1/−1
• src/Database/PostgreSQL/Simple/FromField.hs +25/−4
• src/Database/PostgreSQL/Simple/HStore.hs +2/−2
• src/Database/PostgreSQL/Simple/Internal.hs +10/−7
• src/Database/PostgreSQL/Simple/LargeObjects.hs +1/−1
• src/Database/PostgreSQL/Simple/Notification.hs +2/−2
• src/Database/PostgreSQL/Simple/Time.hs +1/−1
• src/Database/PostgreSQL/Simple/Transaction.hs +2/−2
• src/Database/PostgreSQL/Simple/Types.hs +19/−9
• test/Common.hs +2/−2
• test/Main.hs +107/−59
• test/Notify.hs +1/−2
• test/Serializable.hs +1/−2
• test/Time.hs +2/−2

@@ -0,0 +1,18 @@+For the full changelog, see+<https://github.com/lpsmith/postgresql-simple/blob/master/CHANGES.md>++### Version 0.5.2.0 (2016-05-25)+  * Significantly improved the error reporting from+    `Copy.putCopyData`, thanks to Ben Gamari.++  * Moved the test suite to use `tasty`,  with a big thanks+    to Ben Gamari.++  * Added `FromField.optionalField`,  and updated the documentation+    of `FromField.fromJSONField`, as inspired by an email conversation+    with Ian Wagner.++  * Updated all links in the haddocks to use https,  and added a link+    to the documentation of `connectPostgreSQL`.++  * Added a truncated changelog to the source distribution.

@@ -30,3 +30,4 @@ Alexey Khudyakov <alexey.skladnoy@gmail.com> Timo von Holtz <tvh@anchor.com.au> Amit Levy <amit@amitlevy.com>+Ben Gamari <ben@smart-cactus.org>

@@ -1,5 +1,5 @@ Name:                postgresql-simple-Version:             0.5.1.3+Version:             0.5.2.0 Synopsis:            Mid-Level PostgreSQL client library Description:     Mid-Level PostgreSQL client library, forked from mysql-simple.@@ -16,6 +16,7 @@  extra-source-files:      CONTRIBUTORS+     CHANGELOG.md  Library   hs-source-dirs: src@@ -87,7 +88,7 @@ source-repository this   type:     git   location: http://github.com/lpsmith/postgresql-simple-  tag:      v0.5.1.3+  tag:      v0.5.2.0  test-suite test   type:           exitcode-stdio-1.0@@ -115,6 +116,10 @@                , bytestring                , containers                , cryptohash+               , filepath+               , tasty+               , tasty-hunit+               , tasty-golden                , HUnit                , postgresql-simple                , text

@@ -9,7 +9,7 @@ -- Stability:   experimental -- -- mid-level support for COPY IN and COPY OUT.   See--- <http://www.postgresql.org/docs/9.2/static/sql-copy.html> for+-- <https://www.postgresql.org/docs/9.5/static/sql-copy.html> for -- more information. -- -- To use this binding,  first call 'copy' with an appropriate@@ -224,7 +224,9 @@     consumeResults pqconn     let rowCount =   P.string "COPY " *> (P.decimal <* P.endOfInput)     case P.parseOnly rowCount cmdStat of-      Left  _ -> fail errCmdStatusFmt+      Left  _ -> do mmsg <- PQ.errorMessage pqconn+                    fail $ errCmdStatusFmt+                        ++ maybe "" (\msg -> "\nConnection error: "++B.unpack msg) mmsg       Right n -> return $! n   where     errCmdStatus    = B.unpack funcName ++ ": failed to fetch command status"

@@ -124,7 +124,7 @@ ------------------------------------------------------------------------ -- Error predicates ----- http://www.postgresql.org/docs/current/static/errcodes-appendix.html+-- https://www.postgresql.org/docs/9.5/static/errcodes-appendix.html  isSerializationError :: SqlError -> Bool isSerializationError = isSqlState "40001"

@@ -107,6 +107,7 @@     , PQ.Format(..)     , pgArrayFieldParser +    , optionalField     , fromJSONField     ) where @@ -268,10 +269,21 @@ --   compatible with type @a@.  Note that the type is not checked if --   the value is null, although it is inadvisable to rely on this --   behavior.-instance (FromField a) => FromField (Maybe a) where-    fromField _ Nothing = pure Nothing-    fromField f bs      = Just <$> fromField f bs+instance FromField a => FromField (Maybe a) where+    fromField = optionalField fromField +-- | For dealing with SQL @null@ values outside of the 'FromField' class.+--   Alternatively, one could use 'Control.Applicative.optional',  but that+--   also turns type and conversion errors into 'Nothing',  whereas this is+--   more specific and turns only @null@ values into 'Nothing'.++optionalField :: FieldParser a -> FieldParser (Maybe a)+optionalField p f mv =+    case mv of+      Nothing -> pure Nothing+      Just _  -> Just <$> p f mv+{-# INLINE optionalField #-}+ -- | compatible with any data type,  but the value must be null instance FromField Null where     fromField _ Nothing  = pure Null@@ -559,6 +571,16 @@ -- -- The 'Typeable' constraint is required to show more informative -- error messages when parsing fails.+--+-- Note that @fromJSONField :: FieldParser ('Maybe' Foo)@ will return+-- @'Nothing'@ on the json @null@ value, and return an exception on SQL @null@+-- value.  Alternatively,  one could write @'optionalField' fromJSONField@+-- that will return @Nothing@ on SQL @null@,  and otherwise will call+-- @fromJSONField :: FieldParser Foo@ and then return @'Just'@ the+-- result value,  or return its exception.  If one would+-- like to return @Nothing@ on both the SQL @null@ and json @null@ values,+-- one way to do it would be to write+-- @\\f mv -> 'Control.Monad.join' '<$>' optionalField fromJSONField f mv@ fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a fromJSONField f mbBs = do     value <- fromField f mbBs@@ -566,7 +588,6 @@         JSON.Error err -> returnError ConversionFailed f $                             "JSON decoding error: " ++ err         JSON.Success x -> pure x-  -- | Compatible with the same set of types as @a@.  Note that --   modifying the 'IORef' does not have any effects outside

@@ -8,14 +8,14 @@ -- -- Parsers and printers for hstore,  a extended type bundled with -- PostgreSQL providing finite maps from text strings to text strings.--- See <http://www.postgresql.org/docs/9.2/static/hstore.html> for more+-- See <https://www.postgresql.org/docs/9.5/static/hstore.html> for more -- information. -- -- Note that in order to use this type,  a database superuser must -- install it by running a sql script in the share directory.  This -- can be done on PostgreSQL 9.1 and later with the command -- @CREATE EXTENSION hstore@.  See--- <http://www.postgresql.org/docs/9.2/static/contrib.html> for more+-- <https://www.postgresql.org/docs/9.5/static/contrib.html> for more -- information. -- ------------------------------------------------------------------------------

@@ -154,10 +154,11 @@ connect = connectPostgreSQL . postgreSQLConnectionString  -- | Attempt to make a connection based on a libpq connection string.---   See <http://www.postgresql.org/docs/9.3/static/libpq-connect.html#LIBPQ-CONNSTRING>+--   See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING> --   for more information.  Also note that environment variables also affect --   parameters not provided, parameters provided as the empty string, and a---   few other things; see <http://www.postgresql.org/docs/9.3/static/libpq-envars.html>+--   few other things; see+--   <https://www.postgresql.org/docs/9.5/static/libpq-envars.html> --   for details.  Here is an example with some of the most commonly used --   parameters: --@@ -188,7 +189,7 @@ --   Omitting @password@ will default to an appropriate password found --   in the @pgpass@ file,  or no password at all if a matching line is --   not found.   See---   <http://www.postgresql.org/docs/9.3/static/libpq-pgpass.html> for+--   <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for --   more information regarding this file. -- --   As all parameters are optional and the defaults are sensible,  the@@ -206,18 +207,20 @@ --   or production machines, or you will need to use a @pgpass@ file --   with the @password@ or @md5@ authentication methods. -----   See <http://www.postgresql.org/docs/9.3/static/client-authentication.html>+--   See <https://www.postgresql.org/docs/9.5/static/client-authentication.html> --   for more information regarding the authentication process. -- --   SSL/TLS will typically "just work" if your postgresql server supports or --   requires it.  However,  note that libpq is trivially vulnerable to a MITM---   attack without setting additional SSL parameters in the connection string.---   In particular,  @sslmode@ needs to be set to @require@, @verify-ca@, or+--   attack without setting additional SSL connection parameters.  In+--   particular,  @sslmode@ needs to be set to @require@, @verify-ca@, or --   @verify-full@ in order to perform certificate validation.  When @sslmode@ --   is @require@,  then you will also need to specify a @sslrootcert@ file, --   otherwise no validation of the server's identity will be performed. --   Client authentication via certificates is also possible via the---   @sslcert@ and @sslkey@ parameters.+--   @sslcert@ and @sslkey@ parameters.   See+--   <https://www.postgresql.org/docs/9.5/static/libpq-ssl.html>+--   for detailed information regarding libpq and SSL.  connectPostgreSQL :: ByteString -> IO Connection connectPostgreSQL connstr = do

@@ -7,7 +7,7 @@ -- Maintainer  :  leon@melding-monads.com -- -- Support for PostgreSQL's Large Objects;  see--- <http://www.postgresql.org/docs/9.1/static/largeobjects.html> for more+-- <https://www.postgresql.org/docs/9.5/static/largeobjects.html> for more -- information. -- -- Note that Large Object File Descriptors are only valid within a single

@@ -14,7 +14,7 @@ -- -- Support for receiving asynchronous notifications via PostgreSQL's -- Listen/Notify mechanism.  See--- <http://www.postgresql.org/docs/9.1/static/sql-notify.html> for more+-- <https://www.postgresql.org/docs/9.5/static/sql-notify.html> for more -- information. -- -- Note that on Windows,  @getNotification@ currently uses a polling loop@@ -25,7 +25,7 @@ -- Notifications do not create any extra work for the backend,  and are -- likely cheaper on the client side as well. ----- <http://hackage.haskell.org/trac/ghc/ticket/7353>+-- <https://hackage.haskell.org/trac/ghc/ticket/7353> -- ----------------------------------------------------------------------------- 

@@ -11,7 +11,7 @@ Also, this module also contains commentary regarding postgresql's timestamp types,  civil timekeeping in general,  and how it relates to postgresql-simple. You can read more about PostgreSQL's date and time types-at <http://www.postgresql.org/docs/9.1/static/datatype-datetime.html>,+at <https://www.postgresql.org/docs/9.5/static/datatype-datetime.html>, and the IANA time zone database at <https://en.wikipedia.org/wiki/Tz_database>.  Stack Overflow also has some excellent commentary on time,  if it is a

@@ -45,7 +45,7 @@  -- | 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>+-- See <https://www.postgresql.org/docs/9.5/static/transaction-iso.html> -- for more information.   Note that prior to PostgreSQL 9.0, 'RepeatableRead' -- was equivalent to 'Serializable'. @@ -203,7 +203,7 @@ -- be used inside of a transaction, and provides a sort of -- \"nested transaction\". ----- See <http://www.postgresql.org/docs/current/static/sql-savepoint.html>+-- See <https://www.postgresql.org/docs/9.5/static/sql-savepoint.html> withSavepoint :: Connection -> IO a -> IO a withSavepoint conn body =   mask $ \restore -> do

@@ -131,11 +131,11 @@ -- 1.  Use postgresql-simple's 'Values' type instead,  which can handle the --     empty case correctly.  Note however that while specifying the --     postgresql type @"int4"@ is mandatory in the empty case,  specifying---     the haskell type @[Only Int]@ would not normally be needed in+--     the haskell type @Values (Only Int)@ would not normally be needed in --     realistic use cases. -- --     > query c "select * from whatever where id not in ?"---     >         (Only (Values "int4") ([] :: [Only Int]))+--     >         (Only (Values ["int4"] [] :: Values (Only Int))) -- -- -- 2.  Use sql's @COALESCE@ operator to turn a logical @null@ into the correct@@ -143,10 +143,18 @@ --     case: -- --     > query c "select * from whatever where coalesce(id NOT in ?, TRUE)"---     >         (Only (In ([] :: [Int])))+--     >         (Only (In [] :: In [Int])) -- --     > query c "select * from whatever where coalesce(id IN ?, FALSE)"---     >         (Only (In ([] :: [Int])))+--     >         (Only (In [] :: In [Int]))+--+--     Note that at as of PostgreSQL 9.4,  the query planner cannot see inside+--     the @COALESCE@ operator,  so if you have an index on @id@ then you+--     probably don't want to write the last example with @COALESCE@,  which+--     would result in a table scan.   There are further caveats if @id@ can+--     be null or you want null treated sensibly as a component of @IN@ or+--     @NOT IN@.+ newtype In a = In a     deriving (Eq, Ord, Read, Show, Typeable, Functor) @@ -209,8 +217,9 @@ newtype Savepoint = Savepoint Query     deriving (Eq, Ord, Show, Read, Typeable) --- | Represents a @VALUES@ table literal,  usable as an alternative---   to @executeMany@ and @returning@.  The main advantage is that+-- | Represents a @VALUES@ table literal,  usable as an alternative to+--   'Database.PostgreSQL.Simple.executeMany' and+--   'Database.PostgreSQL.Simple.returning'.  The main advantage is that --   you can parametrize more than just a single @VALUES@ expression. --   For example,  here's a query to insert a thing into one table --   and some attributes of that thing into another,   returning the@@ -223,7 +232,7 @@ -- >     ), new_attributes AS ( -- >       INSERT INTO thing_attributes -- >          SELECT new_thing.id, attrs.*--- >            FROM new_thing JOIN ? attrs+-- >            FROM new_thing JOIN ? attrs ON TRUE -- >     ) SELECT * FROM new_thing -- >  |] ("foo", Values [  "int4", "text"    ] -- >                    [ ( 1    , "hello" )@@ -249,7 +258,8 @@ --   is turned into a properly quoted identifier,  the type name is case --   sensitive and must be as it appears in the @pg_type@ table.   Thus, --   you must write @timestamptz@ instead of @timestamp with time zone@,---   @int4@ instead of @integer@, @_int8@ instead of @bigint[]@, etcetera.+--   @int4@ instead of @integer@ or @serial@, @_int8@ instead of @bigint[]@,+--   etcetera. -- --   You may omit the type names,  however,  if you do so the list --   of values must be non-empty,  and postgresql must be able to infer@@ -258,7 +268,7 @@ --   without issuing the query.   In the second case,  the postgres server --   will return an error which will be turned into a @SqlError@ exception. -----   See <http://www.postgresql.org/docs/9.3/static/sql-values.html> for+--   See <https://www.postgresql.org/docs/9.5/static/sql-values.html> for --   more information. data Values a = Values [QualifiedIdentifier] [a]     deriving (Eq, Ord, Show, Read, Typeable)

@@ -1,6 +1,6 @@ module Common (     module Database.PostgreSQL.Simple,-    module Test.HUnit,+    module Test.Tasty.HUnit,     TestEnv(..),     md5, ) where@@ -8,7 +8,7 @@ import Data.ByteString              (ByteString) import Data.Text                    (Text) import Database.PostgreSQL.Simple-import Test.HUnit+import Test.Tasty.HUnit  import qualified Crypto.Hash.MD5        as MD5 import qualified Data.ByteString.Base16 as Base16

@@ -8,51 +8,58 @@ import Database.PostgreSQL.Simple.HStore import Database.PostgreSQL.Simple.Copy import qualified Database.PostgreSQL.Simple.Transaction as ST+ import Control.Applicative import Control.Exception as E import Control.Monad-import Data.ByteString (ByteString)+import Data.Char+import Data.List (sort) import Data.IORef import Data.Typeable+import GHC.Generics (Generic)++import Data.Aeson+import Data.ByteString (ByteString) import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy.Char8 as BL import Data.Map (Map)-import Data.List (sort) import qualified Data.Map as Map import Data.Text(Text) import qualified Data.Text.Encoding as T-import System.Exit (exitFailure)-import System.IO import qualified Data.Vector as V-import Data.Aeson-import GHC.Generics (Generic)+import System.FilePath +import Test.Tasty+import Test.Tasty.Golden import Notify import Serializable import Time -tests :: [TestEnv -> Test]-tests =-    [ TestLabel "Bytea"         . testBytea-    , TestLabel "ExecuteMany"   . testExecuteMany-    , TestLabel "Fold"          . testFold-    , TestLabel "Notify"        . testNotify-    , TestLabel "Serializable"  . testSerializable-    , TestLabel "Time"          . testTime-    , TestLabel "Array"         . testArray-    , TestLabel "HStore"        . testHStore-    , TestLabel "JSON"          . testJSON-    , TestLabel "Savepoint"     . testSavepoint-    , TestLabel "Unicode"       . testUnicode-    , TestLabel "Values"        . testValues-    , TestLabel "Copy"          . testCopy-    , TestLabel "Double"        . testDouble-    , TestLabel "1-ary generic" . testGeneric1-    , TestLabel "2-ary generic" . testGeneric2-    , TestLabel "3-ary generic" . testGeneric3+tests :: TestEnv -> TestTree+tests env = testGroup "tests"+    $ map ($ env)+    [ testBytea+    , testCase "ExecuteMany"   . testExecuteMany+    , testCase "Fold"          . testFold+    , testCase "Notify"        . testNotify+    , testCase "Serializable"  . testSerializable+    , testCase "Time"          . testTime+    , testCase "Array"         . testArray+    , testCase "HStore"        . testHStore+    , testCase "JSON"          . testJSON+    , testCase "Savepoint"     . testSavepoint+    , testCase "Unicode"       . testUnicode+    , testCase "Values"        . testValues+    , testCase "Copy"          . testCopy+    , testCopyFailures+    , testCase "Double"        . testDouble+    , testCase "1-ary generic" . testGeneric1+    , testCase "2-ary generic" . testGeneric2+    , testCase "3-ary generic" . testGeneric3     ] -testBytea :: TestEnv -> Test-testBytea TestEnv{..} = TestList+testBytea :: TestEnv -> TestTree+testBytea TestEnv{..} = testGroup "Bytea"     [ testStr "empty"                  []     , testStr "\"hello\""              $ map (fromIntegral . fromEnum) ("hello" :: String)     , testStr "ascending"              [0..255]@@ -61,7 +68,7 @@     , testStr "descending, doubled up" $ doubleUp [255,254..0]     ]   where-    testStr label bytes = TestLabel label $ TestCase $ do+    testStr label bytes = testCase label $ do         let bs = B.pack bytes          [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]@@ -72,8 +79,8 @@      doubleUp = concatMap (\x -> [x, x]) -testExecuteMany :: TestEnv -> Test-testExecuteMany TestEnv{..} = TestCase $ do+testExecuteMany :: TestEnv -> Assertion+testExecuteMany TestEnv{..} = do     execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"      let rows :: [(Int, String, Binary ByteString)]@@ -90,8 +97,8 @@      return () -testFold :: TestEnv -> Test-testFold TestEnv{..} = TestCase $ do+testFold :: TestEnv -> Assertion+testFold TestEnv{..} = do     xs <- fold_ conn "SELECT generate_series(1,10000)"             [] $ \xs (Only x) -> return (x:xs)     reverse xs @?= ([1..10000] :: [Int])@@ -160,8 +167,8 @@                               ++ show (typeOf resultType)                               ++ " -> " ++ show val) -testArray :: TestEnv -> Test-testArray TestEnv{..} = TestCase $ do+testArray :: TestEnv -> Assertion+testArray TestEnv{..} = do     xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"     xs @?= [Only (V.fromList [1,2,3,4 :: Int])]     xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"@@ -170,8 +177,8 @@     queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)     queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int) -testHStore :: TestEnv -> Test-testHStore TestEnv{..} = TestCase $ do+testHStore :: TestEnv -> Assertion+testHStore TestEnv{..} = do     execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"     roundTrip []     roundTrip [("foo","bar"),("bar","baz"),("baz","hello")]@@ -183,8 +190,8 @@       m' <- query conn "SELECT ?::hstore" m       [m] @?= m' -testJSON :: TestEnv -> Test-testJSON TestEnv{..} = TestCase $ do+testJSON :: TestEnv -> Assertion+testJSON TestEnv{..} = do     roundTrip (Map.fromList [] :: Map Text Text)     roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)     roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)@@ -198,8 +205,8 @@       js' <- query conn "SELECT ?::json" js       [js] @?= js' -testSavepoint :: TestEnv -> Test-testSavepoint TestEnv{..} = TestCase $ do+testSavepoint :: TestEnv -> Assertion+testSavepoint TestEnv{..} = do     True <- expectError ST.isNoActiveTransactionError $             withSavepoint conn $ return () @@ -259,8 +266,8 @@      return () -testUnicode :: TestEnv -> Test-testUnicode TestEnv{..} = TestCase $ do+testUnicode :: TestEnv -> Assertion+testUnicode TestEnv{..} = do     let q = Query . T.encodeUtf8  -- Handle encoding ourselves to ensure                                   -- the table gets created correctly.     let messages = map Only ["привет","мир"] :: [Only Text]@@ -269,8 +276,8 @@     messages' <- query_ conn "SELECT сообщение FROM ру́сский"     sort messages @?= sort messages' -testValues :: TestEnv -> Test-testValues TestEnv{..} = TestCase $ do+testValues :: TestEnv -> Assertion+testValues TestEnv{..} = do     execute_ conn "CREATE TEMPORARY TABLE values_test (x int, y text)"     test (Values ["int4","text"] [])     test (Values ["int4","text"] [(1,"hello")])@@ -287,8 +294,8 @@       sort vals @?= sort vals'  -testCopy :: TestEnv -> Test-testCopy TestEnv{..} = TestCase $ do+testCopy :: TestEnv -> Assertion+testCopy TestEnv{..} = do     execute_ conn "CREATE TEMPORARY TABLE copy_test (x int, y text)"     copy_ conn "COPY copy_test FROM STDIN (FORMAT CSV)"     mapM_ (putCopyData conn) copyRows@@ -315,8 +322,53 @@         CopyOutDone _   -> return rows         CopyOutRow  row -> loop (row:rows) -testDouble :: TestEnv -> Test-testDouble TestEnv{..} = TestCase $ do+testCopyFailures :: TestEnv -> TestTree+testCopyFailures env = testGroup "Copy failures"+    $ map ($ env)+    [ testCopyUniqueConstraintError+    , testCopyMalformedError+    ]++goldenTest :: TestName -> IO BL.ByteString -> TestTree+goldenTest testName =+    goldenVsString testName (resultsDir </> fileName<.>"expected")+  where+    resultsDir = "test" </> "results"+    fileName = map normalize testName+    normalize c | not (isAlpha c) = '-'+                | otherwise       = c++-- | Test that we provide a sensible error message on failure+testCopyUniqueConstraintError :: TestEnv -> TestTree+testCopyUniqueConstraintError TestEnv{..} =+    goldenTest "unique constraint violation"+    $ handle (\(SomeException exc) -> return $ BL.pack $ show exc) $ do+        execute_ conn "CREATE TEMPORARY TABLE copy_unique_constraint_error_test (x int PRIMARY KEY, y text)"+        copy_ conn "COPY copy_unique_constraint_error_test FROM STDIN (FORMAT CSV)"+        mapM_ (putCopyData conn) copyRows+        _n <- putCopyEnd conn+        return BL.empty+  where+    copyRows  = ["1,foo\n"+                ,"2,bar\n"+                ,"1,baz\n"]++testCopyMalformedError :: TestEnv -> TestTree+testCopyMalformedError TestEnv{..} =+    goldenTest "malformed input"+    $ handle (\(SomeException exc) -> return $ BL.pack $ show exc) $ do+        execute_ conn "CREATE TEMPORARY TABLE copy_malformed_input_error_test (x int PRIMARY KEY, y text)"+        copy_ conn "COPY copy_unique_constraint_error_test FROM STDIN (FORMAT CSV)"+        mapM_ (putCopyData conn) copyRows+        _n <- putCopyEnd conn+        return BL.empty+  where+    copyRows  = ["1,foo\n"+                ,"2,bar\n"+                ,"z,baz\n"]++testDouble :: TestEnv -> Assertion+testDouble TestEnv{..} = do     [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"     assertBool "expected NaN" (isNaN x)     [Only (x :: Double)] <- query_ conn "SELECT 'Infinity'::float8"@@ -325,24 +377,24 @@     x @?= (-1 / 0)  -testGeneric1 :: TestEnv -> Test-testGeneric1 TestEnv{..} = TestCase $ do+testGeneric1 :: TestEnv -> Assertion+testGeneric1 TestEnv{..} = do     roundTrip conn (Gen1 123)   where     roundTrip conn x0 = do         r <- query conn "SELECT ?::int" (x0 :: Gen1)         r @?= [x0] -testGeneric2 :: TestEnv -> Test-testGeneric2 TestEnv{..} = TestCase $ do+testGeneric2 :: TestEnv -> Assertion+testGeneric2 TestEnv{..} = do     roundTrip conn (Gen2 123 "asdf")   where     roundTrip conn x0 = do         r <- query conn "SELECT ?::int, ?::text" x0         r @?= [x0] -testGeneric3 :: TestEnv -> Test-testGeneric3 TestEnv{..} = TestCase $ do+testGeneric3 :: TestEnv -> Assertion+testGeneric3 TestEnv{..} = do     roundTrip conn (Gen3 123 "asdf" True)   where     roundTrip conn x0 = do@@ -401,8 +453,4 @@     withConn = bracket testConnect close  main :: IO ()-main = do-    mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]-    Counts{cases, tried, errors, failures} <--        withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests-    when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure+main = withTestEnv $ defaultMain . tests

@@ -14,9 +14,8 @@ -- TODO: Test with payload, but only for PostgreSQL >= 9.0 -- (when that feature was introduced). -testNotify :: TestEnv -> Test+testNotify :: TestEnv -> Assertion testNotify TestEnv{..} =-    TestCase $     withConn $ \conn2 -> do         execute_ conn "LISTEN foo"         execute_ conn "LISTEN bar"

@@ -23,9 +23,8 @@     1 <- execute conn "UPDATE testSerializableCounter SET n=?" (Only n)     return () -testSerializable :: TestEnv -> Test+testSerializable :: TestEnv -> Assertion testSerializable TestEnv{..} =-    TestCase $     withConn $ \conn2 -> do         initCounter conn 

@@ -43,8 +43,8 @@ numTests :: Int numTests = 200 -testTime :: TestEnv -> Test-testTime env@TestEnv{..} = TestCase $ do+testTime :: TestEnv -> Assertion+testTime env@TestEnv{..} = do   initializeTable env   execute_ conn "SET timezone TO 'UTC'"   checkRoundTrips env "1860-01-01 00:00:00+00"