git.iko.soy/typeable/postgresql-simple
on 2c2463a help sign in
.github/workflows/haskell-ci.yml+53−41
since splitsnapshots
unifiedsplit
@@ -8,9 +8,9 @@
8#
8#
9# For more information, see https://github.com/haskell-CI/haskell-ci
9# For more information, see https://github.com/haskell-CI/haskell-ci
10#
10#
11−# version: 0.17.20231110
11+# version: 0.15.20221009
12#
12#
13−# REGENDATA ("0.17.20231110",["github","cabal.project"])
13+# REGENDATA ("0.15.20221009",["github","cabal.project"])
14#
14#
15name: Haskell-CI
15name: Haskell-CI
16on:
16on:
@@ -38,24 +38,14 @@ jobs:
38 strategy:
38 strategy:
39 matrix:
39 matrix:
40 include:
40 include:
41− - compiler: ghc-9.8.1
41+ - compiler: ghc-9.4.2
42 compilerKind: ghc
42 compilerKind: ghc
43− compilerVersion: 9.8.1
43+ compilerVersion: 9.4.2
44 setup-method: ghcup
44 setup-method: ghcup
45 allow-failure: false
45 allow-failure: false
46− - compiler: ghc-9.6.3
46+ - compiler: ghc-9.2.4
47 compilerKind: ghc
47 compilerKind: ghc
48− compilerVersion: 9.6.3
48+ compilerVersion: 9.2.4
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
59 setup-method: ghcup
49 setup-method: ghcup
60 allow-failure: false
50 allow-failure: false
61 - compiler: ghc-9.0.2
51 - compiler: ghc-9.0.2
@@ -78,6 +68,36 @@ jobs:
78 compilerVersion: 8.6.5
68 compilerVersion: 8.6.5
79 setup-method: hvr-ppa
69 setup-method: hvr-ppa
80 allow-failure: false
70 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
81 fail-fast: false
101 fail-fast: false
82 steps:
102 steps:
83 - name: apt
103 - name: apt
@@ -86,18 +106,18 @@ jobs:
86 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
106 apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
87 if [ "${{ matrix.setup-method }}" = ghcup ]; then
107 if [ "${{ matrix.setup-method }}" = ghcup ]; then
88 mkdir -p "$HOME/.ghcup/bin"
108 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"
109+ curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup"
90 chmod a+x "$HOME/.ghcup/bin/ghcup"
110 chmod a+x "$HOME/.ghcup/bin/ghcup"
91 "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
111 "$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)
112+ "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
93 else
113 else
94 apt-add-repository -y 'ppa:hvr/ghc'
114 apt-add-repository -y 'ppa:hvr/ghc'
95 apt-get update
115 apt-get update
96 apt-get install -y "$HCNAME"
116 apt-get install -y "$HCNAME"
97 mkdir -p "$HOME/.ghcup/bin"
117 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"
118+ curl -sL https://downloads.haskell.org/ghcup/0.1.18.0/x86_64-linux-ghcup-0.1.18.0 > "$HOME/.ghcup/bin/ghcup"
99 chmod a+x "$HOME/.ghcup/bin/ghcup"
119 chmod a+x "$HOME/.ghcup/bin/ghcup"
100− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
120+ "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
101 fi
121 fi
102 env:
122 env:
103 HCKIND: ${{ matrix.compilerKind }}
123 HCKIND: ${{ matrix.compilerKind }}
@@ -111,19 +131,17 @@ jobs:
111 echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
131 echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
112 HCDIR=/opt/$HCKIND/$HCVER
132 HCDIR=/opt/$HCKIND/$HCVER
113 if [ "${{ matrix.setup-method }}" = ghcup ]; then
133 if [ "${{ matrix.setup-method }}" = ghcup ]; then
114− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
134+ 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"
135 echo "HC=$HC" >> "$GITHUB_ENV"
118− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
136+ echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
119− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
137+ echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
120− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
138+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
121 else
139 else
122 HC=$HCDIR/bin/$HCKIND
140 HC=$HCDIR/bin/$HCKIND
123 echo "HC=$HC" >> "$GITHUB_ENV"
141 echo "HC=$HC" >> "$GITHUB_ENV"
124 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
142 echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
125 echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
143 echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
126− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
144+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
127 fi
145 fi
128
146
129 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
147 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
@@ -175,14 +193,14 @@ jobs:
175 - name: install cabal-plan
193 - name: install cabal-plan
176 run: |
194 run: |
177 mkdir -p $HOME/.cabal/bin
195 mkdir -p $HOME/.cabal/bin
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
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
179− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
197+ echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
180 xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
198 xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
181 rm -f cabal-plan.xz
199 rm -f cabal-plan.xz
182 chmod a+x $HOME/.cabal/bin/cabal-plan
200 chmod a+x $HOME/.cabal/bin/cabal-plan
183 cabal-plan --version
201 cabal-plan --version
184 - name: checkout
202 - name: checkout
185− uses: actions/checkout@v3
203+ uses: actions/checkout@v2
186 with:
204 with:
187 path: source
205 path: source
188 - name: initial cabal.project for sdist
206 - name: initial cabal.project for sdist
@@ -206,8 +224,8 @@ jobs:
206 touch cabal.project
224 touch cabal.project
207 touch cabal.project.local
225 touch cabal.project.local
208 echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
226 echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
209− echo "package postgresql-simple" >> cabal.project
227+ if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package postgresql-simple" >> cabal.project ; fi
210− echo " ghc-options: -Werror=missing-methods" >> cabal.project
228+ if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi
211 cat >> cabal.project <<EOF
229 cat >> cabal.project <<EOF
212 allow-newer: cryptohash-md5-0.11.100.1:base
230 allow-newer: cryptohash-md5-0.11.100.1:base
213 EOF
231 EOF
@@ -218,8 +236,8 @@ jobs:
218 run: |
236 run: |
219 $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
237 $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
220 cabal-plan
238 cabal-plan
221− - name: restore cache
239+ - name: cache
222− uses: actions/cache/restore@v3
240+ uses: actions/cache@v2
223 with:
241 with:
224 key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
242 key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
225 path: ~/.cabal/store
243 path: ~/.cabal/store
@@ -243,14 +261,8 @@ jobs:
243 ${CABAL} -vnormal check
261 ${CABAL} -vnormal check
244 - name: haddock
262 - name: haddock
245 run: |
263 run: |
246− $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
264+ $CABAL v2-haddock --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
247 - name: unconstrained build
265 - name: unconstrained build
248 run: |
266 run: |
249 rm -f cabal.project.local
267 rm -f cabal.project.local
250 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
268 $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:
14 strategy:
15 matrix:
15 matrix:
16 os: [macos-latest, windows-latest]
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
18 fail-fast: false
19 timeout-minutes:
19 timeout-minutes:
20 60
20 60
@@ -26,10 +26,10 @@ jobs:
26
26
27 - name: Set up Haskell
27 - name: Set up Haskell
28 id: setup-haskell
28 id: setup-haskell
29− uses: haskell/actions/setup@v2
29+ uses: haskell/actions/setup@v1
30 with:
30 with:
31 ghc-version: ${{ matrix.ghc }}
31 ghc-version: ${{ matrix.ghc }}
32− cabal-version: '3.10.2.0'
32+ cabal-version: '3.8.1.0'
33
33
34 - name: Set up PostgreSQL
34 - name: Set up PostgreSQL
35 uses: ikalnytskyi/action-setup-postgres@v3
35 uses: ikalnytskyi/action-setup-postgres@v3
CHANGES.md−18
@@ -1,21 +1,3 @@
1−### Version 0.7.0.0 (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−
11−### Version 0.6.5.1 (2023-07-09)
12−
13− * Support `aeson-2.2.0.0`
14−
15−### Version 0.6.5 (2022-10-30)
16−
17− * Add `withConnect`
18−
19### Version 0.6.4 (2021-01-06)
1### Version 0.6.4 (2021-01-06)
20
2
21 * Add foldCopyData helper function
3 * Add foldCopyData helper function
postgresql-simple.cabal+47−24
@@ -1,7 +1,7 @@
1cabal-version: 1.12
1cabal-version: 1.12
2name: postgresql-simple
2name: postgresql-simple
3−version: 0.7.0.0
3+version: 0.6.4
4−x-revision: 1
4+x-revision: 9
5synopsis: Mid-Level PostgreSQL client library
5synopsis: Mid-Level PostgreSQL client library
6description:
6description:
7 Mid-Level PostgreSQL client library, forked from mysql-simple.
7 Mid-Level PostgreSQL client library, forked from mysql-simple.
@@ -24,14 +24,18 @@ extra-source-files:
24 test/results/unique-constraint-violation.expected
24 test/results/unique-constraint-violation.expected
25
25
26tested-with:
26tested-with:
27+ GHC ==7.6.3
28+ || ==7.8.4
29+ || ==7.10.3
30+ || ==8.0.2
31+ || ==8.2.2
32+ || ==8.4.4
27− GHC ==8.6.5
33+ || ==8.6.5
28 || ==8.8.4
34 || ==8.8.4
29 || ==8.10.7
35 || ==8.10.7
30 || ==9.0.2
36 || ==9.0.2
31− || ==9.2.8
37+ || ==9.2.4
32− || ==9.4.8
38+ || ==9.4.2
33− || ==9.6.3
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.18
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.20
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.2
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(..)
64 , Only(..)
65 , (:.)(..)
65 , (:.)(..)
66 -- ** Exceptions
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
12 ) where
13
13
14import qualified Control.Exception as E
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
86 PQ.TuplesOk -> err
87 PQ.CopyOut -> return ()
87 PQ.CopyOut -> return ()
88 PQ.CopyIn -> 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 )
25 )
26 where
26 where
27
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+5−7
@@ -118,8 +118,10 @@ module Database.PostgreSQL.Simple.FromField
118
118
119import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
119import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
120import Control.Concurrent.MVar (MVar, newMVar)
120import Control.Concurrent.MVar (MVar, newMVar)
121−import Control.Exception (Exception (toException, fromException))
121+import Control.Exception (Exception)
122import qualified Data.Aeson as JSON
122import qualified Data.Aeson as JSON
123+import qualified Data.Aeson.Internal as JSON
124+import qualified Data.Aeson.Parser as JSON (value')
123import Data.Attoparsec.ByteString.Char8 hiding (Result)
125import Data.Attoparsec.ByteString.Char8 hiding (Result)
124import Data.ByteString (ByteString)
126import Data.ByteString (ByteString)
125import qualified Data.ByteString.Char8 as B
127import qualified Data.ByteString.Char8 as B
@@ -154,8 +156,6 @@ import qualified Data.UUID.Types as UUID
154import Data.Scientific (Scientific)
156import Data.Scientific (Scientific)
155import GHC.Real (infinity, notANumber)
157import GHC.Real (infinity, notANumber)
156
158
157−import qualified Data.Aeson.Types as JSON
158−
159-- | Exception thrown if conversion from a SQL value to a Haskell
159-- | Exception thrown if conversion from a SQL value to a Haskell
160-- value fails.
160-- value fails.
161data ResultError = Incompatible { errSQLType :: String
161data ResultError = Incompatible { errSQLType :: String
@@ -182,9 +182,7 @@ data ResultError = Incompatible { errSQLType :: String
182 -- between metadata and actual data in a row).
182 -- between metadata and actual data in a row).
183 deriving (Eq, Show, Typeable)
183 deriving (Eq, Show, Typeable)
184
184
185−instance Exception ResultError where
185+instance Exception ResultError
186− toException = postgresqlExceptionToException
187− fromException = postgresqlExceptionFromException
188
186
189left :: Exception a => a -> Conversion b
187left :: Exception a => a -> Conversion b
190left = conversionError
188left = conversionError
@@ -576,7 +574,7 @@ instance FromField UUID where
576-- | json, jsonb
574-- | json, jsonb
577instance FromField JSON.Value where
575instance FromField JSON.Value where
578 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
576 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
579− where parseBS bs = case JSON.eitherDecodeStrict' bs of
577+ where parseBS bs = case parseOnly (JSON.value' <* endOfInput) bs of
580 Left err -> returnError ConversionFailed f err
578 Left err -> returnError ConversionFailed f err
581 Right val -> pure val
579 Right val -> pure val
582
580
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
22import qualified Data.ByteString.Builder as BU
23import Data.ByteString.Internal (c2w, w2c)
23import Data.ByteString.Internal (c2w, w2c)
24import qualified Data.ByteString.Lazy as BL
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−33
@@ -1,8 +1,6 @@
1{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}
1{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}
2{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
2{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
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
@@ -183,8 +156,6 @@ connect :: ConnectInfo -> IO Connection
183connect = connectPostgreSQL . postgreSQLConnectionString
156connect = connectPostgreSQL . postgreSQLConnectionString
184
157
185-- | Memory bracket around 'connect' and 'close'.
158-- | Memory bracket around 'connect' and 'close'.
186−--
187−-- @since 0.6.5
188withConnect :: ConnectInfo -> (Connection -> IO c) -> IO c
159withConnect :: ConnectInfo -> (Connection -> IO c) -> IO c
189withConnect connInfo = bracket (connect connInfo) close
160withConnect connInfo = bracket (connect connInfo) close
190
161
@@ -517,6 +488,9 @@ instance Alternative Conversion where
517 Errors _ -> (oka <|>) <$> runConversion mb conn
488 Errors _ -> (oka <|>) <$> runConversion mb conn
518
489
519instance Monad Conversion where
490instance Monad Conversion where
491+#if !(MIN_VERSION_base(4,8,0))
492+ return = pure
493+#endif
520 m >>= f = Conversion $ \conn -> do
494 m >>= f = Conversion $ \conn -> do
521 oka <- runConversion m conn
495 oka <- runConversion m conn
522 case oka of
496 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?)"
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"
77 PQ.CopyOut -> queryErr "query: COPY TO is not supported"
78 PQ.CopyIn -> queryErr "query: COPY FROM 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
47
48#if defined(mingw32_HOST_OS)
48#if defined(mingw32_HOST_OS)
49import Control.Concurrent ( threadDelay )
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 = (<|>)
72 mplus = (<|>)
73
73
74instance Monad Ok where
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
59import qualified Database.PostgreSQL.LibPQ as PQ
60import Database.PostgreSQL.Simple.Time
60import Database.PostgreSQL.Simple.Time
61import Data.Scientific (Scientific)
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+7
@@ -50,6 +50,10 @@ import Database.PostgreSQL.Simple.Compat (toByteString)
50data Null = Null
50data Null = Null
51 deriving (Read, Show, Typeable)
51 deriving (Read, Show, Typeable)
52
52
53+instance Eq Null where
54+ _ == _ = False
55+ _ /= _ = False
56+
53-- | A placeholder for the PostgreSQL @DEFAULT@ value.
57-- | A placeholder for the PostgreSQL @DEFAULT@ value.
54data Default = Default
58data Default = Default
55 deriving (Read, Show, Typeable)
59 deriving (Read, Show, Typeable)
@@ -93,6 +97,9 @@ instance Semigroup Query where
93
97
94instance Monoid Query where
98instance Monoid Query where
95 mempty = Query B.empty
99 mempty = Query B.empty
100+#if !(MIN_VERSION_base(4,11,0))
101+ mappend = (<>)
102+#endif
96
103
97-- | Wrap a list of values for use in an @IN@ clause. Replaces a
104-- | Wrap a list of values for use in an @IN@ clause. Replaces a
98-- single \"@?@\" character with a parenthesized list of rendered
105-- 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
55import Serializable
56import Time
56import Time
57import Interval
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