master..27a1345 · typeable/postgresql-simple

.github/workflows/haskell-ci.yml+47−24

since splitsnapshots

unifiedsplit

@@ -8,9 +8,9 @@

8#

9# For more information, see https://github.com/haskell-CI/haskell-ci

10#

11−# version: 0.17.20231110

11+# version: 0.16.6

12#

13−# REGENDATA ("0.17.20231110",["github","cabal.project"])

13+# REGENDATA ("0.16.6",["github","cabal.project"])

14#

15name: Haskell-CI

16on:

@@ -38,19 +38,14 @@ jobs:

38 strategy:

39 matrix:

40 include:

41− - compiler: ghc-9.8.1

41+ - compiler: ghc-9.6.2

42 compilerKind: ghc

43− compilerVersion: 9.8.1

43+ compilerVersion: 9.6.2

44 setup-method: ghcup

45 allow-failure: false

46− - compiler: ghc-9.6.3

46+ - compiler: ghc-9.4.5

47 compilerKind: ghc

48− compilerVersion: 9.6.3

48+ compilerVersion: 9.4.5

49− setup-method: ghcup

50− allow-failure: false

51− - compiler: ghc-9.4.8

52− compilerKind: ghc

53− compilerVersion: 9.4.8

54 setup-method: ghcup

49 setup-method: ghcup

55 allow-failure: false

50 allow-failure: false

56 - compiler: ghc-9.2.8

51 - compiler: ghc-9.2.8

@@ -78,6 +73,36 @@ jobs:

78 compilerVersion: 8.6.5

73 compilerVersion: 8.6.5

79 setup-method: hvr-ppa

74 setup-method: hvr-ppa

80 allow-failure: false

75 allow-failure: false

76+ - compiler: ghc-8.4.4

77+ compilerKind: ghc

78+ compilerVersion: 8.4.4

79+ setup-method: hvr-ppa

80+ allow-failure: false

81+ - compiler: ghc-8.2.2

82+ compilerKind: ghc

83+ compilerVersion: 8.2.2

84+ setup-method: hvr-ppa

85+ allow-failure: false

86+ - compiler: ghc-8.0.2

87+ compilerKind: ghc

88+ compilerVersion: 8.0.2

89+ setup-method: hvr-ppa

90+ allow-failure: false

91+ - compiler: ghc-7.10.3

92+ compilerKind: ghc

93+ compilerVersion: 7.10.3

94+ setup-method: hvr-ppa

95+ allow-failure: false

96+ - compiler: ghc-7.8.4

97+ compilerKind: ghc

98+ compilerVersion: 7.8.4

99+ setup-method: hvr-ppa

100+ allow-failure: false

101+ - compiler: ghc-7.6.3

102+ compilerKind: ghc

103+ compilerVersion: 7.6.3

104+ setup-method: hvr-ppa

105+ allow-failure: false

81 fail-fast: false

106 fail-fast: false

82 steps:

107 steps:

83 - name: apt

108 - name: apt

@@ -86,18 +111,18 @@ jobs:

86 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

111 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

87 if [ "${{ matrix.setup-method }}" = ghcup ]; then

112 if [ "${{ matrix.setup-method }}" = ghcup ]; then

88 mkdir -p "$HOME/.ghcup/bin"

113 mkdir -p "$HOME/.ghcup/bin"

89− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"

114+ curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"

90 chmod a+x "$HOME/.ghcup/bin/ghcup"

115 chmod a+x "$HOME/.ghcup/bin/ghcup"

91 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)

116 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)

92− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

117+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

93 else

118 else

94 apt-add-repository -y 'ppa:hvr/ghc'

119 apt-add-repository -y 'ppa:hvr/ghc'

95 apt-get update

120 apt-get update

96 apt-get install -y "$HCNAME"

121 apt-get install -y "$HCNAME"

97 mkdir -p "$HOME/.ghcup/bin"

122 mkdir -p "$HOME/.ghcup/bin"

98− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"

123+ curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup"

99 chmod a+x "$HOME/.ghcup/bin/ghcup"

124 chmod a+x "$HOME/.ghcup/bin/ghcup"

100− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

125+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

101 fi

126 fi

102 env:

127 env:

103 HCKIND: ${{ matrix.compilerKind }}

128 HCKIND: ${{ matrix.compilerKind }}

@@ -111,19 +136,17 @@ jobs:

