hpqtypes 1.6.0.0 → 1.6.1.0

raw patch · 43 files changed

+396/−193 lines, 43 filesdep ~basesetup-changedPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +42/−37
• Setup.hs +1/−3
• hpqtypes.cabal +11/−11
• src/Data/Monoid/Utils.hs +0/−2
• src/Database/PostgreSQL/PQTypes.hs +2/−0
• src/Database/PostgreSQL/PQTypes/Array.hs +4/−7
• src/Database/PostgreSQL/PQTypes/Class.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Composite.hs +1/−4
• src/Database/PostgreSQL/PQTypes/Cursor.hs +192/−0
• src/Database/PostgreSQL/PQTypes/Fold.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Format.hs +1/−3
• src/Database/PostgreSQL/PQTypes/FromRow.hs +0/−2
• src/Database/PostgreSQL/PQTypes/FromSQL.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Internal/C/Get.hs +0/−1
• src/Database/PostgreSQL/PQTypes/Internal/C/Interface.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Internal/C/Put.hs +0/−1
• src/Database/PostgreSQL/PQTypes/Internal/C/Types.hsc +0/−4
• src/Database/PostgreSQL/PQTypes/Internal/Composite.hs +0/−1
• src/Database/PostgreSQL/PQTypes/Internal/Connection.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Internal/Error.hs +11/−12
• src/Database/PostgreSQL/PQTypes/Internal/Error/Code.hs +1/−4
• src/Database/PostgreSQL/PQTypes/Internal/Exception.hs +1/−3
• src/Database/PostgreSQL/PQTypes/Internal/Monad.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc +2/−6
• src/Database/PostgreSQL/PQTypes/Internal/Query.hs +0/−3
• src/Database/PostgreSQL/PQTypes/Internal/QueryResult.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Internal/State.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Internal/Utils.hs +0/−2
• src/Database/PostgreSQL/PQTypes/Interval.hsc +1/−7
• src/Database/PostgreSQL/PQTypes/JSON.hs +2/−5
• src/Database/PostgreSQL/PQTypes/Notification.hs +0/−1
• src/Database/PostgreSQL/PQTypes/SQL.hs +0/−2
• src/Database/PostgreSQL/PQTypes/SQL/Class.hs +0/−1
• src/Database/PostgreSQL/PQTypes/SQL/Raw.hs +1/−3
• src/Database/PostgreSQL/PQTypes/ToRow.hs +0/−1
• src/Database/PostgreSQL/PQTypes/ToSQL.hs +0/−1
• src/Database/PostgreSQL/PQTypes/Transaction.hs +0/−1
• src/Database/PostgreSQL/PQTypes/Transaction/Settings.hs +3/−6
• src/Database/PostgreSQL/PQTypes/Utils.hs +0/−1
• src/Database/PostgreSQL/PQTypes/XML.hs +1/−3
• test/Main.hs +116/−34
• test/Prelude/Instances.hs +2/−1
• test/Test/QuickCheck/Arbitrary/Instances.hs +1/−4

@@ -1,73 +1,78 @@+# hpqtypes-1.6.1.0 (2018-11-24)+* Add support for cursors.+* 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.+* Support GHC 8.6. * Drop support for GHC < 8.  # hpqtypes-1.5.3.0 (2018-06-04)-* add INLINE/INLINEABLE pragmas for call site specialization-* remove -O2 -funbox-strict-fields from ghc-options-* make query execution interruptible with asynchronous exceptions-* make connect interruptible with asynchronous exceptions+* Add INLINE/INLINEABLE pragmas for call site specialization.+* Remove -O2 -funbox-strict-fields from ghc-options.+* Make query execution interruptible with asynchronous exceptions.+* Make connect interruptible with asynchronous exceptions.  # hpqtypes-1.5.2.0 (2018-03-18)-* support GHC 8.4.1+* Support GHC 8.4.1.  # hpqtypes-1.5.1.1 (2016-09-22)-* fix test suite compilation with GHC 8-* fix lower bound of base version-* fix compilation with 'cabal new-build' and Cabal < 1.24+* Fix test suite compilation with GHC 8.+* Fix lower bound of base version.+* Fix compilation with 'cabal new-build' and Cabal < 1.24.  # hpqtypes-1.5.1 (2016-07-04)-* Do not use linux/limits.h+* Do not use linux/limits.h.  # hpqtypes-1.5.0 (2016-06-21)-* remove orphan MonadDB instances-* turn ConnectionSource into indexed datatype-* remove Binary wrapper and (de)serialize ByteString as bytea-* use Text instead of ByteString where appropriate-* use UTF-8 client encoding by default for compatibility with Text+* Remove orphan MonadDB instances.+* Turn ConnectionSource into indexed datatype.+* Remove Binary wrapper and (de)serialize ByteString as bytes.+* Use Text instead of ByteString where appropriate.+* Use UTF-8 client encoding by default for compatibility with Text.  # hpqtypes-1.4.5 (2016-05-30)-* fix compilation with Cabal 1.24 and GHC 8.0.1+* Fix compilation with Cabal 1.24 and GHC 8.0.1.  # hpqtypes-1.4.4 (2016-01-19)-* fix lower bound of base version+* Fix lower bound of base version.  # hpqtypes-1.4.3 (2015-10-09)-* remove invalid FromSQL ZonedTime instance+* Remove invalid FromSQL ZonedTime instance.  # hpqtypes-1.4.2 (2015-06-08)-* use strict StateT for DBT-* use catch in withTransaction only if it might be used+* Use strict StateT for DBT.+* Use catch in withTransaction only if it might be used.  # hpqtypes-1.4.1 (2015-05-15)-* add support for json and jsonb sql types-* add support for lazy ByteString and Text+* Add support for json and jsonb sql types.+* Add support for lazy ByteString and Text.  # hpqtypes-1.4.0 (2015-02-26)-* add support for QuickCheck 2.7-* add support for notifications-* remove SpaceMonoid, use Monoid and IsString instead-* use data-default-class package for default values-* drop Single, use Identity functor instead-* remove someSQL from IsSQL class-* remove foldlM/foldrM from MonadDB and make QueryResult instance of Foldable instead-* add support for a type representing cartesian product of rows for more composability-* do not wrap exceptions thrown from DBT in DBException unless explicitly requested-* provide custom Show instance for Interval-* add ToSQL instance for Int+* Add support for QuickCheck 2.7.+* Add support for notifications.+* Remove SpaceMonoid, use Monoid and IsString instead.+* Use data-default-class package for default values.+* Drop Single, use Identity functor instead.+* Remove someSQL from IsSQL class.+* Remove foldlM/foldrM from MonadDB and make QueryResult instance of Foldable instead.+* Add support for a type representing cartesian product of rows for more composability.+* Do not wrap exceptions thrown from DBT in DBException unless explicitly requested.+* Provide custom Show instance for Interval.+* Add ToSQL instance for Int.  # hpqtypes-1.3.2 (2015-01-27)-* replace wrong package uploaded to hackage+* Replace wrong package uploaded to hackage.  # hpqtypes-1.3.1 (2015-01-26)-* add support for XML type+* Add support for XML type.  # hpqtypes-1.3.0 (2015-01-09)-* composite: make {from,to}Composite functions pure+* Composite: make {from,to}Composite functions pure.  # hpqtypes-1.2.5 (2015-01-04)-* add support for monad-control >= 1.0.0.1+* Add support for monad-control >= 1.0.0.1.  # hpqtypes-1.2.4 (2014-12-08)-* add IsString instance for Savepoint newtype+* Add IsString instance for Savepoint newtype.

