50dcd8b..master · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

.github/workflows/haskell-ci.yml+41−53

since splitsnapshots

unifiedsplit

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

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

10#

11−# version: 0.15.20221009

11+# version: 0.17.20231110

12#

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

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

14#

15name: Haskell-CI

16on:

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

38 strategy:

39 matrix:

40 include:

41− - compiler: ghc-9.4.2

41+ - compiler: ghc-9.8.1

42 compilerKind: ghc

43− compilerVersion: 9.4.2

43+ compilerVersion: 9.8.1

44 setup-method: ghcup

45 allow-failure: false

46− - compiler: ghc-9.2.4

46+ - compiler: ghc-9.6.3

47 compilerKind: ghc

48− compilerVersion: 9.2.4

48+ compilerVersion: 9.6.3

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

55+ allow-failure: false

56+ - compiler: ghc-9.2.8

57+ compilerKind: ghc

58+ compilerVersion: 9.2.8

49 setup-method: ghcup

59 setup-method: ghcup

50 allow-failure: false

60 allow-failure: false

51 - compiler: ghc-9.0.2

61 - compiler: ghc-9.0.2

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

68 compilerVersion: 8.6.5

78 compilerVersion: 8.6.5

69 setup-method: hvr-ppa

79 setup-method: hvr-ppa

70 allow-failure: false

80 allow-failure: false

71− - compiler: ghc-8.4.4

72− compilerKind: ghc

73− compilerVersion: 8.4.4

74− setup-method: hvr-ppa

75− allow-failure: false

76− - compiler: ghc-8.2.2

77− compilerKind: ghc

78− compilerVersion: 8.2.2

79− setup-method: hvr-ppa

80− allow-failure: false

81− - compiler: ghc-8.0.2

82− compilerKind: ghc

83− compilerVersion: 8.0.2

84− setup-method: hvr-ppa

85− allow-failure: false

86− - compiler: ghc-7.10.3

87− compilerKind: ghc

88− compilerVersion: 7.10.3

89− setup-method: hvr-ppa

90− allow-failure: false

91− - compiler: ghc-7.8.4

92− compilerKind: ghc

93− compilerVersion: 7.8.4

94− setup-method: hvr-ppa

95− allow-failure: false

96− - compiler: ghc-7.6.3

97− compilerKind: ghc

98− compilerVersion: 7.6.3

99− setup-method: hvr-ppa

100− allow-failure: false

101 fail-fast: false

81 fail-fast: false

102 steps:

82 steps:

103 - name: apt

83 - name: apt

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

113 else

93 else

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

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

115 apt-get update

95 apt-get update

116 apt-get install -y "$HCNAME"

96 apt-get install -y "$HCNAME"

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

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

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

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

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

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

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

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

121 fi

101 fi

122 env:

102 env:

123 HCKIND: ${{ matrix.compilerKind }}

103 HCKIND: ${{ matrix.compilerKind }}

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

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

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

132 HCDIR=/opt/$HCKIND/$HCVER

112 HCDIR=/opt/$HCKIND/$HCVER

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

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

134− HC=$HOME/.ghcup/bin/$HCKIND-$HCVER

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

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

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

135 echo "HC=$HC" >> "$GITHUB_ENV"

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

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

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

137− echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"

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

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

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

139 else

121 else

140 HC=$HCDIR/bin/$HCKIND

122 HC=$HCDIR/bin/$HCKIND

141 echo "HC=$HC" >> "$GITHUB_ENV"

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

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

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

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

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

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

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

145 fi

127 fi

146

128

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

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

@@ -193,14 +175,14 @@ jobs:

193 - name: install cabal-plan

175 - name: install cabal-plan

194 run: |

176 run: |

195 mkdir -p $HOME/.cabal/bin

177 mkdir -p $HOME/.cabal/bin

196− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz

178+ curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz

197− echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -

179+ echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -

198 xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan

180 xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan

199 rm -f cabal-plan.xz

181 rm -f cabal-plan.xz

200 chmod a+x $HOME/.cabal/bin/cabal-plan

182 chmod a+x $HOME/.cabal/bin/cabal-plan

201 cabal-plan --version

183 cabal-plan --version

202 - name: checkout

184 - name: checkout

203− uses: actions/checkout@v2

185+ uses: actions/checkout@v3

204 with:

186 with:

205 path: source