111 echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

136 echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

112 HCDIR=/opt/$HCKIND/$HCVER

137 HCDIR=/opt/$HCKIND/$HCVER

113 if [ "${{ matrix.setup-method }}" = ghcup ]; then

138 if [ "${{ matrix.setup-method }}" = ghcup ]; then

114− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")

139+ HC=$HOME/.ghcup/bin/$HCKIND-$HCVER

115− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')

116− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')

117 echo "HC=$HC" >> "$GITHUB_ENV"

140 echo "HC=$HC" >> "$GITHUB_ENV"

118− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"

141+ echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"

119− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"

142+ echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"

120− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

143+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"

121 else

144 else

122 HC=$HCDIR/bin/$HCKIND

145 HC=$HCDIR/bin/$HCKIND

123 echo "HC=$HC" >> "$GITHUB_ENV"

146 echo "HC=$HC" >> "$GITHUB_ENV"

124 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"

147 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"

125 echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"

148 echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"

126− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

149+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV"

127 fi

150 fi

128

151

129 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

152 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

@@ -206,8 +229,8 @@ jobs:

206 touch cabal.project

229 touch cabal.project

207 touch cabal.project.local

230 touch cabal.project.local

208 echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project

231 echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project

209− echo "package postgresql-simple" >> cabal.project

232+ if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package postgresql-simple" >> cabal.project ; fi

210− echo " ghc-options: -Werror=missing-methods" >> cabal.project

233+ if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi

211 cat >> cabal.project <<EOF

234 cat >> cabal.project <<EOF

212 allow-newer: cryptohash-md5-0.11.100.1:base

235 allow-newer: cryptohash-md5-0.11.100.1:base

213 EOF

236 EOF

.github/workflows/simple.yml+2−2

@@ -14,7 +14,7 @@ jobs:

14 strategy:

15 matrix:

16 os: [macos-latest, windows-latest]

17− ghc: ['8.10','9.0','9.2','9.4.8','9.6.3','9.8.1']

17+ ghc: ['8.10','9.0','9.2','9.4.2']

18 fail-fast: false

19 timeout-minutes:

20 60

@@ -29,7 +29,7 @@ jobs:

29 uses: haskell/actions/setup@v2

30 with:

31 ghc-version: ${{ matrix.ghc }}

32− cabal-version: '3.10.2.0'

32+ cabal-version: '3.10.1.0'

33

34 - name: Set up PostgreSQL

35 uses: ikalnytskyi/action-setup-postgres@v3

CHANGES.md+1−7

@@ -1,12 +1,6 @@

1−### Version 0.7.0.0 (2023-07-31)

1+### Version 0.7 (2023-07-31)

2

3 * Remove Eq Null instance. (Future `base` may break it, we remove it profilacticly).

4− * Use `postgresql-libpq >=0.10.0.0`. It includes critical fixes,

5− by using `postgresql-simple >=0.7` you won't get older `postgresql-libpq`.

6− * Drop support for GHC prior 8.6

7− * Added a class for `postgresql-simple` exceptions: `SomePostgreSqlException`.

8− This allows to catch all `postgresql-simple` exceptions at once.