@@ -1,12 +1,10 @@ {-# OPTIONS_GHC -Wall #-}-{-# LANGUAGE ScopedTypeVariables #-} import Control.Monad import Data.Char import Distribution.PackageDescription import Distribution.Simple import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program-import Distribution.Simple.Program.Find import Distribution.Simple.Setup import Distribution.Simple.Utils import Distribution.Verbosity@@ -41,7 +39,7 @@ psqlBuildInfo :: Verbosity -> LocalBuildInfo -> IO BuildInfo psqlBuildInfo verbosity lbi = do   (pgconfigProg, _) <- requireProgram verbosity pgconfigProgram (withPrograms lbi)-  let pgconfig = rawSystemProgramStdout verbosity pgconfigProg+  let pgconfig = getProgramOutput verbosity pgconfigProg    incDir <- pgconfig ["--includedir"]   libDir <- pgconfig ["--libdir"]

@@ -1,5 +1,5 @@ name:                hpqtypes-version:             1.6.0.0+version:             1.6.1.0 synopsis:            Haskell bindings to libpqtypes  description:         Efficient and easy-to-use bindings to (slightly modified)@@ -36,7 +36,7 @@ category:            Database build-type:          Custom cabal-version:       1.18-tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3+tested-with:         GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.2   extra-source-files: README.md@@ -67,8 +67,8 @@                   , libpqtypes/src/libpqtypes.h  custom-setup-  setup-depends: base >= 4.7 && < 4.12,-                 Cabal >= 1.24 && < 2.3,+  setup-depends: base >= 4.9 && < 4.13,+                 Cabal >= 1.24 && < 2.5,                  directory,                  filepath @@ -79,7 +79,7 @@ source-repository this   type:     git   location: https://github.com/scrive/hpqtypes.git-  tag:      1.6.0.0+  tag:      1.6.1.0  library   exposed-modules:     Data.Monoid.Utils@@ -95,6 +95,7 @@                      , Database.PostgreSQL.PQTypes.ToSQL                      , Database.PostgreSQL.PQTypes.Transaction                      , Database.PostgreSQL.PQTypes.Class+                     , Database.PostgreSQL.PQTypes.Cursor                      , Database.PostgreSQL.PQTypes.Format                      , Database.PostgreSQL.PQTypes.Interval                      , Database.PostgreSQL.PQTypes.Notification@@ -119,7 +120,7 @@                      , Database.PostgreSQL.PQTypes.Internal.C.Interface                      , Database.PostgreSQL.PQTypes.Internal.C.Get -  build-depends:       base >= 4.7 && < 4.12+  build-depends:       base >= 4.9 && < 4.13                      , text >= 0.11                      , aeson >= 0.6.2.0                      , async >= 2.1.1.1@@ -170,7 +171,6 @@   default-extensions: BangPatterns                     , ConstraintKinds                     , DataKinds-                    , DeriveDataTypeable                     , DeriveFunctor                     , ExistentialQuantification                     , FlexibleContexts@@ -181,7 +181,6 @@                     , LambdaCase                     , MultiParamTypeClasses                     , MultiWayIf-                    , NoImplicitPrelude                     , OverloadedStrings                     , RankNTypes                     , RecordWildCards@@ -191,6 +190,9 @@                     , TypeFamilies                     , TypeOperators                     , UndecidableInstances+  other-extensions:   AllowAmbiguousTypes+                    , CPP+                    , TypeApplications  test-suite hpqtypes-tests   type:              exitcode-stdio-1.0@@ -202,7 +204,7 @@                      Test.QuickCheck.Compat                      Test.QuickCheck.Arbitrary.Instances   build-depends:       hpqtypes-                     , base >= 4.7 && < 5+                     , base >= 4.9 && < 4.13                      , HUnit >= 1.2                      , QuickCheck >= 2.5                      , aeson >= 0.6.2.0@@ -226,7 +228,6 @@   default-extensions: BangPatterns                     , ConstraintKinds                     , DataKinds-                    , DeriveDataTypeable                     , DeriveFunctor                     , ExistentialQuantification                     , FlexibleContexts@@ -237,7 +238,6 @@                     , LambdaCase                     , MultiParamTypeClasses                     , MultiWayIf-                    , NoImplicitPrelude                     , OverloadedStrings                     , RankNTypes                     , RecordWildCards

@@ -7,9 +7,7 @@   ) where  import Data.List-import Data.Monoid import Data.String-import Prelude  -- | Generalization of 'intercalate' to arbitrary 'Monoid'. {-# INLINE mintercalate #-}

@@ -40,6 +40,7 @@   , module Database.PostgreSQL.PQTypes.Array   , module Database.PostgreSQL.PQTypes.Class   , module Database.PostgreSQL.PQTypes.Composite+  , module Database.PostgreSQL.PQTypes.Cursor   , module Database.PostgreSQL.PQTypes.Fold   , module Database.PostgreSQL.PQTypes.Format   , module Database.PostgreSQL.PQTypes.FromRow@@ -63,6 +64,7 @@ import Database.PostgreSQL.PQTypes.Array import Database.PostgreSQL.PQTypes.Class import Database.PostgreSQL.PQTypes.Composite+import Database.PostgreSQL.PQTypes.Cursor import Database.PostgreSQL.PQTypes.Fold import Database.PostgreSQL.PQTypes.Format import Database.PostgreSQL.PQTypes.FromRow

@@ -14,14 +14,11 @@   , unCompositeArray2   ) where -import Control.Applicative import Control.Monad-import Data.Typeable import Foreign.C import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable-import Prelude import qualified Control.Exception as E import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Unsafe as BS@@ -41,7 +38,7 @@  -- | One dimensional array of non-composite elements. newtype Array1 a = Array1 [a]-  deriving (Eq, Functor, Ord, Show, Typeable)+  deriving (Eq, Functor, Ord, Show)  -- | Extract list of elements from 'Array1'. unArray1 :: Array1 a -> [a]@@ -73,7 +70,7 @@  -- | One dimensional array of composite elements. newtype CompositeArray1 a = CompositeArray1 [a]-  deriving (Eq, Functor, Ord, Show, Typeable)+  deriving (Eq, Functor, Ord, Show)  -- | Extract list of elements from 'CompositeArray1'. unCompositeArray1 :: CompositeArray1 a -> [a]@@ -150,7 +147,7 @@  -- | Two dimensional array of non-composite elements. newtype Array2 a = Array2 [[a]]-  deriving (Eq, Functor, Ord, Show, Typeable)+  deriving (Eq, Functor, Ord, Show)  -- | Extract list of elements from 'Array2'. unArray2 :: Array2 a -> [[a]]@@ -182,7 +179,7 @@  -- | Two dimensional array of composite elements. newtype CompositeArray2 a = CompositeArray2 [[a]]-  deriving (Eq, Functor, Ord, Show, Typeable)+  deriving (Eq, Functor, Ord, Show)  -- | Extract list of elements from 'CompositeArray2'. unCompositeArray2 :: CompositeArray2 a -> [[a]]

