git.iko.soy/typeable/postgresql-simple
on 16bbb6b help sign in
3ac2949
swap
0 ahead, 83 behind
33 files changed+394−1009
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml−256 .github/workflows/simple.yml−58 .travis.yml+161 CHANGES.md+4−54 CONTRIBUTING.md+1−1 README.md+3 cabal.project−2 cabal.project.local.win−4 postgresql-simple.cabal+58−41 src/Database/PostgreSQL/Simple.hs+1−3 src/Database/PostgreSQL/Simple/Compat.hs+53 src/Database/PostgreSQL/Simple/Copy.hs+5−26 src/Database/PostgreSQL/Simple/Errors.hs+3−4 src/Database/PostgreSQL/Simple/FromField.hs+21−56 src/Database/PostgreSQL/Simple/HStore/Implementation.hs+6 src/Database/PostgreSQL/Simple/Internal.hs+7−37 src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+4 src/Database/PostgreSQL/Simple/Newtypes.hs−49 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+1−11 src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+3−12 src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+2−14 src/Database/PostgreSQL/Simple/ToField.hs+8−19 src/Database/PostgreSQL/Simple/Transaction.hs+12−16 src/Database/PostgreSQL/Simple/Types.hs+7 test/Exception.hs−70 test/Interval.hs−176 test/Main.hs+10−95 test/Time.hs+1−1 test/results/malformed-input.expected+1−1
.github/workflows/haskell-ci.ymldeleted−256
@@ -1,256 +0,0 @@
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.ymldeleted−58
@@ -1,58 +0,0 @@
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.ymlnew file+161
@@ -0,0 +1,161 @@
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+# For more information, see https://github.com/haskell-CI/haskell-ci
6+#
7+# version: 0.9.20200326
8+#
9+version: ~> 1.0
10+language: c
11+os: linux
12+dist: xenial
13+git:
14+ # whether to recursively clone submodules
15+ submodules: false
16+branches:
17+ only:
18+ - master
19+services:
20+ - postgresql
21+addons:
22+ postgresql: "10"
23+cache:
24+ directories:
25+ - $HOME/.cabal/packages
26+ - $HOME/.cabal/store
27+ - $HOME/.hlint
28+before_cache:
29+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
30+ # remove files that are regenerated by 'cabal update'
31+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
32+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
33+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
34+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
35+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
36+ - rm -rfv $CABALHOME/packages/head.hackage
37+jobs:
38+ include:
39+ - compiler: ghc-8.8.1
40+ 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.1","cabal-install-3.0"]}}
41+ os: linux
42+ - compiler: ghc-8.6.5
43+ 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.0"]}}
44+ os: linux
45+ - compiler: ghc-8.4.4
46+ 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.0"]}}
47+ os: linux
48+ - compiler: ghc-8.2.2
49+ 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.0"]}}
50+ os: linux
51+ - compiler: ghc-8.0.2
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.0.2","cabal-install-3.0"]}}
53+ os: linux
54+ - compiler: ghc-7.10.3
55+ 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.0"]}}
56+ os: linux
57+ - compiler: ghc-7.8.4
58+ 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.0"]}}
59+ os: linux
60+ - compiler: ghc-7.6.3
61+ 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.0"]}}
62+ os: linux
63+before_install:
64+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
65+ - WITHCOMPILER="-w $HC"
66+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
67+ - HCPKG="$HC-pkg"
68+ - unset CC
69+ - CABAL=/opt/ghc/bin/cabal
70+ - CABALHOME=$HOME/.cabal
71+ - export PATH="$CABALHOME/bin:$PATH"
72+ - TOP=$(pwd)
73+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
74+ - echo $HCNUMVER
75+ - CABAL="$CABAL -vnormal+nowrap"
76+ - set -o pipefail
77+ - TEST=--enable-tests
78+ - BENCH=--enable-benchmarks
79+ - HEADHACKAGE=false
80+ - rm -f $CABALHOME/config
81+ - |
82+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
83+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
84+ echo "write-ghc-environment-files: always" >> $CABALHOME/config
85+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
86+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
87+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
88+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
89+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
90+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
91+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
92+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
93+ echo "install-dirs user" >> $CABALHOME/config
94+ echo " prefix: $CABALHOME" >> $CABALHOME/config
95+ echo "repository hackage.haskell.org" >> $CABALHOME/config
96+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
97+install:
98+ - ${CABAL} --version
99+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
100+ - |
101+ echo "program-default-options" >> $CABALHOME/config
102+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
103+ - cat $CABALHOME/config
104+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
105+ - travis_retry ${CABAL} v2-update -v
106+ # Generate cabal.project
107+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
108+ - touch cabal.project
109+ - |
110+ echo "packages: ." >> cabal.project
111+ - if [ $HCNUMVER -ge 80000 ] ; then echo 'package postgresql-simple' >> cabal.project ; fi
112+ - "if [ $HCNUMVER -ge 80000 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
113+ - |
114+ - "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"
115+ - cat cabal.project || true
116+ - cat cabal.project.local || true
117+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
118+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
119+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
120+ - rm cabal.project.freeze
121+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
122+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
123+script:
124+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
125+ # Packaging...
126+ - ${CABAL} v2-sdist all
127+ # Unpacking...
128+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
129+ - cd ${DISTDIR} || false
130+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
131+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
132+ - PKGDIR_postgresql_simple="$(find . -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"
133+ # Generate cabal.project
134+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
135+ - touch cabal.project
136+ - |
137+ echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
138+ - if [ $HCNUMVER -ge 80000 ] ; then echo 'package postgresql-simple' >> cabal.project ; fi
139+ - "if [ $HCNUMVER -ge 80000 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
140+ - |
141+ - "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"
142+ - cat cabal.project || true
143+ - cat cabal.project.local || true
144+ # Building...
145+ # this builds all libraries and executables (without tests/benchmarks)
146+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
147+ # Building with tests and benchmarks...
148+ # build & run tests, build benchmarks
149+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
150+ # Testing...
151+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
152+ # cabal check...
153+ - (cd ${PKGDIR_postgresql_simple} && ${CABAL} -vnormal check)
154+ # haddock...
155+ - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
156+ # Building without installed constraints for packages in global-db...
157+ - rm -f cabal.project.local
158+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
159+
160+# REGENDATA ("0.9.20200326",["--config","cabal.haskell-ci","--output",".travis.yml","postgresql-simple.cabal"])
161+# EOF
CHANGES.md+4−54
@@ -1,53 +1,3 @@
1−### Version 0.7.0.0 (2023-07-31)
2−
3− * Remove Eq Null instance. (Future `base` may break it, we remove it profilacticly).
4− * Use `postgresql-libpq >=0.10.0.0`. It includes critical fixes,
5− by using `postgresql-simple >=0.7` you won't get older `postgresql-libpq`.
6− * Drop support for GHC prior 8.6
7− * Added a class for `postgresql-simple` exceptions: `SomePostgreSqlException`.
8− This allows to catch all `postgresql-simple` exceptions at once.
9− (c.f. `AsyncException` in `base).
10−
11−### Version 0.6.5.1 (2023-07-09)
12−
13− * Support `aeson-2.2.0.0`
14−
15−### Version 0.6.5 (2022-10-30)
16−
17− * Add `withConnect`
18−
19−### Version 0.6.4 (2021-01-06)
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−
29−### Version 0.6.3 (2020-11-15)
30−
31− * Add `fromFieldJSONByteString`
32− Thanks to tomjaguarpaw for the implementation
33− https://github.com/haskellari/postgresql-simple/pull/47
34− * Add `attoFieldParser`
35− Thanks to Victor Nawothnig for the implementation
36− https://github.com/haskellari/postgresql-simple/pull/45
37− * Add `Identity` and `Const` instance
38− Thanks to Cary Robbins for the implementation
39− https://github.com/haskellari/postgresql-simple/pull/46
40− * Add `withTransactionModeRetry'`, a variant of `withTransactionModeRetry`
41− for all exception types.
42− Thanks to Elliot Cameron for the implementation
43− https://github.com/haskellari/postgresql-simple/pull/42
44− * Fix spurious aborts when retrying transactions
45− Thanks to Elliot Cameron for the implementation
46− https://github.com/haskellari/postgresql-simple/pull/34
47− * Add `Database.PostgreSQL.Simple.Newtypes` module
48− with `Aeson` newtype.
49− https://github.com/haskellari/postgresql-simple/pull/55
50−
511### Version 0.6.2 (2019-04-26)
522
533 * Define `MonadFail Ok`.
@@ -271,7 +221,7 @@
271221 support UTF8 except for Mule Internal Code, the Multilingual
272222 Extensions for Emacs. An exception should be raised upon
273223 connecting to a database by the backend if the backend cannot
274− accommodate this requirement.
224+ accomodate this requirement.
275225
276226 * Added `Eq` and `Typeable` instances for `Connection`.
277227
@@ -409,7 +359,7 @@
409359
410360 * Changed the Identifier and QualifiedIdentifier to use Text in
411361 order to avoid encoding errors. Technically this requires a
412− major version bump, but let's pretend 0.4.1.0 didn't happen.
362+ major verson bump, but let's pretend 0.4.1.0 didn't happen.
413363
414364 * Removed non-exhaustive cases in the ToField instance for Values,
415365 and tweaked error messages.
@@ -569,7 +519,7 @@
569519
570520 * Added a brand new TypeInfo system that gives FromField instances
571521 convenient and efficient access to the pg_type metatable. This
572− replaced the older typename cache, and was necessary to properly
522+ replaced the older typename cache, and was neccesary to properly
573523 support postgres array types. Thanks to Bas van Dijk for his
574524 work on this feature.
575525
@@ -661,7 +611,7 @@
661611 now the preferred way of dealing with `timestamp` (without time zone).
662612
663613 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
664− that accommodate PostgreSQL's infinities.
614+ that accomodate PostgreSQL's infinities.
665615
666616 * All time-related `FromField`/`ToField` instances are now based on new,
667617 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 `.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))
7+ - Regenerate `.travis.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,4 +1,7 @@
1+[![Continuous Integration status][status-png]][status]
12[![Hackage page (downloads and API reference)][hackage-png]][hackage]
23
4+ [status-png]: https://api.travis-ci.org/lpsmith/postgresql-simple.svg
5+ [status]: http://travis-ci.org/lpsmith/postgresql-simple?branch=master
36 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg
47 [hackage]: http://hackage.haskell.org/package/postgresql-simple
cabal.project−2
@@ -1,4 +1,2 @@
11packages: .
22tests: true
3−
4−allow-newer: cryptohash-md5-0.11.100.1:base
cabal.project.local.windeleted−4
@@ -1,4 +0,0 @@
1−constraints: these -assoc
2−
3−package postgresql-libpq
4− flags: -use-pkg-config
postgresql-simple.cabal+58−41
@@ -1,7 +1,7 @@
11cabal-version: 1.12
22name: postgresql-simple
3−version: 0.7.0.0
4−x-revision: 1
3+version: 0.6.2
4+x-revision: 3
55synopsis: Mid-Level PostgreSQL client library
66description:
77 Mid-Level PostgreSQL client library, forked from mysql-simple.
@@ -13,25 +13,25 @@ maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
1313copyright:
1414 (c) 2011 MailRank, Inc.
1515 (c) 2011-2018 Leon P Smith
16− (c) 2018-2020 Oleg Grenrus
16+ (c) 2018-2019 Oleg Grenrus
1717
1818category: Database
1919build-type: Simple
2020extra-source-files:
21− CHANGES.md
2221 CONTRIBUTORS
22+ CHANGES.md
2323 test/results/malformed-input.expected
2424 test/results/unique-constraint-violation.expected
2525
2626tested-with:
27− GHC ==8.6.5
28− || ==8.8.4
29− || ==8.10.7
30− || ==9.0.2
31− || ==9.2.8
32− || ==9.4.8
33− || ==9.6.3
34− || ==9.8.1
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
34+ || ==8.8.1
3535
3636library
3737 default-language: Haskell2010
@@ -41,14 +41,11 @@ library
4141 Database.PostgreSQL.Simple.Arrays
4242 Database.PostgreSQL.Simple.Copy
4343 Database.PostgreSQL.Simple.Cursor
44− Database.PostgreSQL.Simple.Errors
4544 Database.PostgreSQL.Simple.FromField
4645 Database.PostgreSQL.Simple.FromRow
46+ Database.PostgreSQL.Simple.LargeObjects
4747 Database.PostgreSQL.Simple.HStore
4848 Database.PostgreSQL.Simple.HStore.Internal
49− Database.PostgreSQL.Simple.Internal
50− Database.PostgreSQL.Simple.LargeObjects
51− Database.PostgreSQL.Simple.Newtypes
5249 Database.PostgreSQL.Simple.Notification
5350 Database.PostgreSQL.Simple.Ok
5451 Database.PostgreSQL.Simple.Range
@@ -62,9 +59,12 @@ library
6259 Database.PostgreSQL.Simple.TypeInfo.Macro
6360 Database.PostgreSQL.Simple.TypeInfo.Static
6461 Database.PostgreSQL.Simple.Types
62+ Database.PostgreSQL.Simple.Errors
6563 Database.PostgreSQL.Simple.Vector
6664 Database.PostgreSQL.Simple.Vector.Unboxed
6765
66+ Database.PostgreSQL.Simple.Internal
67+
6868 -- Other-modules:
6969 other-modules:
7070 Database.PostgreSQL.Simple.Compat
@@ -77,47 +77,64 @@ library
7777
7878 -- GHC bundled libs
7979 build-depends:
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
80+ base >=4.6.0.0 && <4.15
81+ , bytestring >=0.10.0.0 && <0.11
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.10
86+ , transformers >=0.3.0.0 && <0.6
8787
8888 -- Other dependencies
8989 build-depends:
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
90+ aeson >=1.4.1.0 && <1.5
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
99108
100109 default-extensions:
101− BangPatterns
102110 DoAndIfThenElse
103111 OverloadedStrings
104− TypeOperators
112+ BangPatterns
105113 ViewPatterns
114+ TypeOperators
106115
107116 ghc-options: -Wall -fno-warn-name-shadowing
108117
109118source-repository head
110119 type: git
111− location: http://github.com/haskellari/postgresql-simple
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
112126
113127test-suite inspection
128+ if !impl(ghc >=8.0)
129+ buildable: False
130+
114131 default-language: Haskell2010
115132 type: exitcode-stdio-1.0
116133 hs-source-dirs: test
117134 main-is: Inspection.hs
118135 build-depends:
119136 base
120− , inspection-testing >=0.4.1.1 && <0.6
137+ , inspection-testing >=0.4.1.1 && <0.5
121138 , postgresql-libpq
122139 , postgresql-simple
123140 , tasty
@@ -130,20 +147,17 @@ test-suite test
130147 main-is: Main.hs
131148 other-modules:
132149 Common
133− Exception
134− Interval
135150 Notify
136151 Serializable
137152 Time
138153
139− ghc-options: -threaded
140154 ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
141155 default-extensions:
142156 NamedFieldPuns
143157 OverloadedStrings
144− PatternGuards
145158 Rank2Types
146159 RecordWildCards
160+ PatternGuards
147161 ScopedTypeVariables
148162
149163 build-depends:
@@ -161,9 +175,12 @@ test-suite test
161175 , tasty-golden
162176 , tasty-hunit
163177 , text
164− , time-compat
178+ , time
165179 , vector
166180
181+ if !impl(ghc >=7.6)
182+ build-depends: ghc-prim
183+
167184benchmark select
168185 default-language: Haskell2010
169186 type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs+1−3
@@ -64,7 +64,6 @@ module Database.PostgreSQL.Simple
6464 , Only(..)
6565 , (:.)(..)
6666 -- ** Exceptions
67− , SomePostgreSqlException(..)
6867 , SqlError(..)
6968 , PQ.ExecStatus(..)
7069 , FormatError(..)
@@ -74,7 +73,6 @@ module Database.PostgreSQL.Simple
7473 , Base.connectPostgreSQL
7574 , Base.close
7675 , Base.connect
77− , Base.withConnect
7876 , Base.ConnectInfo(..)
7977 , Base.defaultConnectInfo
8078 , Base.postgreSQLConnectionString
@@ -902,7 +900,7 @@ forEachWith_ parser conn template = foldWith_ parser conn template () . const
902900-- all values of the given PostgreSQL type is considered \"compatible\".
903901-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@
904902-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately
905−-- represent a @SMALLINT@, so it is considered compatible with those types.
903+-- represent a @SMALLINT@, so it is considered compatble with those types.
906904--
907905-- * A numeric compatibility check is based only on the type of a
908906-- column, /not/ on its values. For instance, a PostgreSQL 64-bit
src/Database/PostgreSQL/Simple/Compat.hs+53
@@ -12,13 +12,36 @@ module Database.PostgreSQL.Simple.Compat
1212 ) where
1313
1414import qualified Control.Exception as E
15+import Data.Monoid
1516import Data.ByteString (ByteString)
17+#if MIN_VERSION_bytestring(0,10,0)
1618import Data.ByteString.Lazy (toStrict)
19+#else
20+import qualified Data.ByteString as B
21+import Data.ByteString.Lazy (toChunks)
22+#endif
1723import Data.ByteString.Builder (Builder, toLazyByteString)
24+
25+#if MIN_VERSION_scientific(0,3,0)
1826import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
27+#else
28+import Data.Scientific (scientificBuilder)
29+#endif
30+
31+#if __GLASGOW_HASKELL__ >= 702
1932import System.IO.Unsafe (unsafeDupablePerformIO)
33+#elif __GLASGOW_HASKELL__ >= 611
34+import GHC.IO (unsafeDupablePerformIO)
35+#else
36+import GHC.IOBase (unsafeDupablePerformIO)
37+#endif
38+
2039import Data.Fixed (Pico)
40+#if MIN_VERSION_base(4,7,0)
2141import Data.Fixed (Fixed(MkFixed))
42+#else
43+import Unsafe.Coerce (unsafeCoerce)
44+#endif
2245
2346-- | Like 'E.mask', but backported to base before version 4.3.0.
2447--
@@ -28,14 +51,44 @@ import Data.Fixed (Fixed(MkFixed))
2851-- 'withTransactionMode' function calls the restore callback only once, so we
2952-- don't need that polymorphism.
3053mask :: ((IO a -> IO a) -> IO b) -> IO b
54+#if MIN_VERSION_base(4,3,0)
3155mask 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
3261{-# INLINE mask #-}
3362
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+
3471toByteString :: Builder -> ByteString
72+#if MIN_VERSION_bytestring(0,10,0)
3573toByteString 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)
3679
3780toPico :: Integer -> Pico
3881toPico = MkFixed
3982
4083fromPico :: Pico -> Integer
4184fromPico (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+5−26
@@ -32,7 +32,6 @@ module Database.PostgreSQL.Simple.Copy
3232 ( copy
3333 , copy_
3434 , CopyOutResult(..)
35− , foldCopyData
3635 , getCopyData
3736 , putCopyData
3837 , putCopyEnd
@@ -55,7 +54,7 @@ import Database.PostgreSQL.Simple.Internal hiding (result, row)
5554-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former
5655-- case, the connection's state will change to @CopyIn@; in the latter,
5756-- @CopyOut@. The connection must be in the ready state in order
58−-- to call this function. Performs parameter substitution.
57+-- to call this function. Performs parameter subsitution.
5958
6059copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()
6160copy conn template qs = do
@@ -86,8 +85,12 @@ doCopy funcName conn template q = do
8685 PQ.TuplesOk -> err
8786 PQ.CopyOut -> return ()
8887 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)
9092 PQ.SingleTuple -> errMsg "single-row mode is not supported"
93+#endif
9194 PQ.BadResponse -> throwResultError funcName result status
9295 PQ.NonfatalError -> throwResultError funcName result status
9396 PQ.FatalError -> throwResultError funcName result status
@@ -101,30 +104,6 @@ data CopyOutResult
101104 deriving (Eq, Typeable, Show)
102105
103106
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−
128107-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
129108-- must be in the @CopyOut@ state in order to call this function. If this
130109-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,
src/Database/PostgreSQL/Simple/Errors.hs+3−4
@@ -25,6 +25,7 @@ module Database.PostgreSQL.Simple.Errors
2525 )
2626 where
2727
28+import Control.Applicative
2829import Control.Exception as E
2930
3031import Data.Attoparsec.ByteString.Char8
@@ -59,13 +60,11 @@ data ConstraintViolation
5960 deriving (Show, Eq, Ord, Typeable)
6061
6162-- Default instance should be enough
62−instance Exception ConstraintViolation where
63− toException = postgresqlExceptionToException
64− fromException = postgresqlExceptionFromException
63+instance Exception ConstraintViolation
6564
6665
6766-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
68−-- succeeds only if able to parse sqlErrorMsg.
67+-- succeedes only if able to parse sqlErrorMsg.
6968--
7069-- > createUser = handleJust constraintViolation handler $ execute conn ...
7170-- > where
src/Database/PostgreSQL/Simple/FromField.hs+21−56
@@ -2,7 +2,6 @@
22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
33{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
44{-# LANGUAGE RecordWildCards #-}
5−{-# LANGUAGE PolyKinds #-}
65
76{- |
87Module: Database.PostgreSQL.Simple.FromField
@@ -107,27 +106,26 @@ module Database.PostgreSQL.Simple.FromField
107106 , PQ.Oid(..)
108107 , PQ.Format(..)
109108 , pgArrayFieldParser
110− , attoFieldParser
111109
112110 , optionalField
113111 , fromJSONField
114− , fromFieldJSONByteString
115112 ) where
116113
117114#include "MachDeps.h"
118115
119−import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
116+import Control.Applicative ( (<|>), (<$>), pure, (*>), (<*) )
120117import Control.Concurrent.MVar (MVar, newMVar)
121−import Control.Exception (Exception (toException, fromException))
118+import Control.Exception (Exception)
122119import qualified Data.Aeson as JSON
120+import qualified Data.Aeson.Internal as JSON
121+import qualified Data.Aeson.Parser as JSON (value')
123122import Data.Attoparsec.ByteString.Char8 hiding (Result)
124123import Data.ByteString (ByteString)
125124import qualified Data.ByteString.Char8 as B
126−import Data.Functor.Identity (Identity(Identity))
127125import Data.Int (Int16, Int32, Int64)
128126import Data.IORef (IORef, newIORef)
129127import Data.Ratio (Ratio)
130−import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )
128+import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )
131129import Data.Typeable (Typeable, typeOf)
132130import Data.Vector (Vector)
133131import Data.Vector.Mutable (IOVector)
@@ -154,8 +152,6 @@ import qualified Data.UUID.Types as UUID
154152import Data.Scientific (Scientific)
155153import GHC.Real (infinity, notANumber)
156154
157−import qualified Data.Aeson.Types as JSON
158−
159155-- | Exception thrown if conversion from a SQL value to a Haskell
160156-- value fails.
161157data ResultError = Incompatible { errSQLType :: String
@@ -182,9 +178,7 @@ data ResultError = Incompatible { errSQLType :: String
182178 -- between metadata and actual data in a row).
183179 deriving (Eq, Show, Typeable)
184180
185−instance Exception ResultError where
186− toException = postgresqlExceptionToException
187− fromException = postgresqlExceptionFromException
181+instance Exception ResultError
188182
189183left :: Exception a => a -> Conversion b
190184left = conversionError
@@ -273,12 +267,6 @@ instance FromField () where
273267 | typeOid f /= TI.voidOid = returnError Incompatible f ""
274268 | otherwise = pure ()
275269
276−instance (FromField a) => FromField (Const a b) where
277− fromField f bs = Const <$> fromField f bs
278−
279−instance (FromField a) => FromField (Identity a) where
280− fromField f bs = Identity <$> fromField f bs
281−
282270-- | For dealing with null values. Compatible with any postgresql type
283271-- compatible with type @a@. Note that the type is not checked if
284272-- the value is null, although it is inadvisable to rely on this
@@ -325,11 +313,11 @@ instance FromField Char where
325313
326314-- | int2
327315instance FromField Int16 where
328− fromField = attoFieldParser ok16 $ signed decimal
316+ fromField = atto ok16 $ signed decimal
329317
330318-- | int2, int4
331319instance FromField Int32 where
332− fromField = attoFieldParser ok32 $ signed decimal
320+ fromField = atto ok32 $ signed decimal
333321
334322#if WORD_SIZE_IN_BITS < 64
335323-- | int2, int4, and if compiled as 64-bit code, int8 as well.
@@ -339,36 +327,36 @@ instance FromField Int32 where
339327-- This library was compiled as 64-bit code.
340328#endif
341329instance FromField Int where
342− fromField = attoFieldParser okInt $ signed decimal
330+ fromField = atto okInt $ signed decimal
343331
344332-- | int2, int4, int8
345333instance FromField Int64 where
346− fromField = attoFieldParser ok64 $ signed decimal
334+ fromField = atto ok64 $ signed decimal
347335
348336-- | int2, int4, int8
349337instance FromField Integer where
350− fromField = attoFieldParser ok64 $ signed decimal
338+ fromField = atto ok64 $ signed decimal
351339
352340-- | int2, float4 (Uses attoparsec's 'double' routine, for
353341-- better accuracy convert to 'Scientific' or 'Rational' first)
354342instance FromField Float where
355− fromField = attoFieldParser ok (realToFrac <$> pg_double)
343+ fromField = atto ok (realToFrac <$> pg_double)
356344 where ok = eq TI.float4Oid \/ eq TI.int2Oid
357345
358346-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for
359347-- better accuracy convert to 'Scientific' or 'Rational' first)
360348instance FromField Double where
361− fromField = attoFieldParser ok pg_double
349+ fromField = atto ok pg_double
362350 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid
363351
364352-- | int2, int4, int8, float4, float8, numeric
365353instance FromField (Ratio Integer) where
366− fromField = attoFieldParser ok pg_rational
354+ fromField = atto ok pg_rational
367355 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
368356
369357-- | int2, int4, int8, float4, float8, numeric
370358instance FromField Scientific where
371− fromField = attoFieldParser ok rational
359+ fromField = atto ok rational
372360 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
373361
374362unBinary :: Binary t -> t
@@ -396,7 +384,7 @@ instance FromField SB.ByteString where
396384
397385-- | oid
398386instance FromField PQ.Oid where
399− fromField f dat = PQ.Oid <$> attoFieldParser (== TI.oidOid) decimal f dat
387+ fromField f dat = PQ.Oid <$> atto (== TI.oidOid) decimal f dat
400388
401389-- | bytea, name, text, \"char\", bpchar, varchar, unknown
402390instance FromField LB.ByteString where
@@ -489,15 +477,6 @@ instance FromField LocalTimestamp where
489477instance FromField Date where
490478 fromField = ff TI.dateOid "Date" parseDate
491479
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−
501480ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
502481 -> Field -> Maybe B8.ByteString -> Conversion a
503482ff compatOid hsType parseBS f mstr =
@@ -576,13 +555,11 @@ instance FromField UUID where
576555-- | json, jsonb
577556instance FromField JSON.Value where
578557 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
579− where parseBS bs = case JSON.eitherDecodeStrict' bs of
558+ where parseBS bs = case parseOnly (JSON.value' <* endOfInput) bs of
580559 Left err -> returnError ConversionFailed f err
581560 Right val -> pure val
582561
583562-- | Return the JSON ByteString directly
584−--
585−-- @since 0.6.3
586563fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString
587564fromFieldJSONByteString f mbs =
588565 if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid
@@ -684,22 +661,10 @@ returnError mkErr f msg = do
684661 (show (typeOf (undefined :: a)))
685662 msg
686663
687−-- | Construct a field parser from an attoparsec parser. An 'Incompatible' error is thrown if the
688−-- PostgreSQL oid does not match the specified predicate.
689−--
690−-- @
691−-- instance FromField Int16 where
692−-- fromField = attoFieldParser ok16 (signed decimal)
693−-- @
694−--
695−-- @since 0.6.3
696−attoFieldParser :: forall a. (Typeable a)
697− => (PQ.Oid -> Bool)
698− -- ^ Predicate for whether the postgresql type oid is compatible with this parser
699− -> Parser a
700− -- ^ An attoparsec parser.
701− -> FieldParser a
702−attoFieldParser types p0 f dat = doFromField f types (go p0) dat
664+atto :: forall a. (Typeable a)
665+ => Compat -> Parser a -> Field -> Maybe ByteString
666+ -> Conversion a
667+atto types p0 f dat = doFromField f types (go p0) dat
703668 where
704669 go :: Parser a -> ByteString -> Conversion a
705670 go p s =
src/Database/PostgreSQL/Simple/HStore/Implementation.hs+6
@@ -22,6 +22,9 @@ 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
2528import Data.Map(Map)
2629import qualified Data.Map as Map
2730import Data.Text(Text)
@@ -66,6 +69,9 @@ instance Semigroup HStoreBuilder where
6669
6770instance Monoid HStoreBuilder where
6871 mempty = Empty
72+#if !(MIN_VERSION_base(4,11,0))
73+ mappend = (<>)
74+#endif
6975
7076class ToHStoreText a where
7177 toHStoreText :: a -> HStoreText
src/Database/PostgreSQL/Simple/Internal.hs+7−37
@@ -1,8 +1,6 @@
11{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}
22{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
33{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE ExistentialQuantification #-}
5−{-# LANGUAGE InstanceSigs #-}
64
75------------------------------------------------------------------------------
86-- |
@@ -36,6 +34,7 @@ import Data.Int (Int64)
3634import qualified Data.IntMap as IntMap
3735import Data.IORef
3836import Data.Maybe(fromMaybe)
37+import Data.Monoid
3938import Data.String
4039import qualified Data.Text as T
4140import qualified Data.Text.Encoding as TE
@@ -83,25 +82,6 @@ data Connection = Connection {
8382instance Eq Connection where
8483 x == y = connectionHandle x == connectionHandle y
8584
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−
10585data SqlError = SqlError {
10686 sqlState :: ByteString
10787 , sqlExecStatus :: ExecStatus
@@ -113,10 +93,7 @@ data SqlError = SqlError {
11393fatalError :: ByteString -> SqlError
11494fatalError msg = SqlError "" FatalError msg "" ""
11595
116−instance Exception SqlError where
117− toException = postgresqlExceptionToException
118− fromException = postgresqlExceptionFromException
119−
96+instance Exception SqlError
12097
12198-- | Exception thrown if 'query' is used to perform an @INSERT@-like
12299-- operation, or 'execute' is used to perform a @SELECT@-like operation.
@@ -125,9 +102,7 @@ data QueryError = QueryError {
125102 , qeQuery :: Query
126103 } deriving (Eq, Show, Typeable)
127104
128−instance Exception QueryError where
129− toException = postgresqlExceptionToException
130− fromException = postgresqlExceptionFromException
105+instance Exception QueryError
131106
132107-- | Exception thrown if a 'Query' could not be formatted correctly.
133108-- This may occur if the number of \'@?@\' characters in the query
@@ -138,9 +113,7 @@ data FormatError = FormatError {
138113 , fmtParams :: [ByteString]
139114 } deriving (Eq, Show, Typeable)
140115
141−instance Exception FormatError where
142− toException = postgresqlExceptionToException
143− fromException = postgresqlExceptionFromException
116+instance Exception FormatError
144117
145118data ConnectInfo = ConnectInfo {
146119 connectHost :: String
@@ -182,12 +155,6 @@ defaultConnectInfo = ConnectInfo {
182155connect :: ConnectInfo -> IO Connection
183156connect = connectPostgreSQL . postgreSQLConnectionString
184157
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−
191158-- | Attempt to make a connection based on a libpq connection string.
192159-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
193160-- for more information. Also note that environment variables also affect
@@ -517,6 +484,9 @@ instance Alternative Conversion where
517484 Errors _ -> (oka <|>) <$> runConversion mb conn
518485
519486instance Monad Conversion where
487+#if !(MIN_VERSION_base(4,8,0))
488+ return = pure
489+#endif
520490 m >>= f = Conversion $ \conn -> do
521491 oka <- runConversion m conn
522492 case oka of
src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+4
@@ -76,8 +76,12 @@ 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)
7980 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"
81+#endif
82+#if MIN_VERSION_postgresql_libpq(0,9,2)
8083 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"
84+#endif
8185 PQ.BadResponse -> throwResultError "query" result status
8286 PQ.NonfatalError -> throwResultError "query" result status
8387 PQ.FatalError -> throwResultError "query" result status
src/Database/PostgreSQL/Simple/Newtypes.hsdeleted−49
@@ -1,49 +0,0 @@
1−{-# LANGUAGE DeriveFunctor #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
3−-- | Module with newtypes suitable to usage with @DerivingVia@ or standalone.
4−--
5−-- The newtypes are named after packages they wrap.
6−module Database.PostgreSQL.Simple.Newtypes (
7− Aeson (..), getAeson,
8−) where
9−
10−import Data.Typeable (Typeable)
11−import Database.PostgreSQL.Simple.ToField (ToField (..))
12−import Database.PostgreSQL.Simple.FromField (FromField (..), fromJSONField)
13−
14−import qualified Data.Aeson as Aeson
15−
16−-------------------------------------------------------------------------------
17−-- aeson
18−-------------------------------------------------------------------------------
19−
20−-- | A newtype wrapper with 'ToField' and 'FromField' instances
21−-- based on 'Aeson.ToJSON' and 'Aeson.FromJSON' type classes from @aeson@.
22−--
23−-- Example using @DerivingVia@:
24−--
25−-- @
26−-- data Foo = Foo Int String
27−-- deriving stock (Eq, Show, Generic) -- GHC built int
28−-- deriving anyclass ('Aeson.FromJSON', 'Aeson.ToJSON') -- Derived using GHC Generics
29−-- deriving ('ToField', 'FromField') via 'Aeson' Foo -- DerivingVia
30−-- @
31−--
32−-- Example using 'Aeson' newtype directly, for more ad-hoc queries
33−--
34−-- @
35−-- execute conn "INSERT INTO tbl (fld) VALUES (?)" (Only ('Aeson' x))
36−-- @
37−--
38−-- @since 0.6.3
39−newtype Aeson a = Aeson a
40− deriving (Eq, Show, Read, Typeable, Functor)
41−
42−getAeson :: Aeson a -> a
43−getAeson (Aeson a) = a
44−
45−instance Aeson.ToJSON a => ToField (Aeson a) where
46− toField = toField . Aeson.encode . getAeson
47−
48−instance (Aeson.FromJSON a, Typeable a) => FromField (Aeson a) where
49− fromField f bs = fmap Aeson (fromJSONField f bs)
src/Database/PostgreSQL/Simple/Notification.hs+17
@@ -47,6 +47,8 @@ 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 )
5052#else
5153import GHC.Conc ( atomically )
5254import Control.Concurrent ( threadWaitReadSTM )
@@ -92,6 +94,21 @@ getNotification conn = join $ withConnection conn fetch
9294 -- with async exceptions, whereas threadDelay can.
9395 Just _fd -> do
9496 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
95112#else
96113 -- This case fixes the race condition above. By registering
97114 -- our interest in the descriptor before we drop the lock,
src/Database/PostgreSQL/Simple/Ok.hs+4
@@ -72,6 +72,10 @@ instance MonadPlus Ok where
7272 mplus = (<|>)
7373
7474instance Monad Ok where
75+#if !(MIN_VERSION_base(4,8,0))
76+ return = pure
77+#endif
78+
7579 Errors es >>= _ = Errors es
7680 Ok a >>= f = f a
7781
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.Compat (Day, LocalTime,
41+import Data.Time (Day, LocalTime,
4242 NominalDiffTime,
4343 TimeOfDay, UTCTime,
4444 ZonedTime,
src/Database/PostgreSQL/Simple/Time.hs−2
@@ -227,7 +227,6 @@ module Database.PostgreSQL.Simple.Time
227227 , parseUTCTimestamp
228228 , parseZonedTimestamp
229229 , parseLocalTimestamp
230− , parseCalendarDiffTime
231230 , dayToBuilder
232231 , utcTimeToBuilder
233232 , zonedTimeToBuilder
@@ -240,7 +239,6 @@ module Database.PostgreSQL.Simple.Time
240239 , localTimestampToBuilder
241240 , unboundedToBuilder
242241 , nominalDiffTimeToBuilder
243− , calendarDiffTimeToBuilder
244242 ) where
245243
246244import Database.PostgreSQL.Simple.Time.Implementation
src/Database/PostgreSQL/Simple/Time/Implementation.hs+1−11
@@ -18,8 +18,7 @@ import Data.ByteString.Builder.Prim(primBounded)
1818import Control.Arrow((***))
1919import Control.Applicative
2020import qualified Data.ByteString as B
21−import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)
22−import Data.Time.LocalTime.Compat (CalendarDiffTime)
21+import Data.Time hiding (getTimeZone, getZonedTime)
2322import Data.Typeable
2423import Data.Maybe (fromMaybe)
2524import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -78,9 +77,6 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)
7877parseDate :: B.ByteString -> Either String Date
7978parseDate = A.parseOnly (getDate <* A.endOfInput)
8079
81−parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime
82−parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)
83−
8480getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
8581getUnbounded getFinite
8682 = (pure NegInfinity <* A.string "-infinity")
@@ -129,9 +125,6 @@ getUTCTime = TP.utcTime
129125getUTCTimestamp :: A.Parser UTCTimestamp
130126getUTCTimestamp = getUnbounded getUTCTime
131127
132−getCalendarDiffTime :: A.Parser CalendarDiffTime
133−getCalendarDiffTime = TP.calendarDiffTime
134−
135128dayToBuilder :: Day -> Builder
136129dayToBuilder = primBounded TPP.day
137130
@@ -171,6 +164,3 @@ dateToBuilder = unboundedToBuilder dayToBuilder
171164
172165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
173166nominalDiffTimeToBuilder = TPP.nominalDiffTime
174−
175−calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder
176−calendarDiffTimeToBuilder = TPP.calendarDiffTime
src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+3−12
@@ -21,24 +21,20 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser
2121 , localToUTCTimeOfDayHMS
2222 , utcTime
2323 , zonedTime
24− , calendarDiffTime
2524 ) where
2625
2726import Control.Applicative ((<$>), (<*>), (<*), (*>))
2827import Database.PostgreSQL.Simple.Compat (toPico)
2928import Data.Attoparsec.ByteString.Char8 as A
3029import Data.Bits ((.&.))
31−import Data.ByteString (ByteString)
3230import Data.Char (ord)
3331import Data.Fixed (Pico)
3432import Data.Int (Int64)
3533import Data.Maybe (fromMaybe)
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)
34+import Data.Time.Calendar (Day, fromGregorianValid, addDays)
35+import Data.Time.Clock (UTCTime(..))
4036import qualified Data.ByteString.Char8 as B8
41−import qualified Data.Time.LocalTime.Compat as Local
37+import qualified Data.Time.LocalTime as Local
4238
4339-- | Parse a date of the form @YYYY-MM-DD@.
4440day :: Parser Day
@@ -197,8 +193,3 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
197193
198194utc :: Local.TimeZone
199195utc = 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+2−14
@@ -17,23 +17,19 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer
1717 , localTime
1818 , zonedTime
1919 , nominalDiffTime
20− , calendarDiffTime
2120 ) where
2221
2322import Control.Arrow ((>>>))
24−import Data.ByteString.Builder (Builder, byteString, integerDec)
23+import Data.ByteString.Builder (Builder, integerDec)
2524import Data.ByteString.Builder.Prim
2625 ( liftFixedToBounded, (>$<), (>*<)
2726 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
2827import Data.Char ( chr )
2928import Data.Int ( Int32, Int64 )
30−import Data.String (fromString)
31−import Data.Time.Compat
29+import Data.Time
3230 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
3331 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
3432 , TimeZone, timeZoneMinutes )
35−import Data.Time.Format.ISO8601.Compat (iso8601Show)
36−import Data.Time.LocalTime.Compat (CalendarDiffTime)
3733import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
3834import Unsafe.Coerce (unsafeCoerce)
3935
@@ -125,11 +121,3 @@ nominalDiffTime :: NominalDiffTime -> Builder
125121nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
126122 where
127123 (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−19
@@ -1,6 +1,5 @@
11{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
3−{-# LANGUAGE PolyKinds #-}
43
54------------------------------------------------------------------------------
65-- |
@@ -23,7 +22,6 @@ module Database.PostgreSQL.Simple.ToField
2322 , inQuotes
2423 ) where
2524
26−import Control.Applicative (Const(Const))
2725import qualified Data.Aeson as JSON
2826import Data.ByteString (ByteString)
2927import Data.ByteString.Builder
@@ -32,12 +30,10 @@ import Data.ByteString.Builder
3230 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec
3331 , floatDec, doubleDec
3432 )
35−import Data.Functor.Identity (Identity(Identity))
3633import Data.Int (Int8, Int16, Int32, Int64)
3734import Data.List (intersperse)
3835import Data.Monoid (mappend)
39−import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
40−import Data.Time.LocalTime.Compat (CalendarDiffTime)
36+import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
4137import Data.Typeable (Typeable)
4238import Data.Word (Word, Word8, Word16, Word32, Word64)
4339import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
@@ -59,7 +55,11 @@ import qualified Data.Vector as V
5955import qualified Database.PostgreSQL.LibPQ as PQ
6056import Database.PostgreSQL.Simple.Time
6157import Data.Scientific (Scientific)
58+#if MIN_VERSION_scientific(0,3,0)
6259import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
60+#else
61+import Data.Scientific (scientificBuilder)
62+#endif
6363import Foreign.C.Types (CUInt(..))
6464
6565-- | How to render an element when substituting it into a query.
@@ -100,14 +100,6 @@ instance ToField Action where
100100 toField a = a
101101 {-# INLINE toField #-}
102102
103−instance (ToField a) => ToField (Const a b) where
104− toField (Const a) = toField a
105− {-# INLINE toField #-}
106−
107−instance (ToField a) => ToField (Identity a) where
108− toField (Identity a) = toField a
109− {-# INLINE toField #-}
110−
111103instance (ToField a) => ToField (Maybe a) where
112104 toField Nothing = renderNull
113105 toField (Just a) = toField a
@@ -290,10 +282,6 @@ instance ToField NominalDiffTime where
290282 toField = Plain . inQuotes . nominalDiffTimeToBuilder
291283 {-# INLINE toField #-}
292284
293−instance ToField CalendarDiffTime where
294− toField = Plain . inQuotes . calendarDiffTimeToBuilder
295− {-# INLINE toField #-}
296−
297285instance (ToField a) => ToField (PGArray a) where
298286 toField pgArray =
299287 case fromPGArray pgArray of
@@ -314,13 +302,14 @@ instance ToField UUID where
314302instance ToField JSON.Value where
315303 toField = toField . JSON.encode
316304
317−-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.
305+-- | Convert a Haskell value to a JSON 'JSON.Value' using
306+-- 'JSON.toJSON' and convert that to a field using 'toField'.
318307--
319308-- This can be used as the default implementation for the 'toField'
320309-- method for Haskell types that have a JSON representation in
321310-- PostgreSQL.
322311toJSONField :: JSON.ToJSON a => a -> Action
323−toJSONField = toField . JSON.encode
312+toJSONField = toField . JSON.toJSON
324313
325314-- | Surround a string with single-quote characters: \"@'@\"
326315--
src/Database/PostgreSQL/Simple/Transaction.hs+12−16
@@ -17,7 +17,6 @@ module Database.PostgreSQL.Simple.Transaction
1717 , withTransactionLevel
1818 , withTransactionMode
1919 , withTransactionModeRetry
20− , withTransactionModeRetry'
2120 , withTransactionSerializable
2221 , TransactionMode(..)
2322 , IsolationLevel(..)
@@ -147,34 +146,31 @@ withTransactionMode mode conn act =
147146 commit conn
148147 return r
149148
150−-- | 'withTransactionModeRetry'' but with the exception type pinned to 'SqlError'.
151−withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
152−withTransactionModeRetry = withTransactionModeRetry'
153−
154149-- | Like 'withTransactionMode', but also takes a custom callback to
155−-- determine if a transaction should be retried if an exception occurs.
156−-- If the callback returns 'True', then the transaction will be retried.
157−-- If the callback returns 'False', or an exception other than an @e@
150+-- determine if a transaction should be retried if an 'SqlError' occurs.
151+-- If the callback returns True, then the transaction will be retried.
152+-- If the callback returns False, or an exception other than an 'SqlError'
158153-- occurs then the transaction will be rolled back and the exception rethrown.
159154--
160155-- This is used to implement 'withTransactionSerializable'.
161−withTransactionModeRetry' :: forall a e. E.Exception e => TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a
162−withTransactionModeRetry' mode shouldRetry conn act =
156+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
157+withTransactionModeRetry mode shouldRetry conn act =
163158 mask $ \restore ->
164159 retryLoop $ E.try $ do
165− a <- restore act `E.onException` rollback_ conn
160+ a <- restore act
166161 commit conn
167162 return a
168163 where
169− retryLoop :: IO (Either e a) -> IO a
164+ retryLoop :: IO (Either E.SomeException a) -> IO a
170165 retryLoop act' = do
171166 beginMode mode conn
172167 r <- act'
173168 case r of
174− Left e ->
175− case shouldRetry e of
176− True -> retryLoop act'
177− False -> E.throwIO e
169+ Left e -> do
170+ rollback_ conn
171+ case fmap shouldRetry (E.fromException e) of
172+ Just True -> retryLoop act'
173+ _ -> E.throwIO e
178174 Right a ->
179175 return a
180176
src/Database/PostgreSQL/Simple/Types.hs+7
@@ -50,6 +50,10 @@ 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+
5357-- | A placeholder for the PostgreSQL @DEFAULT@ value.
5458data Default = Default
5559 deriving (Read, Show, Typeable)
@@ -93,6 +97,9 @@ instance Semigroup Query where
9397
9498instance Monoid Query where
9599 mempty = Query B.empty
100+#if !(MIN_VERSION_base(4,11,0))
101+ mappend = (<>)
102+#endif
96103
97104-- | Wrap a list of values for use in an @IN@ clause. Replaces a
98105-- single \"@?@\" character with a parenthesized list of rendered
test/Exception.hsdeleted−70
@@ -1,70 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−
5−module Exception (testExceptions) where
6−
7−import Database.PostgreSQL.Simple
8−import Test.Tasty.HUnit (Assertion, assertBool)
9−import Common (TestEnv)
10−import Control.Exception (Exception (..), SomeException)
11−import Data.Maybe (isJust)
12−import Data.Either (isLeft)
13−import Control.Exception (throwIO, try)
14−
15−testExceptions :: TestEnv -> Assertion
16−testExceptions _ = do
17− let sqlError = SqlError
18− { sqlState = ""
19− , sqlExecStatus = FatalError
20− , sqlErrorMsg = ""
21− , sqlErrorDetail = ""
22− , sqlErrorHint = ""
23− }
24− let sqlEx :: SomeException = toException sqlError
25− assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)
26− assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)
27− eSqlError :: Either SqlError () <- try $ throwIO sqlEx
28− assertBool "Can catch SqlError" $ isLeft eSqlError
29− eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx
30− assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx
31−
32− let formatError = FormatError
33− { fmtMessage = ""
34− , fmtQuery = ""
35− , fmtParams = []
36− }
37− let formatEx :: SomeException = toException formatError
38− assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)
39− assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)
40− eFormatError :: Either FormatError () <- try $ throwIO formatEx
41− assertBool "Can catch FormatError" $ isLeft eFormatError
42− eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx
43− assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx
44−
45− let queryError = QueryError
46− { qeMessage = ""
47− , qeQuery = ""
48− }
49− let queryEx :: SomeException = toException queryError
50− assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)
51− assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)
52− eQueryError :: Either QueryError () <- try $ throwIO queryEx
53− assertBool "Can catch QueryError" $ isLeft eQueryError
54− eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx
55− assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx
56−
57− let resultError = Incompatible
58− { errSQLType = ""
59− , errSQLTableOid = Nothing
60− , errSQLField = ""
61− , errHaskellType = ""
62− , errMessage = ""
63− }
64− let resultEx :: SomeException = toException resultError
65− assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)
66− assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)
67− eResultEx :: Either ResultError () <- try $ throwIO resultEx
68− assertBool "Can catch ResultError" $ isLeft eResultEx
69− eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx
70− assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx
test/Interval.hsdeleted−176
@@ -1,176 +0,0 @@
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+10−95
@@ -3,19 +3,10 @@
33{-# LANGUAGE DeriveDataTypeable #-}
44{-# LANGUAGE DoAndIfThenElse #-}
55{-# LANGUAGE ScopedTypeVariables #-}
6−#if __GLASGOW_HASKELL__ >= 806
7−{-# LANGUAGE DerivingStrategies #-}
8−{-# LANGUAGE DerivingVia #-}
9−{-# LANGUAGE DeriveAnyClass #-}
10−#endif
11−module Main (main) where
12−
136import Common
147import Database.PostgreSQL.Simple.Copy
15−import Database.PostgreSQL.Simple.ToField (ToField)
168import Database.PostgreSQL.Simple.FromField (FromField)
179import Database.PostgreSQL.Simple.HStore
18−import Database.PostgreSQL.Simple.Newtypes
1910import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)
2011import Database.PostgreSQL.Simple.Types(Query(..),Values(..), PGArray(..))
2112import qualified Database.PostgreSQL.Simple.Transaction as ST
@@ -24,7 +15,6 @@ import Control.Applicative
2415import Control.Exception as E
2516import Control.Monad
2617import Data.Char
27−import Data.Foldable (toList)
2818import Data.List (concat, sort)
2919import Data.IORef
3020import Data.Monoid ((<>))
@@ -35,7 +25,6 @@ import GHC.Generics (Generic)
3525import Data.Aeson
3626import Data.ByteString (ByteString)
3727import qualified Data.ByteString as B
38−import qualified Data.ByteString.Char8 as BS8
3928import qualified Data.ByteString.Lazy.Char8 as BL
4029import Data.CaseInsensitive (CI)
4130import qualified Data.CaseInsensitive as CI
@@ -46,16 +35,13 @@ import qualified Data.Text.Encoding as T
4635import qualified Data.Vector as V
4736import System.FilePath
4837import System.Timeout(timeout)
49−import Data.Time.Compat (getCurrentTime, diffUTCTime)
50−import System.Environment (getEnvironment)
38+import Data.Time(getCurrentTime, diffUTCTime)
5139
5240import Test.Tasty
5341import Test.Tasty.Golden
5442import Notify
5543import Serializable
5644import Time
57−import Interval
58−import Exception (testExceptions)
5945
6046tests :: TestEnv -> TestTree
6147tests env = testGroup "tests"
@@ -66,14 +52,11 @@ tests env = testGroup "tests"
6652 , testCase "Notify" . testNotify
6753 , testCase "Serializable" . testSerializable
6854 , testCase "Time" . testTime
69− , testCase "Interval" . testInterval
7055 , testCase "Array" . testArray
7156 , testCase "Array of nullables" . testNullableArray
7257 , testCase "HStore" . testHStore
7358 , testCase "citext" . testCIText
7459 , testCase "JSON" . testJSON
75− , testCase "Aeson newtype" . testAeson
76− , testCase "DerivingVia" . testDerivingVia
7760 , testCase "Question mark escape" . testQM
7861 , testCase "Savepoint" . testSavepoint
7962 , testCase "Unicode" . testUnicode
@@ -85,7 +68,6 @@ tests env = testGroup "tests"
8568 , testCase "2-ary generic" . testGeneric2
8669 , testCase "3-ary generic" . testGeneric3
8770 , testCase "Timeout" . testTimeout
88− , testCase "Exceptions" . testExceptions
8971 ]
9072
9173testBytea :: TestEnv -> TestTree
@@ -139,7 +121,7 @@ testFold TestEnv{..} = do
139121 xs <- readIORef ref
140122 writeIORef ref $! (a,b):xs
141123 xs <- readIORef ref
142− reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]
124+ reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
143125
144126 -- Make sure fold propagates our exception.
145127 ref <- newIORef []
@@ -256,40 +238,6 @@ testJSON TestEnv{..} = do
256238 js' <- query conn "SELECT ?::json" js
257239 [js] @?= js'
258240
259−testAeson :: TestEnv -> Assertion
260−testAeson TestEnv{..} = do
261− roundTrip (Map.fromList [] :: Map Text Text)
262− roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)
263− roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)
264− roundTrip (V.fromList [1,2,3,4,5::Int])
265− roundTrip ("foo" :: Text)
266− roundTrip (42 :: Int)
267− where
268− roundTrip :: (Eq a, Show a, Typeable a, ToJSON a, FromJSON a)=> a -> Assertion
269− roundTrip x = do
270− y <- query conn "SELECT ?::json" (Only (Aeson x))
271− [Only (Aeson x)] @?= y
272−
273−testDerivingVia :: TestEnv -> Assertion
274−testDerivingVia TestEnv{..} = do
275−#if __GLASGOW_HASKELL__ <806
276− return ()
277−#else
278− roundTrip $ DerivingVia1 42 "Meaning of Life"
279− where
280− roundTrip :: (Eq a, Show a, Typeable a, ToField a, FromField a)=> a -> Assertion
281− roundTrip x = do
282− y <- query conn "SELECT ?::json" (Only x)
283− [Only x] @?= y
284−
285−data DerivingVia1 = DerivingVia1 Int String
286− deriving stock (Eq, Show, Generic)
287− deriving anyclass (FromJSON, ToJSON)
288− deriving (ToField, FromField) via Aeson DerivingVia1
289−
290−#endif
291−
292−
293241testQM :: TestEnv -> Assertion
294242testQM TestEnv{..} = do
295243 -- Just test on a single string
@@ -447,14 +395,6 @@ testCopy TestEnv{..} = do
447395 -- so that we can issue more queries:
448396 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
449397 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
458398 where
459399 copyRows = ["1,foo\n"
460400 ,"2,bar\n"]
@@ -474,13 +414,12 @@ testCopyFailures env = testGroup "Copy failures"
474414
475415goldenTest :: TestName -> IO BL.ByteString -> TestTree
476416goldenTest testName =
477− goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")
417+ goldenVsString testName (resultsDir </> fileName<.>"expected")
478418 where
479419 resultsDir = "test" </> "results"
480420 fileName = map normalize testName
481421 normalize c | not (isAlpha c) = '-'
482422 | otherwise = c
483− diff ref new = ["diff", "-u", ref, new]
484423
485424-- | Test that we provide a sensible error message on failure
486425testCopyUniqueConstraintError :: TestEnv -> TestTree
@@ -607,42 +546,18 @@ isFormatError i FormatError{..}
607546--
608547-- Note that some tests, such as Notify, use multiple connections, and assume
609548-- that 'testConnect' connects to the same database every time it is called.
610−withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a
611−withTestEnv connstr cb =
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'"
549+testConnect :: IO Connection
550+testConnect = connectPostgreSQL ""
616551
552+withTestEnv :: (TestEnv -> IO a) -> IO a
553+withTestEnv cb =
554+ withConn $ \conn ->
617555 cb TestEnv
618556 { conn = conn
619557 , withConn = withConn
620558 }
621559 where
622− withConn = bracket (connectPostgreSQL connstr) close
560+ withConn = bracket testConnect close
623561
624562main :: IO ()
625−main = withConnstring $ \connstring -> do
626− withTestEnv connstring (defaultMain . tests)
627−
628−withConnstring :: (BS8.ByteString -> IO ()) -> IO ()
629−withConnstring kont = do
630− env <- getEnvironment
631− case lookup "DATABASE_CONNSTRING" env of
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
637− -- https://www.appveyor.com/docs/services-databases/
638− special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"
639− special "travis" = ""
640− special s = s
641−
642− gha = unwords
643− [ "dbname='postgres'"
644− , "user='postgres'"
645− , "password='postgres'"
646− , "host='postgres'"
647− , "port=5432"
648− ]
563+main = withTestEnv $ defaultMain . tests
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.Compat
39+import Data.Time
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 type integer: "z"
2+Connection error: ERROR: invalid input syntax for integer: "z"
33CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"
44)