9− (c.f. `AsyncException` in `base).

10

4

11### Version 0.6.5.1 (2023-07-09)

5### Version 0.6.5.1 (2023-07-09)

12

6

postgresql-simple.cabal+46−23

@@ -1,7 +1,6 @@

1cabal-version: 1.12

2name: postgresql-simple

3−version: 0.7.0.0

3+version: 0.6.5.1

4−x-revision: 1

5synopsis: Mid-Level PostgreSQL client library

4synopsis: Mid-Level PostgreSQL client library

6description:

5description:

7 Mid-Level PostgreSQL client library, forked from mysql-simple.

6 Mid-Level PostgreSQL client library, forked from mysql-simple.

@@ -24,14 +23,19 @@ extra-source-files:

24 test/results/unique-constraint-violation.expected

23 test/results/unique-constraint-violation.expected

25

24

26tested-with:

25tested-with:

26+ GHC ==7.6.3

27+ || ==7.8.4

28+ || ==7.10.3

29+ || ==8.0.2

30+ || ==8.2.2

31+ || ==8.4.4

27− GHC ==8.6.5

32+ || ==8.6.5

28 || ==8.8.4

33 || ==8.8.4

29 || ==8.10.7

34 || ==8.10.7

30 || ==9.0.2

35 || ==9.0.2

31 || ==9.2.8

36 || ==9.2.8

32− || ==9.4.8

37+ || ==9.4.5

33− || ==9.6.3

38+ || ==9.6.2

34− || ==9.8.1

35

39

36library

40library

37 default-language: Haskell2010

41 default-language: Haskell2010

@@ -77,25 +81,34 @@ library

77

81

78 -- GHC bundled libs

82 -- GHC bundled libs

79 build-depends:

83 build-depends:

80− base >=4.12.0.0 && <4.20

84+ base >=4.6.0.0 && <4.19

81− , bytestring >=0.10.8.2 && <0.13

85+ , bytestring >=0.10.0.0 && <0.12

82− , containers >=0.6.0.1 && <0.7

86+ , containers >=0.5.0.0 && <0.7

83− , template-haskell >=2.14.0.0 && <2.22

87+ , template-haskell >=2.8.0.0 && <2.21

84− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2

88+ , text >=1.2.3.0 && <1.3 || >=2.0 && <2.1

85 , time-compat >=1.9.5 && <1.12

89 , time-compat >=1.9.5 && <1.12

86− , transformers >=0.5.6.2 && <0.7

90+ , transformers >=0.3.0.0 && <0.7

87

91

88 -- Other dependencies

92 -- Other dependencies

89 build-depends:

93 build-depends:

90− aeson >=2.1.2.1 && <2.3

94+ aeson >=1.4.1.0 && <1.6 || >=2.0.0.0 && <2.3

91− , attoparsec >=0.14.4 && <0.15

95+ , attoparsec >=0.13.2.2 && <0.15

96+ , bytestring-builder >=0.10.8.1.0 && <0.11

92− , case-insensitive >=1.2.1.0 && <1.3

97+ , case-insensitive >=1.2.0.11 && <1.3

93− , hashable >=1.4.3.0 && <1.5

98+ , hashable >=1.2.7.0 && <1.5

94− , Only >=0.1 && <0.1.1

99+ , Only >=0.1 && <0.1.1

95− , postgresql-libpq >=0.10.0.0 && <0.11

100+ , postgresql-libpq >=0.9.4.3 && <0.10

96− , scientific >=0.3.7.0 && <0.4

101+ , scientific >=0.3.6.2 && <0.4

97− , uuid-types >=1.0.5 && <1.1

102+ , uuid-types >=1.0.3 && <1.1

98− , vector >=0.13.0.0 && <0.14

103+ , vector >=0.12.0.1 && <0.14

104+

105+ if !impl(ghc >=8.0)

106+ build-depends:

107+ fail >=4.9.0.0 && <4.10

108+ , semigroups >=0.18.5 && <0.21

109+

110+ if !impl(ghc >=7.6)

111+ build-depends: ghc-prim

99

112

100 default-extensions:

113 default-extensions:

101 BangPatterns

114 BangPatterns

@@ -110,7 +123,15 @@ source-repository head

110 type: git

123 type: git

111 location: http://github.com/haskellari/postgresql-simple

124 location: http://github.com/haskellari/postgresql-simple

112

125

126+source-repository this

127+ type: git

128+ location: http://github.com/haskellari/postgresql-simple

129+ tag: v0.6.3

130+

113test-suite inspection

131test-suite inspection

132+ if !impl(ghc >=8.0)

133+ buildable: False

134+

114 default-language: Haskell2010

135 default-language: Haskell2010

115 type: exitcode-stdio-1.0

136 type: exitcode-stdio-1.0

116 hs-source-dirs: test

137 hs-source-dirs: test

@@ -130,11 +151,10 @@ test-suite test

130 main-is: Main.hs

151 main-is: Main.hs

131 other-modules:

152 other-modules:

132 Common

153 Common

133− Exception

134− Interval

135 Notify

154 Notify

136 Serializable

155 Serializable

137 Time

156 Time

157+ Interval

138

158

139 ghc-options: -threaded

159 ghc-options: -threaded

140 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind

160 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind

@@ -164,6 +184,9 @@ test-suite test

164 , time-compat

184 , time-compat

165 , vector

185 , vector

166

186

187+ if !impl(ghc >=7.6)

188+ build-depends: ghc-prim

189+

167benchmark select

190benchmark select

168 default-language: Haskell2010

191 default-language: Haskell2010

169 type: exitcode-stdio-1.0

192 type: exitcode-stdio-1.0

src/Database/PostgreSQL/Simple.hs−1

@@ -64,7 +64,6 @@ module Database.PostgreSQL.Simple

64 , Only(..)

65 , (:.)(..)

66 -- ** Exceptions

67− , SomePostgreSqlException(..)

68 , SqlError(..)

67 , SqlError(..)

69 , PQ.ExecStatus(..)

68 , PQ.ExecStatus(..)

70 , FormatError(..)

69 , FormatError(..)

src/Database/PostgreSQL/Simple/Compat.hs+53

@@ -12,13 +12,36 @@ module Database.PostgreSQL.Simple.Compat

12 ) where

13

14import qualified Control.Exception as E

15+import Data.Monoid

15import Data.ByteString (ByteString)

16import Data.ByteString (ByteString)

17+#if MIN_VERSION_bytestring(0,10,0)

16import Data.ByteString.Lazy (toStrict)

18import Data.ByteString.Lazy (toStrict)

19+#else

20+import qualified Data.ByteString as B

21+import Data.ByteString.Lazy (toChunks)

22+#endif

17import Data.ByteString.Builder (Builder, toLazyByteString)

23import Data.ByteString.Builder (Builder, toLazyByteString)

24+

25+#if MIN_VERSION_scientific(0,3,0)

18import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

26import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

27+#else

28+import Data.Scientific (scientificBuilder)

29+#endif

30+

31+#if __GLASGOW_HASKELL__ >= 702

19import System.IO.Unsafe (unsafeDupablePerformIO)

32import System.IO.Unsafe (unsafeDupablePerformIO)

33+#elif __GLASGOW_HASKELL__ >= 611

34+import GHC.IO (unsafeDupablePerformIO)

35+#else

36+import GHC.IOBase (unsafeDupablePerformIO)

37+#endif

38+

20import Data.Fixed (Pico)

39import Data.Fixed (Pico)

40+#if MIN_VERSION_base(4,7,0)

21import Data.Fixed (Fixed(MkFixed))

41import Data.Fixed (Fixed(MkFixed))

42+#else

43+import Unsafe.Coerce (unsafeCoerce)

44+#endif

22

45

23-- | Like 'E.mask', but backported to base before version 4.3.0.

46-- | Like 'E.mask', but backported to base before version 4.3.0.

24--

47--

@@ -28,14 +51,44 @@ import Data.Fixed (Fixed(MkFixed))

28-- 'withTransactionMode' function calls the restore callback only once, so we

51-- 'withTransactionMode' function calls the restore callback only once, so we

29-- don't need that polymorphism.

52-- don't need that polymorphism.

30mask :: ((IO a -> IO a) -> IO b) -> IO b

53mask :: ((IO a -> IO a) -> IO b) -> IO b

54+#if MIN_VERSION_base(4,3,0)

31mask io = E.mask $ \restore -> io restore

55mask io = E.mask $ \restore -> io restore

56+#else

57+mask io = do

58+ b <- E.blocked

59+ E.block $ io $ \m -> if b then m else E.unblock m

60+#endif

32{-# INLINE mask #-}

61{-# INLINE mask #-}

33

62

63+#if !MIN_VERSION_base(4,5,0)

64+infixr 6 <>

65+

66+(<>) :: Monoid m => m -> m -> m

67+(<>) = mappend

68+{-# INLINE (<>) #-}

69+#endif

70+

34toByteString :: Builder -> ByteString

71toByteString :: Builder -> ByteString

72+#if MIN_VERSION_bytestring(0,10,0)

35toByteString x = toStrict (toLazyByteString x)

73toByteString x = toStrict (toLazyByteString x)

74+#else

75+toByteString x = B.concat (toChunks (toLazyByteString x))

76+#endif

77+

78+#if MIN_VERSION_base(4,7,0)

36

79

37toPico :: Integer -> Pico

80toPico :: Integer -> Pico

38toPico = MkFixed

81toPico = MkFixed

39

82

40fromPico :: Pico -> Integer

83fromPico :: Pico -> Integer

41fromPico (MkFixed i) = i

84fromPico (MkFixed i) = i

85+

86+#else

87+

88+toPico :: Integer -> Pico

89+toPico = unsafeCoerce

90+

91+fromPico :: Pico -> Integer

92+fromPico = unsafeCoerce

93+

94+#endif

src/Database/PostgreSQL/Simple/Copy.hs+4

@@ -86,8 +86,12 @@ doCopy funcName conn template q = do

86 PQ.TuplesOk -> err

87 PQ.CopyOut -> return ()

88 PQ.CopyIn -> return ()

89+#if MIN_VERSION_postgresql_libpq(0,9,3)

89 PQ.CopyBoth -> errMsg "COPY BOTH is not supported"

90 PQ.CopyBoth -> errMsg "COPY BOTH is not supported"

91+#endif

92+#if MIN_VERSION_postgresql_libpq(0,9,2)

90 PQ.SingleTuple -> errMsg "single-row mode is not supported"

93 PQ.SingleTuple -> errMsg "single-row mode is not supported"

94+#endif

91 PQ.BadResponse -> throwResultError funcName result status

95 PQ.BadResponse -> throwResultError funcName result status

92 PQ.NonfatalError -> throwResultError funcName result status

96 PQ.NonfatalError -> throwResultError funcName result status

93 PQ.FatalError -> throwResultError funcName result status

97 PQ.FatalError -> throwResultError funcName result status

src/Database/PostgreSQL/Simple/Errors.hs+2−3

@@ -25,6 +25,7 @@ module Database.PostgreSQL.Simple.Errors

25 )

26 where

27

28+import Control.Applicative

28import Control.Exception as E

29import Control.Exception as E

29

30

30import Data.Attoparsec.ByteString.Char8

31import Data.Attoparsec.ByteString.Char8

@@ -59,9 +60,7 @@ data ConstraintViolation

59 deriving (Show, Eq, Ord, Typeable)

60 deriving (Show, Eq, Ord, Typeable)

60

61

61-- Default instance should be enough

62-- Default instance should be enough

62−instance Exception ConstraintViolation where

63+instance Exception ConstraintViolation

63− toException = postgresqlExceptionToException

64− fromException = postgresqlExceptionFromException

65

64

66

65

67-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and

66-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and

src/Database/PostgreSQL/Simple/FromField.hs+6−4

@@ -118,7 +118,7 @@ module Database.PostgreSQL.Simple.FromField

118

119import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )

120import Control.Concurrent.MVar (MVar, newMVar)

121−import Control.Exception (Exception (toException, fromException))

121+import Control.Exception (Exception)

122import qualified Data.Aeson as JSON

123import Data.Attoparsec.ByteString.Char8 hiding (Result)

124import Data.ByteString (ByteString)

@@ -154,7 +154,11 @@ import qualified Data.UUID.Types as UUID

154import Data.Scientific (Scientific)

155import GHC.Real (infinity, notANumber)

156

157+#if MIN_VERSION_aeson(2,1,2)

157import qualified Data.Aeson.Types as JSON

158import qualified Data.Aeson.Types as JSON

159+#else

160+import qualified Data.Aeson.Internal as JSON

161+#endif

158

162

159-- | Exception thrown if conversion from a SQL value to a Haskell

163-- | Exception thrown if conversion from a SQL value to a Haskell

160-- value fails.

164-- value fails.

@@ -182,9 +186,7 @@ data ResultError = Incompatible { errSQLType :: String

182 -- between metadata and actual data in a row).

186 -- between metadata and actual data in a row).

183 deriving (Eq, Show, Typeable)

187 deriving (Eq, Show, Typeable)

184

188

185−instance Exception ResultError where

189+instance Exception ResultError

186− toException = postgresqlExceptionToException

187− fromException = postgresqlExceptionFromException

188

190

189left :: Exception a => a -> Conversion b

191left :: Exception a => a -> Conversion b

190left = conversionError

192left = conversionError

src/Database/PostgreSQL/Simple/HStore/Implementation.hs+6

@@ -22,6 +22,9 @@ import Data.ByteString.Builder (Builder, byteString, char8)

22import qualified Data.ByteString.Builder as BU

23import Data.ByteString.Internal (c2w, w2c)

24import qualified Data.ByteString.Lazy as BL

25+#if !MIN_VERSION_bytestring(0,10,0)

26+import qualified Data.ByteString.Lazy.Internal as BL (foldrChunks)

27+#endif

25import Data.Map(Map)

28import Data.Map(Map)

26import qualified Data.Map as Map

29import qualified Data.Map as Map

27import Data.Text(Text)

30import Data.Text(Text)

@@ -66,6 +69,9 @@ instance Semigroup HStoreBuilder where

66

69

67instance Monoid HStoreBuilder where

70instance Monoid HStoreBuilder where

68 mempty = Empty

71 mempty = Empty

72+#if !(MIN_VERSION_base(4,11,0))

73+ mappend = (<>)

74+#endif

69

75

70class ToHStoreText a where

76class ToHStoreText a where

71 toHStoreText :: a -> HStoreText

77 toHStoreText :: a -> HStoreText

src/Database/PostgreSQL/Simple/Internal.hs+7−31

@@ -1,8 +1,6 @@

1{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}

2{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4−{-# LANGUAGE ExistentialQuantification #-}

5−{-# LANGUAGE InstanceSigs #-}

6

4

7------------------------------------------------------------------------------

5------------------------------------------------------------------------------

8-- |

6-- |

@@ -36,6 +34,7 @@ import Data.Int (Int64)

36import qualified Data.IntMap as IntMap

34import qualified Data.IntMap as IntMap

37import Data.IORef

35import Data.IORef

38import Data.Maybe(fromMaybe)

36import Data.Maybe(fromMaybe)

37+import Data.Monoid

39import Data.String

38import Data.String

40import qualified Data.Text as T

39import qualified Data.Text as T

41import qualified Data.Text.Encoding as TE

40import qualified Data.Text.Encoding as TE

@@ -83,25 +82,6 @@ data Connection = Connection {

83instance Eq Connection where

82instance Eq Connection where

84 x == y = connectionHandle x == connectionHandle y

83 x == y = connectionHandle x == connectionHandle y

85

84

86−-- | Superclass for postgresql exceptions

87−data SomePostgreSqlException = forall e. Exception e => SomePostgreSqlException e

88− deriving Typeable

89−

90−postgresqlExceptionToException :: Exception e => e -> SomeException

91−postgresqlExceptionToException = toException . SomePostgreSqlException

92−

93−postgresqlExceptionFromException :: Exception e => SomeException -> Maybe e

94−postgresqlExceptionFromException x = do

95− SomePostgreSqlException a <- fromException x

96− cast a

97−

98−instance Show SomePostgreSqlException where

99− showsPrec :: Int -> SomePostgreSqlException -> ShowS

100− showsPrec p (SomePostgreSqlException e) = showsPrec p e

101−

102−instance Exception SomePostgreSqlException where

103− displayException (SomePostgreSqlException e) = displayException e

104−

105data SqlError = SqlError {

85data SqlError = SqlError {

106 sqlState :: ByteString

86 sqlState :: ByteString

107 , sqlExecStatus :: ExecStatus

87 , sqlExecStatus :: ExecStatus

@@ -113,10 +93,7 @@ data SqlError = SqlError {

113fatalError :: ByteString -> SqlError

93fatalError :: ByteString -> SqlError

114fatalError msg = SqlError "" FatalError msg "" ""

94fatalError msg = SqlError "" FatalError msg "" ""

115

95

116−instance Exception SqlError where

96+instance Exception SqlError

117− toException = postgresqlExceptionToException

118− fromException = postgresqlExceptionFromException

119−

120

97

121-- | Exception thrown if 'query' is used to perform an @INSERT@-like

98-- | Exception thrown if 'query' is used to perform an @INSERT@-like

122-- operation, or 'execute' is used to perform a @SELECT@-like operation.

99-- operation, or 'execute' is used to perform a @SELECT@-like operation.

@@ -125,9 +102,7 @@ data QueryError = QueryError {

125 , qeQuery :: Query

102 , qeQuery :: Query

126 } deriving (Eq, Show, Typeable)

103 } deriving (Eq, Show, Typeable)

127

104

128−instance Exception QueryError where

105+instance Exception QueryError

129− toException = postgresqlExceptionToException

130− fromException = postgresqlExceptionFromException

131

106

132-- | Exception thrown if a 'Query' could not be formatted correctly.

107-- | Exception thrown if a 'Query' could not be formatted correctly.

133-- This may occur if the number of \'@?@\' characters in the query

108-- This may occur if the number of \'@?@\' characters in the query

@@ -138,9 +113,7 @@ data FormatError = FormatError {

138 , fmtParams :: [ByteString]

113 , fmtParams :: [ByteString]

139 } deriving (Eq, Show, Typeable)

114 } deriving (Eq, Show, Typeable)

140

115

141−instance Exception FormatError where

116+instance Exception FormatError

142− toException = postgresqlExceptionToException

143− fromException = postgresqlExceptionFromException

144

117

145data ConnectInfo = ConnectInfo {

118data ConnectInfo = ConnectInfo {

146 connectHost :: String

119 connectHost :: String

@@ -517,6 +490,9 @@ instance Alternative Conversion where

517 Errors _ -> (oka <|>) <$> runConversion mb conn

490 Errors _ -> (oka <|>) <$> runConversion mb conn

518

491

519instance Monad Conversion where

492instance Monad Conversion where

493+#if !(MIN_VERSION_base(4,8,0))

494+ return = pure

495+#endif

520 m >>= f = Conversion $ \conn -> do

496 m >>= f = Conversion $ \conn -> do

521 oka <- runConversion m conn

497 oka <- runConversion m conn

522 case oka of

498 case oka of

src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+4

@@ -76,8 +76,12 @@ finishQueryWith' q result k = do

76 PQ.CommandOk -> queryErr "query resulted in a command response (did you mean to use `execute` or forget a RETURNING?)"

77 PQ.CopyOut -> queryErr "query: COPY TO is not supported"

78 PQ.CopyIn -> queryErr "query: COPY FROM is not supported"

79+#if MIN_VERSION_postgresql_libpq(0,9,3)

79 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"

80 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"

81+#endif

82+#if MIN_VERSION_postgresql_libpq(0,9,2)

80 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"

83 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"

84+#endif

81 PQ.BadResponse -> throwResultError "query" result status

85 PQ.BadResponse -> throwResultError "query" result status

82 PQ.NonfatalError -> throwResultError "query" result status

86 PQ.NonfatalError -> throwResultError "query" result status

83 PQ.FatalError -> throwResultError "query" result status

87 PQ.FatalError -> throwResultError "query" result status

src/Database/PostgreSQL/Simple/Notification.hs+17

@@ -47,6 +47,8 @@ import GHC.IO.Exception ( ioe_location )

47

48#if defined(mingw32_HOST_OS)

49import Control.Concurrent ( threadDelay )

50+#elif !MIN_VERSION_base(4,7,0)

51+import Control.Concurrent ( threadWaitRead )

50#else

52#else

51import GHC.Conc ( atomically )

53import GHC.Conc ( atomically )

52import Control.Concurrent ( threadWaitReadSTM )

54import Control.Concurrent ( threadWaitReadSTM )

@@ -92,6 +94,21 @@ getNotification conn = join $ withConnection conn fetch

92 -- with async exceptions, whereas threadDelay can.

94 -- with async exceptions, whereas threadDelay can.

93 Just _fd -> do

95 Just _fd -> do

94 return (threadDelay 1000000 >> loop)

96 return (threadDelay 1000000 >> loop)

97+#elif !MIN_VERSION_base(4,7,0)

98+ -- Technically there's a race condition that is usually benign.

99+ -- If the connection is closed or reset after we drop the

100+ -- lock, and then the fd index is reallocated to a new

101+ -- descriptor before we call threadWaitRead, then

102+ -- we could end up waiting on the wrong descriptor.

103+ --

104+ -- Now, if the descriptor becomes readable promptly, then

105+ -- it's no big deal as we'll wake up and notice the change

106+ -- on the next iteration of the loop. But if are very

107+ -- unlucky, then we could end up waiting a long time.

108+ Just fd -> do

109+ return $ do

110+ threadWaitRead fd `catch` (throwIO . setIOErrorLocation)

111+ loop

95#else

112#else

96 -- This case fixes the race condition above. By registering

113 -- This case fixes the race condition above. By registering

97 -- our interest in the descriptor before we drop the lock,

114 -- our interest in the descriptor before we drop the lock,

src/Database/PostgreSQL/Simple/Ok.hs+4

@@ -72,6 +72,10 @@ instance MonadPlus Ok where

72 mplus = (<|>)

73

74instance Monad Ok where

75+#if !(MIN_VERSION_base(4,8,0))

76+ return = pure

77+#endif

78+

75 Errors es >>= _ = Errors es

79 Errors es >>= _ = Errors es

76 Ok a >>= f = f a

80 Ok a >>= f = f a

77

81

src/Database/PostgreSQL/Simple/ToField.hs+4

@@ -59,7 +59,11 @@ import qualified Data.Vector as V

59import qualified Database.PostgreSQL.LibPQ as PQ

60import Database.PostgreSQL.Simple.Time

61import Data.Scientific (Scientific)

62+#if MIN_VERSION_scientific(0,3,0)

62import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

63import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

64+#else

65+import Data.Scientific (scientificBuilder)

66+#endif

63import Foreign.C.Types (CUInt(..))

67import Foreign.C.Types (CUInt(..))

64

68

65-- | How to render an element when substituting it into a query.

69-- | How to render an element when substituting it into a query.

src/Database/PostgreSQL/Simple/Types.hs+3

@@ -93,6 +93,9 @@ instance Semigroup Query where

93

94instance Monoid Query where

95 mempty = Query B.empty

96+#if !(MIN_VERSION_base(4,11,0))

97+ mappend = (<>)

98+#endif

96

99

97-- | Wrap a list of values for use in an @IN@ clause. Replaces a

100-- | Wrap a list of values for use in an @IN@ clause. Replaces a

98-- single \"@?@\" character with a parenthesized list of rendered

101-- single \"@?@\" character with a parenthesized list of rendered

test/Exception.hsdeleted−70

@@ -1,70 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4−

5−module Exception (testExceptions) where

6−

7−import Database.PostgreSQL.Simple

8−import Test.Tasty.HUnit (Assertion, assertBool)

9−import Common (TestEnv)

10−import Control.Exception (Exception (..), SomeException)

11−import Data.Maybe (isJust)

12−import Data.Either (isLeft)

13−import Control.Exception (throwIO, try)

14−

15−testExceptions :: TestEnv -> Assertion

16−testExceptions _ = do

17− let sqlError = SqlError

18− { sqlState = ""

19− , sqlExecStatus = FatalError

20− , sqlErrorMsg = ""

21− , sqlErrorDetail = ""

22− , sqlErrorHint = ""

23− }

24− let sqlEx :: SomeException = toException sqlError

25− assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)

26− assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)

27− eSqlError :: Either SqlError () <- try $ throwIO sqlEx

28− assertBool "Can catch SqlError" $ isLeft eSqlError

29− eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx

30− assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx

31−

32− let formatError = FormatError

33− { fmtMessage = ""

34− , fmtQuery = ""

35− , fmtParams = []

36− }

37− let formatEx :: SomeException = toException formatError

38− assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)

39− assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)

40− eFormatError :: Either FormatError () <- try $ throwIO formatEx

41− assertBool "Can catch FormatError" $ isLeft eFormatError

42− eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx

43− assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx

44−

45− let queryError = QueryError

46− { qeMessage = ""

47− , qeQuery = ""

48− }

49− let queryEx :: SomeException = toException queryError

50− assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)

51− assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)

52− eQueryError :: Either QueryError () <- try $ throwIO queryEx

53− assertBool "Can catch QueryError" $ isLeft eQueryError

54− eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx

55− assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx

56−

57− let resultError = Incompatible

58− { errSQLType = ""

59− , errSQLTableOid = Nothing

60− , errSQLField = ""

61− , errHaskellType = ""

62− , errMessage = ""

63− }

64− let resultEx :: SomeException = toException resultError

65− assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)

66− assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)

67− eResultEx :: Either ResultError () <- try $ throwIO resultEx

68− assertBool "Can catch ResultError" $ isLeft eResultEx

69− eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx

70− assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx

test/Main.hs−2

@@ -55,7 +55,6 @@ import Notify

55import Serializable

56import Time

57import Interval

58−import Exception (testExceptions)

59

58

60tests :: TestEnv -> TestTree

59tests :: TestEnv -> TestTree

61tests env = testGroup "tests"

60tests env = testGroup "tests"

@@ -85,7 +84,6 @@ tests env = testGroup "tests"

85 , testCase "2-ary generic" . testGeneric2

84 , testCase "2-ary generic" . testGeneric2

86 , testCase "3-ary generic" . testGeneric3

85 , testCase "3-ary generic" . testGeneric3

87 , testCase "Timeout" . testTimeout

86 , testCase "Timeout" . testTimeout

88− , testCase "Exceptions" . testExceptions

89 ]

87 ]

90

88

91testBytea :: TestEnv -> TestTree

89testBytea :: TestEnv -> TestTree