@@ -4,10 +4,8 @@     MonadDB(..)   ) where -import Control.Applicative import Control.Monad.Trans import Control.Monad.Trans.Control-import Prelude  import Database.PostgreSQL.PQTypes.FromRow import Database.PostgreSQL.PQTypes.Internal.Connection

@@ -7,10 +7,7 @@   , CompositeToSQL(..)   ) where -import Control.Applicative-import Data.Typeable import Foreign.Ptr-import Prelude import qualified Control.Exception as E  import Database.PostgreSQL.PQTypes.Format@@ -24,7 +21,7 @@  -- | Wrapper for (de)serializing composite types. newtype Composite a = Composite a-  deriving (Eq, Functor, Ord, Show, Typeable)+  deriving (Eq, Functor, Ord, Show)  -- | Extract underlying value. unComposite :: Composite a -> a

@@ -0,0 +1,192 @@+module Database.PostgreSQL.PQTypes.Cursor+  ( CursorName(..)+  , Scroll(..)+  , Hold(..)+  , Cursor+  , CursorDirection(..)+  , cursorName+  , cursorQuery+  , withCursor+  , withCursorSQL+  , cursorFetch+  , cursorFetch_+  , cursorMove+  , cursorMove_+  ) where++import Control.Monad+import Control.Monad.Catch+import Data.String++import Data.Monoid.Utils+import Database.PostgreSQL.PQTypes.Class+import Database.PostgreSQL.PQTypes.SQL+import Database.PostgreSQL.PQTypes.SQL.Class+import Database.PostgreSQL.PQTypes.Utils++-- | Name of a cursor.+newtype CursorName sql = CursorName { unCursorName :: sql }+  deriving (Eq, Ord)++instance IsString sql => IsString (CursorName sql) where+  fromString = CursorName . fromString++instance Show sql => Show (CursorName sql) where+  showsPrec n (CursorName name) = ("Cursor " ++) . showsPrec n name++----------------------------------------++-- | Defines whether a cursor will be declared as @SCROLL@ or @NO+-- SCROLL@. Scrollable cursors can be scrolled in all directions, otherwise only+-- forward.+data Scroll = Scroll | NoScroll+  deriving (Eq, Ord, Show)++-- | Defines whether a cursor will be declared as @WITH HOLD@ or @WITHOUT HOLD@.+-- Cursors declared as @WITH HOLD@ can only be declared within a transaction+-- block and they're automatically closed once the transaction finishes,+-- otherwise they're independent of the current transaction and can be declared+-- even if no transaction is active.+data Hold = Hold | NoHold+  deriving (Eq, Ord, Show)++-- | Data representing a created cursor.+data Cursor sql = Cursor !(CursorName sql) !sql+  deriving (Eq, Ord, Show)++----------------------------------------++-- | Direction in which to move the cursor. Note that cursors declared as @NO+-- SCROLL@ can only move forward (i.e. only 'CD_Next', 'CD_Forward_All' and+-- 'CD_Forward' is allowed).+data CursorDirection+  = CD_Next+  | CD_Prior+  | CD_First+  | CD_Last+  | CD_Forward_All+  | CD_Backward_All+  | CD_Absolute Int+  | CD_Relative Int+  | CD_Forward  Int+  | CD_Backward Int+  deriving (Eq, Ord, Show)++cursorDirectionToSQL :: (IsString sql, IsSQL sql, Monoid sql) => CursorDirection -> sql+cursorDirectionToSQL = \case+  CD_Next         -> "NEXT"+  CD_Prior        -> "PRIOR"+  CD_First        -> "FIRST"+  CD_Last         -> "LAST"+  CD_Forward_All  -> "FORWARD ALL"+  CD_Backward_All -> "BACKWARD ALL"+  CD_Absolute n   -> "ABSOLUTE" <+> unsafeSQL (show n)+  CD_Relative n   -> "RELATIVE" <+> unsafeSQL (show n)+  CD_Forward n    -> "FORWARD"  <+> unsafeSQL (show n)+  CD_Backward n   -> "BACKWARD" <+> unsafeSQL (show n)++----------------------------------------++-- | Retrieve the name of a cursor.+cursorName :: Cursor sql -> CursorName sql+cursorName (Cursor name _) = name++-- | Retrieve SQL query used to create a cursor.+cursorQuery :: Cursor sql -> sql+cursorQuery (Cursor _ query) = query++-- | Create a cursor from the SQL query and use it within the given context.+withCursor+  :: (IsString sql, IsSQL sql, Monoid sql, MonadDB m, MonadMask m)+  => CursorName sql+  -> Scroll+  -> Hold+  -> sql+  -> (Cursor sql -> m r)+  -> m r+withCursor name scroll hold sql k = bracket_+  (runQuery_ declareCursor)+  (runQuery_ closeCursor)+  (k $ Cursor name sql)+  where+    declareCursor = smconcat+      [ "DECLARE"+      , unCursorName name+      , case scroll of+          Scroll   -> "SCROLL"+          NoScroll -> "NO SCROLL"+      , "CURSOR"+      , case hold of+          Hold   -> "WITH HOLD"+          NoHold -> "WITHOUT HOLD"+      , "FOR"+      , sql+      ]++    -- Because the cursor might potentially be closed within the continuation+    -- (either by an explicit CLOSE or finishing the current transaction), we+    -- need to supress a potential 'InvalidCursorName' exception.+    closeCursor = smconcat+      [ "DO $$"+      , "BEGIN"+      , "  EXECUTE 'CLOSE" <+> unCursorName name <+> "';"+      , "EXCEPTION WHEN invalid_cursor_name THEN"+      , "END $$"+      ]++-- | Version of 'withCursor' without the @sql@ type parameter for convenience.+withCursorSQL+  :: (MonadDB m, MonadMask m)+  => CursorName SQL+  -> Scroll+  -> Hold+  -> SQL+  -> (Cursor SQL -> m r)+  -> m r+withCursorSQL = withCursor++-- | Retrieve rows from a query using a cursor. See+-- https://www.postgresql.org/docs/current/sql-fetch.html for more information.+cursorFetch+  :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m)+  => Cursor sql+  -> CursorDirection+  -> m Int+cursorFetch cursor direction = runQuery $ smconcat+  [ "FETCH"+  , cursorDirectionToSQL direction+  , "FROM"+  , unCursorName $ cursorName cursor+  ]++-- | Same as 'cursorFetch', except the result (i.e. the number of fetched rows)+-- is ignored.+cursorFetch_ :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m)+  => Cursor sql+  -> CursorDirection+  -> m ()+cursorFetch_ cursor = void . cursorFetch cursor++-- | Move a cursor to a specific position. It works exactly like 'cursorFetch',+-- except it only positions the cursor and does not return rows. See+-- https://www.postgresql.org/docs/current/sql-move.html for more information.+cursorMove+  :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m)+  => Cursor sql+  -> CursorDirection+  -> m Int+cursorMove cursor direction = runQuery $ smconcat+  [ "MOVE"+  , cursorDirectionToSQL direction+  , "FROM"+  , unCursorName $ cursorName cursor+  ]++-- | Same as 'cursorMove', except the result (i.e. the number of rows that would+-- be fetched) is ignored.+cursorMove_+  :: (IsSQL sql, IsString sql, Monoid sql, MonadDB m)+  => Cursor sql+  -> CursorDirection+  -> m ()+cursorMove_ cursor = void . cursorMove cursor