187 path: source

206 - name: initial cabal.project for sdist

188 - name: initial cabal.project for sdist

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

224 touch cabal.project

206 touch cabal.project

225 touch cabal.project.local

207 touch cabal.project.local

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

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

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

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

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

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

229 cat >> cabal.project <<EOF

211 cat >> cabal.project <<EOF

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

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

231 EOF

213 EOF

@@ -236,8 +218,8 @@ jobs:

236 run: |

218 run: |

237 $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all

219 $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all

238 cabal-plan

220 cabal-plan

239− - name: cache

221+ - name: restore cache

240− uses: actions/cache@v2

222+ uses: actions/cache/restore@v3

241 with:

223 with:

242 key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

224 key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

243 path: ~/.cabal/store

225 path: ~/.cabal/store

@@ -261,8 +243,14 @@ jobs:

261 ${CABAL} -vnormal check

243 ${CABAL} -vnormal check

262 - name: haddock

244 - name: haddock

263 run: |

245 run: |

264− $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

246+ $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

265 - name: unconstrained build

247 - name: unconstrained build

266 run: |

248 run: |

267 rm -f cabal.project.local

249 rm -f cabal.project.local

268 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

250 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

251+ - name: save cache

252+ uses: actions/cache/save@v3

253+ if: always()

254+ with:

255+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

256+ path: ~/.cabal/store

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

@@ -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.2']

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

18 fail-fast: false

19 timeout-minutes:

20 60

@@ -26,10 +26,10 @@ jobs:

27 - name: Set up Haskell

28 id: setup-haskell

29− uses: haskell/actions/setup@v1

29+ uses: haskell/actions/setup@v2

30 with:

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

32− cabal-version: '3.8.1.0'

32+ cabal-version: '3.10.2.0'

34 - name: Set up PostgreSQL

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

CHANGES.md+14

@@ -1,3 +1,17 @@

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

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+

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

12+

13+ * Support `aeson-2.2.0.0`

14+

1### Version 0.6.5 (2022-10-30)

15### Version 0.6.5 (2022-10-30)

3 * Add `withConnect`

17 * Add `withConnect`

postgresql-simple.cabal+24−46

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

1cabal-version: 1.12

2name: postgresql-simple

3−version: 0.6.5

3+version: 0.7.0.0

4+x-revision: 1

4synopsis: Mid-Level PostgreSQL client library

5synopsis: Mid-Level PostgreSQL client library

5description:

6description:

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

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

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

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

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

25tested-with:

26tested-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

32− || ==8.6.5

27+ GHC ==8.6.5

33 || ==8.8.4

28 || ==8.8.4

34 || ==8.10.7

29 || ==8.10.7

35 || ==9.0.2

30 || ==9.0.2

36− || ==9.2.4

31+ || ==9.2.8

37− || ==9.4.2

32+ || ==9.4.8

33+ || ==9.6.3

34+ || ==9.8.1

39library

36library

40 default-language: Haskell2010

37 default-language: Haskell2010

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

81 -- GHC bundled libs

78 -- GHC bundled libs

82 build-depends:

79 build-depends:

83− base >=4.6.0.0 && <4.18

80+ base >=4.12.0.0 && <4.20

84− , bytestring >=0.10.0.0 && <0.12

81+ , bytestring >=0.10.8.2 && <0.13

85− , containers >=0.5.0.0 && <0.7

82+ , containers >=0.6.0.1 && <0.7

86− , template-haskell >=2.8.0.0 && <2.20

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

87− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.1

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

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

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

89− , transformers >=0.3.0.0 && <0.7

86+ , transformers >=0.5.6.2 && <0.7

91 -- Other dependencies

88 -- Other dependencies

92 build-depends:

89 build-depends:

93− aeson >=1.4.1.0 && <1.6 || >=2.0.0.0 && <2.2

90+ aeson >=2.1.2.1 && <2.3

94− , attoparsec >=0.13.2.2 && <0.15

91+ , attoparsec >=0.14.4 && <0.15

95− , bytestring-builder >=0.10.8.1.0 && <0.11

96− , case-insensitive >=1.2.0.11 && <1.3

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

97− , hashable >=1.2.7.0 && <1.5

93+ , hashable >=1.4.3.0 && <1.5

98− , Only >=0.1 && <0.1.1

94+ , Only >=0.1 && <0.1.1

