Hello community,
here is the log from the commit of package ghc-postgresql-simple for
openSUSE:Factory checked in at 2020-11-19 11:58:55
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-postgresql-simple (Old)
and /work/SRC/openSUSE:Factory/.ghc-postgresql-simple.new.5913 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-postgresql-simple"
Thu Nov 19 11:58:55 2020 rev:4 rq:849162 version:0.6.3
Changes:
--------
---
/work/SRC/openSUSE:Factory/ghc-postgresql-simple/ghc-postgresql-simple.changes
2020-09-07 22:03:25.878101289 +0200
+++
/work/SRC/openSUSE:Factory/.ghc-postgresql-simple.new.5913/ghc-postgresql-simple.changes
2020-11-23 10:27:45.513178117 +0100
@@ -1,0 +2,26 @@
+Sun Nov 15 22:11:18 UTC 2020 - psim...@suse.com
+
+- Update postgresql-simple to version 0.6.3.
+ ### Version 0.6.3 (2020-11-15)
+
+ * Add `fromFieldJSONByteString`
+ Thanks to tomjaguarpaw for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/47
+ * Add `attoFieldParser`
+ Thanks to Victor Nawothnig for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/45
+ * Add `Identity` and `Const` instance
+ Thanks to Cary Robbins for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/46
+ * Add `withTransactionModeRetry'`, a variant of `withTransactionModeRetry`
+ for all exception types.
+ Thanks to Elliot Cameron for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/42
+ * Fix spurious aborts when retrying transactions
+ Thanks to Elliot Cameron for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/34
+ * Add `Database.PostgreSQL.Simple.Newtypes` module
+ with `Aeson` newtype.
+ https://github.com/haskellari/postgresql-simple/pull/55
+
+-------------------------------------------------------------------
Old:
----
postgresql-simple-0.6.2.tar.gz
postgresql-simple.cabal
New:
----
postgresql-simple-0.6.3.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-postgresql-simple.spec ++++++
--- /var/tmp/diff_new_pack.cAoRw8/_old 2020-11-23 10:27:46.077178755 +0100
+++ /var/tmp/diff_new_pack.cAoRw8/_new 2020-11-23 10:27:46.081178759 +0100
@@ -19,13 +19,12 @@
%global pkg_name postgresql-simple
%bcond_with tests
Name: ghc-%{pkg_name}
-Version: 0.6.2
+Version: 0.6.3
Release: 0
Summary: Mid-Level PostgreSQL client library
License: BSD-3-Clause
URL: https://hackage.haskell.org/package/%{pkg_name}
Source0:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{version}.tar.gz
-Source1:
https://hackage.haskell.org/package/%{pkg_name}-%{version}/revision/4.cabal#/%{pkg_name}.cabal
BuildRequires: ghc-Cabal-devel
BuildRequires: ghc-Only-devel
BuildRequires: ghc-aeson-devel
@@ -71,7 +70,6 @@
%prep
%autosetup -n %{pkg_name}-%{version}
-cp -p %{SOURCE1} %{pkg_name}.cabal
%build
%ghc_lib_build
++++++ postgresql-simple-0.6.2.tar.gz -> postgresql-simple-0.6.3.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-simple-0.6.2/CHANGES.md
new/postgresql-simple-0.6.3/CHANGES.md
--- old/postgresql-simple-0.6.2/CHANGES.md 2001-09-09 03:46:40.000000000
+0200
+++ new/postgresql-simple-0.6.3/CHANGES.md 2001-09-09 03:46:40.000000000
+0200
@@ -1,3 +1,25 @@
+### Version 0.6.3 (2020-11-15)
+
+ * Add `fromFieldJSONByteString`
+ Thanks to tomjaguarpaw for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/47
+ * Add `attoFieldParser`
+ Thanks to Victor Nawothnig for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/45
+ * Add `Identity` and `Const` instance
+ Thanks to Cary Robbins for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/46
+ * Add `withTransactionModeRetry'`, a variant of `withTransactionModeRetry`
+ for all exception types.
+ Thanks to Elliot Cameron for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/42
+ * Fix spurious aborts when retrying transactions
+ Thanks to Elliot Cameron for the implementation
+ https://github.com/haskellari/postgresql-simple/pull/34
+ * Add `Database.PostgreSQL.Simple.Newtypes` module
+ with `Aeson` newtype.
+ https://github.com/haskellari/postgresql-simple/pull/55
+
### Version 0.6.2 (2019-04-26)
* Define `MonadFail Ok`.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-simple-0.6.2/postgresql-simple.cabal
new/postgresql-simple-0.6.3/postgresql-simple.cabal
--- old/postgresql-simple-0.6.2/postgresql-simple.cabal 2001-09-09
03:46:40.000000000 +0200
+++ new/postgresql-simple-0.6.3/postgresql-simple.cabal 2001-09-09
03:46:40.000000000 +0200
@@ -1,194 +1,193 @@
-Cabal-version: 1.12
-Name: postgresql-simple
-Version: 0.6.2
-
-Synopsis: Mid-Level PostgreSQL client library
-Description:
- Mid-Level PostgreSQL client library, forked from mysql-simple.
-License: BSD3
-License-file: LICENSE
-Author: Bryan O'Sullivan, Leon P Smith
-Maintainer: Oleg Grenrus <oleg.gren...@iki.fi>
-Copyright: (c) 2011 MailRank, Inc.
- (c) 2011-2018 Leon P Smith
- (c) 2018-2019 Oleg Grenrus
-Category: Database
-Build-type: Simple
+cabal-version: 1.12
+name: postgresql-simple
+version: 0.6.3
+synopsis: Mid-Level PostgreSQL client library
+description:
+ Mid-Level PostgreSQL client library, forked from mysql-simple.
+
+license: BSD3
+license-file: LICENSE
+author: Bryan O'Sullivan, Leon P Smith
+maintainer: Oleg Grenrus <oleg.gren...@iki.fi>
+copyright:
+ (c) 2011 MailRank, Inc.
+ (c) 2011-2018 Leon P Smith
+ (c) 2018-2020 Oleg Grenrus
+category: Database
+build-type: Simple
extra-source-files:
- CONTRIBUTORS
CHANGES.md
+ CONTRIBUTORS
test/results/malformed-input.expected
test/results/unique-constraint-violation.expected
tested-with:
- GHC == 7.6.3
- || == 7.8.4
- || == 7.10.3
- || == 8.0.2
- || == 8.2.2
- || == 8.4.4
- || == 8.6.5
- || == 8.8.1
+ GHC ==7.6.3
+ || ==7.8.4
+ || ==7.10.3
+ || ==8.0.2
+ || ==8.2.2
+ || ==8.4.4
+ || ==8.6.5
+ || ==8.8.4
+ || ==8.10.2
+
+library
+ default-language: Haskell2010
+ hs-source-dirs: src
+ exposed-modules:
+ Database.PostgreSQL.Simple
+ Database.PostgreSQL.Simple.Arrays
+ Database.PostgreSQL.Simple.Copy
+ Database.PostgreSQL.Simple.Cursor
+ Database.PostgreSQL.Simple.Errors
+ Database.PostgreSQL.Simple.FromField
+ Database.PostgreSQL.Simple.FromRow
+ Database.PostgreSQL.Simple.HStore
+ Database.PostgreSQL.Simple.HStore.Internal
+ Database.PostgreSQL.Simple.Internal
+ Database.PostgreSQL.Simple.LargeObjects
+ Database.PostgreSQL.Simple.Newtypes
+ Database.PostgreSQL.Simple.Notification
+ Database.PostgreSQL.Simple.Ok
+ Database.PostgreSQL.Simple.Range
+ Database.PostgreSQL.Simple.SqlQQ
+ Database.PostgreSQL.Simple.Time
+ Database.PostgreSQL.Simple.Time.Internal
+ Database.PostgreSQL.Simple.ToField
+ Database.PostgreSQL.Simple.ToRow
+ Database.PostgreSQL.Simple.Transaction
+ Database.PostgreSQL.Simple.TypeInfo
+ Database.PostgreSQL.Simple.TypeInfo.Macro
+ Database.PostgreSQL.Simple.TypeInfo.Static
+ Database.PostgreSQL.Simple.Types
+ Database.PostgreSQL.Simple.Vector
+ Database.PostgreSQL.Simple.Vector.Unboxed
-Library
- default-language: Haskell2010
- hs-source-dirs: src
- Exposed-modules:
- Database.PostgreSQL.Simple
- Database.PostgreSQL.Simple.Arrays
- Database.PostgreSQL.Simple.Copy
- Database.PostgreSQL.Simple.Cursor
- Database.PostgreSQL.Simple.FromField
- Database.PostgreSQL.Simple.FromRow
- Database.PostgreSQL.Simple.LargeObjects
- Database.PostgreSQL.Simple.HStore
- Database.PostgreSQL.Simple.HStore.Internal
- Database.PostgreSQL.Simple.Notification
- Database.PostgreSQL.Simple.Ok
- Database.PostgreSQL.Simple.Range
- Database.PostgreSQL.Simple.SqlQQ
- Database.PostgreSQL.Simple.Time
- Database.PostgreSQL.Simple.Time.Internal
- Database.PostgreSQL.Simple.ToField
- Database.PostgreSQL.Simple.ToRow
- Database.PostgreSQL.Simple.Transaction
- Database.PostgreSQL.Simple.TypeInfo
- Database.PostgreSQL.Simple.TypeInfo.Macro
- Database.PostgreSQL.Simple.TypeInfo.Static
- Database.PostgreSQL.Simple.Types
- Database.PostgreSQL.Simple.Errors
- Database.PostgreSQL.Simple.Vector
- Database.PostgreSQL.Simple.Vector.Unboxed
-
--- Other-modules:
- Database.PostgreSQL.Simple.Internal
-
- Other-modules:
- Database.PostgreSQL.Simple.Compat
- Database.PostgreSQL.Simple.HStore.Implementation
- Database.PostgreSQL.Simple.Internal.PQResultUtils
- Database.PostgreSQL.Simple.Time.Implementation
- Database.PostgreSQL.Simple.Time.Internal.Parser
- Database.PostgreSQL.Simple.Time.Internal.Printer
- Database.PostgreSQL.Simple.TypeInfo.Types
+ -- Other-modules:
+ other-modules:
+ Database.PostgreSQL.Simple.Compat
+ Database.PostgreSQL.Simple.HStore.Implementation
+ Database.PostgreSQL.Simple.Internal.PQResultUtils
+ Database.PostgreSQL.Simple.Time.Implementation
+ Database.PostgreSQL.Simple.Time.Internal.Parser
+ Database.PostgreSQL.Simple.Time.Internal.Printer
+ Database.PostgreSQL.Simple.TypeInfo.Types
-- GHC bundled libs
- Build-depends:
- base >=4.6.0.0 && <4.13
- , bytestring >=0.10.0.0 && <0.11
- , containers >=0.5.0.0 && <0.7
- , time >=1.4.0.1 && <1.9
- , transformers >=0.3.0.0 && <0.6
- , template-haskell >=2.8.0.0 && <2.15
- , text >=1.2.3.0 && <1.3
+ build-depends:
+ base >=4.6.0.0 && <4.15
+ , bytestring >=0.10.0.0 && <0.12
+ , containers >=0.5.0.0 && <0.7
+ , template-haskell >=2.8.0.0 && <2.17
+ , text >=1.2.3.0 && <1.3
+ , time >=1.4.0.1 && <1.12
+ , transformers >=0.3.0.0 && <0.6
-- Other dependencies
- Build-depends:
- aeson >=1.4.1.0 && <1.5
- , attoparsec >=0.13.2.2 && <0.14
- , bytestring-builder >=0.10.8.1.0 && <0.11
- , case-insensitive >=1.2.0.11 && <1.3
- , hashable >=1.2.7.0 && <1.3
- , Only >=0.1 && <0.1.1
- , postgresql-libpq >=0.9.4.2 && < 0.10
- , uuid-types >=1.0.3 && <1.1
- , scientific >=0.3.6.2 && <0.4
- , vector >=0.12.0.1 && <0.13
-
- if !impl(ghc >= 8.0)
- Build-depends:
- fail >=4.9.0.0 && <4.10,
- semigroups >=0.18.5 && <0.19
-
- if !impl(ghc >= 7.6)
- Build-depends:
- ghc-prim
+ build-depends:
+ aeson >=1.4.1.0 && <1.6
+ , attoparsec >=0.13.2.2 && <0.14
+ , bytestring-builder >=0.10.8.1.0 && <0.11
+ , case-insensitive >=1.2.0.11 && <1.3
+ , hashable >=1.2.7.0 && <1.4
+ , Only >=0.1 && <0.1.1
+ , postgresql-libpq >=0.9.4.2 && <0.10
+ , scientific >=0.3.6.2 && <0.4
+ , uuid-types >=1.0.3 && <1.1
+ , vector >=0.12.0.1 && <0.13
+
+ if !impl(ghc >=8.0)
+ build-depends:
+ fail >=4.9.0.0 && <4.10
+ , semigroups >=0.18.5 && <0.20
+
+ if !impl(ghc >=7.6)
+ build-depends: ghc-prim
default-extensions:
+ BangPatterns
DoAndIfThenElse
OverloadedStrings
- BangPatterns
- ViewPatterns
TypeOperators
+ ViewPatterns
- ghc-options: -Wall -fno-warn-name-shadowing
+ ghc-options: -Wall -fno-warn-name-shadowing
source-repository head
type: git
- location: http://github.com/phadej/postgresql-simple
+ location: http://github.com/haskellari/postgresql-simple
source-repository this
type: git
- location: http://github.com/phadej/postgresql-simple
- tag: v0.6
+ location: http://github.com/haskellari/postgresql-simple
+ tag: v0.6.3
test-suite inspection
- if !impl(ghc >= 8.0)
+ if !impl(ghc >=8.0)
buildable: False
default-language: Haskell2010
- type: exitcode-stdio-1.0
- hs-source-dirs: test
- main-is: Inspection.hs
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Inspection.hs
build-depends:
base
, inspection-testing >=0.4.1.1 && <0.5
- , postgresql-simple
, postgresql-libpq
+ , postgresql-simple
, tasty
, tasty-hunit
test-suite test
- default-language: Haskell2010
- type: exitcode-stdio-1.0
-
- hs-source-dirs: test
- main-is: Main.hs
+ default-language: Haskell2010
+ type: exitcode-stdio-1.0
+ hs-source-dirs: test
+ main-is: Main.hs
other-modules:
Common
Notify
Serializable
Time
- ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
-
+ ghc-options: -threaded
+ ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
default-extensions:
NamedFieldPuns
OverloadedStrings
+ PatternGuards
Rank2Types
RecordWildCards
- PatternGuards
ScopedTypeVariables
- build-depends: base
- , aeson
- , base16-bytestring
- , bytestring
- , containers
- , cryptohash-md5 >= 0.11.100.1 && <0.12
- , filepath
- , tasty
- , tasty-hunit
- , tasty-golden
- , HUnit
- , postgresql-simple
- , text
- , time
- , vector
- , case-insensitive
+ build-depends:
+ aeson
+ , base
+ , base16-bytestring
+ , bytestring
+ , case-insensitive
+ , containers
+ , cryptohash-md5 >=0.11.100.1 && <0.12
+ , filepath
+ , HUnit
+ , postgresql-simple
+ , tasty
+ , tasty-golden
+ , tasty-hunit
+ , text
+ , time
+ , vector
- if !impl(ghc >= 7.6)
- build-depends:
- ghc-prim
+ if !impl(ghc >=7.6)
+ build-depends: ghc-prim
benchmark select
default-language: Haskell2010
type: exitcode-stdio-1.0
-
- hs-source-dirs: bench
- main-is: Select.hs
-
- build-depends: base
- , postgresql-simple
- , vector
+ hs-source-dirs: bench
+ main-is: Select.hs
+ build-depends:
+ base
+ , postgresql-simple
+ , vector
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/FromField.hs
new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/FromField.hs
--- old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/FromField.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/FromField.hs
2001-09-09 03:46:40.000000000 +0200
@@ -2,6 +2,7 @@
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE PolyKinds #-}
{- |
Module: Database.PostgreSQL.Simple.FromField
@@ -106,14 +107,16 @@
, PQ.Oid(..)
, PQ.Format(..)
, pgArrayFieldParser
+ , attoFieldParser
, optionalField
, fromJSONField
+ , fromFieldJSONByteString
) where
#include "MachDeps.h"
-import Control.Applicative ( (<|>), (<$>), pure, (*>), (<*) )
+import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>),
(<*) )
import Control.Concurrent.MVar (MVar, newMVar)
import Control.Exception (Exception)
import qualified Data.Aeson as JSON
@@ -122,6 +125,7 @@
import Data.Attoparsec.ByteString.Char8 hiding (Result)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as B
+import Data.Functor.Identity (Identity(Identity))
import Data.Int (Int16, Int32, Int64)
import Data.IORef (IORef, newIORef)
import Data.Ratio (Ratio)
@@ -244,9 +248,11 @@
then Nothing
else Just x
--- | If the column has a table associated with it, this returns the number
--- off the associated table column. Numbering starts from 0. Analogous
--- to libpq's @PQftablecol@.
+-- | If the column has a table associated with it, this returns the
+-- number of the associated table column. Table columns have
+-- nonzero numbers. Zero is returned if the specified column is not
+-- a simple reference to a table column, or when using pre-3.0
+-- protocol. Analogous to libpq's @PQftablecol@.
tableColumn :: Field -> Int
tableColumn Field{..} = fromCol (unsafeDupablePerformIO (PQ.ftablecol result
column))
@@ -265,6 +271,12 @@
| typeOid f /= TI.voidOid = returnError Incompatible f ""
| otherwise = pure ()
+instance (FromField a) => FromField (Const a b) where
+ fromField f bs = Const <$> fromField f bs
+
+instance (FromField a) => FromField (Identity a) where
+ fromField f bs = Identity <$> fromField f bs
+
-- | For dealing with null values. Compatible with any postgresql type
-- compatible with type @a@. Note that the type is not checked if
-- the value is null, although it is inadvisable to rely on this
@@ -311,11 +323,11 @@
-- | int2
instance FromField Int16 where
- fromField = atto ok16 $ signed decimal
+ fromField = attoFieldParser ok16 $ signed decimal
-- | int2, int4
instance FromField Int32 where
- fromField = atto ok32 $ signed decimal
+ fromField = attoFieldParser ok32 $ signed decimal
#if WORD_SIZE_IN_BITS < 64
-- | int2, int4, and if compiled as 64-bit code, int8 as well.
@@ -325,36 +337,36 @@
-- This library was compiled as 64-bit code.
#endif
instance FromField Int where
- fromField = atto okInt $ signed decimal
+ fromField = attoFieldParser okInt $ signed decimal
-- | int2, int4, int8
instance FromField Int64 where
- fromField = atto ok64 $ signed decimal
+ fromField = attoFieldParser ok64 $ signed decimal
-- | int2, int4, int8
instance FromField Integer where
- fromField = atto ok64 $ signed decimal
+ fromField = attoFieldParser ok64 $ signed decimal
-- | int2, float4 (Uses attoparsec's 'double' routine, for
-- better accuracy convert to 'Scientific' or 'Rational' first)
instance FromField Float where
- fromField = atto ok (realToFrac <$> pg_double)
+ fromField = attoFieldParser ok (realToFrac <$> pg_double)
where ok = eq TI.float4Oid \/ eq TI.int2Oid
-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for
-- better accuracy convert to 'Scientific' or 'Rational' first)
instance FromField Double where
- fromField = atto ok pg_double
+ fromField = attoFieldParser ok pg_double
where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq
TI.int4Oid
-- | int2, int4, int8, float4, float8, numeric
instance FromField (Ratio Integer) where
- fromField = atto ok pg_rational
+ fromField = attoFieldParser ok pg_rational
where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq
TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
-- | int2, int4, int8, float4, float8, numeric
instance FromField Scientific where
- fromField = atto ok rational
+ fromField = attoFieldParser ok rational
where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq
TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
unBinary :: Binary t -> t
@@ -382,7 +394,7 @@
-- | oid
instance FromField PQ.Oid where
- fromField f dat = PQ.Oid <$> atto (== TI.oidOid) decimal f dat
+ fromField f dat = PQ.Oid <$> attoFieldParser (== TI.oidOid) decimal f dat
-- | bytea, name, text, \"char\", bpchar, varchar, unknown
instance FromField LB.ByteString where
@@ -558,6 +570,8 @@
Right val -> pure val
-- | Return the JSON ByteString directly
+--
+-- @since 0.6.3
fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString
fromFieldJSONByteString f mbs =
if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid
@@ -659,10 +673,22 @@
(show (typeOf (undefined :: a)))
msg
-atto :: forall a. (Typeable a)
- => Compat -> Parser a -> Field -> Maybe ByteString
- -> Conversion a
-atto types p0 f dat = doFromField f types (go p0) dat
+-- | Construct a field parser from an attoparsec parser. An 'Incompatible'
error is thrown if the
+-- PostgreSQL oid does not match the specified predicate.
+--
+-- @
+-- instance FromField Int16 where
+-- fromField = attoFieldParser ok16 (signed decimal)
+-- @
+--
+-- @since 0.6.3
+attoFieldParser :: forall a. (Typeable a)
+ => (PQ.Oid -> Bool)
+ -- ^ Predicate for whether the postgresql type oid is compatible with
this parser
+ -> Parser a
+ -- ^ An attoparsec parser.
+ -> FieldParser a
+attoFieldParser types p0 f dat = doFromField f types (go p0) dat
where
go :: Parser a -> ByteString -> Conversion a
go p s =
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/Newtypes.hs
new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/Newtypes.hs
--- old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/Newtypes.hs
1970-01-01 01:00:00.000000000 +0100
+++ new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/Newtypes.hs
2001-09-09 03:46:40.000000000 +0200
@@ -0,0 +1,49 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+-- | Module with newtypes suitable to usage with @DerivingVia@ or standalone.
+--
+-- The newtypes are named after packages they wrap.
+module Database.PostgreSQL.Simple.Newtypes (
+ Aeson (..), getAeson,
+) where
+
+import Data.Typeable (Typeable)
+import Database.PostgreSQL.Simple.ToField (ToField (..))
+import Database.PostgreSQL.Simple.FromField (FromField (..), fromJSONField)
+
+import qualified Data.Aeson as Aeson
+
+-------------------------------------------------------------------------------
+-- aeson
+-------------------------------------------------------------------------------
+
+-- | A newtype wrapper with 'ToField' and 'FromField' instances
+-- based on 'Aeson.ToJSON' and 'Aeson.FromJSON' type classes from @aeson@.
+--
+-- Example using @DerivingVia@:
+--
+-- @
+-- data Foo = Foo Int String
+-- deriving stock (Eq, Show, Generic) -- GHC built int
+-- deriving anyclass ('Aeson.FromJSON', 'Aeson.ToJSON') -- Derived
using GHC Generics
+-- deriving ('ToField', 'FromField') via 'Aeson' Foo -- DerivingVia
+-- @
+--
+-- Example using 'Aeson' newtype directly, for more ad-hoc queries
+--
+-- @
+-- execute conn "INSERT INTO tbl (fld) VALUES (?)" (Only ('Aeson' x))
+-- @
+--
+-- @since 0.6.3
+newtype Aeson a = Aeson a
+ deriving (Eq, Show, Read, Typeable, Functor)
+
+getAeson :: Aeson a -> a
+getAeson (Aeson a) = a
+
+instance Aeson.ToJSON a => ToField (Aeson a) where
+ toField = toField . Aeson.encode . getAeson
+
+instance (Aeson.FromJSON a, Typeable a) => FromField (Aeson a) where
+ fromField f bs = fmap Aeson (fromJSONField f bs)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/SqlQQ.hs
new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/SqlQQ.hs
--- old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/SqlQQ.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/SqlQQ.hs
2001-09-09 03:46:40.000000000 +0200
@@ -35,7 +35,7 @@
-- > (beginTime,endTime,string)
--
-- This quasiquoter returns a literal string expression of type 'Query',
--- and attempts to mimimize whitespace; otherwise the above query would
+-- and attempts to minimize whitespace; otherwise the above query would
-- consist of approximately half whitespace when sent to the database
-- backend. It also recognizes and strips out standard sql comments "--".
--
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/ToField.hs
new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/ToField.hs
--- old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/ToField.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/ToField.hs
2001-09-09 03:46:40.000000000 +0200
@@ -1,5 +1,6 @@
{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+{-# LANGUAGE PolyKinds #-}
------------------------------------------------------------------------------
-- |
@@ -22,6 +23,7 @@
, inQuotes
) where
+import Control.Applicative (Const(Const))
import qualified Data.Aeson as JSON
import Data.ByteString (ByteString)
import Data.ByteString.Builder
@@ -30,6 +32,7 @@
, wordDec, word8Dec, word16Dec, word32Dec, word64Dec
, floatDec, doubleDec
)
+import Data.Functor.Identity (Identity(Identity))
import Data.Int (Int8, Int16, Int32, Int64)
import Data.List (intersperse)
import Data.Monoid (mappend)
@@ -100,6 +103,14 @@
toField a = a
{-# INLINE toField #-}
+instance (ToField a) => ToField (Const a b) where
+ toField (Const a) = toField a
+ {-# INLINE toField #-}
+
+instance (ToField a) => ToField (Identity a) where
+ toField (Identity a) = toField a
+ {-# INLINE toField #-}
+
instance (ToField a) => ToField (Maybe a) where
toField Nothing = renderNull
toField (Just a) = toField a
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/Transaction.hs
new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/Transaction.hs
--- old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple/Transaction.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple/Transaction.hs
2001-09-09 03:46:40.000000000 +0200
@@ -17,6 +17,7 @@
, withTransactionLevel
, withTransactionMode
, withTransactionModeRetry
+ , withTransactionModeRetry'
, withTransactionSerializable
, TransactionMode(..)
, IsolationLevel(..)
@@ -146,31 +147,34 @@
commit conn
return r
+-- | 'withTransactionModeRetry'' but with the exception type pinned to
'SqlError'.
+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) ->
Connection -> IO a -> IO a
+withTransactionModeRetry = withTransactionModeRetry'
+
-- | Like 'withTransactionMode', but also takes a custom callback to
--- determine if a transaction should be retried if an 'SqlError' occurs.
--- If the callback returns True, then the transaction will be retried.
--- If the callback returns False, or an exception other than an 'SqlError'
+-- determine if a transaction should be retried if an exception occurs.
+-- If the callback returns 'True', then the transaction will be retried.
+-- If the callback returns 'False', or an exception other than an @e@
-- occurs then the transaction will be rolled back and the exception rethrown.
--
-- This is used to implement 'withTransactionSerializable'.
-withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) ->
Connection -> IO a -> IO a
-withTransactionModeRetry mode shouldRetry conn act =
+withTransactionModeRetry' :: forall a e. E.Exception e => TransactionMode ->
(e -> Bool) -> Connection -> IO a -> IO a
+withTransactionModeRetry' mode shouldRetry conn act =
mask $ \restore ->
retryLoop $ E.try $ do
- a <- restore act
+ a <- restore act `E.onException` rollback_ conn
commit conn
return a
where
- retryLoop :: IO (Either E.SomeException a) -> IO a
+ retryLoop :: IO (Either e a) -> IO a
retryLoop act' = do
beginMode mode conn
r <- act'
case r of
- Left e -> do
- rollback_ conn
- case fmap shouldRetry (E.fromException e) of
- Just True -> retryLoop act'
- _ -> E.throwIO e
+ Left e ->
+ case shouldRetry e of
+ True -> retryLoop act'
+ False -> E.throwIO e
Right a ->
return a
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple.hs
new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple.hs
--- old/postgresql-simple-0.6.2/src/Database/PostgreSQL/Simple.hs
2001-09-09 03:46:40.000000000 +0200
+++ new/postgresql-simple-0.6.3/src/Database/PostgreSQL/Simple.hs
2001-09-09 03:46:40.000000000 +0200
@@ -338,7 +338,7 @@
-- @
-- executeMany c [sql|
-- UPDATE sometable
--- SET sometable.y = upd.y
+-- SET y = upd.y
-- FROM (VALUES (?,?)) as upd(x,y)
-- WHERE sometable.x = upd.x
-- |] [(1, \"hello\"),(2, \"world\")]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-simple-0.6.2/test/Inspection.hs
new/postgresql-simple-0.6.3/test/Inspection.hs
--- old/postgresql-simple-0.6.2/test/Inspection.hs 2001-09-09
03:46:40.000000000 +0200
+++ new/postgresql-simple-0.6.3/test/Inspection.hs 2001-09-09
03:46:40.000000000 +0200
@@ -53,7 +53,12 @@
-- byteaOid isn't inlined?
, testCase "inlineTypoid" $
- assertFailure' $(inspectTest $ 'lhs02 ==- 'rhs02)
+#if __GLASGOW_HASKELL__ >= 808
+ assertSuccess
+#else
+ assertFailure'
+#endif
+ $(inspectTest $ 'lhs02 ==- 'rhs02)
]
assertSuccess :: Result -> IO ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/postgresql-simple-0.6.2/test/Main.hs
new/postgresql-simple-0.6.3/test/Main.hs
--- old/postgresql-simple-0.6.2/test/Main.hs 2001-09-09 03:46:40.000000000
+0200
+++ new/postgresql-simple-0.6.3/test/Main.hs 2001-09-09 03:46:40.000000000
+0200
@@ -3,10 +3,19 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE ScopedTypeVariables #-}
+#if __GLASGOW_HASKELL__ >= 806
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DeriveAnyClass #-}
+#endif
+module Main (main) where
+
import Common
import Database.PostgreSQL.Simple.Copy
+import Database.PostgreSQL.Simple.ToField (ToField)
import Database.PostgreSQL.Simple.FromField (FromField)
import Database.PostgreSQL.Simple.HStore
+import Database.PostgreSQL.Simple.Newtypes
import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)
import Database.PostgreSQL.Simple.Types(Query(..),Values(..), PGArray(..))
import qualified Database.PostgreSQL.Simple.Transaction as ST
@@ -25,6 +34,7 @@
import Data.Aeson
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
@@ -36,6 +46,7 @@
import System.FilePath
import System.Timeout(timeout)
import Data.Time(getCurrentTime, diffUTCTime)
+import System.Environment (getEnvironment)
import Test.Tasty
import Test.Tasty.Golden
@@ -57,6 +68,8 @@
, testCase "HStore" . testHStore
, testCase "citext" . testCIText
, testCase "JSON" . testJSON
+ , testCase "Aeson newtype" . testAeson
+ , testCase "DerivingVia" . testDerivingVia
, testCase "Question mark escape" . testQM
, testCase "Savepoint" . testSavepoint
, testCase "Unicode" . testUnicode
@@ -238,6 +251,40 @@
js' <- query conn "SELECT ?::json" js
[js] @?= js'
+testAeson :: TestEnv -> Assertion
+testAeson 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)
+ roundTrip (V.fromList [1,2,3,4,5::Int])
+ roundTrip ("foo" :: Text)
+ roundTrip (42 :: Int)
+ where
+ roundTrip :: (Eq a, Show a, Typeable a, ToJSON a, FromJSON a)=> a ->
Assertion
+ roundTrip x = do
+ y <- query conn "SELECT ?::json" (Only (Aeson x))
+ [Only (Aeson x)] @?= y
+
+testDerivingVia :: TestEnv -> Assertion
+testDerivingVia TestEnv{..} = do
+#if __GLASGOW_HASKELL__ <806
+ return ()
+#else
+ roundTrip $ DerivingVia1 42 "Meaning of Life"
+ where
+ roundTrip :: (Eq a, Show a, Typeable a, ToField a, FromField a)=> a ->
Assertion
+ roundTrip x = do
+ y <- query conn "SELECT ?::json" (Only x)
+ [Only x] @?= y
+
+data DerivingVia1 = DerivingVia1 Int String
+ deriving stock (Eq, Show, Generic)
+ deriving anyclass (FromJSON, ToJSON)
+ deriving (ToField, FromField) via Aeson DerivingVia1
+
+#endif
+
+
testQM :: TestEnv -> Assertion
testQM TestEnv{..} = do
-- Just test on a single string
@@ -546,18 +593,24 @@
--
-- Note that some tests, such as Notify, use multiple connections, and assume
-- that 'testConnect' connects to the same database every time it is called.
-testConnect :: IO Connection
-testConnect = connectPostgreSQL ""
-
-withTestEnv :: (TestEnv -> IO a) -> IO a
-withTestEnv cb =
+withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a
+withTestEnv connstr cb =
withConn $ \conn ->
cb TestEnv
{ conn = conn
, withConn = withConn
}
where
- withConn = bracket testConnect close
+ withConn = bracket (connectPostgreSQL connstr) close
main :: IO ()
-main = withTestEnv $ defaultMain . tests
+main = do
+ env <- getEnvironment
+ case lookup "DATABASE_CONNSTRING" env of
+ Nothing -> putStrLn "Set DATABASE_CONNSTRING environment variable"
+ Just s -> withTestEnv (BS8.pack (special s)) (defaultMain . tests)
+ where
+ -- https://www.appveyor.com/docs/services-databases/
+ special "appveyor" = "dbname='TestDb' user='postgres'
password='Password12!'"
+ special "travis" = ""
+ special s = s
_______________________________________________
openSUSE Commits mailing list -- commit@lists.opensuse.org
To unsubscribe, email commit-le...@lists.opensuse.org
List Netiquette: https://en.opensuse.org/openSUSE:Mailing_list_netiquette
List Archives:
https://lists.opensuse.org/archives/list/commit@lists.opensuse.org