@@ -8,9 +8,7 @@   , fetchOne   ) where -import Control.Applicative import Control.Monad.Catch-import Prelude import qualified Data.Foldable as F  import Database.PostgreSQL.PQTypes.Class

@@ -12,9 +12,7 @@ import Data.Int import Data.Proxy import Data.Time-import Data.Typeable import Data.Word-import Prelude import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T@@ -54,7 +52,7 @@  -- | Cartesian product of rows. data a :*: b = a :*: b-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  instance (PQFormat t1, PQFormat t2) => PQFormat (t1 :*: t2) where   pqFormat    = pqFormat @t1 `BS.append` pqFormat @t2

@@ -4,13 +4,11 @@   , fromRow'   ) where -import Control.Applicative import Data.Functor.Identity import Foreign.C import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable-import Prelude import qualified Control.Exception as E import qualified Data.ByteString.Unsafe as BS 

@@ -2,7 +2,6 @@     FromSQL(..)   ) where -import Control.Applicative import Data.Int import Data.Ratio import Data.Text.Encoding@@ -10,7 +9,6 @@ import Data.Word import Foreign.C import Foreign.Storable-import Prelude import qualified Control.Exception as E import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL

@@ -5,7 +5,6 @@  import Foreign.C import Foreign.Ptr-import Prelude  import Database.PostgreSQL.PQTypes.Internal.C.Types 

@@ -32,12 +32,10 @@   , nullStringCStringLen   )  where -import Control.Applicative import Foreign.C import Foreign.ForeignPtr import Foreign.Marshal.Alloc import Foreign.Ptr-import Prelude import System.Posix.Types import qualified Control.Exception as E 

@@ -5,7 +5,6 @@  import Foreign.C import Foreign.Ptr-import Prelude  import Database.PostgreSQL.PQTypes.Internal.C.Types 

@@ -35,18 +35,14 @@   , PGtimestamp(..)   ) where -import Control.Applicative import Data.ByteString.Unsafe import Foreign.C import Foreign.ForeignPtr import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable-import Prelude import qualified Data.ByteString as BS import qualified Data.Vector.Storable as V--#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__);}, y__)  data PGcancel data PGconn

@@ -7,7 +7,6 @@ import Foreign.Marshal.Alloc import Foreign.Marshal.Array import Foreign.Ptr-import Prelude import qualified Data.Text as T  import Database.PostgreSQL.PQTypes.Internal.C.Interface

@@ -13,7 +13,6 @@   , disconnect   ) where -import Control.Applicative import Control.Arrow (first) import Control.Concurrent import Control.Monad@@ -28,7 +27,6 @@ import Foreign.Ptr import Foreign.Storable import GHC.Exts-import Prelude import qualified Control.Exception as E import qualified Data.ByteString as BS import qualified Data.Foldable as F