99− , postgresql-libpq >=0.9.4.3 && <0.10

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

100− , scientific >=0.3.6.2 && <0.4

96+ , scientific >=0.3.7.0 && <0.4

101− , uuid-types >=1.0.3 && <1.1

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

102− , vector >=0.12.0.1 && <0.14

98+ , vector >=0.13.0.0 && <0.14

103−

104− if !impl(ghc >=8.0)

105− build-depends:

106− fail >=4.9.0.0 && <4.10

107− , semigroups >=0.18.5 && <0.21

108−

109− if !impl(ghc >=7.6)

110− build-depends: ghc-prim

111

112 default-extensions:

100 default-extensions:

113 BangPatterns

101 BangPatterns

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

122 type: git

110 type: git

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

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

124

112

125−source-repository this

126− type: git

127− location: http://github.com/haskellari/postgresql-simple

128− tag: v0.6.3

129−

130test-suite inspection

113test-suite inspection

131− if !impl(ghc >=8.0)

132− buildable: False

133−

134 default-language: Haskell2010

114 default-language: Haskell2010

135 type: exitcode-stdio-1.0

115 type: exitcode-stdio-1.0

136 hs-source-dirs: test

116 hs-source-dirs: test

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

150 main-is: Main.hs

130 main-is: Main.hs

151 other-modules:

131 other-modules:

152 Common

132 Common

133+ Exception

134+ Interval

153 Notify

135 Notify

154 Serializable

136 Serializable

155 Time

137 Time

156− Interval

157

138

158 ghc-options: -threaded

139 ghc-options: -threaded

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

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

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

183 , time-compat

164 , time-compat

184 , vector

165 , vector

185

166

186− if !impl(ghc >=7.6)

187− build-depends: ghc-prim

188−

189benchmark select

167benchmark select

190 default-language: Haskell2010

168 default-language: Haskell2010

191 type: exitcode-stdio-1.0

169 type: exitcode-stdio-1.0

src/Database/PostgreSQL/Simple.hs+1

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

64 , Only(..)

65 , (:.)(..)

66 -- ** Exceptions

67+ , SomePostgreSqlException(..)

67 , SqlError(..)

68 , SqlError(..)

68 , PQ.ExecStatus(..)

69 , PQ.ExecStatus(..)

69 , FormatError(..)

70 , FormatError(..)

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

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

12 ) where

14import qualified Control.Exception as E

15−import Data.Monoid

16import Data.ByteString (ByteString)

15import Data.ByteString (ByteString)

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

18import Data.ByteString.Lazy (toStrict)

16import Data.ByteString.Lazy (toStrict)

19−#else

20−import qualified Data.ByteString as B

21−import Data.ByteString.Lazy (toChunks)

22−#endif

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

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

24−

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

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

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

27−#else

28−import Data.Scientific (scientificBuilder)

29−#endif

30−

31−#if __GLASGOW_HASKELL__ >= 702

32import System.IO.Unsafe (unsafeDupablePerformIO)

19import System.IO.Unsafe (unsafeDupablePerformIO)

33−#elif __GLASGOW_HASKELL__ >= 611

34−import GHC.IO (unsafeDupablePerformIO)

35−#else

36−import GHC.IOBase (unsafeDupablePerformIO)

37−#endif

38−

39import Data.Fixed (Pico)

20import Data.Fixed (Pico)

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

41import Data.Fixed (Fixed(MkFixed))

21import Data.Fixed (Fixed(MkFixed))

42−#else

43−import Unsafe.Coerce (unsafeCoerce)

44−#endif

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

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

47--

24--

@@ -51,44 +28,14 @@ import Unsafe.Coerce (unsafeCoerce)

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

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

52-- don't need that polymorphism.

29-- don't need that polymorphism.

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

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

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

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

31mask 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

61{-# INLINE mask #-}

32{-# INLINE mask #-}

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−

71toByteString :: Builder -> ByteString

34toByteString :: Builder -> ByteString

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

73toByteString x = toStrict (toLazyByteString x)

35toByteString 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)

80toPico :: Integer -> Pico

37toPico :: Integer -> Pico

81toPico = MkFixed

38toPico = MkFixed

83fromPico :: Pico -> Integer

40fromPico :: Pico -> Integer

84fromPico (MkFixed i) = i

41fromPico (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,12 +86,8 @@ 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)

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

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

91−#endif

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

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

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

94−#endif

95 PQ.BadResponse -> throwResultError funcName result status

91 PQ.BadResponse -> throwResultError funcName result status

96 PQ.NonfatalError -> throwResultError funcName result status

92 PQ.NonfatalError -> throwResultError funcName result status

97 PQ.FatalError -> throwResultError funcName result status

93 PQ.FatalError -> throwResultError funcName result status

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

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

25 )

