git.iko.soy/typeable/postgresql-simple
on master help sign in
32 files changed+803−462
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+256 .github/workflows/simple.yml+58 .travis.yml−177 CHANGES.md+32−4 CONTRIBUTING.md+1−1 README.md−3 appveyor.yml−80 cabal.haskell-ci−10 cabal.project+2 postgresql-simple.cabal+31−49 src/Database/PostgreSQL/Simple.hs+3−1 src/Database/PostgreSQL/Simple/Compat.hs−53 src/Database/PostgreSQL/Simple/Copy.hs+26−5 src/Database/PostgreSQL/Simple/Errors.hs+4−3 src/Database/PostgreSQL/Simple/FromField.hs+17−6 src/Database/PostgreSQL/Simple/HStore/Implementation.hs−6 src/Database/PostgreSQL/Simple/Internal.hs+37−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/Range.hs+1−1 src/Database/PostgreSQL/Simple/Time.hs+2 src/Database/PostgreSQL/Simple/Time/Implementation.hs+11−1 src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+12−3 src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+14−2 src/Database/PostgreSQL/Simple/ToField.hs+8−8 src/Database/PostgreSQL/Simple/Types.hs−7 test/Exception.hs+70 test/Interval.hs+176 test/Main.hs+40−8 test/Time.hs+1−1 test/results/malformed-input.expected+1−1
.github/workflows/haskell-ci.ymlnew file+256
@@ -0,0 +1,256 @@
1+# This GitHub workflow config has been generated by a script via
2+#
3+# haskell-ci 'github' 'cabal.project'
4+#
5+# To regenerate the script (for example after adjusting tested-with) run
6+#
7+# haskell-ci regenerate
8+#
9+# For more information, see https://github.com/haskell-CI/haskell-ci
10+#
11+# version: 0.17.20231110
12+#
13+# REGENDATA ("0.17.20231110",["github","cabal.project"])
14+#
15+name: Haskell-CI
16+on:
17+ push:
18+ branches:
19+ - master
20+ pull_request:
21+ branches:
22+ - master
23+jobs:
24+ linux:
25+ name: Haskell-CI - Linux - ${{ matrix.compiler }}
26+ runs-on: ubuntu-20.04
27+ timeout-minutes:
28+ 60
29+ container:
30+ image: buildpack-deps:bionic
31+ services:
32+ postgres:
33+ image: postgres:14
34+ env:
35+ POSTGRES_PASSWORD: postgres
36+ options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5
37+ continue-on-error: ${{ matrix.allow-failure }}
38+ strategy:
39+ matrix:
40+ include:
41+ - compiler: ghc-9.8.1
42+ compilerKind: ghc
43+ compilerVersion: 9.8.1
44+ setup-method: ghcup
45+ allow-failure: false
46+ - compiler: ghc-9.6.3
47+ compilerKind: ghc
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
59+ setup-method: ghcup
60+ allow-failure: false
61+ - compiler: ghc-9.0.2
62+ compilerKind: ghc
63+ compilerVersion: 9.0.2
64+ setup-method: ghcup
65+ allow-failure: false
66+ - compiler: ghc-8.10.7
67+ compilerKind: ghc
68+ compilerVersion: 8.10.7
69+ setup-method: ghcup
70+ allow-failure: false
71+ - compiler: ghc-8.8.4
72+ compilerKind: ghc
73+ compilerVersion: 8.8.4
74+ setup-method: hvr-ppa
75+ allow-failure: false
76+ - compiler: ghc-8.6.5
77+ compilerKind: ghc
78+ compilerVersion: 8.6.5
79+ setup-method: hvr-ppa
80+ allow-failure: false
81+ fail-fast: false
82+ steps:
83+ - name: apt
84+ run: |
85+ apt-get update
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
102+ env:
103+ HCKIND: ${{ matrix.compilerKind }}
104+ HCNAME: ${{ matrix.compiler }}
105+ HCVER: ${{ matrix.compilerVersion }}
106+ - name: Set PATH and environment variables
107+ run: |
108+ echo "$HOME/.cabal/bin" >> $GITHUB_PATH
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+
129+ HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
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"
136+ env:
137+ HCKIND: ${{ matrix.compilerKind }}
138+ HCNAME: ${{ matrix.compiler }}
139+ HCVER: ${{ matrix.compilerVersion }}
140+ - name: env
141+ run: |
142+ env
143+ - name: write cabal config
144+ run: |
145+ mkdir -p $CABAL_DIR
146+ cat >> $CABAL_CONFIG <<EOF
147+ remote-build-reporting: anonymous
148+ write-ghc-environment-files: never
149+ remote-repo-cache: $CABAL_DIR/packages
150+ logs-dir: $CABAL_DIR/logs
151+ world-file: $CABAL_DIR/world
152+ extra-prog-path: $CABAL_DIR/bin
153+ symlink-bindir: $CABAL_DIR/bin
154+ installdir: $CABAL_DIR/bin
155+ build-summary: $CABAL_DIR/logs/build.log
156+ store-dir: $CABAL_DIR/store
157+ install-dirs user
158+ prefix: $CABAL_DIR
159+ repository hackage.haskell.org
160+ url: http://hackage.haskell.org/
161+ EOF
162+ cat >> $CABAL_CONFIG <<EOF
163+ program-default-options
164+ ghc-options: $GHCJOBS +RTS -M3G -RTS
165+ EOF
166+ cat $CABAL_CONFIG
167+ - name: versions
168+ run: |
169+ $HC --version || true
170+ $HC --print-project-git-commit-id || true
171+ $CABAL --version || true
172+ - name: update cabal index
173+ run: |
174+ $CABAL v2-update -v
175+ - name: install cabal-plan
176+ run: |
177+ 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
179+ echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
180+ xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
181+ rm -f cabal-plan.xz
182+ chmod a+x $HOME/.cabal/bin/cabal-plan
183+ cabal-plan --version
184+ - name: checkout
185+ uses: actions/checkout@v3
186+ with:
187+ path: source
188+ - name: initial cabal.project for sdist
189+ run: |
190+ touch cabal.project
191+ echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
192+ cat cabal.project
193+ - name: sdist
194+ run: |
195+ mkdir -p sdist
196+ $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
197+ - name: unpack
198+ run: |
199+ mkdir -p unpacked
200+ find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
201+ - name: generate cabal.project
202+ run: |
203+ PKGDIR_postgresql_simple="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"
204+ echo "PKGDIR_postgresql_simple=${PKGDIR_postgresql_simple}" >> "$GITHUB_ENV"
205+ rm -f cabal.project cabal.project.local
206+ touch cabal.project
207+ touch cabal.project.local
208+ echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
209+ echo "package postgresql-simple" >> cabal.project
210+ echo " ghc-options: -Werror=missing-methods" >> cabal.project
211+ cat >> cabal.project <<EOF
212+ allow-newer: cryptohash-md5-0.11.100.1:base
213+ EOF
214+ $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(postgresql-simple)$/; }' >> cabal.project.local
215+ cat cabal.project
216+ cat cabal.project.local
217+ - name: dump install plan
218+ run: |
219+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
220+ cabal-plan
221+ - name: restore cache
222+ uses: actions/cache/restore@v3
223+ with:
224+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
225+ path: ~/.cabal/store
226+ restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
227+ - name: install dependencies
228+ run: |
229+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
230+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
231+ - name: build w/o tests
232+ run: |
233+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
234+ - name: build
235+ run: |
236+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
237+ - name: tests
238+ run: |
239+ $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
240+ - name: cabal check
241+ run: |
242+ cd ${PKGDIR_postgresql_simple} || false
243+ ${CABAL} -vnormal check
244+ - name: haddock
245+ run: |
246+ $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
247+ - name: unconstrained build
248+ run: |
249+ rm -f cabal.project.local
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.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 }}
.travis.ymldeleted−177
@@ -1,177 +0,0 @@
1−# This Travis job script has been generated by a script via
2−#
3−# haskell-ci '--config' 'cabal.haskell-ci' '--output' '.travis.yml' 'postgresql-simple.cabal'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.11.20200918
12−#
13−version: ~> 1.0
14−language: c
15−os: linux
16−dist: xenial
17−git:
18− # whether to recursively clone submodules
19− submodules: false
20−branches:
21− only:
22− - master
23−services:
24− - postgresql
25−addons:
26− postgresql: "10"
27−cache:
28− directories:
29− - $HOME/.cabal/packages
30− - $HOME/.cabal/store
31− - $HOME/.hlint
32−before_cache:
33− - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
34− # remove files that are regenerated by 'cabal update'
35− - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
36− - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
37− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
38− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
39− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
40− - rm -rfv $CABALHOME/packages/head.hackage
41−jobs:
42− include:
43− - compiler: ghc-8.10.2
44− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.2","cabal-install-3.4"]}}
45− env: DATABASE_CONNSTRING=travis
46− os: linux
47− - compiler: ghc-8.8.4
48− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.4","cabal-install-3.4"]}}
49− env: DATABASE_CONNSTRING=travis
50− os: linux
51− - compiler: ghc-8.6.5
52− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.4"]}}
53− env: DATABASE_CONNSTRING=travis
54− os: linux
55− - compiler: ghc-8.4.4
56− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.4"]}}
57− env: DATABASE_CONNSTRING=travis
58− os: linux
59− - compiler: ghc-8.2.2
60− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.4"]}}
61− env: DATABASE_CONNSTRING=travis
62− os: linux
63− - compiler: ghc-8.0.2
64− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.4"]}}
65− env: DATABASE_CONNSTRING=travis
66− os: linux
67− - compiler: ghc-7.10.3
68− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.4"]}}
69− env: DATABASE_CONNSTRING=travis
70− os: linux
71− - compiler: ghc-7.8.4
72− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.4"]}}
73− env: DATABASE_CONNSTRING=travis
74− os: linux
75− - compiler: ghc-7.6.3
76− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.6.3","cabal-install-3.4"]}}
77− env: DATABASE_CONNSTRING=travis
78− os: linux
79−before_install:
80− - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
81− - WITHCOMPILER="-w $HC"
82− - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
83− - HCPKG="$HC-pkg"
84− - unset CC
85− - CABAL=/opt/ghc/bin/cabal
86− - CABALHOME=$HOME/.cabal
87− - export PATH="$CABALHOME/bin:$PATH"
88− - TOP=$(pwd)
89− - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
90− - echo $HCNUMVER
91− - CABAL="$CABAL -vnormal+nowrap"
92− - set -o pipefail
93− - TEST=--enable-tests
94− - BENCH=--enable-benchmarks
95− - HEADHACKAGE=false
96− - rm -f $CABALHOME/config
97− - |
98− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
99− echo "remote-build-reporting: anonymous" >> $CABALHOME/config
100− echo "write-ghc-environment-files: always" >> $CABALHOME/config
101− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
102− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
103− echo "world-file: $CABALHOME/world" >> $CABALHOME/config
104− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
105− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
106− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
107− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
108− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
109− echo "install-dirs user" >> $CABALHOME/config
110− echo " prefix: $CABALHOME" >> $CABALHOME/config
111− echo "repository hackage.haskell.org" >> $CABALHOME/config
112− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
113−install:
114− - ${CABAL} --version
115− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
116− - |
117− echo "program-default-options" >> $CABALHOME/config
118− echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
119− - cat $CABALHOME/config
120− - rm -fv cabal.project cabal.project.local cabal.project.freeze
121− - travis_retry ${CABAL} v2-update -v
122− # Generate cabal.project
123− - rm -rf cabal.project cabal.project.local cabal.project.freeze
124− - touch cabal.project
125− - |
126− echo "packages: ." >> cabal.project
127− - if [ $HCNUMVER -ge 80200 ] ; then echo 'package postgresql-simple' >> cabal.project ; fi
128− - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
129− - |
130− - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(postgresql-simple)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
131− - cat cabal.project || true
132− - cat cabal.project.local || true
133− - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
134− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
135− - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
136− - rm cabal.project.freeze
137− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
138− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
139−script:
140− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
141− # Packaging...
142− - ${CABAL} v2-sdist all
143− # Unpacking...
144− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
145− - cd ${DISTDIR} || false
146− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
147− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
148− - PKGDIR_postgresql_simple="$(find . -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"
149− # Generate cabal.project
150− - rm -rf cabal.project cabal.project.local cabal.project.freeze
151− - touch cabal.project
152− - |
153− echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
154− - if [ $HCNUMVER -ge 80200 ] ; then echo 'package postgresql-simple' >> cabal.project ; fi
155− - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
156− - |
157− - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(postgresql-simple)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
158− - cat cabal.project || true
159− - cat cabal.project.local || true
160− # Building...
161− # this builds all libraries and executables (without tests/benchmarks)
162− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
163− # Building with tests and benchmarks...
164− # build & run tests, build benchmarks
165− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
166− # Testing...
167− - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
168− # cabal check...
169− - (cd ${PKGDIR_postgresql_simple} && ${CABAL} -vnormal check)
170− # haddock...
171− - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
172− # Building without installed constraints for packages in global-db...
173− - rm -f cabal.project.local
174− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
175−
176−# REGENDATA ("0.11.20200918",["--config","cabal.haskell-ci","--output",".travis.yml","postgresql-simple.cabal"])
177−# EOF
CHANGES.md+32−4
@@ -1,3 +1,31 @@
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)
20+
21+ * Add foldCopyData helper function
22+ Thanks to Sebastián Estrella for the implementation
23+ https://github.com/haskellari/postgresql-simple/pull/56
24+ * Implement support for postgresql 'interval' type
25+ Thanks to Andre Marques Lee for the implementation
26+ https://github.com/haskellari/postgresql-simple/pull/60
27+ * Depend on `time-compat` to provide uniform `time` related interface.
28+
129### Version 0.6.3 (2020-11-15)
230
331 * Add `fromFieldJSONByteString`
@@ -243,7 +271,7 @@
243271 support UTF8 except for Mule Internal Code, the Multilingual
244272 Extensions for Emacs. An exception should be raised upon
245273 connecting to a database by the backend if the backend cannot
246− accomodate this requirement.
274+ accommodate this requirement.
247275
248276 * Added `Eq` and `Typeable` instances for `Connection`.
249277
@@ -381,7 +409,7 @@
381409
382410 * Changed the Identifier and QualifiedIdentifier to use Text in
383411 order to avoid encoding errors. Technically this requires a
384− major verson bump, but let's pretend 0.4.1.0 didn't happen.
412+ major version bump, but let's pretend 0.4.1.0 didn't happen.
385413
386414 * Removed non-exhaustive cases in the ToField instance for Values,
387415 and tweaked error messages.
@@ -541,7 +569,7 @@
541569
542570 * Added a brand new TypeInfo system that gives FromField instances
543571 convenient and efficient access to the pg_type metatable. This
544− replaced the older typename cache, and was neccesary to properly
572+ replaced the older typename cache, and was necessary to properly
545573 support postgres array types. Thanks to Bas van Dijk for his
546574 work on this feature.
547575
@@ -633,7 +661,7 @@
633661 now the preferred way of dealing with `timestamp` (without time zone).
634662
635663 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
636− that accomodate PostgreSQL's infinities.
664+ that accommodate PostgreSQL's infinities.
637665
638666 * All time-related `FromField`/`ToField` instances are now based on new,
639667 higher-speed parsers and printers instead of those provided by the
CONTRIBUTING.md+1−1
@@ -4,7 +4,7 @@ Patches welcome!
44 - If it's really **only bounds**, please simply open an issue (so you'll have a URL to refer to). I have a semi-automated process to make revisions, pull requests only disturb it.
55 - If patch includes **source code change** (i.e. I'll need to make a release), and it's a patch to support **newer base/GHC version**:
66 - Amend `tested-with` to include that GHC
7− - Regenerate `.travis.yml` with `haskell-ci regenerate` (get the latest from [GitHub haskell-ci/haskell-ci](https://github.com/haskell-ci/haskell-ci))
7+ - Regenerate `.github/workflows/haskell-ci.yml` with `haskell-ci regenerate` (get the latest from [GitHub haskell-ci/haskell-ci](https://github.com/haskell-ci/haskell-ci))
88
99- Don't edit `CHANGELOG.md`, rather include a copyable entry in your pull request description. I often process pull requests in bulk, and everyone editing the `CHANGELOG.md` causes unnecessary conflicts.
1010- For the same reason, do not edit `version` or `x-revision`
README.md−3
@@ -1,7 +1,4 @@
1−[![Continuous Integration status][status-png]][status]
21[![Hackage page (downloads and API reference)][hackage-png]][hackage]
32
4− [status-png]: https://api.travis-ci.org/lpsmith/postgresql-simple.svg
5− [status]: http://travis-ci.org/lpsmith/postgresql-simple?branch=master
63 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg
74 [hackage]: http://hackage.haskell.org/package/postgresql-simple
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
cabal.haskell-ci−10
@@ -3,13 +3,3 @@ postgresql: True
33
44-- services aren't supported on Travis on macOS
55-- osx: 8.4.4
6−
7−env: 7.6.3:DATABASE_CONNSTRING=travis
8−env: 7.8.4:DATABASE_CONNSTRING=travis
9−env: 7.10.3:DATABASE_CONNSTRING=travis
10−env: 8.0.2:DATABASE_CONNSTRING=travis
11−env: 8.2.2:DATABASE_CONNSTRING=travis
12−env: 8.4.4:DATABASE_CONNSTRING=travis
13−env: 8.6.5:DATABASE_CONNSTRING=travis
14−env: 8.8.4:DATABASE_CONNSTRING=travis
15−env: 8.10.2:DATABASE_CONNSTRING=travis
cabal.project+2
@@ -1,2 +1,4 @@
11packages: .
22tests: true
3+
4+allow-newer: cryptohash-md5-0.11.100.1:base
postgresql-simple.cabal+31−49
@@ -1,6 +1,7 @@
11cabal-version: 1.12
22name: postgresql-simple
3−version: 0.6.3
3+version: 0.7.0.0
4+x-revision: 1
45synopsis: Mid-Level PostgreSQL client library
56description:
67 Mid-Level PostgreSQL client library, forked from mysql-simple.
@@ -12,7 +13,7 @@ maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
1213copyright:
1314 (c) 2011 MailRank, Inc.
1415 (c) 2011-2018 Leon P Smith
15− (c) 2018-2019 Oleg Grenrus
16+ (c) 2018-2020 Oleg Grenrus
1617
1718category: Database
1819build-type: Simple
@@ -23,15 +24,14 @@ extra-source-files:
2324 test/results/unique-constraint-violation.expected
2425
2526tested-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
3328 || ==8.8.4
34− || ==8.10.2
29+ || ==8.10.7
30+ || ==9.0.2
31+ || ==9.2.8
32+ || ==9.4.8
33+ || ==9.6.3
34+ || ==9.8.1
3535
3636library
3737 default-language: Haskell2010
@@ -77,34 +77,25 @@ library
7777
7878 -- GHC bundled libs
7979 build-depends:
80− base >=4.6.0.0 && <4.15
81− , bytestring >=0.10.0.0 && <0.12
82− , containers >=0.5.0.0 && <0.7
83− , template-haskell >=2.8.0.0 && <2.17
84− , text >=1.2.3.0 && <1.3
85− , time >=1.4.0.1 && <1.12
86− , transformers >=0.3.0.0 && <0.6
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
85+ , time-compat >=1.9.5 && <1.12
86+ , transformers >=0.5.6.2 && <0.7
8787
8888 -- Other dependencies
8989 build-depends:
90− aeson >=1.4.1.0 && <1.6
91− , attoparsec >=0.13.2.2 && <0.14
92− , bytestring-builder >=0.10.8.1.0 && <0.11
93− , case-insensitive >=1.2.0.11 && <1.3
94− , hashable >=1.2.7.0 && <1.4
95− , Only >=0.1 && <0.1.1
96− , postgresql-libpq >=0.9.4.2 && <0.10
97− , scientific >=0.3.6.2 && <0.4
98− , uuid-types >=1.0.3 && <1.1
99− , vector >=0.12.0.1 && <0.13
100−
101− if !impl(ghc >=8.0)
102− build-depends:
103− fail >=4.9.0.0 && <4.10
104− , semigroups >=0.18.5 && <0.20
105−
106− if !impl(ghc >=7.6)
107− 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
10899
109100 default-extensions:
110101 BangPatterns
@@ -117,24 +108,16 @@ library
117108
118109source-repository head
119110 type: git
120− location: http://github.com/phadej/postgresql-simple
121−
122−source-repository this
123− type: git
124− location: http://github.com/phadej/postgresql-simple
125− tag: v0.6
111+ location: http://github.com/haskellari/postgresql-simple
126112
127113test-suite inspection
128− if !impl(ghc >=8.0)
129− buildable: False
130−
131114 default-language: Haskell2010
132115 type: exitcode-stdio-1.0
133116 hs-source-dirs: test
134117 main-is: Inspection.hs
135118 build-depends:
136119 base
137− , inspection-testing >=0.4.1.1 && <0.5
120+ , inspection-testing >=0.4.1.1 && <0.6
138121 , postgresql-libpq
139122 , postgresql-simple
140123 , tasty
@@ -147,6 +130,8 @@ test-suite test
147130 main-is: Main.hs
148131 other-modules:
149132 Common
133+ Exception
134+ Interval
150135 Notify
151136 Serializable
152137 Time
@@ -176,12 +161,9 @@ test-suite test
176161 , tasty-golden
177162 , tasty-hunit
178163 , text
179− , time
164+ , time-compat
180165 , vector
181166
182− if !impl(ghc >=7.6)
183− build-depends: ghc-prim
184−
185167benchmark select
186168 default-language: Haskell2010
187169 type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs+3−1
@@ -64,6 +64,7 @@ module Database.PostgreSQL.Simple
6464 , Only(..)
6565 , (:.)(..)
6666 -- ** Exceptions
67+ , SomePostgreSqlException(..)
6768 , SqlError(..)
6869 , PQ.ExecStatus(..)
6970 , FormatError(..)
@@ -73,6 +74,7 @@ module Database.PostgreSQL.Simple
7374 , Base.connectPostgreSQL
7475 , Base.close
7576 , Base.connect
77+ , Base.withConnect
7678 , Base.ConnectInfo(..)
7779 , Base.defaultConnectInfo
7880 , Base.postgreSQLConnectionString
@@ -900,7 +902,7 @@ forEachWith_ parser conn template = foldWith_ parser conn template () . const
900902-- all values of the given PostgreSQL type is considered \"compatible\".
901903-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@
902904-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately
903−-- represent a @SMALLINT@, so it is considered compatble with those types.
905+-- represent a @SMALLINT@, so it is considered compatible with those types.
904906--
905907-- * A numeric compatibility check is based only on the type of a
906908-- column, /not/ on its values. For instance, a PostgreSQL 64-bit
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+26−5
@@ -32,6 +32,7 @@ module Database.PostgreSQL.Simple.Copy
3232 ( copy
3333 , copy_
3434 , CopyOutResult(..)
35+ , foldCopyData
3536 , getCopyData
3637 , putCopyData
3738 , putCopyEnd
@@ -54,7 +55,7 @@ import Database.PostgreSQL.Simple.Internal hiding (result, row)
5455-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former
5556-- case, the connection's state will change to @CopyIn@; in the latter,
5657-- @CopyOut@. The connection must be in the ready state in order
57−-- to call this function. Performs parameter subsitution.
58+-- to call this function. Performs parameter substitution.
5859
5960copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()
6061copy conn template qs = do
@@ -85,12 +86,8 @@ doCopy funcName conn template q = do
8586 PQ.TuplesOk -> err
8687 PQ.CopyOut -> return ()
8788 PQ.CopyIn -> return ()
88−#if MIN_VERSION_postgresql_libpq(0,9,3)
8989 PQ.CopyBoth -> errMsg "COPY BOTH is not supported"
90−#endif
91−#if MIN_VERSION_postgresql_libpq(0,9,2)
9290 PQ.SingleTuple -> errMsg "single-row mode is not supported"
93−#endif
9491 PQ.BadResponse -> throwResultError funcName result status
9592 PQ.NonfatalError -> throwResultError funcName result status
9693 PQ.FatalError -> throwResultError funcName result status
@@ -104,6 +101,30 @@ data CopyOutResult
104101 deriving (Eq, Typeable, Show)
105102
106103
104+-- | Fold over @COPY TO STDOUT@ query passing each copied row to an accumulator
105+-- and calling a post-process at the end. A connection must be in the
106+-- @CopyOut@ state in order to call this function.
107+--
108+-- __Example__
109+--
110+-- > (acc, count) <- foldCopyData conn
111+-- > (\acc row -> return (row:acc))
112+-- > (\acc count -> return (acc, count))
113+-- > []
114+
115+foldCopyData
116+ :: Connection -- ^ Database connection
117+ -> (a -> B.ByteString -> IO a) -- ^ Accumulate one row of the result
118+ -> (a -> Int64 -> IO b) -- ^ Post-process accumulator with a count of rows
119+ -> a -- ^ Initial accumulator
120+ -> IO b -- ^ Result
121+foldCopyData conn f g !acc = do
122+ result <- getCopyData conn
123+ case result of
124+ CopyOutRow row -> f acc row >>= foldCopyData conn f g
125+ CopyOutDone count -> g acc count
126+
127+
107128-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
108129-- must be in the @CopyOut@ state in order to call this function. If this
109130-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,
src/Database/PostgreSQL/Simple/Errors.hs+4−3
@@ -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,11 +59,13 @@ 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
67−-- succeedes only if able to parse sqlErrorMsg.
68+-- succeeds only if able to parse sqlErrorMsg.
6869--
6970-- > createUser = handleJust constraintViolation handler $ execute conn ...
7071-- > where
src/Database/PostgreSQL/Simple/FromField.hs+17−6
@@ -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
@@ -129,7 +127,7 @@ import Data.Functor.Identity (Identity(Identity))
129127import Data.Int (Int16, Int32, Int64)
130128import Data.IORef (IORef, newIORef)
131129import Data.Ratio (Ratio)
132−import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )
130+import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )
133131import Data.Typeable (Typeable, typeOf)
134132import Data.Vector (Vector)
135133import Data.Vector.Mutable (IOVector)
@@ -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
@@ -487,6 +489,15 @@ instance FromField LocalTimestamp where
487489instance FromField Date where
488490 fromField = ff TI.dateOid "Date" parseDate
489491
492+-- | interval. Requires you to configure intervalstyle as @iso_8601@.
493+--
494+-- You can configure intervalstyle on every connection with a @SET@ command,
495+-- but for better performance you may want to configure it permanently in the
496+-- file found with @SHOW config_file;@ .
497+--
498+instance FromField CalendarDiffTime where
499+ fromField = ff TI.intervalOid "CalendarDiffTime" parseCalendarDiffTime
500+
490501ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
491502 -> Field -> Maybe B8.ByteString -> Conversion a
492503ff compatOid hsType parseBS f mstr =
@@ -565,7 +576,7 @@ instance FromField UUID where
565576-- | json, jsonb
566577instance FromField JSON.Value where
567578 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
568− where parseBS bs = case parseOnly (JSON.value' <* endOfInput) bs of
579+ where parseBS bs = case JSON.eitherDecodeStrict' bs of
569580 Left err -> returnError ConversionFailed f err
570581 Right val -> pure val
571582
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+37−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
@@ -155,6 +182,12 @@ defaultConnectInfo = ConnectInfo {
155182connect :: ConnectInfo -> IO Connection
156183connect = connectPostgreSQL . postgreSQLConnectionString
157184
185+-- | Memory bracket around 'connect' and 'close'.
186+--
187+-- @since 0.6.5
188+withConnect :: ConnectInfo -> (Connection -> IO c) -> IO c
189+withConnect connInfo = bracket (connect connInfo) close
190+
158191-- | Attempt to make a connection based on a libpq connection string.
159192-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
160193-- for more information. Also note that environment variables also affect
@@ -484,9 +517,6 @@ instance Alternative Conversion where
484517 Errors _ -> (oka <|>) <$> runConversion mb conn
485518
486519instance Monad Conversion where
487−#if !(MIN_VERSION_base(4,8,0))
488− return = pure
489−#endif
490520 m >>= f = Conversion $ \conn -> do
491521 oka <- runConversion m conn
492522 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/Range.hs+1−1
@@ -38,7 +38,7 @@ import Data.Monoid (mempty)
3838import Data.Scientific (Scientific)
3939import qualified Data.Text.Lazy.Builder as LT
4040import qualified Data.Text.Lazy.Encoding as LT
41−import Data.Time (Day, LocalTime,
41+import Data.Time.Compat (Day, LocalTime,
4242 NominalDiffTime,
4343 TimeOfDay, UTCTime,
4444 ZonedTime,
src/Database/PostgreSQL/Simple/Time.hs+2
@@ -227,6 +227,7 @@ module Database.PostgreSQL.Simple.Time
227227 , parseUTCTimestamp
228228 , parseZonedTimestamp
229229 , parseLocalTimestamp
230+ , parseCalendarDiffTime
230231 , dayToBuilder
231232 , utcTimeToBuilder
232233 , zonedTimeToBuilder
@@ -239,6 +240,7 @@ module Database.PostgreSQL.Simple.Time
239240 , localTimestampToBuilder
240241 , unboundedToBuilder
241242 , nominalDiffTimeToBuilder
243+ , calendarDiffTimeToBuilder
242244 ) where
243245
244246import Database.PostgreSQL.Simple.Time.Implementation
src/Database/PostgreSQL/Simple/Time/Implementation.hs+11−1
@@ -18,7 +18,8 @@ import Data.ByteString.Builder.Prim(primBounded)
1818import Control.Arrow((***))
1919import Control.Applicative
2020import qualified Data.ByteString as B
21−import Data.Time hiding (getTimeZone, getZonedTime)
21+import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)
22+import Data.Time.LocalTime.Compat (CalendarDiffTime)
2223import Data.Typeable
2324import Data.Maybe (fromMaybe)
2425import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -77,6 +78,9 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)
7778parseDate :: B.ByteString -> Either String Date
7879parseDate = A.parseOnly (getDate <* A.endOfInput)
7980
81+parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime
82+parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)
83+
8084getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
8185getUnbounded getFinite
8286 = (pure NegInfinity <* A.string "-infinity")
@@ -125,6 +129,9 @@ getUTCTime = TP.utcTime
125129getUTCTimestamp :: A.Parser UTCTimestamp
126130getUTCTimestamp = getUnbounded getUTCTime
127131
132+getCalendarDiffTime :: A.Parser CalendarDiffTime
133+getCalendarDiffTime = TP.calendarDiffTime
134+
128135dayToBuilder :: Day -> Builder
129136dayToBuilder = primBounded TPP.day
130137
@@ -164,3 +171,6 @@ dateToBuilder = unboundedToBuilder dayToBuilder
164171
165172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
166173nominalDiffTimeToBuilder = TPP.nominalDiffTime
174+
175+calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder
176+calendarDiffTimeToBuilder = TPP.calendarDiffTime
src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+12−3
@@ -21,20 +21,24 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser
2121 , localToUTCTimeOfDayHMS
2222 , utcTime
2323 , zonedTime
24+ , calendarDiffTime
2425 ) where
2526
2627import Control.Applicative ((<$>), (<*>), (<*), (*>))
2728import Database.PostgreSQL.Simple.Compat (toPico)
2829import Data.Attoparsec.ByteString.Char8 as A
2930import Data.Bits ((.&.))
31+import Data.ByteString (ByteString)
3032import Data.Char (ord)
3133import Data.Fixed (Pico)
3234import Data.Int (Int64)
3335import Data.Maybe (fromMaybe)
34−import Data.Time.Calendar (Day, fromGregorianValid, addDays)
35−import Data.Time.Clock (UTCTime(..))
36+import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)
37+import Data.Time.Clock.Compat (UTCTime(..))
38+import Data.Time.Format.ISO8601.Compat (iso8601ParseM)
39+import Data.Time.LocalTime.Compat (CalendarDiffTime)
3640import qualified Data.ByteString.Char8 as B8
37−import qualified Data.Time.LocalTime as Local
41+import qualified Data.Time.LocalTime.Compat as Local
3842
3943-- | Parse a date of the form @YYYY-MM-DD@.
4044day :: Parser Day
@@ -193,3 +197,8 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
193197
194198utc :: Local.TimeZone
195199utc = Local.TimeZone 0 False ""
200+
201+calendarDiffTime :: Parser CalendarDiffTime
202+calendarDiffTime = do
203+ contents <- takeByteString
204+ iso8601ParseM $ B8.unpack contents
src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+14−2
@@ -17,19 +17,23 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer
1717 , localTime
1818 , zonedTime
1919 , nominalDiffTime
20+ , calendarDiffTime
2021 ) where
2122
2223import Control.Arrow ((>>>))
23−import Data.ByteString.Builder (Builder, integerDec)
24+import Data.ByteString.Builder (Builder, byteString, integerDec)
2425import Data.ByteString.Builder.Prim
2526 ( liftFixedToBounded, (>$<), (>*<)
2627 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
2728import Data.Char ( chr )
2829import Data.Int ( Int32, Int64 )
29−import Data.Time
30+import Data.String (fromString)
31+import Data.Time.Compat
3032 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
3133 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
3234 , TimeZone, timeZoneMinutes )
35+import Data.Time.Format.ISO8601.Compat (iso8601Show)
36+import Data.Time.LocalTime.Compat (CalendarDiffTime)
3337import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
3438import Unsafe.Coerce (unsafeCoerce)
3539
@@ -121,3 +125,11 @@ nominalDiffTime :: NominalDiffTime -> Builder
121125nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
122126 where
123127 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000
128+
129+calendarDiffTime :: CalendarDiffTime -> Builder
130+calendarDiffTime = byteString
131+ . fromString
132+ -- from the docs: "Beware: fromString truncates multi-byte characters to octets".
133+ -- However, I think this is a safe usage, because ISO8601-encoding seems restricted
134+ -- to ASCII output.
135+ . iso8601Show
src/Database/PostgreSQL/Simple/ToField.hs+8−8
@@ -36,7 +36,8 @@ import Data.Functor.Identity (Identity(Identity))
3636import Data.Int (Int8, Int16, Int32, Int64)
3737import Data.List (intersperse)
3838import Data.Monoid (mappend)
39−import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
39+import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
40+import Data.Time.LocalTime.Compat (CalendarDiffTime)
4041import Data.Typeable (Typeable)
4142import Data.Word (Word, Word8, Word16, Word32, Word64)
4243import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
@@ -58,11 +59,7 @@ import qualified Data.Vector as V
5859import qualified Database.PostgreSQL.LibPQ as PQ
5960import Database.PostgreSQL.Simple.Time
6061import Data.Scientific (Scientific)
61−#if MIN_VERSION_scientific(0,3,0)
6262import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
63−#else
64−import Data.Scientific (scientificBuilder)
65−#endif
6663import Foreign.C.Types (CUInt(..))
6764
6865-- | How to render an element when substituting it into a query.
@@ -293,6 +290,10 @@ instance ToField NominalDiffTime where
293290 toField = Plain . inQuotes . nominalDiffTimeToBuilder
294291 {-# INLINE toField #-}
295292
293+instance ToField CalendarDiffTime where
294+ toField = Plain . inQuotes . calendarDiffTimeToBuilder
295+ {-# INLINE toField #-}
296+
296297instance (ToField a) => ToField (PGArray a) where
297298 toField pgArray =
298299 case fromPGArray pgArray of
@@ -313,14 +314,13 @@ instance ToField UUID where
313314instance ToField JSON.Value where
314315 toField = toField . JSON.encode
315316
316−-- | Convert a Haskell value to a JSON 'JSON.Value' using
317−-- 'JSON.toJSON' and convert that to a field using 'toField'.
317+-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.
318318--
319319-- This can be used as the default implementation for the 'toField'
320320-- method for Haskell types that have a JSON representation in
321321-- PostgreSQL.
322322toJSONField :: JSON.ToJSON a => a -> Action
323−toJSONField = toField . JSON.toJSON
323+toJSONField = toField . JSON.encode
324324
325325-- | Surround a string with single-quote characters: \"@'@\"
326326--
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/Interval.hsnew file+176
@@ -0,0 +1,176 @@
1+{-# LANGUAGE QuasiQuotes #-}
2+
3+{-
4+
5+Testing strategies:
6+
7+fromString . toString == id ** Todo?
8+
9+toString . fromString == almost id ** Todo?
10+
11+postgresql -> haskell -> postgresql * Done
12+
13+haskell -> postgresql -> haskell ** Todo?
14+
15+But still, what we really want to establish is that the two values
16+correspond; for example, a conversion that consistently added hour
17+when printed to a string and subtracted an hour when parsed from string
18+would still pass these tests.
19+
20+
21+Right now, we are checking that 1400+ timestamps in the range of 1860 to
22+2060 round trip from postgresql to haskell and back in 5 different timezones.
23+In addition to UTC, the four timezones were selected so that 2 have a positive
24+offset, and 2 have a negative offset, and that 2 have an offset of a
25+whole number of hours, while the other two do not.
26+
27+It may be worth adding a few more timezones to ensure better test coverage.
28+
29+We are checking a handful of selected timestamps to ensure we hit
30+various corner-cases in the code, in addition to 1400 timestamps randomly
31+generated with granularity of seconds down to microseconds in powers of ten.
32+
33+-}
34+
35+module Interval (testInterval) where
36+
37+import Common
38+import Control.Monad(forM_, replicateM_)
39+import Data.Time.Compat
40+import Data.Time.LocalTime.Compat (CalendarDiffTime(..))
41+import Data.ByteString(ByteString)
42+import Database.PostgreSQL.Simple.SqlQQ
43+
44+data IntervalTestCase = IntervalTestCase
45+ { label :: String
46+ , inputMonths :: Integer
47+ , inputSeconds :: NominalDiffTime
48+ , asText :: String
49+ }
50+ deriving (Eq, Show)
51+
52+testInterval :: TestEnv -> Assertion
53+testInterval env@TestEnv{..} = do
54+
55+ initializeTable env
56+
57+ let milliseconds = 0.001
58+ seconds = 1
59+ minutes = 60 * seconds
60+ hours = 60 * minutes
61+ days = 24 * hours
62+ weeks = 7 * days
63+ months = 1
64+ years = 12 * months
65+
66+ mapM (checkRoundTrip env)
67+ [ IntervalTestCase
68+ { label = "zero"
69+ , inputMonths = 0
70+ , inputSeconds = 0
71+ , asText = "PT0"
72+ }
73+ , IntervalTestCase
74+ { label = "1 year"
75+ , inputMonths = 1 * years
76+ , inputSeconds = 0
77+ , asText = "P1Y"
78+ }
79+ , IntervalTestCase
80+ { label = "2 months"
81+ , inputMonths = 2 * months
82+ , inputSeconds = 0
83+ , asText = "P2M"
84+ }
85+ , IntervalTestCase
86+ { label = "3 weeks"
87+ , inputMonths = 0
88+ , inputSeconds = 3 * weeks
89+ , asText = "P3W"
90+ }
91+ , IntervalTestCase
92+ { label = "4 days"
93+ , inputMonths = 0
94+ , inputSeconds = 4 * days
95+ , asText = "P4D"
96+ }
97+ , IntervalTestCase
98+ { label = "5 hours"
99+ , inputMonths = 0
100+ , inputSeconds = 5 * hours
101+ , asText = "PT5H"
102+ }
103+ , IntervalTestCase
104+ { label = "6 minutes"
105+ , inputMonths = 0
106+ , inputSeconds = 6 * minutes
107+ , asText = "PT6M"
108+ }
109+ , IntervalTestCase
110+ { label = "7 seconds"
111+ , inputMonths = 0
112+ , inputSeconds = 7 * seconds
113+ , asText = "PT7S"
114+ }
115+ , IntervalTestCase
116+ { label = "8 milliseconds"
117+ , inputMonths = 0
118+ , inputSeconds = 8 * milliseconds
119+ , asText = "PT0.008S"
120+ }
121+ , IntervalTestCase
122+ { label = "combination of intervals (day-size or bigger)"
123+ , inputMonths = 2 * years + 4 * months
124+ , inputSeconds = 3 * weeks + 5 * days
125+ , asText = "P2Y4M3W5D"
126+ }
127+ , IntervalTestCase
128+ { label = "combination of intervals (smaller than day-size)"
129+ , inputMonths = 0
130+ , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds
131+ , asText = "PT18H56M23.563S"
132+ }
133+ , IntervalTestCase
134+ { label = "full combination of intervals"
135+ , inputMonths = 2 * years + 4 * months
136+ , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds
137+ , asText = "P2Y4M3W5DT18H56M23.563S"
138+ }
139+ ]
140+
141+ return ()
142+
143+initializeTable :: TestEnv -> IO ()
144+initializeTable TestEnv{..} = withTransaction conn $ do
145+ execute_ conn
146+ [sql| CREATE TEMPORARY TABLE testinterval
147+ ( id serial, sample interval, PRIMARY KEY(id) ) |]
148+
149+ return ()
150+
151+checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()
152+checkRoundTrip TestEnv{..} IntervalTestCase{..} = do
153+
154+ let input = CalendarDiffTime
155+ { ctMonths = inputMonths
156+ , ctTime = inputSeconds
157+ }
158+
159+ [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|
160+ INSERT INTO testinterval (sample)
161+ VALUES (?)
162+ RETURNING id, sample
163+ |] (Only input)
164+
165+ assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $
166+ output == input
167+
168+ [(Only isExpectedIso)] <- query conn [sql|
169+ SELECT sample = (?)::interval
170+ FROM testinterval
171+ WHERE id = ?
172+ |] (asText, returnedId)
173+
174+ assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")
175+ isExpectedIso
176+
test/Main.hs+40−8
@@ -24,6 +24,7 @@ import Control.Applicative
2424import Control.Exception as E
2525import Control.Monad
2626import Data.Char
27+import Data.Foldable (toList)
2728import Data.List (concat, sort)
2829import Data.IORef
2930import Data.Monoid ((<>))
@@ -45,7 +46,7 @@ import qualified Data.Text.Encoding as T
4546import qualified Data.Vector as V
4647import System.FilePath
4748import System.Timeout(timeout)
48−import Data.Time(getCurrentTime, diffUTCTime)
49+import Data.Time.Compat (getCurrentTime, diffUTCTime)
4950import System.Environment (getEnvironment)
5051
5152import Test.Tasty
@@ -53,6 +54,8 @@ import Test.Tasty.Golden
5354import Notify
5455import Serializable
5556import Time
57+import Interval
58+import Exception (testExceptions)
5659
5760tests :: TestEnv -> TestTree
5861tests env = testGroup "tests"
@@ -63,6 +66,7 @@ tests env = testGroup "tests"
6366 , testCase "Notify" . testNotify
6467 , testCase "Serializable" . testSerializable
6568 , testCase "Time" . testTime
69+ , testCase "Interval" . testInterval
6670 , testCase "Array" . testArray
6771 , testCase "Array of nullables" . testNullableArray
6872 , testCase "HStore" . testHStore
@@ -81,6 +85,7 @@ tests env = testGroup "tests"
8185 , testCase "2-ary generic" . testGeneric2
8286 , testCase "3-ary generic" . testGeneric3
8387 , testCase "Timeout" . testTimeout
88+ , testCase "Exceptions" . testExceptions
8489 ]
8590
8691testBytea :: TestEnv -> TestTree
@@ -134,7 +139,7 @@ testFold TestEnv{..} = do
134139 xs <- readIORef ref
135140 writeIORef ref $! (a,b):xs
136141 xs <- readIORef ref
137− reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
142+ reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]
138143
139144 -- Make sure fold propagates our exception.
140145 ref <- newIORef []
@@ -442,6 +447,14 @@ testCopy TestEnv{..} = do
442447 -- so that we can issue more queries:
443448 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
444449 x @?= 4
450+ -- foldCopyData
451+ copy_ conn "COPY copy_test TO STDOUT (FORMAT CSV)"
452+ (acc, count) <- foldCopyData conn
453+ (\acc row -> return (row:acc))
454+ (\acc count -> return (acc, count))
455+ []
456+ sort acc @?= sort copyRows
457+ count @?= 2
445458 where
446459 copyRows = ["1,foo\n"
447460 ,"2,bar\n"]
@@ -461,12 +474,13 @@ testCopyFailures env = testGroup "Copy failures"
461474
462475goldenTest :: TestName -> IO BL.ByteString -> TestTree
463476goldenTest testName =
464− goldenVsString testName (resultsDir </> fileName<.>"expected")
477+ goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")
465478 where
466479 resultsDir = "test" </> "results"
467480 fileName = map normalize testName
468481 normalize c | not (isAlpha c) = '-'
469482 | otherwise = c
483+ diff ref new = ["diff", "-u", ref, new]
470484
471485-- | Test that we provide a sensible error message on failure
472486testCopyUniqueConstraintError :: TestEnv -> TestTree
@@ -595,7 +609,11 @@ isFormatError i FormatError{..}
595609-- that 'testConnect' connects to the same database every time it is called.
596610withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a
597611withTestEnv connstr cb =
598− withConn $ \conn ->
612+ withConn $ \conn -> do
613+ -- currently required for interval to work.
614+ -- we also test that this doesn't interfere with anything else
615+ execute_ conn "SET intervalstyle TO 'iso_8601'"
616+
599617 cb TestEnv
600618 { conn = conn
601619 , withConn = withConn
@@ -604,13 +622,27 @@ withTestEnv connstr cb =
604622 withConn = bracket (connectPostgreSQL connstr) close
605623
606624main :: IO ()
607−main = do
625+main = withConnstring $ \connstring -> do
626+ withTestEnv connstring (defaultMain . tests)
627+
628+withConnstring :: (BS8.ByteString -> IO ()) -> IO ()
629+withConnstring kont = do
608630 env <- getEnvironment
609631 case lookup "DATABASE_CONNSTRING" env of
610− Nothing -> putStrLn "Set DATABASE_CONNSTRING environment variable"
611− Just s -> withTestEnv (BS8.pack (special s)) (defaultMain . tests)
612− where
632+ Just s -> kont (BS8.pack (special s))
633+ Nothing -> case lookup "GITHUB_ACTIONS" env of
634+ Just "true" -> kont (BS8.pack gha)
635+ _ -> putStrLn "Set DATABASE_CONNSTRING environment variable"
636+ where
613637 -- https://www.appveyor.com/docs/services-databases/
614638 special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"
615639 special "travis" = ""
616640 special s = s
641+
642+ gha = unwords
643+ [ "dbname='postgres'"
644+ , "user='postgres'"
645+ , "password='postgres'"
646+ , "host='postgres'"
647+ , "port=5432"
648+ ]
test/Time.hs+1−1
@@ -36,7 +36,7 @@ module Time (testTime) where
3636
3737import Common
3838import Control.Monad(forM_, replicateM_)
39−import Data.Time
39+import Data.Time.Compat
4040import Data.ByteString(ByteString)
4141import Database.PostgreSQL.Simple.SqlQQ
4242
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)