@@ -14,7 +14,6 @@   ) where  import Data.Typeable-import Prelude import qualified Control.Exception as E  import Database.PostgreSQL.PQTypes.Internal.Error.Code@@ -34,20 +33,20 @@ , qeSourceFile        :: !(Maybe String) , qeSourceLine        :: !(Maybe Int) , qeSourceFunction    :: !(Maybe String)-} deriving (Eq, Ord, Show, Typeable)+} deriving (Eq, Ord, Show)  -- | Simple SQL query error. Thrown when there is no -- PGresult object corresponding to query execution. newtype QueryError = QueryError String-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  -- | Internal error in this library. newtype HPQTypesError = HPQTypesError String-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  -- | Internal error in libpq/libpqtypes library. newtype LibPQError = LibPQError String-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  -- | Data conversion error. Since it's polymorphic in error type, -- it nicely reports arbitrarily nested conversion errors.@@ -60,7 +59,7 @@ , convRow        :: !Int -- | Exact error. , convError      :: !e-} deriving Typeable+}  deriving instance Show ConversionError @@ -71,7 +70,7 @@   arrItemIndex :: !Int -- | Exact error. , arrItemError :: !e-} deriving Typeable+}  deriving instance Show ArrayItemError @@ -81,7 +80,7 @@   ivValue       :: t -- Optional list of valid values. , ivValidValues :: Maybe [t]-} deriving (Eq, Ord, Show, Typeable)+} deriving (Eq, Ord, Show)  -- | Range error for various data types. data RangeError t = RangeError {@@ -89,7 +88,7 @@   reRange :: [(t, t)] -- | Provided value which is not in above range. , reValue :: t-} deriving (Eq, Ord, Show, Typeable)+} deriving (Eq, Ord, Show)  -- | Array dimenstion mismatch error. data ArrayDimensionMismatch = ArrayDimensionMismatch {@@ -97,7 +96,7 @@   arrDimExpected  :: !Int -- | Dimension provided by the database. , arrDimDelivered :: !Int-} deriving (Eq, Ord, Show, Typeable)+} deriving (Eq, Ord, Show)  -- | Row length mismatch error. data RowLengthMismatch = RowLengthMismatch {@@ -105,7 +104,7 @@   lengthExpected  :: !Int -- | Length delivered by the database. , lengthDelivered :: !Int-} deriving (Eq, Ord, Show, Typeable)+} deriving (Eq, Ord, Show)  -- | Affected/returned rows mismatch error. data AffectedRowsMismatch = AffectedRowsMismatch {@@ -115,7 +114,7 @@   rowsExpected  :: ![(Int, Int)] -- | Number of affected/returned rows by the database. , rowsDelivered :: !Int-} deriving (Eq, Ord, Show, Typeable)+} deriving (Eq, Ord, Show)  instance E.Exception DetailedQueryError instance E.Exception QueryError

@@ -3,9 +3,6 @@   , stringToErrorCode   ) where -import Data.Typeable-import Prelude- -- | SQL error code. Reference: -- <http://www.postgresql.org/docs/devel/static/errcodes-appendix.html>. data ErrorCode@@ -285,7 +282,7 @@   | IndexCorrupted   -- Unknown error code   | UnknownErrorCode String-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  -- | Convert 'String' to corresponding 'ErrorCode'. stringToErrorCode :: String -> ErrorCode

@@ -4,8 +4,6 @@   , rethrowWithContext   ) where -import Data.Typeable-import Prelude import qualified Control.Exception as E  import Database.PostgreSQL.PQTypes.SQL.Class@@ -17,7 +15,7 @@   dbeQueryContext :: !sql -- | Specific error. , dbeError        :: !e-} deriving Typeable+}  deriving instance Show DBException 

@@ -15,8 +15,6 @@ import Control.Monad.State.Strict import Control.Monad.Trans.Control import Control.Monad.Writer.Class-import Data.Monoid-import Prelude import qualified Control.Monad.Trans.State.Strict as S  import Database.PostgreSQL.PQTypes.Class

@@ -8,10 +8,8 @@ import Control.Monad import Control.Monad.Fix import Data.String-import Data.Typeable import Foreign.Ptr import Foreign.Storable-import Prelude import System.Posix.Types import System.Timeout import qualified Control.Exception as E@@ -26,8 +24,6 @@ import Database.PostgreSQL.PQTypes.Internal.Utils import Database.PostgreSQL.PQTypes.SQL.Raw -#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__);}, y__)- #include <libpq-fe.h>  foreign import ccall unsafe "PQnotifies"@@ -37,7 +33,7 @@  -- | Representation of notification channel. newtype Channel = Channel (RawSQL ())-  deriving (Eq, Ord, Typeable)+  deriving (Eq, Ord)  instance IsString Channel where   fromString = Channel . fromString@@ -55,7 +51,7 @@ , ntChannel :: !Channel   -- | Notification payload string. , ntPayload :: !T.Text-} deriving (Eq, Ord, Show, Typeable)+} deriving (Eq, Ord, Show)  instance Storable Notification where   sizeOf _ = #{size PGnotify}

@@ -2,12 +2,9 @@     runQueryIO   ) where -import Control.Applicative import Control.Concurrent.Async-import Control.Monad import Foreign.ForeignPtr import Foreign.Ptr-import Prelude import qualified Control.Exception as E import qualified Data.ByteString.Char8 as BS 

@@ -5,14 +5,12 @@   , nfields   ) where -import Control.Applicative import Control.Monad import Data.Foldable import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Marshal.Alloc import Foreign.Ptr-import Prelude import System.IO.Unsafe import qualified Control.Exception as E 

@@ -3,8 +3,6 @@     DBState(..)   ) where -import Prelude- import Database.PostgreSQL.PQTypes.FromRow import Database.PostgreSQL.PQTypes.Internal.Connection import Database.PostgreSQL.PQTypes.Internal.QueryResult

@@ -15,7 +15,6 @@   , unexpectedNULL   ) where -import Control.Applicative import Control.Monad import Data.ByteString.Unsafe import Foreign.C@@ -25,7 +24,6 @@ import Foreign.Ptr import Foreign.Storable import GHC.Exts-import Prelude import qualified Control.Exception as E import qualified Data.Text as T import qualified Data.Text.Encoding as T

@@ -9,13 +9,9 @@   , imicroseconds   ) where -import Control.Applicative import Data.Int import Data.List-import Data.Monoid-import Data.Typeable import Foreign.Storable-import Prelude import qualified Data.ByteString.Char8 as BS import qualified Data.Semigroup as SG @@ -24,8 +20,6 @@ import Database.PostgreSQL.PQTypes.Internal.Utils import Database.PostgreSQL.PQTypes.ToSQL -#let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__);}, y__)- #include <libpqtypes.h>  ----------------------------------------@@ -39,7 +33,7 @@ , intMinutes       :: !Int32 , intSeconds       :: !Int32 , intMicroseconds  :: !Int32-} deriving (Eq, Ord, Typeable)+} deriving (Eq, Ord)  instance Show Interval where   showsPrec _ Interval{..} = (++) . intercalate ", " $ filter (not . null) [