26 where

28−import Control.Applicative

29import Control.Exception as E

28import Control.Exception as E

31import Data.Attoparsec.ByteString.Char8

30import Data.Attoparsec.ByteString.Char8

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

60 deriving (Show, Eq, Ord, Typeable)

59 deriving (Show, Eq, Ord, Typeable)

62-- Default instance should be enough

61-- Default instance should be enough

63−instance Exception ConstraintViolation

62+instance Exception ConstraintViolation where

63+ toException = postgresqlExceptionToException

64+ fromException = postgresqlExceptionFromException

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

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

src/Database/PostgreSQL/Simple/FromField.hs+7−5

@@ -118,10 +118,8 @@ module Database.PostgreSQL.Simple.FromField

118

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

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

121−import Control.Exception (Exception)

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

122import qualified Data.Aeson as JSON

123−import qualified Data.Aeson.Internal as JSON

124−import qualified Data.Aeson.Parser as JSON (value')

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

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

126import Data.ByteString (ByteString)

124import Data.ByteString (ByteString)

127import qualified Data.ByteString.Char8 as B

125import qualified Data.ByteString.Char8 as B

@@ -156,6 +154,8 @@ import qualified Data.UUID.Types as UUID

156import Data.Scientific (Scientific)

154import Data.Scientific (Scientific)

157import GHC.Real (infinity, notANumber)

155import GHC.Real (infinity, notANumber)

158

156

157+import qualified Data.Aeson.Types as JSON

158+

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

160-- value fails.

161data ResultError = Incompatible { errSQLType :: String

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

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

183 deriving (Eq, Show, Typeable)

184

185−instance Exception ResultError

185+instance Exception ResultError where

186+ toException = postgresqlExceptionToException

187+ fromException = postgresqlExceptionFromException

186

188

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

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

188left = conversionError

190left = conversionError

@@ -574,7 +576,7 @@ instance FromField UUID where

574-- | json, jsonb

576-- | json, jsonb

575instance FromField JSON.Value where

577instance FromField JSON.Value where

576 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs

578 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs

577− where parseBS bs = case parseOnly (JSON.value' <* endOfInput) bs of

579+ where parseBS bs = case JSON.eitherDecodeStrict' bs of

578 Left err -> returnError ConversionFailed f err

580 Left err -> returnError ConversionFailed f err

579 Right val -> pure val

581 Right val -> pure val

580

582

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

@@ -22,9 +22,6 @@ 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

28import Data.Map(Map)

25import Data.Map(Map)

29import qualified Data.Map as Map

26import qualified Data.Map as Map

30import Data.Text(Text)

27import Data.Text(Text)

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

70instance Monoid HStoreBuilder where

67instance Monoid HStoreBuilder where

71 mempty = Empty

68 mempty = Empty

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

73− mappend = (<>)

74−#endif

76class ToHStoreText a where

70class ToHStoreText a where

77 toHStoreText :: a -> HStoreText

71 toHStoreText :: a -> HStoreText

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

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

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

2{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE ExistentialQuantification #-}

5+{-# LANGUAGE InstanceSigs #-}

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

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

6-- |

8-- |

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

34import qualified Data.IntMap as IntMap

36import qualified Data.IntMap as IntMap

35import Data.IORef

37import Data.IORef

36import Data.Maybe(fromMaybe)

38import Data.Maybe(fromMaybe)

37−import Data.Monoid

38import Data.String

39import Data.String

39import qualified Data.Text as T

40import qualified Data.Text as T

40import qualified Data.Text.Encoding as TE

41import qualified Data.Text.Encoding as TE

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

82instance Eq Connection where

83instance Eq Connection where

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

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

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+

85data SqlError = SqlError {

105data SqlError = SqlError {

86 sqlState :: ByteString

106 sqlState :: ByteString

87 , sqlExecStatus :: ExecStatus

107 , sqlExecStatus :: ExecStatus

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

93fatalError :: ByteString -> SqlError

113fatalError :: ByteString -> SqlError

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

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

115

96−instance Exception SqlError

116+instance Exception SqlError where

117+ toException = postgresqlExceptionToException

118+ fromException = postgresqlExceptionFromException

119+

120

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

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

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

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

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

102 , qeQuery :: Query

125 , qeQuery :: Query

103 } deriving (Eq, Show, Typeable)

126 } deriving (Eq, Show, Typeable)

104

127

105−instance Exception QueryError

128+instance Exception QueryError where

129+ toException = postgresqlExceptionToException

130+ fromException = postgresqlExceptionFromException

106

131

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

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

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

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

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

113 , fmtParams :: [ByteString]

138 , fmtParams :: [ByteString]

114 } deriving (Eq, Show, Typeable)

139 } deriving (Eq, Show, Typeable)

115

140

116−instance Exception FormatError

141+instance Exception FormatError where

142+ toException = postgresqlExceptionToException

143+ fromException = postgresqlExceptionFromException

117

144

118data ConnectInfo = ConnectInfo {

145data ConnectInfo = ConnectInfo {

119 connectHost :: String

146 connectHost :: String

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

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

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

491

518

492instance Monad Conversion where

519instance Monad Conversion where

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

494− return = pure

495−#endif

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

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

497 oka <- runConversion m conn

521 oka <- runConversion m conn

498 case oka of

522 case oka of

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

@@ -76,12 +76,8 @@ 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)

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

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

81−#endif

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

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

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

84−#endif

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

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

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

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

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

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

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

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

48#if defined(mingw32_HOST_OS)

49import Control.Concurrent ( threadDelay )

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

51−import Control.Concurrent ( threadWaitRead )

52#else

50#else

53import GHC.Conc ( atomically )

51import GHC.Conc ( atomically )

54import Control.Concurrent ( threadWaitReadSTM )

52import Control.Concurrent ( threadWaitReadSTM )

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

94 -- with async exceptions, whereas threadDelay can.

92 -- with async exceptions, whereas threadDelay can.

95 Just _fd -> do

93 Just _fd -> do

96 return (threadDelay 1000000 >> loop)

94 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

112#else

95#else

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

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

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

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

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

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

72 mplus = (<|>)

74instance Monad Ok where

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

76− return = pure

77−#endif

78−

79 Errors es >>= _ = Errors es

75 Errors es >>= _ = Errors es

80 Ok a >>= f = f a

76 Ok a >>= f = f a

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

@@ -59,11 +59,7 @@ 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)

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

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

64−#else

65−import Data.Scientific (scientificBuilder)

66−#endif

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

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

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

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

src/Database/PostgreSQL/Simple/Types.hs−7

@@ -50,10 +50,6 @@ import Database.PostgreSQL.Simple.Compat (toByteString)

50data Null = Null

51 deriving (Read, Show, Typeable)

53−instance Eq Null where

54− _ == _ = False

55− _ /= _ = False

56−

57-- | A placeholder for the PostgreSQL @DEFAULT@ value.

53-- | A placeholder for the PostgreSQL @DEFAULT@ value.

58data Default = Default

54data Default = Default

59 deriving (Read, Show, Typeable)

55 deriving (Read, Show, Typeable)

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

98instance Monoid Query where

94instance Monoid Query where

99 mempty = Query B.empty

95 mempty = Query B.empty

100−#if !(MIN_VERSION_base(4,11,0))

101− mappend = (<>)

102−#endif

103

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

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

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

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

test/Exception.hsnew file+70

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

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

5+module Exception (testExceptions) where

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,6 +55,7 @@ import Notify

55import Serializable

56import Time

57import Interval

58+import Exception (testExceptions)

59tests :: TestEnv -> TestTree

60tests :: TestEnv -> TestTree

60tests env = testGroup "tests"

61tests env = testGroup "tests"

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

84 , testCase "2-ary generic" . testGeneric2

85 , testCase "2-ary generic" . testGeneric2

85 , testCase "3-ary generic" . testGeneric3

86 , testCase "3-ary generic" . testGeneric3

86 , testCase "Timeout" . testTimeout

87 , testCase "Timeout" . testTimeout

88+ , testCase "Exceptions" . testExceptions

87 ]

89 ]

89testBytea :: TestEnv -> TestTree

91testBytea :: TestEnv -> TestTree