diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,10 +1,18 @@ +# hpqtypes-1.7.0.0 (2019-05-21) +* Remove the `Default` instances for `ConnectionSettings` and + `TransactionSettings`; use `defaultConnectionSettings` and + `defaultTransactionsettings` instead + ([#15](https://github.com/scrive/hpqtypes/pull/15)). + # hpqtypes-1.6.1.0 (2018-11-24) -* Add support for cursors. -* Remove explicit 'deriving Typeable' from all data types. +* Add support for cursors + ([#13](https://github.com/scrive/hpqtypes/pull/13)). +* Remove explicit `deriving Typeable` from all data types. # hpqtypes-1.6.0.0 (2018-07-11) -* Convert the PQFormat class to use TypeApplications instead of - an 'undefined :: t' argument. +* Convert the `PQFormat` class to use `TypeApplications` instead of an + `undefined :: t` argument + ([#11](https://github.com/scrive/hpqtypes/pull/11)). * Support GHC 8.6. * Drop support for GHC < 8. diff --git a/hpqtypes.cabal b/hpqtypes.cabal --- a/hpqtypes.cabal +++ b/hpqtypes.cabal @@ -1,25 +1,28 @@ name: hpqtypes -version: 1.6.1.0 +version: 1.7.0.0 synopsis: Haskell bindings to libpqtypes description: Efficient and easy-to-use bindings to (slightly modified) - libpqtypes, lipq extension that adds support for binary - transport format and composite types. + @libpqtypes@, a @libpq@ extension that adds support + for a binary transport format and composite types. . - Since modified libpqtypes is used, its source code is bundled - along with the bindings. The differences between verbatim - libpqtypes and the one used by this package: + Since modified @libpqtypes@ is used, its source + code is bundled along with the bindings. The + differences between verbatim @libpqtypes@ and the + one used by this package: . - * per-thread global error structures were replaced by + * Per-thread global error structures were replaced by explicit passing of these structures around so that there is no need to use bound threads. . - * handlers that take values to be put into the database were - modified to always expect pointers to objects, as opposed - to previous situation where primitives were being taken by - value (which was convenient if the library was used - directly from C, but created inconsistency problems - while trying to define bindings in a sensible way). + * Handlers that take values to be put into the + database were modified to always expect + pointers to objects, as opposed to previous + situation where primitives were being taken by + value (which was convenient if the library was + used directly from C, but created inconsistency + problems while trying to define bindings in a + sensible way). . Examples can be found in the @@ -36,7 +39,7 @@ category: Database build-type: Custom cabal-version: 1.18 -tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.2 +tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5 extra-source-files: README.md @@ -79,7 +82,7 @@ source-repository this type: git location: https://github.com/scrive/hpqtypes.git - tag: 1.6.1.0 + tag: 1.7.0.0 library exposed-modules: Data.Monoid.Utils @@ -136,7 +139,6 @@ , transformers >= 0.2.2 , containers >= 0.4.0.0 , exceptions >= 0.6 - , data-default-class , text-show >= 2 hs-source-dirs: src diff --git a/src/Database/PostgreSQL/PQTypes.hs b/src/Database/PostgreSQL/PQTypes.hs --- a/src/Database/PostgreSQL/PQTypes.hs +++ b/src/Database/PostgreSQL/PQTypes.hs @@ -5,6 +5,7 @@ Connection , ConnectionStats(..) , ConnectionSettings(..) + , defaultConnectionSettings , ConnectionSourceM , ConnectionSource(..) , simpleSource diff --git a/src/Database/PostgreSQL/PQTypes/Internal/Connection.hs b/src/Database/PostgreSQL/PQTypes/Internal/Connection.hs --- a/src/Database/PostgreSQL/PQTypes/Internal/Connection.hs +++ b/src/Database/PostgreSQL/PQTypes/Internal/Connection.hs @@ -4,7 +4,7 @@ , withConnectionData , ConnectionStats(..) , ConnectionSettings(..) - , def + , defaultConnectionSettings , ConnectionSourceM(..) , ConnectionSource(..) , simpleSource @@ -18,7 +18,6 @@ import Control.Monad import Control.Monad.Base import Control.Monad.Catch -import Data.Default.Class import Data.Function import Data.Pool import Data.Time.Clock @@ -52,11 +51,12 @@ -- | Default connection settings. Note that all strings sent to PostgreSQL by -- the library are encoded as UTF-8, so don't alter client encoding unless you -- know what you're doing. -instance Default ConnectionSettings where - def = ConnectionSettings { - csConnInfo = T.empty +defaultConnectionSettings :: ConnectionSettings +defaultConnectionSettings = + ConnectionSettings + { csConnInfo = T.empty , csClientEncoding = Just "UTF-8" - , csComposites = [] + , csComposites = [] } ---------------------------------------- diff --git a/src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs b/src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs --- a/src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs +++ b/src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs @@ -3,10 +3,9 @@ , TransactionSettings(..) , IsolationLevel(..) , Permissions(..) - , def + , defaultTransactionSettings ) where -import Data.Default.Class import qualified Control.Exception as E -- | Predicate that determines whether the transaction has to be restarted. @@ -46,9 +45,10 @@ deriving (Eq, Ord, Show) -- | Default transaction settings. -instance Default TransactionSettings where - def = TransactionSettings { - tsAutoTransaction = True +defaultTransactionSettings :: TransactionSettings +defaultTransactionSettings = + TransactionSettings + { tsAutoTransaction = True , tsIsolationLevel = DefaultLevel , tsRestartPredicate = Nothing , tsPermissions = DefaultPermissions diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -9,7 +9,7 @@ import Control.Monad.Catch import Control.Monad.State import Control.Monad.Trans.Control -import Data.Aeson +import Data.Aeson hiding (()) import Data.Char import Data.Int import Data.Maybe @@ -210,7 +210,7 @@ ---------------------------------------- tsNoTrans :: TransactionSettings -tsNoTrans = def { tsAutoTransaction = False } +tsNoTrans = defaultTransactionSettings { tsAutoTransaction = False } randomValue :: Arbitrary t => Int -> TestEnv t randomValue n = withQCGen $ \gen -> unGen arbitrary gen n @@ -246,7 +246,7 @@ ] where basicCursorWorks = testCase "Basic cursor works" $ do - runTestEnv td def $ do + runTestEnv td defaultTransactionSettings $ do withCursor "ints" NoScroll NoHold (sqlGenInts 5) $ \cursor -> do xs <- (`fix` []) $ \loop acc -> cursorFetch cursor CD_Next >>= \case 0 -> return $ reverse acc @@ -257,7 +257,7 @@ assertEqualEq "Data fetched correctly" [1..5] xs scrollableCursorWorks = testCase "Cursor declared as SCROLL works" $ do - runTestEnv td def $ do + runTestEnv td defaultTransactionSettings $ do withCursor "ints" Scroll NoHold (sqlGenInts 10) $ \cursor -> do checkMove cursor CD_Next 1 checkMove cursor CD_Prior 0 @@ -291,7 +291,7 @@ assertEqualEq "sum_ is correct" 55 sum_ doubleCloseWorks = testCase "Double CLOSE works on a cursor" $ do - runTestEnv td def $ do + runTestEnv td defaultTransactionSettings $ do withCursorSQL "ints" NoScroll NoHold "SELECT 1" $ \_cursor -> do -- Commiting a transaction closes the cursor commit @@ -303,7 +303,7 @@ runTestEnv td tsNoTrans $ do testQuery id sleep testQuery id ints - runTestEnv td def $ do + runTestEnv td defaultTransactionSettings $ do testQuery (withSavepoint "ints") ints testQuery (withSavepoint "sleep") sleep where @@ -324,11 +324,12 @@ readOnlyTest :: TestData -> Test readOnlyTest td = testCase "Read only transaction mode works" . - runTestEnv td def{tsPermissions = ReadOnly} $ do + runTestEnv td + defaultTransactionSettings {tsPermissions = ReadOnly} $ do let sint = Identity (2::Int32) eres <- try . runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint case eres :: Either DBException () of - Left _ -> return () + Left _ -> return () Right _ -> liftBase . assertFailure $ "DBException wasn't thrown" rollback n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint @@ -336,7 +337,7 @@ savepointTest :: TestData -> Test savepointTest td = testCase "Savepoint support works" . - runTestEnv td def $ do + runTestEnv td defaultTransactionSettings $ do let int1 = 3 :: Int32 int2 = 4 :: Int32 @@ -386,10 +387,12 @@ forkNewConn = void . fork . withNewConnection transactionTest :: TestData -> IsolationLevel -> Test -transactionTest td lvl = testCase - ("Auto transaction works by default with isolation level" - <+> show lvl) . - runTestEnv td def{tsIsolationLevel = lvl} $ do +transactionTest td lvl = + testCase + ("Auto transaction works by default with isolation level" + <+> show lvl) . + runTestEnv td + defaultTransactionSettings {tsIsolationLevel = lvl} $ do let sint = Identity (5::Int32) runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint withNewConnection $ do @@ -401,7 +404,7 @@ => TestData -> t -> Test nullTest td t = testCase ("Attempt to get non-NULL value of type" <+> show (typeOf t) <+> "fails if NULL is provided") . - runTestEnv td def $ do + runTestEnv td defaultTransactionSettings $ do runSQL_ $ "SELECT" (Nothing::Maybe t) eres <- try $ fetchOne runIdentity case eres :: Either DBException t of @@ -414,7 +417,8 @@ ("Putting value of type" <+> show (typeOf t) <+> "through database doesn't change its value") . - runTestEnv td def . runTimes 1000 $ do + runTestEnv td defaultTransactionSettings . + runTimes 1000 $ do v :: t <- randomValue n --liftBase . putStrLn . show $ v runSQL_ $ "SELECT" v @@ -423,7 +427,7 @@ xmlTest :: TestData -> Test xmlTest td = testCase "Put and get XML value works" . - runTestEnv td def $ do + runTestEnv td defaultTransactionSettings $ do runSQL_ $ "SET CLIENT_ENCODING TO 'UTF8'" let v = XML "somestringå" runSQL_ $ "SELECT XML 'somestringå'" @@ -439,7 +443,7 @@ rowTest td _r = testCase ("Putting row of length" <+> show (pqVariables @row) <+> "through database works") . - runTestEnv td def . runTimes 100 $ do + runTestEnv td defaultTransactionSettings . runTimes 100 $ do row :: row <- randomValue 100 let fmt = mintercalate ", " $ map (T.append "$" . showt) [1..pqVariables @row] runQuery_ $ rawSQL ("SELECT" <+> fmt) row @@ -582,14 +586,14 @@ ---------------------------------------- createStructures :: ConnectionSourceM IO -> IO () -createStructures cs = runDBT cs def $ do +createStructures cs = runDBT cs defaultTransactionSettings $ do liftBase . putStrLn $ "Creating structures..." runSQL_ "CREATE TABLE test1_ (a INTEGER)" runSQL_ "CREATE TYPE simple_ AS (a INTEGER, b DATE)" runSQL_ "CREATE TYPE nested_ AS (d DOUBLE PRECISION, s SIMPLE_)" dropStructures :: ConnectionSourceM IO -> IO () -dropStructures cs = runDBT cs def $ do +dropStructures cs = runDBT cs defaultTransactionSettings $ do liftBase . putStrLn $ "Dropping structures..." runSQL_ "DROP TYPE nested_" runSQL_ "DROP TYPE simple_" @@ -614,7 +618,7 @@ main :: IO () main = do (connString, args) <- getConnString - let connSettings = def { + let connSettings = defaultConnectionSettings { csConnInfo = connString , csClientEncoding = Just "latin1" }