@@ -3,11 +3,8 @@   , JSONB(..)   ) where -import Control.Applicative import Data.Aeson-import Data.Typeable import Foreign.Ptr-import Prelude import qualified Control.Exception as E import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL@@ -19,7 +16,7 @@  -- | Wrapper for (de)serializing underlying type as 'json'. newtype JSON json = JSON { unJSON :: json }-  deriving (Eq, Functor, Ord, Show, Typeable)+  deriving (Eq, Functor, Ord, Show)  instance PQFormat (JSON json) where   pqFormat = BS.pack "%json"@@ -52,7 +49,7 @@  -- | Wrapper for (de)serializing underlying type as 'jsonb'. newtype JSONB jsonb = JSONB { unJSONB :: jsonb }-  deriving (Eq, Functor, Ord, Show, Typeable)+  deriving (Eq, Functor, Ord, Show)  instance PQFormat (JSONB jsonb) where   pqFormat = BS.pack "%jsonb"

@@ -8,7 +8,6 @@   ) where  import Data.Text (Text)-import Prelude  import Data.Monoid.Utils import Database.PostgreSQL.PQTypes.Class

@@ -7,12 +7,10 @@   , isSqlEmpty   ) where -import Control.Applicative import Control.Concurrent.MVar import Data.Monoid import Data.String import Foreign.Marshal.Alloc-import Prelude import TextShow import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Unsafe as BS

@@ -7,7 +7,6 @@ import Data.String import Foreign.C.String import Foreign.Ptr-import Prelude  import Database.PostgreSQL.PQTypes.Internal.C.Types import Database.PostgreSQL.PQTypes.ToSQL

@@ -4,10 +4,8 @@   , unRawSQL   ) where -import Data.Monoid import Data.String import Foreign.Marshal.Alloc-import Prelude import qualified Data.ByteString.Char8 as BS import qualified Data.Semigroup as SG import qualified Data.Text as T@@ -34,7 +32,7 @@   fromString = flip RawSQL () . T.pack  instance SG.Semigroup (RawSQL ()) where-  RawSQL a () <> RawSQL b () = RawSQL (a <> b) ()+  RawSQL a () <> RawSQL b () = RawSQL (a SG.<> b) ()   sconcat xs = RawSQL (SG.sconcat $ fmap (\(RawSQL s ()) -> s) xs) ()  instance Monoid (RawSQL ()) where

@@ -8,7 +8,6 @@ import Foreign.C import Foreign.Marshal.Alloc import Foreign.Ptr-import Prelude import qualified Data.ByteString.Unsafe as BS  import Database.PostgreSQL.PQTypes.Format

@@ -13,7 +13,6 @@ import Foreign.Marshal.Alloc import Foreign.Ptr import Foreign.Storable-import Prelude import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T

@@ -16,7 +16,6 @@ import Data.Function import Data.String import Data.Typeable-import Prelude  import Data.Monoid.Utils import Database.PostgreSQL.PQTypes.Class

@@ -7,14 +7,11 @@   ) where  import Data.Default.Class-import Data.Typeable-import Prelude import qualified Control.Exception as E  -- | Predicate that determines whether the transaction has to be restarted. data RestartPredicate = forall e. E.Exception e                      => RestartPredicate (e -> Integer -> Bool)-  deriving Typeable  instance Show RestartPredicate where   showsPrec _ RestartPredicate{} = (++) "RestartPredicate"@@ -40,13 +37,13 @@ , tsRestartPredicate :: !(Maybe RestartPredicate) -- | Permissions of all transactions. , tsPermissions      :: !Permissions-} deriving (Show, Typeable)+} deriving Show  data IsolationLevel = DefaultLevel | ReadCommitted | RepeatableRead | Serializable-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  data Permissions = DefaultPermissions | ReadOnly | ReadWrite-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  -- | Default transaction settings. instance Default TransactionSettings where

@@ -14,7 +14,6 @@  import Control.Monad import Control.Monad.Catch-import Prelude  import Database.PostgreSQL.PQTypes.Class import Database.PostgreSQL.PQTypes.Internal.Error

@@ -3,8 +3,6 @@   ) where  import Data.Text-import Data.Typeable-import Prelude import qualified Data.ByteString.Char8 as BSC  import Database.PostgreSQL.PQTypes.Format@@ -15,7 +13,7 @@ -- | Representation of SQL XML types as 'Text'.  Users of hpqtypes may -- want to add conversion instances for their favorite XML type around 'XML'. newtype XML = XML { unXML :: Text }-  deriving (Eq, Ord, Read, Show, Typeable)+  deriving (Eq, Ord, Read, Show)  instance PQFormat XML where   pqFormat = BSC.pack "%xml"

