git.iko.soy/typeable/postgresql-simple
on master help sign in
20 files changed+327−290
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+106−47 .github/workflows/simple.yml+58 CHANGES.md+18 appveyor.yml−80 postgresql-simple.cabal+25−47 src/Database/PostgreSQL/Simple.hs+1 src/Database/PostgreSQL/Simple/Compat.hs−53 src/Database/PostgreSQL/Simple/Copy.hs−4 src/Database/PostgreSQL/Simple/Errors.hs+3−2 src/Database/PostgreSQL/Simple/FromField.hs+7−5 src/Database/PostgreSQL/Simple/HStore/Implementation.hs−6 src/Database/PostgreSQL/Simple/Internal.hs+33−7 src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs−4 src/Database/PostgreSQL/Simple/Notification.hs−17 src/Database/PostgreSQL/Simple/Ok.hs−4 src/Database/PostgreSQL/Simple/ToField.hs−4 src/Database/PostgreSQL/Simple/Types.hs−7 test/Exception.hs+70 test/Main.hs+5−2 test/results/malformed-input.expected+1−1
.github/workflows/haskell-ci.yml+106−47
@@ -8,9 +8,9 @@
88#
99# For more information, see https://github.com/haskell-CI/haskell-ci
1010#
11−# version: 0.12
11+# version: 0.17.20231110
1212#
13−# REGENDATA ("0.12",["github","cabal.project"])
13+# REGENDATA ("0.17.20231110",["github","cabal.project"])
1414#
1515name: Haskell-CI
1616on:
@@ -23,12 +23,14 @@ on:
2323jobs:
2424 linux:
2525 name: Haskell-CI - Linux - ${{ matrix.compiler }}
26− runs-on: ubuntu-18.04
26+ runs-on: ubuntu-20.04
27+ timeout-minutes:
28+ 60
2729 container:
2830 image: buildpack-deps:bionic
2931 services:
3032 postgres:
31− image: postgres:10
33+ image: postgres:14
3234 env:
3335 POSTGRES_PASSWORD: postgres
3436 options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5
@@ -36,59 +38,105 @@ jobs:
3638 strategy:
3739 matrix:
3840 include:
39− - compiler: ghc-9.0.1
41+ - compiler: ghc-9.8.1
42+ compilerKind: ghc
43+ compilerVersion: 9.8.1
44+ setup-method: ghcup
4045 allow-failure: false
41− - compiler: ghc-8.10.4
46+ - compiler: ghc-9.6.3
47+ compilerKind: ghc
48+ compilerVersion: 9.6.3
49+ setup-method: ghcup
4250 allow-failure: false
43− - compiler: ghc-8.8.4
44− allow-failure: false
45− - compiler: ghc-8.6.5
51+ - compiler: ghc-9.4.8
52+ compilerKind: ghc
53+ compilerVersion: 9.4.8
54+ setup-method: ghcup
4655 allow-failure: false
47− - compiler: ghc-8.4.4
56+ - compiler: ghc-9.2.8
57+ compilerKind: ghc
58+ compilerVersion: 9.2.8
59+ setup-method: ghcup
4860 allow-failure: false
49− - compiler: ghc-8.2.2
61+ - compiler: ghc-9.0.2
62+ compilerKind: ghc
63+ compilerVersion: 9.0.2
64+ setup-method: ghcup
5065 allow-failure: false
51− - compiler: ghc-8.0.2
66+ - compiler: ghc-8.10.7
67+ compilerKind: ghc
68+ compilerVersion: 8.10.7
69+ setup-method: ghcup
5270 allow-failure: false
53− - compiler: ghc-7.10.3
54− allow-failure: false
55− - compiler: ghc-7.8.4
71+ - compiler: ghc-8.8.4
72+ compilerKind: ghc
73+ compilerVersion: 8.8.4
74+ setup-method: hvr-ppa
5675 allow-failure: false
57− - compiler: ghc-7.6.3
76+ - compiler: ghc-8.6.5
77+ compilerKind: ghc
78+ compilerVersion: 8.6.5
79+ setup-method: hvr-ppa
5880 allow-failure: false
5981 fail-fast: false
6082 steps:
6183 - name: apt
6284 run: |
6385 apt-get update
64− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
65− apt-add-repository -y 'ppa:hvr/ghc'
66− apt-get update
67− apt-get install -y $CC cabal-install-3.4
86+ apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
87+ if [ "${{ matrix.setup-method }}" = ghcup ]; then
88+ 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"
90+ chmod a+x "$HOME/.ghcup/bin/ghcup"
91+ "$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)
93+ else
94+ apt-add-repository -y 'ppa:hvr/ghc'
95+ apt-get update
96+ apt-get install -y "$HCNAME"
97+ 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"
99+ chmod a+x "$HOME/.ghcup/bin/ghcup"
100+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
101+ fi
68102 env:
69− CC: ${{ matrix.compiler }}
103+ HCKIND: ${{ matrix.compilerKind }}
104+ HCNAME: ${{ matrix.compiler }}
105+ HCVER: ${{ matrix.compilerVersion }}
70106 - name: Set PATH and environment variables
71107 run: |
72108 echo "$HOME/.cabal/bin" >> $GITHUB_PATH
73− echo "LANG=C.UTF-8" >> $GITHUB_ENV
74− echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV
75− echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV
76− HCDIR=$(echo "/opt/$CC" | sed 's/-/\//')
77− HCNAME=ghc
78− HC=$HCDIR/bin/$HCNAME
79− echo "HC=$HC" >> $GITHUB_ENV
80− echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV
81− echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV
82− echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
109+ echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
110+ echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
111+ echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
112+ HCDIR=/opt/$HCKIND/$HCVER
113+ if [ "${{ matrix.setup-method }}" = ghcup ]; then
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#')
117+ echo "HC=$HC" >> "$GITHUB_ENV"
118+ echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
119+ echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
120+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
121+ else
122+ HC=$HCDIR/bin/$HCKIND
123+ echo "HC=$HC" >> "$GITHUB_ENV"
124+ echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
125+ echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
126+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
127+ fi
128+
83129 HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
84− echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
85− echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
86− echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
87− echo "HEADHACKAGE=false" >> $GITHUB_ENV
88− echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV
89− echo "GHCJSARITH=0" >> $GITHUB_ENV
130+ echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
131+ echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
132+ echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
133+ echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
134+ echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
135+ echo "GHCJSARITH=0" >> "$GITHUB_ENV"
90136 env:
91− CC: ${{ matrix.compiler }}
137+ HCKIND: ${{ matrix.compilerKind }}
138+ HCNAME: ${{ matrix.compiler }}
139+ HCVER: ${{ matrix.compilerVersion }}
92140 - name: env
93141 run: |
94142 env
@@ -111,6 +159,10 @@ jobs:
111159 repository hackage.haskell.org
112160 url: http://hackage.haskell.org/
113161 EOF
162+ cat >> $CABAL_CONFIG <<EOF
163+ program-default-options
164+ ghc-options: $GHCJOBS +RTS -M3G -RTS
165+ EOF
114166 cat $CABAL_CONFIG
115167 - name: versions
116168 run: |
@@ -123,14 +175,14 @@ jobs:
123175 - name: install cabal-plan
124176 run: |
125177 mkdir -p $HOME/.cabal/bin
126− 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
127− echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
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
179+ echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
128180 xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
129181 rm -f cabal-plan.xz
130182 chmod a+x $HOME/.cabal/bin/cabal-plan
131183 cabal-plan --version
132184 - name: checkout
133− uses: actions/checkout@v2
185+ uses: actions/checkout@v3
134186 with:
135187 path: source
136188 - name: initial cabal.project for sdist
@@ -149,12 +201,13 @@ jobs:
149201 - name: generate cabal.project
150202 run: |
151203 PKGDIR_postgresql_simple="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"
152− echo "PKGDIR_postgresql_simple=${PKGDIR_postgresql_simple}" >> $GITHUB_ENV
204+ echo "PKGDIR_postgresql_simple=${PKGDIR_postgresql_simple}" >> "$GITHUB_ENV"
205+ rm -f cabal.project cabal.project.local
153206 touch cabal.project
154207 touch cabal.project.local
155208 echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
156− if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package postgresql-simple" >> cabal.project ; fi
157− if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi
209+ echo "package postgresql-simple" >> cabal.project
210+ echo " ghc-options: -Werror=missing-methods" >> cabal.project
158211 cat >> cabal.project <<EOF
159212 allow-newer: cryptohash-md5-0.11.100.1:base
160213 EOF
@@ -165,8 +218,8 @@ jobs:
165218 run: |
166219 $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
167220 cabal-plan
168− - name: cache
169− uses: actions/cache@v2
221+ - name: restore cache
222+ uses: actions/cache/restore@v3
170223 with:
171224 key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
172225 path: ~/.cabal/store
@@ -190,8 +243,14 @@ jobs:
190243 ${CABAL} -vnormal check
191244 - name: haddock
192245 run: |
193− $CABAL v2-haddock $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
194247 - name: unconstrained build
195248 run: |
196249 rm -f cabal.project.local
197250 $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.ymlnew file+58
@@ -0,0 +1,58 @@
1+name: Simple
2+on:
3+ push:
4+ branches:
5+ - master
6+ pull_request:
7+ branches:
8+ - master
9+
10+jobs:
11+ native:
12+ name: "Simple: GHC ${{ matrix.ghc }} on ${{ matrix.os }}"
13+ runs-on: ${{ matrix.os }}
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']
18+ fail-fast: false
19+ timeout-minutes:
20+ 60
21+ steps:
22+ - name: Set git to use LF
23+ run: |
24+ git config --global core.autocrlf false
25+ git config --global core.eol lf
26+
27+ - name: Set up Haskell
28+ id: setup-haskell
29+ uses: haskell/actions/setup@v2
30+ with:
31+ ghc-version: ${{ matrix.ghc }}
32+ cabal-version: '3.10.2.0'
33+
34+ - name: Set up PostgreSQL
35+ uses: ikalnytskyi/action-setup-postgres@v3
36+ id: postgres
37+ with:
38+ username: ci
39+ password: sw0rdfish
40+ database: test
41+
42+ - name: Checkout
43+ uses: actions/checkout@v3.0.2
44+
45+ - name: Cache
46+ uses: actions/cache@v2.1.3
47+ with:
48+ path: ${{ steps.setup-haskell.outputs.cabal-store }}
49+ key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }}
50+ restore-keys: ${{ runner.os }}-${{ matrix.ghc }}-
51+
52+ - name: Build
53+ run: cabal build all --enable-tests
54+
55+ - name: Test
56+ run: cabal test all --enable-tests --test-show-details=direct
57+ env:
58+ DATABASE_CONNSTRING: ${{ steps.postgres.outputs.connection-uri }}
CHANGES.md+18
@@ -1,3 +1,21 @@
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+
119### Version 0.6.4 (2021-01-06)
220
321 * Add foldCopyData helper function
appveyor.ymldeleted−80
@@ -1,80 +0,0 @@
1−clone_folder: "c:\\WORK"
2−
3−branches:
4− only:
5− - master
6−
7−services:
8− - postgresql96
9−
10−environment:
11− global:
12− CABOPTS: "--store-dir=C:\\SR --http-transport=plain-http"
13− PGUSER: postgres
14− PGPASSWORD: Password12!
15− PGPORT: "5432"
16− DATABASE_CONNSTRING: appveyor
17− matrix:
18− # 64 bit builds
19− - GHCVER: "8.8.1"
20− CHOCOPTS:
21− - GHCVER: "8.6.5"
22− CHOCOPTS:
23− - GHCVER: "8.4.4"
24− CHOCOPTS:
25− - GHCVER: "8.2.2"
26− CHOCOPTS:
27− - GHCVER: "8.0.2"
28− CHOCOPTS:
29− - GHCVER: "7.10.3.2"
30− CHOCOPTS:
31−
32− # Fails to link
33− #
34− # - GHCVER: "7.8.4.1"
35− # CHOCOPTS:
36−
37− # 32 bit builds
38−
39− # Linker errors...
40−
41− # - GHCVER: "8.6.5"
42− # CHOCOPTS: --forcex86
43− # - GHCVER: "8.4.4"
44− # CHOCOPTS: --forcex86
45− # - GHCVER: "8.2.2"
46− # CHOCOPTS: --forcex86
47−
48− # older segfault?
49−
50−cache:
51−- "C:\\SR"
52−
53−install:
54− - "choco install -y ghc --version %GHCVER% %CHOCOPTS%"
55− - "choco install -y cabal %CHOCOPTS%"
56− - "refreshenv"
57− - "set PATH=C:\\ghc\\ghc-%GHCVER%:C:\\msys64\\mingw64\\bin;C:\\msys64\\usr\\bin;%PATH%"
58− - "cabal --version"
59− - "ghc --version"
60−
61− - set PATH=C:\Progra~1\PostgreSQL\9.6\bin\;%PATH%
62−
63−build: off
64−
65−test_script:
66− - "cabal %CABOPTS% update -v"
67− - createdb TestDb
68− - IF EXIST configure.ac bash -c "autoreconf -i"
69− - "move cabal.project.local.win cabal.project.local"
70−
71− - "cabal %CABOPTS% v2-build -j1 libs test"
72− # - "cabal %CABOPTS% v2-test -j1 all"
73− - "cabal %CABOPTS% v2-run test"
74− # - "cabal %CABOPTS% v2-run inspection" # only GHC-8.0 (or GHC-8.2+)
75−
76− # Build from sdist
77− - "rmdir /Q /S dist-newstyle"
78− - "cabal v2-sdist"
79− - "sh -c 'echo packages: dist-newstyle/sdist/*.tar.gz > cabal.project'"
80− - "cabal v2-build -j1 postgresql-simple" # TODO: unfortunately the package name have to be here
postgresql-simple.cabal+25−47
@@ -1,7 +1,7 @@
11cabal-version: 1.12
22name: postgresql-simple
3−version: 0.6.4
4−x-revision: 8
3+version: 0.7.0.0
4+x-revision: 1
55synopsis: Mid-Level PostgreSQL client library
66description:
77 Mid-Level PostgreSQL client library, forked from mysql-simple.
@@ -24,17 +24,14 @@ extra-source-files:
2424 test/results/unique-constraint-violation.expected
2525
2626tested-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
33− || ==8.6.5
27+ GHC ==8.6.5
3428 || ==8.8.4
3529 || ==8.10.7
36− || ==9.0.1
37− || ==9.2.1
30+ || ==9.0.2
31+ || ==9.2.8
32+ || ==9.4.8
33+ || ==9.6.3
34+ || ==9.8.1
3835
3936library
4037 default-language: Haskell2010
@@ -80,34 +77,25 @@ library
8077
8178 -- GHC bundled libs
8279 build-depends:
83− base >=4.6.0.0 && <4.17
84− , bytestring >=0.10.0.0 && <0.12
85− , containers >=0.5.0.0 && <0.7
86− , template-haskell >=2.8.0.0 && <2.19
87− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.1
80+ base >=4.12.0.0 && <4.20
81+ , bytestring >=0.10.8.2 && <0.13
82+ , containers >=0.6.0.1 && <0.7
83+ , template-haskell >=2.14.0.0 && <2.22
84+ , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
8885 , time-compat >=1.9.5 && <1.12
89− , transformers >=0.3.0.0 && <0.7
86+ , transformers >=0.5.6.2 && <0.7
9087
9188 -- Other dependencies
9289 build-depends:
93− aeson >=1.4.1.0 && <1.6 || >=2.0.0.0 && <2.2
94− , attoparsec >=0.13.2.2 && <0.15
95− , bytestring-builder >=0.10.8.1.0 && <0.11
96− , case-insensitive >=1.2.0.11 && <1.3
97− , hashable >=1.2.7.0 && <1.5
98− , Only >=0.1 && <0.1.1
99− , postgresql-libpq >=0.9.4.3 && <0.10
100− , scientific >=0.3.6.2 && <0.4
101− , uuid-types >=1.0.3 && <1.1
102− , vector >=0.12.0.1 && <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
90+ aeson >=2.1.2.1 && <2.3
91+ , attoparsec >=0.14.4 && <0.15
92+ , case-insensitive >=1.2.1.0 && <1.3
93+ , hashable >=1.4.3.0 && <1.5
94+ , Only >=0.1 && <0.1.1
95+ , postgresql-libpq >=0.10.0.0 && <0.11
96+ , scientific >=0.3.7.0 && <0.4
97+ , uuid-types >=1.0.5 && <1.1
98+ , vector >=0.13.0.0 && <0.14
11199
112100 default-extensions:
113101 BangPatterns
@@ -122,15 +110,7 @@ source-repository head
122110 type: git
123111 location: http://github.com/haskellari/postgresql-simple
124112
125−source-repository this
126− type: git
127− location: http://github.com/haskellari/postgresql-simple
128− tag: v0.6.3
129−
130113test-suite inspection
131− if !impl(ghc >=8.0)
132− buildable: False
133−
134114 default-language: Haskell2010
135115 type: exitcode-stdio-1.0
136116 hs-source-dirs: test
@@ -150,10 +130,11 @@ test-suite test
150130 main-is: Main.hs
151131 other-modules:
152132 Common
133+ Exception
134+ Interval
153135 Notify
154136 Serializable
155137 Time
156− Interval
157138
158139 ghc-options: -threaded
159140 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
@@ -183,9 +164,6 @@ test-suite test
183164 , time-compat
184165 , vector
185166
186− if !impl(ghc >=7.6)
187− build-depends: ghc-prim
188−
189167benchmark select
190168 default-language: Haskell2010
191169 type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs+1
@@ -64,6 +64,7 @@ module Database.PostgreSQL.Simple
6464 , Only(..)
6565 , (:.)(..)
6666 -- ** Exceptions
67+ , SomePostgreSqlException(..)
6768 , SqlError(..)
6869 , PQ.ExecStatus(..)
6970 , FormatError(..)
src/Database/PostgreSQL/Simple/Compat.hs−53
@@ -12,36 +12,13 @@ module Database.PostgreSQL.Simple.Compat
1212 ) where
1313
1414import qualified Control.Exception as E
15−import Data.Monoid
1615import Data.ByteString (ByteString)
17−#if MIN_VERSION_bytestring(0,10,0)
1816import Data.ByteString.Lazy (toStrict)
19−#else
20−import qualified Data.ByteString as B
21−import Data.ByteString.Lazy (toChunks)
22−#endif
2317import Data.ByteString.Builder (Builder, toLazyByteString)
24−
25−#if MIN_VERSION_scientific(0,3,0)
2618import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
27−#else
28−import Data.Scientific (scientificBuilder)
29−#endif
30−
31−#if __GLASGOW_HASKELL__ >= 702
3219import System.IO.Unsafe (unsafeDupablePerformIO)
33−#elif __GLASGOW_HASKELL__ >= 611
34−import GHC.IO (unsafeDupablePerformIO)
35−#else
36−import GHC.IOBase (unsafeDupablePerformIO)
37−#endif
38−
3920import Data.Fixed (Pico)
40−#if MIN_VERSION_base(4,7,0)
4121import Data.Fixed (Fixed(MkFixed))
42−#else
43−import Unsafe.Coerce (unsafeCoerce)
44−#endif
4522
4623-- | Like 'E.mask', but backported to base before version 4.3.0.
4724--
@@ -51,44 +28,14 @@ import Unsafe.Coerce (unsafeCoerce)
5128-- 'withTransactionMode' function calls the restore callback only once, so we
5229-- don't need that polymorphism.
5330mask :: ((IO a -> IO a) -> IO b) -> IO b
54−#if MIN_VERSION_base(4,3,0)
5531mask 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
6132{-# INLINE mask #-}
6233
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−
7134toByteString :: Builder -> ByteString
72−#if MIN_VERSION_bytestring(0,10,0)
7335toByteString 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)
7936
8037toPico :: Integer -> Pico
8138toPico = MkFixed
8239
8340fromPico :: Pico -> Integer
8441fromPico (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
8686 PQ.TuplesOk -> err
8787 PQ.CopyOut -> return ()
8888 PQ.CopyIn -> return ()
89−#if MIN_VERSION_postgresql_libpq(0,9,3)
9089 PQ.CopyBoth -> errMsg "COPY BOTH is not supported"
91−#endif
92−#if MIN_VERSION_postgresql_libpq(0,9,2)
9390 PQ.SingleTuple -> errMsg "single-row mode is not supported"
94−#endif
9591 PQ.BadResponse -> throwResultError funcName result status
9692 PQ.NonfatalError -> throwResultError funcName result status
9793 PQ.FatalError -> throwResultError funcName result status
src/Database/PostgreSQL/Simple/Errors.hs+3−2
@@ -25,7 +25,6 @@ module Database.PostgreSQL.Simple.Errors
2525 )
2626 where
2727
28−import Control.Applicative
2928import Control.Exception as E
3029
3130import Data.Attoparsec.ByteString.Char8
@@ -60,7 +59,9 @@ data ConstraintViolation
6059 deriving (Show, Eq, Ord, Typeable)
6160
6261-- Default instance should be enough
63−instance Exception ConstraintViolation
62+instance Exception ConstraintViolation where
63+ toException = postgresqlExceptionToException
64+ fromException = postgresqlExceptionFromException
6465
6566
6667-- | 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
118118
119119import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
120120import Control.Concurrent.MVar (MVar, newMVar)
121−import Control.Exception (Exception)
121+import Control.Exception (Exception (toException, fromException))
122122import qualified Data.Aeson as JSON
123−import qualified Data.Aeson.Internal as JSON
124−import qualified Data.Aeson.Parser as JSON (value')
125123import Data.Attoparsec.ByteString.Char8 hiding (Result)
126124import Data.ByteString (ByteString)
127125import qualified Data.ByteString.Char8 as B
@@ -156,6 +154,8 @@ import qualified Data.UUID.Types as UUID
156154import Data.Scientific (Scientific)
157155import GHC.Real (infinity, notANumber)
158156
157+import qualified Data.Aeson.Types as JSON
158+
159159-- | Exception thrown if conversion from a SQL value to a Haskell
160160-- value fails.
161161data ResultError = Incompatible { errSQLType :: String
@@ -182,7 +182,9 @@ data ResultError = Incompatible { errSQLType :: String
182182 -- between metadata and actual data in a row).
183183 deriving (Eq, Show, Typeable)
184184
185−instance Exception ResultError
185+instance Exception ResultError where
186+ toException = postgresqlExceptionToException
187+ fromException = postgresqlExceptionFromException
186188
187189left :: Exception a => a -> Conversion b
188190left = conversionError
@@ -574,7 +576,7 @@ instance FromField UUID where
574576-- | json, jsonb
575577instance FromField JSON.Value where
576578 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
578580 Left err -> returnError ConversionFailed f err
579581 Right val -> pure val
580582
src/Database/PostgreSQL/Simple/HStore/Implementation.hs−6
@@ -22,9 +22,6 @@ import Data.ByteString.Builder (Builder, byteString, char8)
2222import qualified Data.ByteString.Builder as BU
2323import Data.ByteString.Internal (c2w, w2c)
2424import 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
2825import Data.Map(Map)
2926import qualified Data.Map as Map
3027import Data.Text(Text)
@@ -69,9 +66,6 @@ instance Semigroup HStoreBuilder where
6966
7067instance Monoid HStoreBuilder where
7168 mempty = Empty
72−#if !(MIN_VERSION_base(4,11,0))
73− mappend = (<>)
74−#endif
7569
7670class ToHStoreText a where
7771 toHStoreText :: a -> HStoreText
src/Database/PostgreSQL/Simple/Internal.hs+33−7
@@ -1,6 +1,8 @@
11{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}
22{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
33{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+{-# LANGUAGE ExistentialQuantification #-}
5+{-# LANGUAGE InstanceSigs #-}
46
57------------------------------------------------------------------------------
68-- |
@@ -34,7 +36,6 @@ import Data.Int (Int64)
3436import qualified Data.IntMap as IntMap
3537import Data.IORef
3638import Data.Maybe(fromMaybe)
37−import Data.Monoid
3839import Data.String
3940import qualified Data.Text as T
4041import qualified Data.Text.Encoding as TE
@@ -82,6 +83,25 @@ data Connection = Connection {
8283instance Eq Connection where
8384 x == y = connectionHandle x == connectionHandle y
8485
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+
85105data SqlError = SqlError {
86106 sqlState :: ByteString
87107 , sqlExecStatus :: ExecStatus
@@ -93,7 +113,10 @@ data SqlError = SqlError {
93113fatalError :: ByteString -> SqlError
94114fatalError msg = SqlError "" FatalError msg "" ""
95115
96−instance Exception SqlError
116+instance Exception SqlError where
117+ toException = postgresqlExceptionToException
118+ fromException = postgresqlExceptionFromException
119+
97120
98121-- | Exception thrown if 'query' is used to perform an @INSERT@-like
99122-- operation, or 'execute' is used to perform a @SELECT@-like operation.
@@ -102,7 +125,9 @@ data QueryError = QueryError {
102125 , qeQuery :: Query
103126 } deriving (Eq, Show, Typeable)
104127
105−instance Exception QueryError
128+instance Exception QueryError where
129+ toException = postgresqlExceptionToException
130+ fromException = postgresqlExceptionFromException
106131
107132-- | Exception thrown if a 'Query' could not be formatted correctly.
108133-- This may occur if the number of \'@?@\' characters in the query
@@ -113,7 +138,9 @@ data FormatError = FormatError {
113138 , fmtParams :: [ByteString]
114139 } deriving (Eq, Show, Typeable)
115140
116−instance Exception FormatError
141+instance Exception FormatError where
142+ toException = postgresqlExceptionToException
143+ fromException = postgresqlExceptionFromException
117144
118145data ConnectInfo = ConnectInfo {
119146 connectHost :: String
@@ -156,6 +183,8 @@ connect :: ConnectInfo -> IO Connection
156183connect = connectPostgreSQL . postgreSQLConnectionString
157184
158185-- | Memory bracket around 'connect' and 'close'.
186+--
187+-- @since 0.6.5
159188withConnect :: ConnectInfo -> (Connection -> IO c) -> IO c
160189withConnect connInfo = bracket (connect connInfo) close
161190
@@ -488,9 +517,6 @@ instance Alternative Conversion where
488517 Errors _ -> (oka <|>) <$> runConversion mb conn
489518
490519instance Monad Conversion where
491−#if !(MIN_VERSION_base(4,8,0))
492− return = pure
493−#endif
494520 m >>= f = Conversion $ \conn -> do
495521 oka <- runConversion m conn
496522 case oka of
src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs−4
@@ -76,12 +76,8 @@ finishQueryWith' q result k = do
7676 PQ.CommandOk -> queryErr "query resulted in a command response (did you mean to use `execute` or forget a RETURNING?)"
7777 PQ.CopyOut -> queryErr "query: COPY TO is not supported"
7878 PQ.CopyIn -> queryErr "query: COPY FROM is not supported"
79−#if MIN_VERSION_postgresql_libpq(0,9,3)
8079 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"
81−#endif
82−#if MIN_VERSION_postgresql_libpq(0,9,2)
8380 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"
84−#endif
8581 PQ.BadResponse -> throwResultError "query" result status
8682 PQ.NonfatalError -> throwResultError "query" result status
8783 PQ.FatalError -> throwResultError "query" result status
src/Database/PostgreSQL/Simple/Notification.hs−17
@@ -47,8 +47,6 @@ import GHC.IO.Exception ( ioe_location )
4747
4848#if defined(mingw32_HOST_OS)
4949import Control.Concurrent ( threadDelay )
50−#elif !MIN_VERSION_base(4,7,0)
51−import Control.Concurrent ( threadWaitRead )
5250#else
5351import GHC.Conc ( atomically )
5452import Control.Concurrent ( threadWaitReadSTM )
@@ -94,21 +92,6 @@ getNotification conn = join $ withConnection conn fetch
9492 -- with async exceptions, whereas threadDelay can.
9593 Just _fd -> do
9694 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
11295#else
11396 -- This case fixes the race condition above. By registering
11497 -- 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
7272 mplus = (<|>)
7373
7474instance Monad Ok where
75−#if !(MIN_VERSION_base(4,8,0))
76− return = pure
77−#endif
78−
7975 Errors es >>= _ = Errors es
8076 Ok a >>= f = f a
8177
src/Database/PostgreSQL/Simple/ToField.hs−4
@@ -59,11 +59,7 @@ import qualified Data.Vector as V
5959import qualified Database.PostgreSQL.LibPQ as PQ
6060import Database.PostgreSQL.Simple.Time
6161import Data.Scientific (Scientific)
62−#if MIN_VERSION_scientific(0,3,0)
6362import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
64−#else
65−import Data.Scientific (scientificBuilder)
66−#endif
6763import Foreign.C.Types (CUInt(..))
6864
6965-- | 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)
5050data Null = Null
5151 deriving (Read, Show, Typeable)
5252
53−instance Eq Null where
54− _ == _ = False
55− _ /= _ = False
56−
5753-- | A placeholder for the PostgreSQL @DEFAULT@ value.
5854data Default = Default
5955 deriving (Read, Show, Typeable)
@@ -97,9 +93,6 @@ instance Semigroup Query where
9793
9894instance Monoid Query where
9995 mempty = Query B.empty
100−#if !(MIN_VERSION_base(4,11,0))
101− mappend = (<>)
102−#endif
10396
10497-- | Wrap a list of values for use in an @IN@ clause. Replaces a
10598-- 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 #-}
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+5−2
@@ -55,6 +55,7 @@ import Notify
5555import Serializable
5656import Time
5757import Interval
58+import Exception (testExceptions)
5859
5960tests :: TestEnv -> TestTree
6061tests env = testGroup "tests"
@@ -84,6 +85,7 @@ tests env = testGroup "tests"
8485 , testCase "2-ary generic" . testGeneric2
8586 , testCase "3-ary generic" . testGeneric3
8687 , testCase "Timeout" . testTimeout
88+ , testCase "Exceptions" . testExceptions
8789 ]
8890
8991testBytea :: TestEnv -> TestTree
@@ -137,7 +139,7 @@ testFold TestEnv{..} = do
137139 xs <- readIORef ref
138140 writeIORef ref $! (a,b):xs
139141 xs <- readIORef ref
140− reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
142+ reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]
141143
142144 -- Make sure fold propagates our exception.
143145 ref <- newIORef []
@@ -472,12 +474,13 @@ testCopyFailures env = testGroup "Copy failures"
472474
473475goldenTest :: TestName -> IO BL.ByteString -> TestTree
474476goldenTest testName =
475− goldenVsString testName (resultsDir </> fileName<.>"expected")
477+ goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")
476478 where
477479 resultsDir = "test" </> "results"
478480 fileName = map normalize testName
479481 normalize c | not (isAlpha c) = '-'
480482 | otherwise = c
483+ diff ref new = ["diff", "-u", ref, new]
481484
482485-- | Test that we provide a sensible error message on failure
483486testCopyUniqueConstraintError :: TestEnv -> TestTree
test/results/malformed-input.expected+1−1
@@ -1,4 +1,4 @@
11user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status
2−Connection error: ERROR: invalid input syntax for integer: "z"
2+Connection error: ERROR: invalid input syntax for type integer: "z"
33CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"
44)