git.iko.soy/typeable/postgresql-simple
on 405eed4 help sign in
.github/workflows/haskell-ci.ymldeleted−256
since splitsnapshots
unifiedsplit
@@ -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+177
@@ -0,0 +1,177 @@
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+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−
51### Version 0.6.2 (2019-04-26)
1### Version 0.6.2 (2019-04-26)
52
2
53 * Define `MonadFail Ok`.
3 * Define `MonadFail Ok`.
@@ -271,7 +221,7 @@
271 support UTF8 except for Mule Internal Code, the Multilingual
221 support UTF8 except for Mule Internal Code, the Multilingual
272 Extensions for Emacs. An exception should be raised upon
222 Extensions for Emacs. An exception should be raised upon
273 connecting to a database by the backend if the backend cannot
223 connecting to a database by the backend if the backend cannot
274− accommodate this requirement.
224+ accomodate this requirement.
275
225
276 * Added `Eq` and `Typeable` instances for `Connection`.
226 * Added `Eq` and `Typeable` instances for `Connection`.
277
227
@@ -409,7 +359,7 @@
409
359
410 * Changed the Identifier and QualifiedIdentifier to use Text in
360 * Changed the Identifier and QualifiedIdentifier to use Text in
411 order to avoid encoding errors. Technically this requires a
361 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.
413
363
414 * Removed non-exhaustive cases in the ToField instance for Values,
364 * Removed non-exhaustive cases in the ToField instance for Values,
415 and tweaked error messages.
365 and tweaked error messages.
@@ -569,7 +519,7 @@
569
519
570 * Added a brand new TypeInfo system that gives FromField instances
520 * Added a brand new TypeInfo system that gives FromField instances
571 convenient and efficient access to the pg_type metatable. This
521 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
573 support postgres array types. Thanks to Bas van Dijk for his
523 support postgres array types. Thanks to Bas van Dijk for his
574 work on this feature.
524 work on this feature.
575
525
@@ -661,7 +611,7 @@
661 now the preferred way of dealing with `timestamp` (without time zone).
611 now the preferred way of dealing with `timestamp` (without time zone).
662
612
663 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
613 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
664− that accommodate PostgreSQL's infinities.
614+ that accomodate PostgreSQL's infinities.
665
615
666 * All time-related `FromField`/`ToField` instances are now based on new,
616 * All time-related `FromField`/`ToField` instances are now based on new,
667 higher-speed parsers and printers instead of those provided by the
617 higher-speed parsers and printers instead of those provided by the
CONTRIBUTING.md+1−1
@@ -4,7 +4,7 @@ Patches welcome!
4 - 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.
4 - 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.
5 - 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**:
5 - 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**:
6 - Amend `tested-with` to include that GHC
6 - 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))
8
8
9- 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.
9- 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.
10- For the same reason, do not edit `version` or `x-revision`
10- 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]
1[![Hackage page (downloads and API reference)][hackage-png]][hackage]
2[![Hackage page (downloads and API reference)][hackage-png]][hackage]
2
3
4+ [status-png]: https://api.travis-ci.org/lpsmith/postgresql-simple.svg
5+ [status]: http://travis-ci.org/lpsmith/postgresql-simple?branch=master
3 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg
6 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg
4 [hackage]: http://hackage.haskell.org/package/postgresql-simple
7 [hackage]: http://hackage.haskell.org/package/postgresql-simple
appveyor.ymlnew file+80
@@ -0,0 +1,80 @@
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,3 +3,13 @@ postgresql: True
3
3
4-- services aren't supported on Travis on macOS
4-- services aren't supported on Travis on macOS
5-- osx: 8.4.4
5-- 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,4 +1,2 @@
1packages: .
1packages: .
2tests: true
2tests: true
3−
4−allow-newer: cryptohash-md5-0.11.100.1:base
postgresql-simple.cabal+50−32
@@ -1,7 +1,7 @@
1cabal-version: 1.12
1cabal-version: 1.12
2name: postgresql-simple
2name: postgresql-simple
3−version: 0.7.0.0
3+version: 0.6.2
4−x-revision: 1
4+x-revision: 4
5synopsis: Mid-Level PostgreSQL client library
5synopsis: Mid-Level PostgreSQL client library
6description:
6description:
7 Mid-Level PostgreSQL client library, forked from mysql-simple.
7 Mid-Level PostgreSQL client library, forked from mysql-simple.
@@ -13,7 +13,7 @@ maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
13copyright:
13copyright:
14 (c) 2011 MailRank, Inc.
14 (c) 2011 MailRank, Inc.
15 (c) 2011-2018 Leon P Smith
15 (c) 2011-2018 Leon P Smith
16− (c) 2018-2020 Oleg Grenrus
16+ (c) 2018-2019 Oleg Grenrus
17
17
18category: Database
18category: Database
19build-type: Simple
19build-type: Simple
@@ -24,14 +24,15 @@ extra-source-files:
24 test/results/unique-constraint-violation.expected
24 test/results/unique-constraint-violation.expected
25
25
26tested-with:
26tested-with:
27+ GHC ==7.6.3
28+ || ==7.8.4
29+ || ==7.10.3
30+ || ==8.0.2
31+ || ==8.2.2
32+ || ==8.4.4
27− GHC ==8.6.5
33+ || ==8.6.5
28 || ==8.8.4
34 || ==8.8.4
29− || ==8.10.7
35+ || ==8.10.2
30− || ==9.0.2
31− || ==9.2.8
32− || ==9.4.8
33− || ==9.6.3
34− || ==9.8.1
35
36
36library
37library
37 default-language: Haskell2010
38 default-language: Haskell2010
@@ -48,7 +49,6 @@ library
48 Database.PostgreSQL.Simple.HStore.Internal
49 Database.PostgreSQL.Simple.HStore.Internal
49 Database.PostgreSQL.Simple.Internal
50 Database.PostgreSQL.Simple.Internal
50 Database.PostgreSQL.Simple.LargeObjects
51 Database.PostgreSQL.Simple.LargeObjects
51− Database.PostgreSQL.Simple.Newtypes
52 Database.PostgreSQL.Simple.Notification
52 Database.PostgreSQL.Simple.Notification
53 Database.PostgreSQL.Simple.Ok
53 Database.PostgreSQL.Simple.Ok
54 Database.PostgreSQL.Simple.Range
54 Database.PostgreSQL.Simple.Range
@@ -77,25 +77,34 @@ library
77
77
78 -- GHC bundled libs
78 -- GHC bundled libs
79 build-depends:
79 build-depends:
80− base >=4.12.0.0 && <4.20
80+ base >=4.6.0.0 && <4.15
81− , bytestring >=0.10.8.2 && <0.13
81+ , bytestring >=0.10.0.0 && <0.12
82− , containers >=0.6.0.1 && <0.7
82+ , containers >=0.5.0.0 && <0.7
83− , template-haskell >=2.14.0.0 && <2.22
83+ , template-haskell >=2.8.0.0 && <2.17
84− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
84+ , text >=1.2.3.0 && <1.3
85− , time-compat >=1.9.5 && <1.12
85+ , time >=1.4.0.1 && <1.12
86− , transformers >=0.5.6.2 && <0.7
86+ , transformers >=0.3.0.0 && <0.6
87
87
88 -- Other dependencies
88 -- Other dependencies
89 build-depends:
89 build-depends:
90− aeson >=2.1.2.1 && <2.3
90+ aeson >=1.4.1.0 && <1.6
91− , attoparsec >=0.14.4 && <0.15
91+ , attoparsec >=0.13.2.2 && <0.14
92+ , bytestring-builder >=0.10.8.1.0 && <0.11
92− , case-insensitive >=1.2.1.0 && <1.3
93+ , case-insensitive >=1.2.0.11 && <1.3
93− , hashable >=1.4.3.0 && <1.5
94+ , hashable >=1.2.7.0 && <1.4
94− , Only >=0.1 && <0.1.1
95+ , Only >=0.1 && <0.1.1
95− , postgresql-libpq >=0.10.0.0 && <0.11
96+ , postgresql-libpq >=0.9.4.2 && <0.10
96− , scientific >=0.3.7.0 && <0.4
97+ , scientific >=0.3.6.2 && <0.4
97− , uuid-types >=1.0.5 && <1.1
98+ , uuid-types >=1.0.3 && <1.1
98− , vector >=0.13.0.0 && <0.14
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
99
108
100 default-extensions:
109 default-extensions:
101 BangPatterns
110 BangPatterns
@@ -108,16 +117,24 @@ library
108
117
109source-repository head
118source-repository head
110 type: git
119 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
112
126
113test-suite inspection
127test-suite inspection
128+ if !impl(ghc >=8.0)
129+ buildable: False
130+
114 default-language: Haskell2010
131 default-language: Haskell2010
115 type: exitcode-stdio-1.0
132 type: exitcode-stdio-1.0
116 hs-source-dirs: test
133 hs-source-dirs: test
117 main-is: Inspection.hs
134 main-is: Inspection.hs
118 build-depends:
135 build-depends:
119 base
136 base
120− , inspection-testing >=0.4.1.1 && <0.6
137+ , inspection-testing >=0.4.1.1 && <0.5
121 , postgresql-libpq
138 , postgresql-libpq
122 , postgresql-simple
139 , postgresql-simple
123 , tasty
140 , tasty
@@ -130,8 +147,6 @@ test-suite test
130 main-is: Main.hs
147 main-is: Main.hs
131 other-modules:
148 other-modules:
132 Common
149 Common
133− Exception
134− Interval
135 Notify
150 Notify
136 Serializable
151 Serializable
137 Time
152 Time
@@ -161,9 +176,12 @@ test-suite test
161 , tasty-golden
176 , tasty-golden
162 , tasty-hunit
177 , tasty-hunit
163 , text
178 , text
164− , time-compat
179+ , time
165 , vector
180 , vector
166
181
182+ if !impl(ghc >=7.6)
183+ build-depends: ghc-prim
184+
167benchmark select
185benchmark select
168 default-language: Haskell2010
186 default-language: Haskell2010
169 type: exitcode-stdio-1.0
187 type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs+1−3
@@ -64,7 +64,6 @@ module Database.PostgreSQL.Simple
64 , Only(..)
64 , Only(..)
65 , (:.)(..)
65 , (:.)(..)
66 -- ** Exceptions
66 -- ** Exceptions
67− , SomePostgreSqlException(..)
68 , SqlError(..)
67 , SqlError(..)
69 , PQ.ExecStatus(..)
68 , PQ.ExecStatus(..)
70 , FormatError(..)
69 , FormatError(..)
@@ -74,7 +73,6 @@ module Database.PostgreSQL.Simple
74 , Base.connectPostgreSQL
73 , Base.connectPostgreSQL
75 , Base.close
74 , Base.close
76 , Base.connect
75 , Base.connect
77− , Base.withConnect
78 , Base.ConnectInfo(..)
76 , Base.ConnectInfo(..)
79 , Base.defaultConnectInfo
77 , Base.defaultConnectInfo
80 , Base.postgreSQLConnectionString
78 , Base.postgreSQLConnectionString
@@ -902,7 +900,7 @@ forEachWith_ parser conn template = foldWith_ parser conn template () . const
902-- all values of the given PostgreSQL type is considered \"compatible\".
900-- all values of the given PostgreSQL type is considered \"compatible\".
903-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@
901-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@
904-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately
902-- 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.
906--
904--
907-- * A numeric compatibility check is based only on the type of a
905-- * A numeric compatibility check is based only on the type of a
908-- column, /not/ on its values. For instance, a PostgreSQL 64-bit
906-- 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
12 ) where
12 ) where
13
13
14import qualified Control.Exception as E
14import qualified Control.Exception as E
15+import Data.Monoid
15import Data.ByteString (ByteString)
16import Data.ByteString (ByteString)
17+#if MIN_VERSION_bytestring(0,10,0)
16import Data.ByteString.Lazy (toStrict)
18import Data.ByteString.Lazy (toStrict)
19+#else
20+import qualified Data.ByteString as B
21+import Data.ByteString.Lazy (toChunks)
22+#endif
17import Data.ByteString.Builder (Builder, toLazyByteString)
23import Data.ByteString.Builder (Builder, toLazyByteString)
24+
25+#if MIN_VERSION_scientific(0,3,0)
18import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
26import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
27+#else
28+import Data.Scientific (scientificBuilder)
29+#endif
30+
31+#if __GLASGOW_HASKELL__ >= 702
19import System.IO.Unsafe (unsafeDupablePerformIO)
32import System.IO.Unsafe (unsafeDupablePerformIO)
33+#elif __GLASGOW_HASKELL__ >= 611
34+import GHC.IO (unsafeDupablePerformIO)
35+#else
36+import GHC.IOBase (unsafeDupablePerformIO)
37+#endif
38+
20import Data.Fixed (Pico)
39import Data.Fixed (Pico)
40+#if MIN_VERSION_base(4,7,0)
21import Data.Fixed (Fixed(MkFixed))
41import Data.Fixed (Fixed(MkFixed))
42+#else
43+import Unsafe.Coerce (unsafeCoerce)
44+#endif
22
45
23-- | Like 'E.mask', but backported to base before version 4.3.0.
46-- | Like 'E.mask', but backported to base before version 4.3.0.
24--
47--
@@ -28,14 +51,44 @@ import Data.Fixed (Fixed(MkFixed))
28-- 'withTransactionMode' function calls the restore callback only once, so we
51-- 'withTransactionMode' function calls the restore callback only once, so we
29-- don't need that polymorphism.
52-- don't need that polymorphism.
30mask :: ((IO a -> IO a) -> IO b) -> IO b
53mask :: ((IO a -> IO a) -> IO b) -> IO b
54+#if MIN_VERSION_base(4,3,0)
31mask io = E.mask $ \restore -> io restore
55mask io = E.mask $ \restore -> io restore
56+#else
57+mask io = do
58+ b <- E.blocked
59+ E.block $ io $ \m -> if b then m else E.unblock m
60+#endif
32{-# INLINE mask #-}
61{-# INLINE mask #-}
33
62
63+#if !MIN_VERSION_base(4,5,0)
64+infixr 6 <>
65+
66+(<>) :: Monoid m => m -> m -> m
67+(<>) = mappend
68+{-# INLINE (<>) #-}
69+#endif
70+
34toByteString :: Builder -> ByteString
71toByteString :: Builder -> ByteString
72+#if MIN_VERSION_bytestring(0,10,0)
35toByteString x = toStrict (toLazyByteString x)
73toByteString x = toStrict (toLazyByteString x)
74+#else
75+toByteString x = B.concat (toChunks (toLazyByteString x))
76+#endif
77+
78+#if MIN_VERSION_base(4,7,0)
36
79
37toPico :: Integer -> Pico
80toPico :: Integer -> Pico
38toPico = MkFixed
81toPico = MkFixed
39
82
40fromPico :: Pico -> Integer
83fromPico :: Pico -> Integer
41fromPico (MkFixed i) = i
84fromPico (MkFixed i) = i
85+
86+#else
87+
88+toPico :: Integer -> Pico
89+toPico = unsafeCoerce
90+
91+fromPico :: Pico -> Integer
92+fromPico = unsafeCoerce
93+
94+#endif
src/Database/PostgreSQL/Simple/Copy.hs+5−26
@@ -32,7 +32,6 @@ module Database.PostgreSQL.Simple.Copy
32 ( copy
32 ( copy
33 , copy_
33 , copy_
34 , CopyOutResult(..)
34 , CopyOutResult(..)
35− , foldCopyData
36 , getCopyData
35 , getCopyData
37 , putCopyData
36 , putCopyData
38 , putCopyEnd
37 , putCopyEnd
@@ -55,7 +54,7 @@ import Database.PostgreSQL.Simple.Internal hiding (result, row)
55-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former
54-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former
56-- case, the connection's state will change to @CopyIn@; in the latter,
55-- case, the connection's state will change to @CopyIn@; in the latter,
57-- @CopyOut@. The connection must be in the ready state in order
56-- @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.
59
58
60copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()
59copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()
61copy conn template qs = do
60copy conn template qs = do
@@ -86,8 +85,12 @@ doCopy funcName conn template q = do
86 PQ.TuplesOk -> err
85 PQ.TuplesOk -> err
87 PQ.CopyOut -> return ()
86 PQ.CopyOut -> return ()
88 PQ.CopyIn -> return ()
87 PQ.CopyIn -> return ()
88+#if MIN_VERSION_postgresql_libpq(0,9,3)
89 PQ.CopyBoth -> errMsg "COPY BOTH is not supported"
89 PQ.CopyBoth -> errMsg "COPY BOTH is not supported"
90+#endif
91+#if MIN_VERSION_postgresql_libpq(0,9,2)
90 PQ.SingleTuple -> errMsg "single-row mode is not supported"
92 PQ.SingleTuple -> errMsg "single-row mode is not supported"
93+#endif
91 PQ.BadResponse -> throwResultError funcName result status
94 PQ.BadResponse -> throwResultError funcName result status
92 PQ.NonfatalError -> throwResultError funcName result status
95 PQ.NonfatalError -> throwResultError funcName result status
93 PQ.FatalError -> throwResultError funcName result status
96 PQ.FatalError -> throwResultError funcName result status
@@ -101,30 +104,6 @@ data CopyOutResult
101 deriving (Eq, Typeable, Show)
104 deriving (Eq, Typeable, Show)
102
105
103
106
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−
128-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
107-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
129-- must be in the @CopyOut@ state in order to call this function. If this
108-- must be in the @CopyOut@ state in order to call this function. If this
130-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,
109-- 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
25 )
25 )
26 where
26 where
27
27
28+import Control.Applicative
28import Control.Exception as E
29import Control.Exception as E
29
30
30import Data.Attoparsec.ByteString.Char8
31import Data.Attoparsec.ByteString.Char8
@@ -59,13 +60,11 @@ data ConstraintViolation
59 deriving (Show, Eq, Ord, Typeable)
60 deriving (Show, Eq, Ord, Typeable)
60
61
61-- Default instance should be enough
62-- Default instance should be enough
62−instance Exception ConstraintViolation where
63+instance Exception ConstraintViolation
63− toException = postgresqlExceptionToException
64− fromException = postgresqlExceptionFromException
65
64
66
65
67-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
66-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
68−-- succeeds only if able to parse sqlErrorMsg.
67+-- succeedes only if able to parse sqlErrorMsg.
69--
68--
70-- > createUser = handleJust constraintViolation handler $ execute conn ...
69-- > createUser = handleJust constraintViolation handler $ execute conn ...
71-- > where
70-- > where
src/Database/PostgreSQL/Simple/FromField.hs+21−56
@@ -2,7 +2,6 @@
2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
3{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
3{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
4{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
5−{-# LANGUAGE PolyKinds #-}
6
5
7{- |
6{- |
8Module: Database.PostgreSQL.Simple.FromField
7Module: Database.PostgreSQL.Simple.FromField
@@ -107,27 +106,26 @@ module Database.PostgreSQL.Simple.FromField
107 , PQ.Oid(..)
106 , PQ.Oid(..)
108 , PQ.Format(..)
107 , PQ.Format(..)
109 , pgArrayFieldParser
108 , pgArrayFieldParser
110− , attoFieldParser
111
109
112 , optionalField
110 , optionalField
113 , fromJSONField
111 , fromJSONField
114− , fromFieldJSONByteString
115 ) where
112 ) where
116
113
117#include "MachDeps.h"
114#include "MachDeps.h"
118
115
119−import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
116+import Control.Applicative ( (<|>), (<$>), pure, (*>), (<*) )
120import Control.Concurrent.MVar (MVar, newMVar)
117import Control.Concurrent.MVar (MVar, newMVar)
121−import Control.Exception (Exception (toException, fromException))
118+import Control.Exception (Exception)
122import qualified Data.Aeson as JSON
119import qualified Data.Aeson as JSON
120+import qualified Data.Aeson.Internal as JSON
121+import qualified Data.Aeson.Parser as JSON (value')
123import Data.Attoparsec.ByteString.Char8 hiding (Result)
122import Data.Attoparsec.ByteString.Char8 hiding (Result)
124import Data.ByteString (ByteString)
123import Data.ByteString (ByteString)
125import qualified Data.ByteString.Char8 as B
124import qualified Data.ByteString.Char8 as B
126−import Data.Functor.Identity (Identity(Identity))
127import Data.Int (Int16, Int32, Int64)
125import Data.Int (Int16, Int32, Int64)
128import Data.IORef (IORef, newIORef)
126import Data.IORef (IORef, newIORef)
129import Data.Ratio (Ratio)
127import Data.Ratio (Ratio)
130−import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )
128+import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )
131import Data.Typeable (Typeable, typeOf)
129import Data.Typeable (Typeable, typeOf)
132import Data.Vector (Vector)
130import Data.Vector (Vector)
133import Data.Vector.Mutable (IOVector)
131import Data.Vector.Mutable (IOVector)
@@ -154,8 +152,6 @@ import qualified Data.UUID.Types as UUID
154import Data.Scientific (Scientific)
152import Data.Scientific (Scientific)
155import GHC.Real (infinity, notANumber)
153import GHC.Real (infinity, notANumber)
156
154
157−import qualified Data.Aeson.Types as JSON
158−
159-- | Exception thrown if conversion from a SQL value to a Haskell
155-- | Exception thrown if conversion from a SQL value to a Haskell
160-- value fails.
156-- value fails.
161data ResultError = Incompatible { errSQLType :: String
157data ResultError = Incompatible { errSQLType :: String
@@ -182,9 +178,7 @@ data ResultError = Incompatible { errSQLType :: String
182 -- between metadata and actual data in a row).
178 -- between metadata and actual data in a row).
183 deriving (Eq, Show, Typeable)
179 deriving (Eq, Show, Typeable)
184
180
185−instance Exception ResultError where
181+instance Exception ResultError
186− toException = postgresqlExceptionToException
187− fromException = postgresqlExceptionFromException
188
182
189left :: Exception a => a -> Conversion b
183left :: Exception a => a -> Conversion b
190left = conversionError
184left = conversionError
@@ -273,12 +267,6 @@ instance FromField () where
273 | typeOid f /= TI.voidOid = returnError Incompatible f ""
267 | typeOid f /= TI.voidOid = returnError Incompatible f ""
274 | otherwise = pure ()
268 | otherwise = pure ()
275
269
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−
282-- | For dealing with null values. Compatible with any postgresql type
270-- | For dealing with null values. Compatible with any postgresql type
283-- compatible with type @a@. Note that the type is not checked if
271-- compatible with type @a@. Note that the type is not checked if
284-- the value is null, although it is inadvisable to rely on this
272-- the value is null, although it is inadvisable to rely on this
@@ -325,11 +313,11 @@ instance FromField Char where
325
313
326-- | int2
314-- | int2
327instance FromField Int16 where
315instance FromField Int16 where
328− fromField = attoFieldParser ok16 $ signed decimal
316+ fromField = atto ok16 $ signed decimal
329
317
330-- | int2, int4
318-- | int2, int4
331instance FromField Int32 where
319instance FromField Int32 where
332− fromField = attoFieldParser ok32 $ signed decimal
320+ fromField = atto ok32 $ signed decimal
333
321
334#if WORD_SIZE_IN_BITS < 64
322#if WORD_SIZE_IN_BITS < 64
335-- | int2, int4, and if compiled as 64-bit code, int8 as well.
323-- | int2, int4, and if compiled as 64-bit code, int8 as well.
@@ -339,36 +327,36 @@ instance FromField Int32 where
339-- This library was compiled as 64-bit code.
327-- This library was compiled as 64-bit code.
340#endif
328#endif
341instance FromField Int where
329instance FromField Int where
342− fromField = attoFieldParser okInt $ signed decimal
330+ fromField = atto okInt $ signed decimal
343
331
344-- | int2, int4, int8
332-- | int2, int4, int8
345instance FromField Int64 where
333instance FromField Int64 where
346− fromField = attoFieldParser ok64 $ signed decimal
334+ fromField = atto ok64 $ signed decimal
347
335
348-- | int2, int4, int8
336-- | int2, int4, int8
349instance FromField Integer where
337instance FromField Integer where
350− fromField = attoFieldParser ok64 $ signed decimal
338+ fromField = atto ok64 $ signed decimal
351
339
352-- | int2, float4 (Uses attoparsec's 'double' routine, for
340-- | int2, float4 (Uses attoparsec's 'double' routine, for
353-- better accuracy convert to 'Scientific' or 'Rational' first)
341-- better accuracy convert to 'Scientific' or 'Rational' first)
354instance FromField Float where
342instance FromField Float where
355− fromField = attoFieldParser ok (realToFrac <$> pg_double)
343+ fromField = atto ok (realToFrac <$> pg_double)
356 where ok = eq TI.float4Oid \/ eq TI.int2Oid
344 where ok = eq TI.float4Oid \/ eq TI.int2Oid
357
345
358-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for
346-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for
359-- better accuracy convert to 'Scientific' or 'Rational' first)
347-- better accuracy convert to 'Scientific' or 'Rational' first)
360instance FromField Double where
348instance FromField Double where
361− fromField = attoFieldParser ok pg_double
349+ fromField = atto ok pg_double
362 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid
350 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid
363
351
364-- | int2, int4, int8, float4, float8, numeric
352-- | int2, int4, int8, float4, float8, numeric
365instance FromField (Ratio Integer) where
353instance FromField (Ratio Integer) where
366− fromField = attoFieldParser ok pg_rational
354+ fromField = atto ok pg_rational
367 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
355 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
368
356
369-- | int2, int4, int8, float4, float8, numeric
357-- | int2, int4, int8, float4, float8, numeric
370instance FromField Scientific where
358instance FromField Scientific where
371− fromField = attoFieldParser ok rational
359+ fromField = atto ok rational
372 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
360 where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
373
361
374unBinary :: Binary t -> t
362unBinary :: Binary t -> t
@@ -396,7 +384,7 @@ instance FromField SB.ByteString where
396
384
397-- | oid
385-- | oid
398instance FromField PQ.Oid where
386instance 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
400
388
401-- | bytea, name, text, \"char\", bpchar, varchar, unknown
389-- | bytea, name, text, \"char\", bpchar, varchar, unknown
402instance FromField LB.ByteString where
390instance FromField LB.ByteString where
@@ -489,15 +477,6 @@ instance FromField LocalTimestamp where
489instance FromField Date where
477instance FromField Date where
490 fromField = ff TI.dateOid "Date" parseDate
478 fromField = ff TI.dateOid "Date" parseDate
491
479
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−
501ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
480ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
502 -> Field -> Maybe B8.ByteString -> Conversion a
481 -> Field -> Maybe B8.ByteString -> Conversion a
503ff compatOid hsType parseBS f mstr =
482ff compatOid hsType parseBS f mstr =
@@ -576,13 +555,11 @@ instance FromField UUID where
576-- | json, jsonb
555-- | json, jsonb
577instance FromField JSON.Value where
556instance FromField JSON.Value where
578 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
557 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
580 Left err -> returnError ConversionFailed f err
559 Left err -> returnError ConversionFailed f err
581 Right val -> pure val
560 Right val -> pure val
582
561
583-- | Return the JSON ByteString directly
562-- | Return the JSON ByteString directly
584−--
585−-- @since 0.6.3
586fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString
563fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString
587fromFieldJSONByteString f mbs =
564fromFieldJSONByteString f mbs =
588 if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid
565 if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid
@@ -684,22 +661,10 @@ returnError mkErr f msg = do
684 (show (typeOf (undefined :: a)))
661 (show (typeOf (undefined :: a)))
685 msg
662 msg
686
663
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)
664+atto :: forall a. (Typeable a)
697− => (PQ.Oid -> Bool)
665+ => Compat -> Parser a -> Field -> Maybe ByteString
698− -- ^ Predicate for whether the postgresql type oid is compatible with this parser
666+ -> Conversion a
699− -> Parser a
700− -- ^ An attoparsec parser.
701− -> FieldParser a
702−attoFieldParser types p0 f dat = doFromField f types (go p0) dat
667+atto types p0 f dat = doFromField f types (go p0) dat
703 where
668 where
704 go :: Parser a -> ByteString -> Conversion a
669 go :: Parser a -> ByteString -> Conversion a
705 go p s =
670 go p s =
src/Database/PostgreSQL/Simple/HStore/Implementation.hs+6
@@ -22,6 +22,9 @@ import Data.ByteString.Builder (Builder, byteString, char8)
22import qualified Data.ByteString.Builder as BU
22import qualified Data.ByteString.Builder as BU
23import Data.ByteString.Internal (c2w, w2c)
23import Data.ByteString.Internal (c2w, w2c)
24import qualified Data.ByteString.Lazy as BL
24import qualified Data.ByteString.Lazy as BL
25+#if !MIN_VERSION_bytestring(0,10,0)
26+import qualified Data.ByteString.Lazy.Internal as BL (foldrChunks)
27+#endif
25import Data.Map(Map)
28import Data.Map(Map)
26import qualified Data.Map as Map
29import qualified Data.Map as Map
27import Data.Text(Text)
30import Data.Text(Text)
@@ -66,6 +69,9 @@ instance Semigroup HStoreBuilder where
66
69
67instance Monoid HStoreBuilder where
70instance Monoid HStoreBuilder where
68 mempty = Empty
71 mempty = Empty
72+#if !(MIN_VERSION_base(4,11,0))
73+ mappend = (<>)
74+#endif
69
75
70class ToHStoreText a where
76class ToHStoreText a where
71 toHStoreText :: a -> HStoreText
77 toHStoreText :: a -> HStoreText
src/Database/PostgreSQL/Simple/Internal.hs+7−37
@@ -1,8 +1,6 @@
1{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}
1{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}
2{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
2{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE ExistentialQuantification #-}
5−{-# LANGUAGE InstanceSigs #-}
6
4
7------------------------------------------------------------------------------
5------------------------------------------------------------------------------
8-- |
6-- |
@@ -36,6 +34,7 @@ import Data.Int (Int64)
36import qualified Data.IntMap as IntMap
34import qualified Data.IntMap as IntMap
37import Data.IORef
35import Data.IORef
38import Data.Maybe(fromMaybe)
36import Data.Maybe(fromMaybe)
37+import Data.Monoid
39import Data.String
38import Data.String
40import qualified Data.Text as T
39import qualified Data.Text as T
41import qualified Data.Text.Encoding as TE
40import qualified Data.Text.Encoding as TE
@@ -83,25 +82,6 @@ data Connection = Connection {
83instance Eq Connection where
82instance Eq Connection where
84 x == y = connectionHandle x == connectionHandle y
83 x == y = connectionHandle x == connectionHandle y
85
84
86−-- | Superclass for postgresql exceptions
87−data SomePostgreSqlException = forall e. Exception e => SomePostgreSqlException e
88− deriving Typeable
89−
90−postgresqlExceptionToException :: Exception e => e -> SomeException
91−postgresqlExceptionToException = toException . SomePostgreSqlException
92−
93−postgresqlExceptionFromException :: Exception e => SomeException -> Maybe e
94−postgresqlExceptionFromException x = do
95− SomePostgreSqlException a <- fromException x
96− cast a
97−
98−instance Show SomePostgreSqlException where
99− showsPrec :: Int -> SomePostgreSqlException -> ShowS
100− showsPrec p (SomePostgreSqlException e) = showsPrec p e
101−
102−instance Exception SomePostgreSqlException where
103− displayException (SomePostgreSqlException e) = displayException e
104−
105data SqlError = SqlError {
85data SqlError = SqlError {
106 sqlState :: ByteString
86 sqlState :: ByteString
107 , sqlExecStatus :: ExecStatus
87 , sqlExecStatus :: ExecStatus
@@ -113,10 +93,7 @@ data SqlError = SqlError {
113fatalError :: ByteString -> SqlError
93fatalError :: ByteString -> SqlError
114fatalError msg = SqlError "" FatalError msg "" ""
94fatalError msg = SqlError "" FatalError msg "" ""
115
95
116−instance Exception SqlError where
96+instance Exception SqlError
117− toException = postgresqlExceptionToException
118− fromException = postgresqlExceptionFromException
119−
120
97
121-- | Exception thrown if 'query' is used to perform an @INSERT@-like
98-- | Exception thrown if 'query' is used to perform an @INSERT@-like
122-- operation, or 'execute' is used to perform a @SELECT@-like operation.
99-- operation, or 'execute' is used to perform a @SELECT@-like operation.
@@ -125,9 +102,7 @@ data QueryError = QueryError {
125 , qeQuery :: Query
102 , qeQuery :: Query
126 } deriving (Eq, Show, Typeable)
103 } deriving (Eq, Show, Typeable)
127
104
128−instance Exception QueryError where
105+instance Exception QueryError
129− toException = postgresqlExceptionToException
130− fromException = postgresqlExceptionFromException
131
106
132-- | Exception thrown if a 'Query' could not be formatted correctly.
107-- | Exception thrown if a 'Query' could not be formatted correctly.
133-- This may occur if the number of \'@?@\' characters in the query
108-- This may occur if the number of \'@?@\' characters in the query
@@ -138,9 +113,7 @@ data FormatError = FormatError {
138 , fmtParams :: [ByteString]
113 , fmtParams :: [ByteString]
139 } deriving (Eq, Show, Typeable)
114 } deriving (Eq, Show, Typeable)
140
115
141−instance Exception FormatError where
116+instance Exception FormatError
142− toException = postgresqlExceptionToException
143− fromException = postgresqlExceptionFromException
144
117
145data ConnectInfo = ConnectInfo {
118data ConnectInfo = ConnectInfo {
146 connectHost :: String
119 connectHost :: String
@@ -182,12 +155,6 @@ defaultConnectInfo = ConnectInfo {
182connect :: ConnectInfo -> IO Connection
155connect :: ConnectInfo -> IO Connection
183connect = connectPostgreSQL . postgreSQLConnectionString
156connect = connectPostgreSQL . postgreSQLConnectionString
184
157
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−
191-- | Attempt to make a connection based on a libpq connection string.
158-- | Attempt to make a connection based on a libpq connection string.
192-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
159-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
193-- for more information. Also note that environment variables also affect
160-- for more information. Also note that environment variables also affect
@@ -517,6 +484,9 @@ instance Alternative Conversion where
517 Errors _ -> (oka <|>) <$> runConversion mb conn
484 Errors _ -> (oka <|>) <$> runConversion mb conn
518
485
519instance Monad Conversion where
486instance Monad Conversion where
487+#if !(MIN_VERSION_base(4,8,0))
488+ return = pure
489+#endif
520 m >>= f = Conversion $ \conn -> do
490 m >>= f = Conversion $ \conn -> do
521 oka <- runConversion m conn
491 oka <- runConversion m conn
522 case oka of
492 case oka of
src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+4
@@ -76,8 +76,12 @@ finishQueryWith' q result k = do
76 PQ.CommandOk -> queryErr "query resulted in a command response (did you mean to use `execute` or forget a RETURNING?)"
76 PQ.CommandOk -> queryErr "query resulted in a command response (did you mean to use `execute` or forget a RETURNING?)"
77 PQ.CopyOut -> queryErr "query: COPY TO is not supported"
77 PQ.CopyOut -> queryErr "query: COPY TO is not supported"
78 PQ.CopyIn -> queryErr "query: COPY FROM is not supported"
78 PQ.CopyIn -> queryErr "query: COPY FROM is not supported"
79+#if MIN_VERSION_postgresql_libpq(0,9,3)
79 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"
80 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"
81+#endif
82+#if MIN_VERSION_postgresql_libpq(0,9,2)
80 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"
83 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"
84+#endif
81 PQ.BadResponse -> throwResultError "query" result status
85 PQ.BadResponse -> throwResultError "query" result status
82 PQ.NonfatalError -> throwResultError "query" result status
86 PQ.NonfatalError -> throwResultError "query" result status
83 PQ.FatalError -> throwResultError "query" result status
87 PQ.FatalError -> throwResultError "query" result status
src/Database/PostgreSQL/Simple/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 )
47
47
48#if defined(mingw32_HOST_OS)
48#if defined(mingw32_HOST_OS)
49import Control.Concurrent ( threadDelay )
49import Control.Concurrent ( threadDelay )
50+#elif !MIN_VERSION_base(4,7,0)
51+import Control.Concurrent ( threadWaitRead )
50#else
52#else
51import GHC.Conc ( atomically )
53import GHC.Conc ( atomically )
52import Control.Concurrent ( threadWaitReadSTM )
54import Control.Concurrent ( threadWaitReadSTM )
@@ -92,6 +94,21 @@ getNotification conn = join $ withConnection conn fetch
92 -- with async exceptions, whereas threadDelay can.
94 -- with async exceptions, whereas threadDelay can.
93 Just _fd -> do
95 Just _fd -> do
94 return (threadDelay 1000000 >> loop)
96 return (threadDelay 1000000 >> loop)
97+#elif !MIN_VERSION_base(4,7,0)
98+ -- Technically there's a race condition that is usually benign.
99+ -- If the connection is closed or reset after we drop the
100+ -- lock, and then the fd index is reallocated to a new
101+ -- descriptor before we call threadWaitRead, then
102+ -- we could end up waiting on the wrong descriptor.
103+ --
104+ -- Now, if the descriptor becomes readable promptly, then
105+ -- it's no big deal as we'll wake up and notice the change
106+ -- on the next iteration of the loop. But if are very
107+ -- unlucky, then we could end up waiting a long time.
108+ Just fd -> do
109+ return $ do
110+ threadWaitRead fd `catch` (throwIO . setIOErrorLocation)
111+ loop
95#else
112#else
96 -- This case fixes the race condition above. By registering
113 -- This case fixes the race condition above. By registering
97 -- our interest in the descriptor before we drop the lock,
114 -- our interest in the descriptor before we drop the lock,
src/Database/PostgreSQL/Simple/Ok.hs+4
@@ -72,6 +72,10 @@ instance MonadPlus Ok where
72 mplus = (<|>)
72 mplus = (<|>)
73
73
74instance Monad Ok where
74instance Monad Ok where
75+#if !(MIN_VERSION_base(4,8,0))
76+ return = pure
77+#endif
78+
75 Errors es >>= _ = Errors es
79 Errors es >>= _ = Errors es
76 Ok a >>= f = f a
80 Ok a >>= f = f a
77
81
src/Database/PostgreSQL/Simple/Range.hs+1−1
@@ -38,7 +38,7 @@ import Data.Monoid (mempty)
38import Data.Scientific (Scientific)
38import Data.Scientific (Scientific)
39import qualified Data.Text.Lazy.Builder as LT
39import qualified Data.Text.Lazy.Builder as LT
40import qualified Data.Text.Lazy.Encoding as LT
40import qualified Data.Text.Lazy.Encoding as LT
41−import Data.Time.Compat (Day, LocalTime,
41+import Data.Time (Day, LocalTime,
42 NominalDiffTime,
42 NominalDiffTime,
43 TimeOfDay, UTCTime,
43 TimeOfDay, UTCTime,
44 ZonedTime,
44 ZonedTime,
src/Database/PostgreSQL/Simple/Time.hs−2
@@ -227,7 +227,6 @@ module Database.PostgreSQL.Simple.Time
227 , parseUTCTimestamp
227 , parseUTCTimestamp
228 , parseZonedTimestamp
228 , parseZonedTimestamp
229 , parseLocalTimestamp
229 , parseLocalTimestamp
230− , parseCalendarDiffTime
231 , dayToBuilder
230 , dayToBuilder
232 , utcTimeToBuilder
231 , utcTimeToBuilder
233 , zonedTimeToBuilder
232 , zonedTimeToBuilder
@@ -240,7 +239,6 @@ module Database.PostgreSQL.Simple.Time
240 , localTimestampToBuilder
239 , localTimestampToBuilder
241 , unboundedToBuilder
240 , unboundedToBuilder
242 , nominalDiffTimeToBuilder
241 , nominalDiffTimeToBuilder
243− , calendarDiffTimeToBuilder
244 ) where
242 ) where
245
243
246import Database.PostgreSQL.Simple.Time.Implementation
244import Database.PostgreSQL.Simple.Time.Implementation
src/Database/PostgreSQL/Simple/Time/Implementation.hs+1−11
@@ -18,8 +18,7 @@ import Data.ByteString.Builder.Prim(primBounded)
18import Control.Arrow((***))
18import Control.Arrow((***))
19import Control.Applicative
19import Control.Applicative
20import qualified Data.ByteString as B
20import qualified Data.ByteString as B
21−import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)
21+import Data.Time hiding (getTimeZone, getZonedTime)
22−import Data.Time.LocalTime.Compat (CalendarDiffTime)
23import Data.Typeable
22import Data.Typeable
24import Data.Maybe (fromMaybe)
23import Data.Maybe (fromMaybe)
25import qualified Data.Attoparsec.ByteString.Char8 as A
24import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -78,9 +77,6 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)
78parseDate :: B.ByteString -> Either String Date
77parseDate :: B.ByteString -> Either String Date
79parseDate = A.parseOnly (getDate <* A.endOfInput)
78parseDate = A.parseOnly (getDate <* A.endOfInput)
80
79
81−parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime
82−parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)
83−
84getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
80getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
85getUnbounded getFinite
81getUnbounded getFinite
86 = (pure NegInfinity <* A.string "-infinity")
82 = (pure NegInfinity <* A.string "-infinity")
@@ -129,9 +125,6 @@ getUTCTime = TP.utcTime
129getUTCTimestamp :: A.Parser UTCTimestamp
125getUTCTimestamp :: A.Parser UTCTimestamp
130getUTCTimestamp = getUnbounded getUTCTime
126getUTCTimestamp = getUnbounded getUTCTime
131
127
132−getCalendarDiffTime :: A.Parser CalendarDiffTime
133−getCalendarDiffTime = TP.calendarDiffTime
134−
135dayToBuilder :: Day -> Builder
128dayToBuilder :: Day -> Builder
136dayToBuilder = primBounded TPP.day
129dayToBuilder = primBounded TPP.day
137
130
@@ -171,6 +164,3 @@ dateToBuilder = unboundedToBuilder dayToBuilder
171
164
172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
173nominalDiffTimeToBuilder = TPP.nominalDiffTime
166nominalDiffTimeToBuilder = 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
21 , localToUTCTimeOfDayHMS
21 , localToUTCTimeOfDayHMS
22 , utcTime
22 , utcTime
23 , zonedTime
23 , zonedTime
24− , calendarDiffTime
25 ) where
24 ) where
26
25
27import Control.Applicative ((<$>), (<*>), (<*), (*>))
26import Control.Applicative ((<$>), (<*>), (<*), (*>))
28import Database.PostgreSQL.Simple.Compat (toPico)
27import Database.PostgreSQL.Simple.Compat (toPico)
29import Data.Attoparsec.ByteString.Char8 as A
28import Data.Attoparsec.ByteString.Char8 as A
30import Data.Bits ((.&.))
29import Data.Bits ((.&.))
31−import Data.ByteString (ByteString)
32import Data.Char (ord)
30import Data.Char (ord)
33import Data.Fixed (Pico)
31import Data.Fixed (Pico)
34import Data.Int (Int64)
32import Data.Int (Int64)
35import Data.Maybe (fromMaybe)
33import Data.Maybe (fromMaybe)
36−import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)
34+import Data.Time.Calendar (Day, fromGregorianValid, addDays)
37−import Data.Time.Clock.Compat (UTCTime(..))
35+import Data.Time.Clock (UTCTime(..))
38−import Data.Time.Format.ISO8601.Compat (iso8601ParseM)
39−import Data.Time.LocalTime.Compat (CalendarDiffTime)
40import qualified Data.ByteString.Char8 as B8
36import qualified Data.ByteString.Char8 as B8
41−import qualified Data.Time.LocalTime.Compat as Local
37+import qualified Data.Time.LocalTime as Local
42
38
43-- | Parse a date of the form @YYYY-MM-DD@.
39-- | Parse a date of the form @YYYY-MM-DD@.
44day :: Parser Day
40day :: Parser Day
@@ -197,8 +193,3 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
197
193
198utc :: Local.TimeZone
194utc :: Local.TimeZone
199utc = Local.TimeZone 0 False ""
195utc = 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
17 , localTime
17 , localTime
18 , zonedTime
18 , zonedTime
19 , nominalDiffTime
19 , nominalDiffTime
20− , calendarDiffTime
21 ) where
20 ) where
22
21
23import Control.Arrow ((>>>))
22import Control.Arrow ((>>>))
24−import Data.ByteString.Builder (Builder, byteString, integerDec)
23+import Data.ByteString.Builder (Builder, integerDec)
25import Data.ByteString.Builder.Prim
24import Data.ByteString.Builder.Prim
26 ( liftFixedToBounded, (>$<), (>*<)
25 ( liftFixedToBounded, (>$<), (>*<)
27 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
26 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
28import Data.Char ( chr )
27import Data.Char ( chr )
29import Data.Int ( Int32, Int64 )
28import Data.Int ( Int32, Int64 )
30−import Data.String (fromString)
29+import Data.Time
31−import Data.Time.Compat
32 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
30 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
33 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
31 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
34 , TimeZone, timeZoneMinutes )
32 , TimeZone, timeZoneMinutes )
35−import Data.Time.Format.ISO8601.Compat (iso8601Show)
36−import Data.Time.LocalTime.Compat (CalendarDiffTime)
37import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
33import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
38import Unsafe.Coerce (unsafeCoerce)
34import Unsafe.Coerce (unsafeCoerce)
39
35
@@ -125,11 +121,3 @@ nominalDiffTime :: NominalDiffTime -> Builder
125nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
121nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
126 where
122 where
127 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000
123 (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 @@
1{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
1{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
3−{-# LANGUAGE PolyKinds #-}
4
3
5------------------------------------------------------------------------------
4------------------------------------------------------------------------------
6-- |
5-- |
@@ -23,7 +22,6 @@ module Database.PostgreSQL.Simple.ToField
23 , inQuotes
22 , inQuotes
24 ) where
23 ) where
25
24
26−import Control.Applicative (Const(Const))
27import qualified Data.Aeson as JSON
25import qualified Data.Aeson as JSON
28import Data.ByteString (ByteString)
26import Data.ByteString (ByteString)
29import Data.ByteString.Builder
27import Data.ByteString.Builder
@@ -32,12 +30,10 @@ import Data.ByteString.Builder
32 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec
30 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec
33 , floatDec, doubleDec
31 , floatDec, doubleDec
34 )
32 )
35−import Data.Functor.Identity (Identity(Identity))
36import Data.Int (Int8, Int16, Int32, Int64)
33import Data.Int (Int8, Int16, Int32, Int64)
37import Data.List (intersperse)
34import Data.List (intersperse)
38import Data.Monoid (mappend)
35import Data.Monoid (mappend)
39−import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
36+import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
40−import Data.Time.LocalTime.Compat (CalendarDiffTime)
41import Data.Typeable (Typeable)
37import Data.Typeable (Typeable)
42import Data.Word (Word, Word8, Word16, Word32, Word64)
38import Data.Word (Word, Word8, Word16, Word32, Word64)
43import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
39import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
@@ -59,7 +55,11 @@ import qualified Data.Vector as V
59import qualified Database.PostgreSQL.LibPQ as PQ
55import qualified Database.PostgreSQL.LibPQ as PQ
60import Database.PostgreSQL.Simple.Time
56import Database.PostgreSQL.Simple.Time
61import Data.Scientific (Scientific)
57import Data.Scientific (Scientific)
58+#if MIN_VERSION_scientific(0,3,0)
62import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
59import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
60+#else
61+import Data.Scientific (scientificBuilder)
62+#endif
63import Foreign.C.Types (CUInt(..))
63import Foreign.C.Types (CUInt(..))
64
64
65-- | How to render an element when substituting it into a query.
65-- | How to render an element when substituting it into a query.
@@ -100,14 +100,6 @@ instance ToField Action where
100 toField a = a
100 toField a = a
101 {-# INLINE toField #-}
101 {-# INLINE toField #-}
102
102
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−
111instance (ToField a) => ToField (Maybe a) where
103instance (ToField a) => ToField (Maybe a) where
112 toField Nothing = renderNull
104 toField Nothing = renderNull
113 toField (Just a) = toField a
105 toField (Just a) = toField a
@@ -290,10 +282,6 @@ instance ToField NominalDiffTime where
290 toField = Plain . inQuotes . nominalDiffTimeToBuilder
282 toField = Plain . inQuotes . nominalDiffTimeToBuilder
291 {-# INLINE toField #-}
283 {-# INLINE toField #-}
292
284
293−instance ToField CalendarDiffTime where
294− toField = Plain . inQuotes . calendarDiffTimeToBuilder
295− {-# INLINE toField #-}
296−
297instance (ToField a) => ToField (PGArray a) where
285instance (ToField a) => ToField (PGArray a) where
298 toField pgArray =
286 toField pgArray =
299 case fromPGArray pgArray of
287 case fromPGArray pgArray of
@@ -314,13 +302,14 @@ instance ToField UUID where
314instance ToField JSON.Value where
302instance ToField JSON.Value where
315 toField = toField . JSON.encode
303 toField = toField . JSON.encode
316
304
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'.
318--
307--
319-- This can be used as the default implementation for the 'toField'
308-- This can be used as the default implementation for the 'toField'
320-- method for Haskell types that have a JSON representation in
309-- method for Haskell types that have a JSON representation in
321-- PostgreSQL.
310-- PostgreSQL.
322toJSONField :: JSON.ToJSON a => a -> Action
311toJSONField :: JSON.ToJSON a => a -> Action
323−toJSONField = toField . JSON.encode
312+toJSONField = toField . JSON.toJSON
324
313
325-- | Surround a string with single-quote characters: \"@'@\"
314-- | Surround a string with single-quote characters: \"@'@\"
326--
315--
src/Database/PostgreSQL/Simple/Transaction.hs+12−16
@@ -17,7 +17,6 @@ module Database.PostgreSQL.Simple.Transaction
17 , withTransactionLevel
17 , withTransactionLevel
18 , withTransactionMode
18 , withTransactionMode
19 , withTransactionModeRetry
19 , withTransactionModeRetry
20− , withTransactionModeRetry'
21 , withTransactionSerializable
20 , withTransactionSerializable
22 , TransactionMode(..)
21 , TransactionMode(..)
23 , IsolationLevel(..)
22 , IsolationLevel(..)
@@ -147,34 +146,31 @@ withTransactionMode mode conn act =
147 commit conn
146 commit conn
148 return r
147 return r
149
148
150−-- | 'withTransactionModeRetry'' but with the exception type pinned to 'SqlError'.
151−withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
152−withTransactionModeRetry = withTransactionModeRetry'
153−
154-- | Like 'withTransactionMode', but also takes a custom callback to
149-- | Like 'withTransactionMode', but also takes a custom callback to
155−-- determine if a transaction should be retried if an exception occurs.
150+-- determine if a transaction should be retried if an 'SqlError' occurs.
156−-- If the callback returns 'True', then the transaction will be retried.
151+-- If the callback returns True, then the transaction will be retried.
157−-- If the callback returns 'False', or an exception other than an @e@
152+-- If the callback returns False, or an exception other than an 'SqlError'
158-- occurs then the transaction will be rolled back and the exception rethrown.
153-- occurs then the transaction will be rolled back and the exception rethrown.
159--
154--
160-- This is used to implement 'withTransactionSerializable'.
155-- This is used to implement 'withTransactionSerializable'.
161−withTransactionModeRetry' :: forall a e. E.Exception e => TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a
156+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
162−withTransactionModeRetry' mode shouldRetry conn act =
157+withTransactionModeRetry mode shouldRetry conn act =
163 mask $ \restore ->
158 mask $ \restore ->
164 retryLoop $ E.try $ do
159 retryLoop $ E.try $ do
165− a <- restore act `E.onException` rollback_ conn
160+ a <- restore act
166 commit conn
161 commit conn
167 return a
162 return a
168 where
163 where
169− retryLoop :: IO (Either e a) -> IO a
164+ retryLoop :: IO (Either E.SomeException a) -> IO a
170 retryLoop act' = do
165 retryLoop act' = do
171 beginMode mode conn
166 beginMode mode conn
172 r <- act'
167 r <- act'
173 case r of
168 case r of
174− Left e ->
169+ Left e -> do
170+ rollback_ conn
175− case shouldRetry e of
171+ case fmap shouldRetry (E.fromException e) of
176− True -> retryLoop act'
172+ Just True -> retryLoop act'
177− False -> E.throwIO e
173+ _ -> E.throwIO e
178 Right a ->
174 Right a ->
179 return a
175 return a
180
176
src/Database/PostgreSQL/Simple/Types.hs+7
@@ -50,6 +50,10 @@ import Database.PostgreSQL.Simple.Compat (toByteString)
50data Null = Null
50data Null = Null
51 deriving (Read, Show, Typeable)
51 deriving (Read, Show, Typeable)
52
52
53+instance Eq Null where
54+ _ == _ = False
55+ _ /= _ = False
56+
53-- | A placeholder for the PostgreSQL @DEFAULT@ value.
57-- | A placeholder for the PostgreSQL @DEFAULT@ value.
54data Default = Default
58data Default = Default
55 deriving (Read, Show, Typeable)
59 deriving (Read, Show, Typeable)
@@ -93,6 +97,9 @@ instance Semigroup Query where
93
97
94instance Monoid Query where
98instance Monoid Query where
95 mempty = Query B.empty
99 mempty = Query B.empty
100+#if !(MIN_VERSION_base(4,11,0))
101+ mappend = (<>)
102+#endif
96
103
97-- | Wrap a list of values for use in an @IN@ clause. Replaces a
104-- | Wrap a list of values for use in an @IN@ clause. Replaces a
98-- single \"@?@\" character with a parenthesized list of rendered
105-- single \"@?@\" character with a parenthesized list of rendered
test/Exception.hsdeleted−70
@@ -1,70 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−
5−module Exception (testExceptions) where
6−
7−import Database.PostgreSQL.Simple
8−import Test.Tasty.HUnit (Assertion, assertBool)
9−import Common (TestEnv)
10−import Control.Exception (Exception (..), SomeException)
11−import Data.Maybe (isJust)
12−import Data.Either (isLeft)
13−import Control.Exception (throwIO, try)
14−
15−testExceptions :: TestEnv -> Assertion
16−testExceptions _ = do
17− let sqlError = SqlError
18− { sqlState = ""
19− , sqlExecStatus = FatalError
20− , sqlErrorMsg = ""
21− , sqlErrorDetail = ""
22− , sqlErrorHint = ""
23− }
24− let sqlEx :: SomeException = toException sqlError
25− assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)
26− assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)
27− eSqlError :: Either SqlError () <- try $ throwIO sqlEx
28− assertBool "Can catch SqlError" $ isLeft eSqlError
29− eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx
30− assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx
31−
32− let formatError = FormatError
33− { fmtMessage = ""
34− , fmtQuery = ""
35− , fmtParams = []
36− }
37− let formatEx :: SomeException = toException formatError
38− assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)
39− assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)
40− eFormatError :: Either FormatError () <- try $ throwIO formatEx
41− assertBool "Can catch FormatError" $ isLeft eFormatError
42− eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx
43− assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx
44−
45− let queryError = QueryError
46− { qeMessage = ""
47− , qeQuery = ""
48− }
49− let queryEx :: SomeException = toException queryError
50− assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)
51− assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)
52− eQueryError :: Either QueryError () <- try $ throwIO queryEx
53− assertBool "Can catch QueryError" $ isLeft eQueryError
54− eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx
55− assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx
56−
57− let resultError = Incompatible
58− { errSQLType = ""
59− , errSQLTableOid = Nothing
60− , errSQLField = ""
61− , errHaskellType = ""
62− , errMessage = ""
63− }
64− let resultEx :: SomeException = toException resultError
65− assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)
66− assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)
67− eResultEx :: Either ResultError () <- try $ throwIO resultEx
68− assertBool "Can catch ResultError" $ isLeft eResultEx
69− eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx
70− assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx
test/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+8−85
@@ -3,19 +3,10 @@
3{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DoAndIfThenElse #-}
4{-# LANGUAGE DoAndIfThenElse #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6−#if __GLASGOW_HASKELL__ >= 806
7−{-# LANGUAGE DerivingStrategies #-}
8−{-# LANGUAGE DerivingVia #-}
9−{-# LANGUAGE DeriveAnyClass #-}
10−#endif
11−module Main (main) where
12−
13import Common
6import Common
14import Database.PostgreSQL.Simple.Copy
7import Database.PostgreSQL.Simple.Copy
15−import Database.PostgreSQL.Simple.ToField (ToField)
16import Database.PostgreSQL.Simple.FromField (FromField)
8import Database.PostgreSQL.Simple.FromField (FromField)
17import Database.PostgreSQL.Simple.HStore
9import Database.PostgreSQL.Simple.HStore
18−import Database.PostgreSQL.Simple.Newtypes
19import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)
10import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)
20import Database.PostgreSQL.Simple.Types(Query(..),Values(..), PGArray(..))
11import Database.PostgreSQL.Simple.Types(Query(..),Values(..), PGArray(..))
21import qualified Database.PostgreSQL.Simple.Transaction as ST
12import qualified Database.PostgreSQL.Simple.Transaction as ST
@@ -24,7 +15,6 @@ import Control.Applicative
24import Control.Exception as E
15import Control.Exception as E
25import Control.Monad
16import Control.Monad
26import Data.Char
17import Data.Char
27−import Data.Foldable (toList)
28import Data.List (concat, sort)
18import Data.List (concat, sort)
29import Data.IORef
19import Data.IORef
30import Data.Monoid ((<>))
20import Data.Monoid ((<>))
@@ -46,7 +36,7 @@ import qualified Data.Text.Encoding as T
46import qualified Data.Vector as V
36import qualified Data.Vector as V
47import System.FilePath
37import System.FilePath
48import System.Timeout(timeout)
38import System.Timeout(timeout)
49−import Data.Time.Compat (getCurrentTime, diffUTCTime)
39+import Data.Time(getCurrentTime, diffUTCTime)
50import System.Environment (getEnvironment)
40import System.Environment (getEnvironment)
51
41
52import Test.Tasty
42import Test.Tasty
@@ -54,8 +44,6 @@ import Test.Tasty.Golden
54import Notify
44import Notify
55import Serializable
45import Serializable
56import Time
46import Time
57−import Interval
58−import Exception (testExceptions)
59
47
60tests :: TestEnv -> TestTree
48tests :: TestEnv -> TestTree
61tests env = testGroup "tests"
49tests env = testGroup "tests"
@@ -66,14 +54,11 @@ tests env = testGroup "tests"
66 , testCase "Notify" . testNotify
54 , testCase "Notify" . testNotify
67 , testCase "Serializable" . testSerializable
55 , testCase "Serializable" . testSerializable
68 , testCase "Time" . testTime
56 , testCase "Time" . testTime
69− , testCase "Interval" . testInterval
70 , testCase "Array" . testArray
57 , testCase "Array" . testArray
71 , testCase "Array of nullables" . testNullableArray
58 , testCase "Array of nullables" . testNullableArray
72 , testCase "HStore" . testHStore
59 , testCase "HStore" . testHStore
73 , testCase "citext" . testCIText
60 , testCase "citext" . testCIText
74 , testCase "JSON" . testJSON
61 , testCase "JSON" . testJSON
75− , testCase "Aeson newtype" . testAeson
76− , testCase "DerivingVia" . testDerivingVia
77 , testCase "Question mark escape" . testQM
62 , testCase "Question mark escape" . testQM
78 , testCase "Savepoint" . testSavepoint
63 , testCase "Savepoint" . testSavepoint
79 , testCase "Unicode" . testUnicode
64 , testCase "Unicode" . testUnicode
@@ -85,7 +70,6 @@ tests env = testGroup "tests"
85 , testCase "2-ary generic" . testGeneric2
70 , testCase "2-ary generic" . testGeneric2
86 , testCase "3-ary generic" . testGeneric3
71 , testCase "3-ary generic" . testGeneric3
87 , testCase "Timeout" . testTimeout
72 , testCase "Timeout" . testTimeout
88− , testCase "Exceptions" . testExceptions
89 ]
73 ]
90
74
91testBytea :: TestEnv -> TestTree
75testBytea :: TestEnv -> TestTree
@@ -139,7 +123,7 @@ testFold TestEnv{..} = do
139 xs <- readIORef ref
123 xs <- readIORef ref
140 writeIORef ref $! (a,b):xs
124 writeIORef ref $! (a,b):xs
141 xs <- readIORef ref
125 xs <- readIORef ref
142− reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]
126+ reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
143
127
144 -- Make sure fold propagates our exception.
128 -- Make sure fold propagates our exception.
145 ref <- newIORef []
129 ref <- newIORef []
@@ -256,40 +240,6 @@ testJSON TestEnv{..} = do
256 js' <- query conn "SELECT ?::json" js
240 js' <- query conn "SELECT ?::json" js
257 [js] @?= js'
241 [js] @?= js'
258
242
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−
293testQM :: TestEnv -> Assertion
243testQM :: TestEnv -> Assertion
294testQM TestEnv{..} = do
244testQM TestEnv{..} = do
295 -- Just test on a single string
245 -- Just test on a single string
@@ -447,14 +397,6 @@ testCopy TestEnv{..} = do
447 -- so that we can issue more queries:
397 -- so that we can issue more queries:
448 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
398 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
449 x @?= 4
399 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
458 where
400 where
459 copyRows = ["1,foo\n"
401 copyRows = ["1,foo\n"
460 ,"2,bar\n"]
402 ,"2,bar\n"]
@@ -474,13 +416,12 @@ testCopyFailures env = testGroup "Copy failures"
474
416
475goldenTest :: TestName -> IO BL.ByteString -> TestTree
417goldenTest :: TestName -> IO BL.ByteString -> TestTree
476goldenTest testName =
418goldenTest testName =
477− goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")
419+ goldenVsString testName (resultsDir </> fileName<.>"expected")
478 where
420 where
479 resultsDir = "test" </> "results"
421 resultsDir = "test" </> "results"
480 fileName = map normalize testName
422 fileName = map normalize testName
481 normalize c | not (isAlpha c) = '-'
423 normalize c | not (isAlpha c) = '-'
482 | otherwise = c
424 | otherwise = c
483− diff ref new = ["diff", "-u", ref, new]
484
425
485-- | Test that we provide a sensible error message on failure
426-- | Test that we provide a sensible error message on failure
486testCopyUniqueConstraintError :: TestEnv -> TestTree
427testCopyUniqueConstraintError :: TestEnv -> TestTree
@@ -609,11 +550,7 @@ isFormatError i FormatError{..}
609-- that 'testConnect' connects to the same database every time it is called.
550-- that 'testConnect' connects to the same database every time it is called.
610withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a
551withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a
611withTestEnv connstr cb =
552withTestEnv connstr cb =
612− withConn $ \conn -> do
553+ withConn $ \conn ->
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−
617 cb TestEnv
554 cb TestEnv
618 { conn = conn
555 { conn = conn
619 , withConn = withConn
556 , withConn = withConn
@@ -622,27 +559,13 @@ withTestEnv connstr cb =
622 withConn = bracket (connectPostgreSQL connstr) close
559 withConn = bracket (connectPostgreSQL connstr) close
623
560
624main :: IO ()
561main :: IO ()
625−main = withConnstring $ \connstring -> do
562+main = do
626− withTestEnv connstring (defaultMain . tests)
627−
628−withConnstring :: (BS8.ByteString -> IO ()) -> IO ()
629−withConnstring kont = do
630 env <- getEnvironment
563 env <- getEnvironment
631 case lookup "DATABASE_CONNSTRING" env of
564 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"
565+ Nothing -> putStrLn "Set DATABASE_CONNSTRING environment variable"
566+ Just s -> withTestEnv (BS8.pack (special s)) (defaultMain . tests)
636− where
567+ where
637 -- https://www.appveyor.com/docs/services-databases/
568 -- https://www.appveyor.com/docs/services-databases/
638 special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"
569 special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"
639 special "travis" = ""
570 special "travis" = ""
640 special s = s
571 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
36
36
37import Common
37import Common
38import Control.Monad(forM_, replicateM_)
38import Control.Monad(forM_, replicateM_)
39−import Data.Time.Compat
39+import Data.Time
40import Data.ByteString(ByteString)
40import Data.ByteString(ByteString)
41import Database.PostgreSQL.Simple.SqlQQ
41import Database.PostgreSQL.Simple.SqlQQ
42
42
test/results/malformed-input.expected+1−1
@@ -1,4 +1,4 @@
1user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status
1user 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"
3CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"
3CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"
4)
4)