@@ -3,7 +3,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Main where -import Control.Applicative import Control.Concurrent.Lifted import Control.Monad import Control.Monad.Base@@ -17,7 +16,6 @@ import Data.Time import Data.Typeable import Data.Word-import Prelude import System.Environment import System.Exit import System.Random@@ -40,7 +38,8 @@ type InnerTestEnv = StateT QCGen (DBT IO)  newtype TestEnv a = TestEnv { unTestEnv :: InnerTestEnv a }-  deriving (Applicative, Functor, Monad, MonadBase IO, MonadCatch, MonadDB, MonadMask, MonadThrow)+  deriving ( Applicative, Functor, Monad+           , MonadBase IO, MonadCatch, MonadDB, MonadMask, MonadThrow )  instance MonadBaseControl IO TestEnv where #if MIN_VERSION_monad_control(1,0,0)@@ -76,7 +75,7 @@ ----------------------------------------  newtype AsciiChar = AsciiChar { unAsciiChar :: Char }-  deriving (Eq, Show, Typeable)+  deriving (Eq, Show)  instance PQFormat AsciiChar where   pqFormat = pqFormat @Char@@ -142,7 +141,7 @@ ----------------------------------------  data Simple = Simple (Maybe Int32) (Maybe Day)-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  type instance CompositeRow Simple = (Maybe Int32, Maybe Day) @@ -157,7 +156,7 @@   arbitrary = Simple <$> arbitrary <*> arbitrary  data Nested = Nested (Maybe Double) (Maybe Simple)-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  type instance CompositeRow Nested = (Maybe Double, Maybe (Composite Simple)) @@ -226,16 +225,81 @@       , "expected: " ++ show expected ++ "\n but got: " ++ show actual       ] +assertEqualEq :: (Eq a, Show a, MonadBase IO m) => String -> a -> a -> m ()+assertEqualEq preface expected actual = assertEqual preface expected actual (==)+ ---------------------------------------- +sqlGenInts :: Int32 -> SQL+sqlGenInts n = smconcat+  [ "WITH RECURSIVE ints(n) AS"+  , "( VALUES (1) UNION ALL SELECT n+1 FROM ints WHERE n <" <?> n+  , ") SELECT n FROM ints"+  ]++cursorTest :: TestData -> Test+cursorTest td = testGroup "Cursors"+  [ basicCursorWorks+  , scrollableCursorWorks+  , withHoldCursorWorks+  , doubleCloseWorks+  ]+  where+    basicCursorWorks = testCase "Basic cursor works" $ do+      runTestEnv td def $ do+        withCursor "ints" NoScroll NoHold (sqlGenInts 5) $ \cursor -> do+          xs <- (`fix` []) $ \loop acc -> cursorFetch cursor CD_Next >>= \case+            0 -> return $ reverse acc+            1 -> do+              (n::Int32) <- fetchOne runIdentity+              loop $ n : acc+            n -> error $ "Unexpected number of rows: " ++ show n+          assertEqualEq "Data fetched correctly" [1..5] xs++    scrollableCursorWorks = testCase "Cursor declared as SCROLL works" $ do+      runTestEnv td def $ do+        withCursor "ints" Scroll NoHold (sqlGenInts 10) $ \cursor -> do+          checkMove cursor CD_Next         1+          checkMove cursor CD_Prior        0+          checkMove cursor CD_First        1+          checkMove cursor CD_Last         1+          checkMove cursor CD_Backward_All 9+          checkMove cursor CD_Forward_All  10+          checkMove cursor (CD_Absolute 0) 0+          checkMove cursor (CD_Relative 0) 0+          checkMove cursor (CD_Forward 5)  5+          checkMove cursor (CD_Backward 5) 4++          cursorFetch_ cursor CD_Forward_All+          xs1::[Int32] <- fetchMany runIdentity+          assertEqualEq "xs1 is correct" [1..10] xs1+          cursorFetch_ cursor CD_Backward_All+          xs2::[Int32] <- fetchMany runIdentity+          assertEqualEq "xs2 is correct" (reverse [1..10]) xs2+      where+        checkMove cursor cd expected = do+          moved <- cursorMove cursor cd+          assertEqualEq ("Moving cursor with" <+> show cd+                         <+> "would fetch a correct amount of rows")+            expected moved++    withHoldCursorWorks = testCase "Cursor declared as WITH HOLD works" $ do+      runTestEnv td tsNoTrans $ do+        withCursor "ints" NoScroll Hold (sqlGenInts 10) $ \cursor -> do+          cursorFetch_ cursor CD_Forward_All+          sum_::Int32 <- sum . fmap runIdentity <$> queryResult+          assertEqualEq "sum_ is correct" 55 sum_++    doubleCloseWorks = testCase "Double CLOSE works on a cursor" $ do+      runTestEnv td def $ do+        withCursorSQL "ints" NoScroll NoHold "SELECT 1" $ \_cursor -> do+          -- Commiting a transaction closes the cursor+          commit+ queryInterruptionTest :: TestData -> Test queryInterruptionTest td = testCase "Queries are interruptible" $ do   let sleep = "SELECT pg_sleep(2)"-      ints  = smconcat-        [ "WITH RECURSIVE ints(n) AS"-        , "( VALUES (1) UNION ALL SELECT n+1 FROM ints WHERE n < 5000000"-        , ") SELECT n FROM ints"-        ]+      ints  = sqlGenInts 5000000   runTestEnv td tsNoTrans $ do     testQuery id sleep     testQuery id ints@@ -243,22 +307,24 @@     testQuery (withSavepoint "ints")  ints     testQuery (withSavepoint "sleep") sleep    where-    testQuery m sql = timeout 500000 (m . runQuery_ $ rawSQL sql ()) >>= \case+    testQuery m sql = timeout 500000 (m $ runSQL_ sql) >>= \case       Just _  -> liftBase $ do-        assertFailure $ "Query" <+> T.unpack sql <+> "wasn't interrupted in time"+        assertFailure $ "Query" <+> show sql <+> "wasn't interrupted in time"       Nothing -> return ()  autocommitTest :: TestData -> Test-autocommitTest td = testCase "Autocommit mode works" . runTestEnv td tsNoTrans $ do+autocommitTest td = testCase "Autocommit mode works" .+                    runTestEnv td tsNoTrans $ do   let sint = Identity (1::Int32)   runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint   withNewConnection $ do     n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint-    assertEqual "Other connection sees autocommited data" n 1 (==)+    assertEqualEq "Other connection sees autocommited data" 1 n   runQuery_ $ rawSQL "DELETE FROM test1_ WHERE a = $1" sint  readOnlyTest :: TestData -> Test-readOnlyTest td = testCase "Read only transaction mode works" . runTestEnv td def{tsPermissions = ReadOnly} $ do+readOnlyTest td = testCase "Read only transaction mode works" .+                  runTestEnv td def{tsPermissions = ReadOnly} $ do   let sint = Identity (2::Int32)   eres <- try . runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint   case eres :: Either DBException () of@@ -266,10 +332,11 @@     Right _ -> liftBase . assertFailure $ "DBException wasn't thrown"   rollback   n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint-  assertEqual "SELECT works in read only mode" n 0 (==)+  assertEqualEq "SELECT works in read only mode" 0 n  savepointTest :: TestData -> Test-savepointTest td = testCase "Savepoint support works" . runTestEnv td def $ do+savepointTest td = testCase "Savepoint support works" .+                   runTestEnv td def $ do   let int1 = 3 :: Int32       int2 = 4 :: Int32 @@ -280,7 +347,7 @@     runSQL_ "SELECT * FROM table_that_is_not_there"   runQuery_ $ rawSQL "SELECT a FROM test1_ WHERE a IN ($1, $2)" (int1, int2)   res1 <- fetchMany runIdentity-  assertEqual "Part of transaction was rolled back" res1 [int1] (==)+  assertEqualEq "Part of transaction was rolled back" [int1] res1    rollback @@ -288,9 +355,10 @@   runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int1)   withSavepoint (Savepoint "test") $ do     runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" (Identity int2)-  runQuery_ $ rawSQL "SELECT a FROM test1_ WHERE a IN ($1, $2) ORDER BY a" (int1, int2)+  runQuery_ $ rawSQL+    "SELECT a FROM test1_ WHERE a IN ($1, $2) ORDER BY a" (int1, int2)   res2 <- fetchMany runIdentity-  assertEqual "Result of all queries is visible" res2 [int1, int2] (==)+  assertEqualEq "Result of all queries is visible" [int1, int2] res2  notifyTest :: TestData -> Test notifyTest td = testCase "Notifications work" . runTestEnv td tsNoTrans $ do@@ -299,36 +367,41 @@   mnt1 <- getNotification 100000   liftBase $ assertBool "Notification received" (isJust mnt1)   let Just nt1 = mnt1-  assertEqual "Channels are equal" chan (ntChannel nt1) (==)-  assertEqual "Payloads are equal" payload (ntPayload nt1) (==)+  assertEqualEq "Channels are equal" chan (ntChannel nt1)+  assertEqualEq "Payloads are equal" payload (ntPayload nt1)    unlisten chan   forkNewConn $ notify chan payload   mnt2 <- getNotification 100000-  assertEqual "No notification received after unlisten" Nothing mnt2 (==)+  assertEqualEq "No notification received after unlisten" Nothing mnt2    listen chan   unlistenAll   forkNewConn $ notify chan payload   mnt3 <- getNotification 100000-  assertEqual "No notification received after unlistenAll" Nothing mnt3 (==)+  assertEqualEq "No notification received after unlistenAll" Nothing mnt3   where     chan = "test_channel"     payload = "test_payload"     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 def{tsIsolationLevel = lvl} $ do   let sint = Identity (5::Int32)   runQuery_ $ rawSQL "INSERT INTO test1_ (a) VALUES ($1)" sint   withNewConnection $ do     n <- runQuery $ rawSQL "SELECT a FROM test1_ WHERE a = $1" sint-    assertEqual "Other connection doesn't see uncommited data" n 0 (==)+    assertEqualEq "Other connection doesn't see uncommited data" 0 n   rollback  nullTest :: forall t. (Show t, ToSQL t, FromSQL t, Typeable t)          => 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+nullTest td t = testCase ("Attempt to get non-NULL value of type"+                          <+> show (typeOf t) <+> "fails if NULL is provided") .+                runTestEnv td def $ do   runSQL_ $ "SELECT" <?> (Nothing::Maybe t)   eres  <- try $ fetchOne runIdentity   case eres :: Either DBException t of@@ -337,7 +410,11 @@  putGetTest :: forall t. (Arbitrary t, Show t, ToSQL t, FromSQL t, Typeable t)            => TestData -> Int -> t -> (t -> t -> Bool) -> Test-putGetTest td n t eq = testCase ("Putting value of type" <+> show (typeOf t) <+> "through database doesn't change its value") . runTestEnv td def . runTimes 1000 $ do+putGetTest td n t eq = testCase+                       ("Putting value of type"+                         <+> show (typeOf t)+                         <+> "through database doesn't change its value") .+                       runTestEnv td def . runTimes 1000 $ do   v :: t <- randomValue n   --liftBase . putStrLn . show $ v   runSQL_ $ "SELECT" <?> v@@ -345,25 +422,29 @@   assertEqual "Value doesn't change after getting through database" v v' eq  xmlTest :: TestData -> Test-xmlTest td  = testCase "Put and get XML value works" . runTestEnv td def $ do+xmlTest td  = testCase "Put and get XML value works" .+              runTestEnv td def $ do   runSQL_ $ "SET CLIENT_ENCODING TO 'UTF8'"   let v = XML "some<tag>stringå</tag>"   runSQL_ $ "SELECT XML 'some<tag>stringå</tag>'"   v' <- fetchOne runIdentity-  assertEqual "XML value correct" v v' (==)+  assertEqualEq "XML value correct" v v'   runSQL_ $ "SELECT" <?> v   v'' <- fetchOne runIdentity-  assertEqual "XML value correct" v v'' (==)+  assertEqualEq "XML value correct" v v''   runSQL_ $ "SET CLIENT_ENCODING TO 'latin-1'"  rowTest :: forall row. (Arbitrary row, Eq row, Show row, ToRow row, FromRow row)         => TestData -> row -> Test-rowTest td _r = testCase ("Putting row of length" <+> show (pqVariables @row) <+> "through database works") . runTestEnv td def . runTimes 100 $ do+rowTest td _r = testCase ("Putting row of length"+                          <+> show (pqVariables @row)+                          <+> "through database works") .+                runTestEnv td def . runTimes 100 $ do   row :: row <- randomValue 100   let fmt = mintercalate ", " $ map (T.append "$" . showt) [1..pqVariables @row]   runQuery_ $ rawSQL ("SELECT" <+> fmt) row   row' <- fetchOne id-  assertEqual "Row doesn't change after getting through database" row row' (==)+  assertEqualEq "Row doesn't change after getting through database" row row'  _printTime :: MonadBase IO m => m a -> m a _printTime m = do@@ -381,6 +462,7 @@   , savepointTest td   , notifyTest td   , queryInterruptionTest td+  , cursorTest td   ----------------------------------------   , transactionTest td ReadCommitted   , transactionTest td RepeatableRead

@@ -1,8 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Prelude.Instances where -import Prelude + deriving instance (     Eq a1, Eq a2, Eq a3, Eq a4, Eq a5, Eq a6, Eq a7, Eq a8, Eq a9, Eq a10   , Eq a11, Eq a12, Eq a13, Eq a14, Eq a15, Eq a16@@ -504,3 +504,4 @@   , Show a41, Show a42, Show a43, Show a44, Show a45, Show a46, Show a47, Show a48   , Show a49, Show a50   ) => Show (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15, a16, a17, a18, a19, a20, a21, a22, a23, a24, a25, a26, a27, a28, a29, a30, a31, a32, a33, a34, a35, a36, a37, a38, a39, a40, a41, a42, a43, a44, a45, a46, a47, a48, a49, a50)+

@@ -3,14 +3,11 @@ {-# LANGUAGE TypeApplications #-} module Test.QuickCheck.Arbitrary.Instances where -import Control.Applicative import Data.Aeson import Data.Char import Data.Scientific import Data.Time-import Data.Typeable import Data.Word-import Prelude import Test.QuickCheck.Arbitrary import Test.QuickCheck.Gen import qualified Data.ByteString as BS@@ -21,7 +18,7 @@ import Database.PostgreSQL.PQTypes  newtype String0 = String0 { unString0 :: String }-  deriving (Eq, Ord, Show, Typeable)+  deriving (Eq, Ord, Show)  instance PQFormat String0 where   pqFormat = pqFormat @String