git.iko.soy/typeable/postgresql-simple
on master help sign in
.github/workflows/haskell-ci.ymlnew file+256
since splitsnapshots
unifiedsplit
@@ -0,0 +1,256 @@
1+# This GitHub workflow config has been generated by a script via
2+#
3+# haskell-ci 'github' 'cabal.project'
4+#
5+# To regenerate the script (for example after adjusting tested-with) run
6+#
7+# haskell-ci regenerate
8+#
9+# For more information, see https://github.com/haskell-CI/haskell-ci
10+#
11+# version: 0.17.20231110
12+#
13+# REGENDATA ("0.17.20231110",["github","cabal.project"])
14+#
15+name: Haskell-CI
16+on:
17+ push:
18+ branches:
19+ - master
20+ pull_request:
21+ branches:
22+ - master
23+jobs:
24+ linux:
25+ name: Haskell-CI - Linux - ${{ matrix.compiler }}
26+ runs-on: ubuntu-20.04
27+ timeout-minutes:
28+ 60
29+ container:
30+ image: buildpack-deps:bionic
31+ services:
32+ postgres:
33+ image: postgres:14
34+ env:
35+ POSTGRES_PASSWORD: postgres
36+ options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5
37+ continue-on-error: ${{ matrix.allow-failure }}
38+ strategy:
39+ matrix:
40+ include:
41+ - compiler: ghc-9.8.1
42+ compilerKind: ghc
43+ compilerVersion: 9.8.1
44+ setup-method: ghcup
45+ allow-failure: false
46+ - compiler: ghc-9.6.3
47+ compilerKind: ghc
48+ compilerVersion: 9.6.3
49+ setup-method: ghcup
50+ allow-failure: false
51+ - compiler: ghc-9.4.8
52+ compilerKind: ghc
53+ compilerVersion: 9.4.8
54+ setup-method: ghcup
55+ allow-failure: false
56+ - compiler: ghc-9.2.8
57+ compilerKind: ghc
58+ compilerVersion: 9.2.8
59+ setup-method: ghcup
60+ allow-failure: false
61+ - compiler: ghc-9.0.2
62+ compilerKind: ghc
63+ compilerVersion: 9.0.2
64+ setup-method: ghcup
65+ allow-failure: false
66+ - compiler: ghc-8.10.7
67+ compilerKind: ghc
68+ compilerVersion: 8.10.7
69+ setup-method: ghcup
70+ allow-failure: false
71+ - compiler: ghc-8.8.4
72+ compilerKind: ghc
73+ compilerVersion: 8.8.4
74+ setup-method: hvr-ppa
75+ allow-failure: false
76+ - compiler: ghc-8.6.5
77+ compilerKind: ghc
78+ compilerVersion: 8.6.5
79+ setup-method: hvr-ppa
80+ allow-failure: false
81+ fail-fast: false
82+ steps:
83+ - name: apt
84+ run: |
85+ apt-get update
86+ apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
87+ if [ "${{ matrix.setup-method }}" = ghcup ]; then
88+ mkdir -p "$HOME/.ghcup/bin"
89+ curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
90+ chmod a+x "$HOME/.ghcup/bin/ghcup"
91+ "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
92+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
93+ else
94+ apt-add-repository -y 'ppa:hvr/ghc'
95+ apt-get update
96+ apt-get install -y "$HCNAME"
97+ mkdir -p "$HOME/.ghcup/bin"
98+ curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
99+ chmod a+x "$HOME/.ghcup/bin/ghcup"
100+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
101+ fi
102+ env:
103+ HCKIND: ${{ matrix.compilerKind }}
104+ HCNAME: ${{ matrix.compiler }}
105+ HCVER: ${{ matrix.compilerVersion }}
106+ - name: Set PATH and environment variables
107+ run: |
108+ echo "$HOME/.cabal/bin" >> $GITHUB_PATH
109+ echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
110+ echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
111+ echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
112+ HCDIR=/opt/$HCKIND/$HCVER
113+ if [ "${{ matrix.setup-method }}" = ghcup ]; then
114+ HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
115+ HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
116+ HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
117+ echo "HC=$HC" >> "$GITHUB_ENV"
118+ echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
119+ echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
120+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
121+ else
122+ HC=$HCDIR/bin/$HCKIND
123+ echo "HC=$HC" >> "$GITHUB_ENV"
124+ echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
125+ echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
126+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
127+ fi
128+
129+ HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
130+ echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
131+ echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
132+ echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
133+ echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
134+ echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
135+ echo "GHCJSARITH=0" >> "$GITHUB_ENV"
136+ env:
137+ HCKIND: ${{ matrix.compilerKind }}
138+ HCNAME: ${{ matrix.compiler }}
139+ HCVER: ${{ matrix.compilerVersion }}
140+ - name: env
141+ run: |
142+ env
143+ - name: write cabal config
144+ run: |
145+ mkdir -p $CABAL_DIR
146+ cat >> $CABAL_CONFIG <<EOF
147+ remote-build-reporting: anonymous
148+ write-ghc-environment-files: never
149+ remote-repo-cache: $CABAL_DIR/packages
150+ logs-dir: $CABAL_DIR/logs
151+ world-file: $CABAL_DIR/world
152+ extra-prog-path: $CABAL_DIR/bin
153+ symlink-bindir: $CABAL_DIR/bin
154+ installdir: $CABAL_DIR/bin
155+ build-summary: $CABAL_DIR/logs/build.log
156+ store-dir: $CABAL_DIR/store
157+ install-dirs user
158+ prefix: $CABAL_DIR
159+ repository hackage.haskell.org
160+ url: http://hackage.haskell.org/
161+ EOF
162+ cat >> $CABAL_CONFIG <<EOF
163+ program-default-options
164+ ghc-options: $GHCJOBS +RTS -M3G -RTS
165+ EOF
166+ cat $CABAL_CONFIG
167+ - name: versions
168+ run: |
169+ $HC --version || true
170+ $HC --print-project-git-commit-id || true
171+ $CABAL --version || true
172+ - name: update cabal index
173+ run: |
174+ $CABAL v2-update -v
175+ - name: install cabal-plan
176+ run: |
177+ mkdir -p $HOME/.cabal/bin
178+ curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
179+ echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
180+ xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
181+ rm -f cabal-plan.xz
182+ chmod a+x $HOME/.cabal/bin/cabal-plan
183+ cabal-plan --version
184+ - name: checkout
185+ uses: actions/checkout@v3
186+ with:
187+ path: source
188+ - name: initial cabal.project for sdist
189+ run: |
190+ touch cabal.project
191+ echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
192+ cat cabal.project
193+ - name: sdist
194+ run: |
195+ mkdir -p sdist
196+ $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
197+ - name: unpack
198+ run: |
199+ mkdir -p unpacked
200+ find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
201+ - name: generate cabal.project
202+ run: |
203+ PKGDIR_postgresql_simple="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"
204+ echo "PKGDIR_postgresql_simple=${PKGDIR_postgresql_simple}" >> "$GITHUB_ENV"
205+ rm -f cabal.project cabal.project.local
206+ touch cabal.project
207+ touch cabal.project.local
208+ echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
209+ echo "package postgresql-simple" >> cabal.project
210+ echo " ghc-options: -Werror=missing-methods" >> cabal.project
211+ cat >> cabal.project <<EOF
212+ allow-newer: cryptohash-md5-0.11.100.1:base
213+ EOF
214+ $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(postgresql-simple)$/; }' >> cabal.project.local
215+ cat cabal.project
216+ cat cabal.project.local
217+ - name: dump install plan
218+ run: |
219+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
220+ cabal-plan
221+ - name: restore cache
222+ uses: actions/cache/restore@v3
223+ with:
224+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
225+ path: ~/.cabal/store
226+ restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
227+ - name: install dependencies
228+ run: |
229+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
230+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
231+ - name: build w/o tests
232+ run: |
233+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
234+ - name: build
235+ run: |
236+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
237+ - name: tests
238+ run: |
239+ $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
240+ - name: cabal check
241+ run: |
242+ cd ${PKGDIR_postgresql_simple} || false
243+ ${CABAL} -vnormal check
244+ - name: haddock
245+ run: |
246+ $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
247+ - name: unconstrained build
248+ run: |
249+ rm -f cabal.project.local
250+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
251+ - name: save cache
252+ uses: actions/cache/save@v3
253+ if: always()
254+ with:
255+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
256+ path: ~/.cabal/store
.github/workflows/simple.ymlnew file+58
@@ -0,0 +1,58 @@
1+name: Simple
2+on:
3+ push:
4+ branches:
5+ - master
6+ pull_request:
7+ branches:
8+ - master
9+
10+jobs:
11+ native:
12+ name: "Simple: GHC ${{ matrix.ghc }} on ${{ matrix.os }}"
13+ runs-on: ${{ matrix.os }}
14+ strategy:
15+ matrix:
16+ os: [macos-latest, windows-latest]
17+ ghc: ['8.10','9.0','9.2','9.4.8','9.6.3','9.8.1']
18+ fail-fast: false
19+ timeout-minutes:
20+ 60
21+ steps:
22+ - name: Set git to use LF
23+ run: |
24+ git config --global core.autocrlf false
25+ git config --global core.eol lf
26+
27+ - name: Set up Haskell
28+ id: setup-haskell
29+ uses: haskell/actions/setup@v2
30+ with:
31+ ghc-version: ${{ matrix.ghc }}
32+ cabal-version: '3.10.2.0'
33+
34+ - name: Set up PostgreSQL
35+ uses: ikalnytskyi/action-setup-postgres@v3
36+ id: postgres
37+ with:
38+ username: ci
39+ password: sw0rdfish
40+ database: test
41+
42+ - name: Checkout
43+ uses: actions/checkout@v3.0.2
44+
45+ - name: Cache
46+ uses: actions/cache@v2.1.3
47+ with:
48+ path: ${{ steps.setup-haskell.outputs.cabal-store }}
49+ key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }}
50+ restore-keys: ${{ runner.os }}-${{ matrix.ghc }}-
51+
52+ - name: Build
53+ run: cabal build all --enable-tests
54+
55+ - name: Test
56+ run: cabal test all --enable-tests --test-show-details=direct
57+ env:
58+ DATABASE_CONNSTRING: ${{ steps.postgres.outputs.connection-uri }}
.travis.ymldeleted−177
@@ -1,177 +0,0 @@
1−# This Travis job script has been generated by a script via
2−#
3−# haskell-ci '--config' 'cabal.haskell-ci' '--output' '.travis.yml' 'postgresql-simple.cabal'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.11.20200918
12−#
13−version: ~> 1.0
14−language: c
15−os: linux
16−dist: xenial
17−git:
18− # whether to recursively clone submodules
19− submodules: false
20−branches:
21− only:
22− - master
23−services:
24− - postgresql
25−addons:
26− postgresql: "10"
27−cache:
28− directories:
29− - $HOME/.cabal/packages
30− - $HOME/.cabal/store
31− - $HOME/.hlint
32−before_cache:
33− - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
34− # remove files that are regenerated by 'cabal update'
35− - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
36− - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
37− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
38− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
39− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
40− - rm -rfv $CABALHOME/packages/head.hackage
41−jobs:
42− include:
43− - compiler: ghc-8.10.2
44− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.2","cabal-install-3.4"]}}
45− env: DATABASE_CONNSTRING=travis
46− os: linux
47− - compiler: ghc-8.8.4
48− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.4","cabal-install-3.4"]}}
49− env: DATABASE_CONNSTRING=travis
50− os: linux
51− - compiler: ghc-8.6.5
52− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.4"]}}
53− env: DATABASE_CONNSTRING=travis
54− os: linux
55− - compiler: ghc-8.4.4
56− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.4"]}}
57− env: DATABASE_CONNSTRING=travis
58− os: linux
59− - compiler: ghc-8.2.2
60− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.4"]}}
61− env: DATABASE_CONNSTRING=travis
62− os: linux
63− - compiler: ghc-8.0.2
64− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.4"]}}
65− env: DATABASE_CONNSTRING=travis
66− os: linux
67− - compiler: ghc-7.10.3
68− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.10.3","cabal-install-3.4"]}}
69− env: DATABASE_CONNSTRING=travis
70− os: linux
71− - compiler: ghc-7.8.4
72− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.8.4","cabal-install-3.4"]}}
73− env: DATABASE_CONNSTRING=travis
74− os: linux
75− - compiler: ghc-7.6.3
76− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-7.6.3","cabal-install-3.4"]}}
77− env: DATABASE_CONNSTRING=travis
78− os: linux
79−before_install:
80− - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
81− - WITHCOMPILER="-w $HC"
82− - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
83− - HCPKG="$HC-pkg"
84− - unset CC
85− - CABAL=/opt/ghc/bin/cabal
86− - CABALHOME=$HOME/.cabal
87− - export PATH="$CABALHOME/bin:$PATH"
88− - TOP=$(pwd)
89− - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
90− - echo $HCNUMVER
91− - CABAL="$CABAL -vnormal+nowrap"
92− - set -o pipefail
93− - TEST=--enable-tests
94− - BENCH=--enable-benchmarks
95− - HEADHACKAGE=false
96− - rm -f $CABALHOME/config
97− - |
98− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
99− echo "remote-build-reporting: anonymous" >> $CABALHOME/config
100− echo "write-ghc-environment-files: always" >> $CABALHOME/config
101− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
102− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
103− echo "world-file: $CABALHOME/world" >> $CABALHOME/config
104− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
105− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
106− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
107− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
108− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
109− echo "install-dirs user" >> $CABALHOME/config
110− echo " prefix: $CABALHOME" >> $CABALHOME/config
111− echo "repository hackage.haskell.org" >> $CABALHOME/config
112− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
113−install:
114− - ${CABAL} --version
115− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
116− - |
117− echo "program-default-options" >> $CABALHOME/config
118− echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
119− - cat $CABALHOME/config
120− - rm -fv cabal.project cabal.project.local cabal.project.freeze
121− - travis_retry ${CABAL} v2-update -v
122− # Generate cabal.project
123− - rm -rf cabal.project cabal.project.local cabal.project.freeze
124− - touch cabal.project
125− - |
126− echo "packages: ." >> cabal.project
127− - if [ $HCNUMVER -ge 80200 ] ; then echo 'package postgresql-simple' >> cabal.project ; fi
128− - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
129− - |
130− - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(postgresql-simple)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
131− - cat cabal.project || true
132− - cat cabal.project.local || true
133− - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
134− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
135− - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
136− - rm cabal.project.freeze
137− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
138− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
139−script:
140− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
141− # Packaging...
142− - ${CABAL} v2-sdist all
143− # Unpacking...
144− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
145− - cd ${DISTDIR} || false
146− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
147− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
148− - PKGDIR_postgresql_simple="$(find . -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"
149− # Generate cabal.project
150− - rm -rf cabal.project cabal.project.local cabal.project.freeze
151− - touch cabal.project
152− - |
153− echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
154− - if [ $HCNUMVER -ge 80200 ] ; then echo 'package postgresql-simple' >> cabal.project ; fi
155− - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
156− - |
157− - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(postgresql-simple)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
158− - cat cabal.project || true
159− - cat cabal.project.local || true
160− # Building...
161− # this builds all libraries and executables (without tests/benchmarks)
162− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
163− # Building with tests and benchmarks...
164− # build & run tests, build benchmarks
165− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
166− # Testing...
167− - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
168− # cabal check...
169− - (cd ${PKGDIR_postgresql_simple} && ${CABAL} -vnormal check)
170− # haddock...
171− - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
172− # Building without installed constraints for packages in global-db...
173− - rm -f cabal.project.local
174− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
175−
176−# REGENDATA ("0.11.20200918",["--config","cabal.haskell-ci","--output",".travis.yml","postgresql-simple.cabal"])
177−# EOF
CHANGES.md+32−4
@@ -1,3 +1,31 @@
1+### Version 0.7.0.0 (2023-07-31)
2+
3+ * Remove Eq Null instance. (Future `base` may break it, we remove it profilacticly).
4+ * Use `postgresql-libpq >=0.10.0.0`. It includes critical fixes,
5+ by using `postgresql-simple >=0.7` you won't get older `postgresql-libpq`.
6+ * Drop support for GHC prior 8.6
7+ * Added a class for `postgresql-simple` exceptions: `SomePostgreSqlException`.
8+ This allows to catch all `postgresql-simple` exceptions at once.
9+ (c.f. `AsyncException` in `base).
10+
11+### Version 0.6.5.1 (2023-07-09)
12+
13+ * Support `aeson-2.2.0.0`
14+
15+### Version 0.6.5 (2022-10-30)
16+
17+ * Add `withConnect`
18+
19+### Version 0.6.4 (2021-01-06)
20+
21+ * Add foldCopyData helper function
22+ Thanks to Sebastián Estrella for the implementation
23+ https://github.com/haskellari/postgresql-simple/pull/56
24+ * Implement support for postgresql 'interval' type
25+ Thanks to Andre Marques Lee for the implementation
26+ https://github.com/haskellari/postgresql-simple/pull/60
27+ * Depend on `time-compat` to provide uniform `time` related interface.
28+
1### Version 0.6.3 (2020-11-15)
29### Version 0.6.3 (2020-11-15)
2
30
3 * Add `fromFieldJSONByteString`
31 * Add `fromFieldJSONByteString`
@@ -243,7 +271,7 @@
243 support UTF8 except for Mule Internal Code, the Multilingual
271 support UTF8 except for Mule Internal Code, the Multilingual
244 Extensions for Emacs. An exception should be raised upon
272 Extensions for Emacs. An exception should be raised upon
245 connecting to a database by the backend if the backend cannot
273 connecting to a database by the backend if the backend cannot
246− accomodate this requirement.
274+ accommodate this requirement.
247
275
248 * Added `Eq` and `Typeable` instances for `Connection`.
276 * Added `Eq` and `Typeable` instances for `Connection`.
249
277
@@ -381,7 +409,7 @@
381
409
382 * Changed the Identifier and QualifiedIdentifier to use Text in
410 * Changed the Identifier and QualifiedIdentifier to use Text in
383 order to avoid encoding errors. Technically this requires a
411 order to avoid encoding errors. Technically this requires a
384− major verson bump, but let's pretend 0.4.1.0 didn't happen.
412+ major version bump, but let's pretend 0.4.1.0 didn't happen.
385
413
386 * Removed non-exhaustive cases in the ToField instance for Values,
414 * Removed non-exhaustive cases in the ToField instance for Values,
387 and tweaked error messages.
415 and tweaked error messages.
@@ -541,7 +569,7 @@
541
569
542 * Added a brand new TypeInfo system that gives FromField instances
570 * Added a brand new TypeInfo system that gives FromField instances
543 convenient and efficient access to the pg_type metatable. This
571 convenient and efficient access to the pg_type metatable. This
544− replaced the older typename cache, and was neccesary to properly
572+ replaced the older typename cache, and was necessary to properly
545 support postgres array types. Thanks to Bas van Dijk for his
573 support postgres array types. Thanks to Bas van Dijk for his
546 work on this feature.
574 work on this feature.
547
575
@@ -633,7 +661,7 @@
633 now the preferred way of dealing with `timestamp` (without time zone).
661 now the preferred way of dealing with `timestamp` (without time zone).
634
662
635 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
663 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
636− that accomodate PostgreSQL's infinities.
664+ that accommodate PostgreSQL's infinities.
637
665
638 * All time-related `FromField`/`ToField` instances are now based on new,
666 * All time-related `FromField`/`ToField` instances are now based on new,
639 higher-speed parsers and printers instead of those provided by the
667 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 `.travis.yml` with `haskell-ci regenerate` (get the latest from [GitHub haskell-ci/haskell-ci](https://github.com/haskell-ci/haskell-ci))
7+ - Regenerate `.github/workflows/haskell-ci.yml` with `haskell-ci regenerate` (get the latest from [GitHub haskell-ci/haskell-ci](https://github.com/haskell-ci/haskell-ci))
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,7 +1,4 @@
1−[![Continuous Integration status][status-png]][status]
2[![Hackage page (downloads and API reference)][hackage-png]][hackage]
1[![Hackage page (downloads and API reference)][hackage-png]][hackage]
3
2
4− [status-png]: https://api.travis-ci.org/lpsmith/postgresql-simple.svg
5− [status]: http://travis-ci.org/lpsmith/postgresql-simple?branch=master
6 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg
3 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg
7 [hackage]: http://hackage.haskell.org/package/postgresql-simple
4 [hackage]: http://hackage.haskell.org/package/postgresql-simple
appveyor.ymldeleted−80
@@ -1,80 +0,0 @@
1−clone_folder: "c:\\WORK"
2−
3−branches:
4− only:
5− - master
6−
7−services:
8− - postgresql96
9−
10−environment:
11− global:
12− CABOPTS: "--store-dir=C:\\SR --http-transport=plain-http"
13− PGUSER: postgres
14− PGPASSWORD: Password12!
15− PGPORT: "5432"
16− DATABASE_CONNSTRING: appveyor
17− matrix:
18− # 64 bit builds
19− - GHCVER: "8.8.1"
20− CHOCOPTS:
21− - GHCVER: "8.6.5"
22− CHOCOPTS:
23− - GHCVER: "8.4.4"
24− CHOCOPTS:
25− - GHCVER: "8.2.2"
26− CHOCOPTS:
27− - GHCVER: "8.0.2"
28− CHOCOPTS:
29− - GHCVER: "7.10.3.2"
30− CHOCOPTS:
31−
32− # Fails to link
33− #
34− # - GHCVER: "7.8.4.1"
35− # CHOCOPTS:
36−
37− # 32 bit builds
38−
39− # Linker errors...
40−
41− # - GHCVER: "8.6.5"
42− # CHOCOPTS: --forcex86
43− # - GHCVER: "8.4.4"
44− # CHOCOPTS: --forcex86
45− # - GHCVER: "8.2.2"
46− # CHOCOPTS: --forcex86
47−
48− # older segfault?
49−
50−cache:
51−- "C:\\SR"
52−
53−install:
54− - "choco install -y ghc --version %GHCVER% %CHOCOPTS%"
55− - "choco install -y cabal %CHOCOPTS%"
56− - "refreshenv"
57− - "set PATH=C:\\ghc\\ghc-%GHCVER%:C:\\msys64\\mingw64\\bin;C:\\msys64\\usr\\bin;%PATH%"
58− - "cabal --version"
59− - "ghc --version"
60−
61− - set PATH=C:\Progra~1\PostgreSQL\9.6\bin\;%PATH%
62−
63−build: off
64−
65−test_script:
66− - "cabal %CABOPTS% update -v"
67− - createdb TestDb
68− - IF EXIST configure.ac bash -c "autoreconf -i"
69− - "move cabal.project.local.win cabal.project.local"
70−
71− - "cabal %CABOPTS% v2-build -j1 libs test"
72− # - "cabal %CABOPTS% v2-test -j1 all"
73− - "cabal %CABOPTS% v2-run test"
74− # - "cabal %CABOPTS% v2-run inspection" # only GHC-8.0 (or GHC-8.2+)
75−
76− # Build from sdist
77− - "rmdir /Q /S dist-newstyle"
78− - "cabal v2-sdist"
79− - "sh -c 'echo packages: dist-newstyle/sdist/*.tar.gz > cabal.project'"
80− - "cabal v2-build -j1 postgresql-simple" # TODO: unfortunately the package name have to be here
cabal.haskell-ci−10
@@ -3,13 +3,3 @@ postgresql: True
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,2 +1,4 @@
1packages: .
1packages: .
2tests: true
2tests: true
3+
4+allow-newer: cryptohash-md5-0.11.100.1:base
postgresql-simple.cabal+31−49
@@ -1,6 +1,7 @@
1cabal-version: 1.12
1cabal-version: 1.12
2name: postgresql-simple
2name: postgresql-simple
3−version: 0.6.3
3+version: 0.7.0.0
4+x-revision: 1
4synopsis: Mid-Level PostgreSQL client library
5synopsis: Mid-Level PostgreSQL client library
5description:
6description:
6 Mid-Level PostgreSQL client library, forked from mysql-simple.
7 Mid-Level PostgreSQL client library, forked from mysql-simple.
@@ -12,7 +13,7 @@ maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
12copyright:
13copyright:
13 (c) 2011 MailRank, Inc.
14 (c) 2011 MailRank, Inc.
14 (c) 2011-2018 Leon P Smith
15 (c) 2011-2018 Leon P Smith
15− (c) 2018-2019 Oleg Grenrus
16+ (c) 2018-2020 Oleg Grenrus
16
17
17category: Database
18category: Database
18build-type: Simple
19build-type: Simple
@@ -23,15 +24,14 @@ extra-source-files:
23 test/results/unique-constraint-violation.expected
24 test/results/unique-constraint-violation.expected
24
25
25tested-with:
26tested-with:
26− GHC ==7.6.3
27− || ==7.8.4
28− || ==7.10.3
29− || ==8.0.2
30− || ==8.2.2
31− || ==8.4.4
32− || ==8.6.5
27+ GHC ==8.6.5
33 || ==8.8.4
28 || ==8.8.4
34− || ==8.10.2
29+ || ==8.10.7
30+ || ==9.0.2
31+ || ==9.2.8
32+ || ==9.4.8
33+ || ==9.6.3
34+ || ==9.8.1
35
35
36library
36library
37 default-language: Haskell2010
37 default-language: Haskell2010
@@ -77,34 +77,25 @@ library
77
77
78 -- GHC bundled libs
78 -- GHC bundled libs
79 build-depends:
79 build-depends:
80− base >=4.6.0.0 && <4.15
80+ base >=4.12.0.0 && <4.20
81− , bytestring >=0.10.0.0 && <0.12
81+ , bytestring >=0.10.8.2 && <0.13
82− , containers >=0.5.0.0 && <0.7
82+ , containers >=0.6.0.1 && <0.7
83− , template-haskell >=2.8.0.0 && <2.17
83+ , template-haskell >=2.14.0.0 && <2.22
84− , text >=1.2.3.0 && <1.3
84+ , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
85− , time >=1.4.0.1 && <1.12
85+ , time-compat >=1.9.5 && <1.12
86− , transformers >=0.3.0.0 && <0.6
86+ , transformers >=0.5.6.2 && <0.7
87
87
88 -- Other dependencies
88 -- Other dependencies
89 build-depends:
89 build-depends:
90− aeson >=1.4.1.0 && <1.6
90+ aeson >=2.1.2.1 && <2.3
91− , attoparsec >=0.13.2.2 && <0.14
91+ , attoparsec >=0.14.4 && <0.15
92− , bytestring-builder >=0.10.8.1.0 && <0.11
93− , case-insensitive >=1.2.0.11 && <1.3
92+ , case-insensitive >=1.2.1.0 && <1.3
94− , hashable >=1.2.7.0 && <1.4
93+ , hashable >=1.4.3.0 && <1.5
95− , Only >=0.1 && <0.1.1
94+ , Only >=0.1 && <0.1.1
96− , postgresql-libpq >=0.9.4.2 && <0.10
95+ , postgresql-libpq >=0.10.0.0 && <0.11
97− , scientific >=0.3.6.2 && <0.4
96+ , scientific >=0.3.7.0 && <0.4
98− , uuid-types >=1.0.3 && <1.1
97+ , uuid-types >=1.0.5 && <1.1
99− , vector >=0.12.0.1 && <0.13
98+ , vector >=0.13.0.0 && <0.14
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
108
99
109 default-extensions:
100 default-extensions:
110 BangPatterns
101 BangPatterns
@@ -117,24 +108,16 @@ library
117
108
118source-repository head
109source-repository head
119 type: git
110 type: git
120− location: http://github.com/phadej/postgresql-simple
111+ location: http://github.com/haskellari/postgresql-simple
121−
122−source-repository this
123− type: git
124− location: http://github.com/phadej/postgresql-simple
125− tag: v0.6
126
112
127test-suite inspection
113test-suite inspection
128− if !impl(ghc >=8.0)
129− buildable: False
130−
131 default-language: Haskell2010
114 default-language: Haskell2010
132 type: exitcode-stdio-1.0
115 type: exitcode-stdio-1.0
133 hs-source-dirs: test
116 hs-source-dirs: test
134 main-is: Inspection.hs
117 main-is: Inspection.hs
135 build-depends:
118 build-depends:
136 base
119 base
137− , inspection-testing >=0.4.1.1 && <0.5
120+ , inspection-testing >=0.4.1.1 && <0.6
138 , postgresql-libpq
121 , postgresql-libpq
139 , postgresql-simple
122 , postgresql-simple
140 , tasty
123 , tasty
@@ -147,6 +130,8 @@ test-suite test
147 main-is: Main.hs
130 main-is: Main.hs
148 other-modules:
131 other-modules:
149 Common
132 Common
133+ Exception
134+ Interval
150 Notify
135 Notify
151 Serializable
136 Serializable
152 Time
137 Time
@@ -176,12 +161,9 @@ test-suite test
176 , tasty-golden
161 , tasty-golden
177 , tasty-hunit
162 , tasty-hunit
178 , text
163 , text
179− , time
164+ , time-compat
180 , vector
165 , vector
181
166
182− if !impl(ghc >=7.6)
183− build-depends: ghc-prim
184−
185benchmark select
167benchmark select
186 default-language: Haskell2010
168 default-language: Haskell2010
187 type: exitcode-stdio-1.0
169 type: exitcode-stdio-1.0
src/Database/PostgreSQL/Simple.hs+3−1
@@ -64,6 +64,7 @@ module Database.PostgreSQL.Simple
64 , Only(..)
64 , Only(..)
65 , (:.)(..)
65 , (:.)(..)
66 -- ** Exceptions
66 -- ** Exceptions
67+ , SomePostgreSqlException(..)
67 , SqlError(..)
68 , SqlError(..)
68 , PQ.ExecStatus(..)
69 , PQ.ExecStatus(..)
69 , FormatError(..)
70 , FormatError(..)
@@ -73,6 +74,7 @@ module Database.PostgreSQL.Simple
73 , Base.connectPostgreSQL
74 , Base.connectPostgreSQL
74 , Base.close
75 , Base.close
75 , Base.connect
76 , Base.connect
77+ , Base.withConnect
76 , Base.ConnectInfo(..)
78 , Base.ConnectInfo(..)
77 , Base.defaultConnectInfo
79 , Base.defaultConnectInfo
78 , Base.postgreSQLConnectionString
80 , Base.postgreSQLConnectionString
@@ -900,7 +902,7 @@ forEachWith_ parser conn template = foldWith_ parser conn template () . const
900-- all values of the given PostgreSQL type is considered \"compatible\".
902-- all values of the given PostgreSQL type is considered \"compatible\".
901-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@
903-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@
902-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately
904-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately
903−-- represent a @SMALLINT@, so it is considered compatble with those types.
905+-- represent a @SMALLINT@, so it is considered compatible with those types.
904--
906--
905-- * A numeric compatibility check is based only on the type of a
907-- * A numeric compatibility check is based only on the type of a
906-- column, /not/ on its values. For instance, a PostgreSQL 64-bit
908-- column, /not/ on its values. For instance, a PostgreSQL 64-bit
src/Database/PostgreSQL/Simple/Compat.hs−53
@@ -12,36 +12,13 @@ module Database.PostgreSQL.Simple.Compat
12 ) where
12 ) where
13
13
14import qualified Control.Exception as E
14import qualified Control.Exception as E
15−import Data.Monoid
16import Data.ByteString (ByteString)
15import Data.ByteString (ByteString)
17−#if MIN_VERSION_bytestring(0,10,0)
18import Data.ByteString.Lazy (toStrict)
16import Data.ByteString.Lazy (toStrict)
19−#else
20−import qualified Data.ByteString as B
21−import Data.ByteString.Lazy (toChunks)
22−#endif
23import Data.ByteString.Builder (Builder, toLazyByteString)
17import Data.ByteString.Builder (Builder, toLazyByteString)
24−
25−#if MIN_VERSION_scientific(0,3,0)
26import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
18import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
27−#else
28−import Data.Scientific (scientificBuilder)
29−#endif
30−
31−#if __GLASGOW_HASKELL__ >= 702
32import System.IO.Unsafe (unsafeDupablePerformIO)
19import System.IO.Unsafe (unsafeDupablePerformIO)
33−#elif __GLASGOW_HASKELL__ >= 611
34−import GHC.IO (unsafeDupablePerformIO)
35−#else
36−import GHC.IOBase (unsafeDupablePerformIO)
37−#endif
38−
39import Data.Fixed (Pico)
20import Data.Fixed (Pico)
40−#if MIN_VERSION_base(4,7,0)
41import Data.Fixed (Fixed(MkFixed))
21import Data.Fixed (Fixed(MkFixed))
42−#else
43−import Unsafe.Coerce (unsafeCoerce)
44−#endif
45
22
46-- | Like 'E.mask', but backported to base before version 4.3.0.
23-- | Like 'E.mask', but backported to base before version 4.3.0.
47--
24--
@@ -51,44 +28,14 @@ import Unsafe.Coerce (unsafeCoerce)
51-- 'withTransactionMode' function calls the restore callback only once, so we
28-- 'withTransactionMode' function calls the restore callback only once, so we
52-- don't need that polymorphism.
29-- don't need that polymorphism.
53mask :: ((IO a -> IO a) -> IO b) -> IO b
30mask :: ((IO a -> IO a) -> IO b) -> IO b
54−#if MIN_VERSION_base(4,3,0)
55mask io = E.mask $ \restore -> io restore
31mask 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
61{-# INLINE mask #-}
32{-# INLINE mask #-}
62
33
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−
71toByteString :: Builder -> ByteString
34toByteString :: Builder -> ByteString
72−#if MIN_VERSION_bytestring(0,10,0)
73toByteString x = toStrict (toLazyByteString x)
35toByteString 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)
79
36
80toPico :: Integer -> Pico
37toPico :: Integer -> Pico
81toPico = MkFixed
38toPico = MkFixed
82
39
83fromPico :: Pico -> Integer
40fromPico :: Pico -> Integer
84fromPico (MkFixed i) = i
41fromPico (MkFixed i) = i
85−
86−#else
87−
88−toPico :: Integer -> Pico
89−toPico = unsafeCoerce
90−
91−fromPico :: Pico -> Integer
92−fromPico = unsafeCoerce
93−
94−#endif
src/Database/PostgreSQL/Simple/Copy.hs+26−5
@@ -32,6 +32,7 @@ module Database.PostgreSQL.Simple.Copy
32 ( copy
32 ( copy
33 , copy_
33 , copy_
34 , CopyOutResult(..)
34 , CopyOutResult(..)
35+ , foldCopyData
35 , getCopyData
36 , getCopyData
36 , putCopyData
37 , putCopyData
37 , putCopyEnd
38 , putCopyEnd
@@ -54,7 +55,7 @@ import Database.PostgreSQL.Simple.Internal hiding (result, row)
54-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former
55-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former
55-- case, the connection's state will change to @CopyIn@; in the latter,
56-- case, the connection's state will change to @CopyIn@; in the latter,
56-- @CopyOut@. The connection must be in the ready state in order
57-- @CopyOut@. The connection must be in the ready state in order
57−-- to call this function. Performs parameter subsitution.
58+-- to call this function. Performs parameter substitution.
58
59
59copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()
60copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()
60copy conn template qs = do
61copy conn template qs = do
@@ -85,12 +86,8 @@ doCopy funcName conn template q = do
85 PQ.TuplesOk -> err
86 PQ.TuplesOk -> err
86 PQ.CopyOut -> return ()
87 PQ.CopyOut -> return ()
87 PQ.CopyIn -> return ()
88 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)
92 PQ.SingleTuple -> errMsg "single-row mode is not supported"
90 PQ.SingleTuple -> errMsg "single-row mode is not supported"
93−#endif
94 PQ.BadResponse -> throwResultError funcName result status
91 PQ.BadResponse -> throwResultError funcName result status
95 PQ.NonfatalError -> throwResultError funcName result status
92 PQ.NonfatalError -> throwResultError funcName result status
96 PQ.FatalError -> throwResultError funcName result status
93 PQ.FatalError -> throwResultError funcName result status
@@ -104,6 +101,30 @@ data CopyOutResult
104 deriving (Eq, Typeable, Show)
101 deriving (Eq, Typeable, Show)
105
102
106
103
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+
107-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
128-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
108-- must be in the @CopyOut@ state in order to call this function. If this
129-- must be in the @CopyOut@ state in order to call this function. If this
109-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,
130-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,
src/Database/PostgreSQL/Simple/Errors.hs+4−3
@@ -25,7 +25,6 @@ module Database.PostgreSQL.Simple.Errors
25 )
25 )
26 where
26 where
27
27
28−import Control.Applicative
29import Control.Exception as E
28import Control.Exception as E
30
29
31import Data.Attoparsec.ByteString.Char8
30import Data.Attoparsec.ByteString.Char8
@@ -60,11 +59,13 @@ data ConstraintViolation
60 deriving (Show, Eq, Ord, Typeable)
59 deriving (Show, Eq, Ord, Typeable)
61
60
62-- Default instance should be enough
61-- Default instance should be enough
63−instance Exception ConstraintViolation
62+instance Exception ConstraintViolation where
63+ toException = postgresqlExceptionToException
64+ fromException = postgresqlExceptionFromException
64
65
65
66
66-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
67-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
67−-- succeedes only if able to parse sqlErrorMsg.
68+-- succeeds only if able to parse sqlErrorMsg.
68--
69--
69-- > createUser = handleJust constraintViolation handler $ execute conn ...
70-- > createUser = handleJust constraintViolation handler $ execute conn ...
70-- > where
71-- > where
src/Database/PostgreSQL/Simple/FromField.hs+17−6
@@ -118,10 +118,8 @@ module Database.PostgreSQL.Simple.FromField
118
118
119import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
119import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
120import Control.Concurrent.MVar (MVar, newMVar)
120import Control.Concurrent.MVar (MVar, newMVar)
121−import Control.Exception (Exception)
121+import Control.Exception (Exception (toException, fromException))
122import qualified Data.Aeson as JSON
122import qualified Data.Aeson as JSON
123−import qualified Data.Aeson.Internal as JSON
124−import qualified Data.Aeson.Parser as JSON (value')
125import Data.Attoparsec.ByteString.Char8 hiding (Result)
123import Data.Attoparsec.ByteString.Char8 hiding (Result)
126import Data.ByteString (ByteString)
124import Data.ByteString (ByteString)
127import qualified Data.ByteString.Char8 as B
125import qualified Data.ByteString.Char8 as B
@@ -129,7 +127,7 @@ import Data.Functor.Identity (Identity(Identity))
129import Data.Int (Int16, Int32, Int64)
127import Data.Int (Int16, Int32, Int64)
130import Data.IORef (IORef, newIORef)
128import Data.IORef (IORef, newIORef)
131import Data.Ratio (Ratio)
129import Data.Ratio (Ratio)
132−import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )
130+import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )
133import Data.Typeable (Typeable, typeOf)
131import Data.Typeable (Typeable, typeOf)
134import Data.Vector (Vector)
132import Data.Vector (Vector)
135import Data.Vector.Mutable (IOVector)
133import Data.Vector.Mutable (IOVector)
@@ -156,6 +154,8 @@ import qualified Data.UUID.Types as UUID
156import Data.Scientific (Scientific)
154import Data.Scientific (Scientific)
157import GHC.Real (infinity, notANumber)
155import GHC.Real (infinity, notANumber)
158
156
157+import qualified Data.Aeson.Types as JSON
158+
159-- | Exception thrown if conversion from a SQL value to a Haskell
159-- | Exception thrown if conversion from a SQL value to a Haskell
160-- value fails.
160-- value fails.
161data ResultError = Incompatible { errSQLType :: String
161data ResultError = Incompatible { errSQLType :: String
@@ -182,7 +182,9 @@ data ResultError = Incompatible { errSQLType :: String
182 -- between metadata and actual data in a row).
182 -- between metadata and actual data in a row).
183 deriving (Eq, Show, Typeable)
183 deriving (Eq, Show, Typeable)
184
184
185−instance Exception ResultError
185+instance Exception ResultError where
186+ toException = postgresqlExceptionToException
187+ fromException = postgresqlExceptionFromException
186
188
187left :: Exception a => a -> Conversion b
189left :: Exception a => a -> Conversion b
188left = conversionError
190left = conversionError
@@ -487,6 +489,15 @@ instance FromField LocalTimestamp where
487instance FromField Date where
489instance FromField Date where
488 fromField = ff TI.dateOid "Date" parseDate
490 fromField = ff TI.dateOid "Date" parseDate
489
491
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+
490ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
501ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
491 -> Field -> Maybe B8.ByteString -> Conversion a
502 -> Field -> Maybe B8.ByteString -> Conversion a
492ff compatOid hsType parseBS f mstr =
503ff compatOid hsType parseBS f mstr =
@@ -565,7 +576,7 @@ instance FromField UUID where
565-- | json, jsonb
576-- | json, jsonb
566instance FromField JSON.Value where
577instance FromField JSON.Value where
567 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
578 fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
568− where parseBS bs = case parseOnly (JSON.value' <* endOfInput) bs of
579+ where parseBS bs = case JSON.eitherDecodeStrict' bs of
569 Left err -> returnError ConversionFailed f err
580 Left err -> returnError ConversionFailed f err
570 Right val -> pure val
581 Right val -> pure val
571
582
src/Database/PostgreSQL/Simple/HStore/Implementation.hs−6
@@ -22,9 +22,6 @@ 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
28import Data.Map(Map)
25import Data.Map(Map)
29import qualified Data.Map as Map
26import qualified Data.Map as Map
30import Data.Text(Text)
27import Data.Text(Text)
@@ -69,9 +66,6 @@ instance Semigroup HStoreBuilder where
69
66
70instance Monoid HStoreBuilder where
67instance Monoid HStoreBuilder where
71 mempty = Empty
68 mempty = Empty
72−#if !(MIN_VERSION_base(4,11,0))
73− mappend = (<>)
74−#endif
75
69
76class ToHStoreText a where
70class ToHStoreText a where
77 toHStoreText :: a -> HStoreText
71 toHStoreText :: a -> HStoreText
src/Database/PostgreSQL/Simple/Internal.hs+37−7
@@ -1,6 +1,8 @@
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 #-}
4
6
5------------------------------------------------------------------------------
7------------------------------------------------------------------------------
6-- |
8-- |
@@ -34,7 +36,6 @@ import Data.Int (Int64)
34import qualified Data.IntMap as IntMap
36import qualified Data.IntMap as IntMap
35import Data.IORef
37import Data.IORef
36import Data.Maybe(fromMaybe)
38import Data.Maybe(fromMaybe)
37−import Data.Monoid
38import Data.String
39import Data.String
39import qualified Data.Text as T
40import qualified Data.Text as T
40import qualified Data.Text.Encoding as TE
41import qualified Data.Text.Encoding as TE
@@ -82,6 +83,25 @@ data Connection = Connection {
82instance Eq Connection where
83instance Eq Connection where
83 x == y = connectionHandle x == connectionHandle y
84 x == y = connectionHandle x == connectionHandle y
84
85
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+
85data SqlError = SqlError {
105data SqlError = SqlError {
86 sqlState :: ByteString
106 sqlState :: ByteString
87 , sqlExecStatus :: ExecStatus
107 , sqlExecStatus :: ExecStatus
@@ -93,7 +113,10 @@ data SqlError = SqlError {
93fatalError :: ByteString -> SqlError
113fatalError :: ByteString -> SqlError
94fatalError msg = SqlError "" FatalError msg "" ""
114fatalError msg = SqlError "" FatalError msg "" ""
95
115
96−instance Exception SqlError
116+instance Exception SqlError where
117+ toException = postgresqlExceptionToException
118+ fromException = postgresqlExceptionFromException
119+
97
120
98-- | Exception thrown if 'query' is used to perform an @INSERT@-like
121-- | Exception thrown if 'query' is used to perform an @INSERT@-like
99-- operation, or 'execute' is used to perform a @SELECT@-like operation.
122-- operation, or 'execute' is used to perform a @SELECT@-like operation.
@@ -102,7 +125,9 @@ data QueryError = QueryError {
102 , qeQuery :: Query
125 , qeQuery :: Query
103 } deriving (Eq, Show, Typeable)
126 } deriving (Eq, Show, Typeable)
104
127
105−instance Exception QueryError
128+instance Exception QueryError where
129+ toException = postgresqlExceptionToException
130+ fromException = postgresqlExceptionFromException
106
131
107-- | Exception thrown if a 'Query' could not be formatted correctly.
132-- | Exception thrown if a 'Query' could not be formatted correctly.
108-- This may occur if the number of \'@?@\' characters in the query
133-- This may occur if the number of \'@?@\' characters in the query
@@ -113,7 +138,9 @@ data FormatError = FormatError {
113 , fmtParams :: [ByteString]
138 , fmtParams :: [ByteString]
114 } deriving (Eq, Show, Typeable)
139 } deriving (Eq, Show, Typeable)
115
140
116−instance Exception FormatError
141+instance Exception FormatError where
142+ toException = postgresqlExceptionToException
143+ fromException = postgresqlExceptionFromException
117
144
118data ConnectInfo = ConnectInfo {
145data ConnectInfo = ConnectInfo {
119 connectHost :: String
146 connectHost :: String
@@ -155,6 +182,12 @@ defaultConnectInfo = ConnectInfo {
155connect :: ConnectInfo -> IO Connection
182connect :: ConnectInfo -> IO Connection
156connect = connectPostgreSQL . postgreSQLConnectionString
183connect = connectPostgreSQL . postgreSQLConnectionString
157
184
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+
158-- | Attempt to make a connection based on a libpq connection string.
191-- | Attempt to make a connection based on a libpq connection string.
159-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
192-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
160-- for more information. Also note that environment variables also affect
193-- for more information. Also note that environment variables also affect
@@ -484,9 +517,6 @@ instance Alternative Conversion where
484 Errors _ -> (oka <|>) <$> runConversion mb conn
517 Errors _ -> (oka <|>) <$> runConversion mb conn
485
518
486instance Monad Conversion where
519instance Monad Conversion where
487−#if !(MIN_VERSION_base(4,8,0))
488− return = pure
489−#endif
490 m >>= f = Conversion $ \conn -> do
520 m >>= f = Conversion $ \conn -> do
491 oka <- runConversion m conn
521 oka <- runConversion m conn
492 case oka of
522 case oka of
src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs−4
@@ -76,12 +76,8 @@ 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)
80 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"
79 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"
81−#endif
82−#if MIN_VERSION_postgresql_libpq(0,9,2)
83 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"
80 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"
84−#endif
85 PQ.BadResponse -> throwResultError "query" result status
81 PQ.BadResponse -> throwResultError "query" result status
86 PQ.NonfatalError -> throwResultError "query" result status
82 PQ.NonfatalError -> throwResultError "query" result status
87 PQ.FatalError -> throwResultError "query" result status
83 PQ.FatalError -> throwResultError "query" result status
src/Database/PostgreSQL/Simple/Notification.hs−17
@@ -47,8 +47,6 @@ 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 )
52#else
50#else
53import GHC.Conc ( atomically )
51import GHC.Conc ( atomically )
54import Control.Concurrent ( threadWaitReadSTM )
52import Control.Concurrent ( threadWaitReadSTM )
@@ -94,21 +92,6 @@ getNotification conn = join $ withConnection conn fetch
94 -- with async exceptions, whereas threadDelay can.
92 -- with async exceptions, whereas threadDelay can.
95 Just _fd -> do
93 Just _fd -> do
96 return (threadDelay 1000000 >> loop)
94 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
112#else
95#else
113 -- This case fixes the race condition above. By registering
96 -- This case fixes the race condition above. By registering
114 -- our interest in the descriptor before we drop the lock,
97 -- our interest in the descriptor before we drop the lock,
src/Database/PostgreSQL/Simple/Ok.hs−4
@@ -72,10 +72,6 @@ instance MonadPlus Ok where
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−
79 Errors es >>= _ = Errors es
75 Errors es >>= _ = Errors es
80 Ok a >>= f = f a
76 Ok a >>= f = f a
81
77
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 (Day, LocalTime,
41+import Data.Time.Compat (Day, LocalTime,
42 NominalDiffTime,
42 NominalDiffTime,
43 TimeOfDay, UTCTime,
43 TimeOfDay, UTCTime,
44 ZonedTime,
44 ZonedTime,
src/Database/PostgreSQL/Simple/Time.hs+2
@@ -227,6 +227,7 @@ module Database.PostgreSQL.Simple.Time
227 , parseUTCTimestamp
227 , parseUTCTimestamp
228 , parseZonedTimestamp
228 , parseZonedTimestamp
229 , parseLocalTimestamp
229 , parseLocalTimestamp
230+ , parseCalendarDiffTime
230 , dayToBuilder
231 , dayToBuilder
231 , utcTimeToBuilder
232 , utcTimeToBuilder
232 , zonedTimeToBuilder
233 , zonedTimeToBuilder
@@ -239,6 +240,7 @@ module Database.PostgreSQL.Simple.Time
239 , localTimestampToBuilder
240 , localTimestampToBuilder
240 , unboundedToBuilder
241 , unboundedToBuilder
241 , nominalDiffTimeToBuilder
242 , nominalDiffTimeToBuilder
243+ , calendarDiffTimeToBuilder
242 ) where
244 ) where
243
245
244import Database.PostgreSQL.Simple.Time.Implementation
246import Database.PostgreSQL.Simple.Time.Implementation
src/Database/PostgreSQL/Simple/Time/Implementation.hs+11−1
@@ -18,7 +18,8 @@ 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 hiding (getTimeZone, getZonedTime)
21+import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)
22+import Data.Time.LocalTime.Compat (CalendarDiffTime)
22import Data.Typeable
23import Data.Typeable
23import Data.Maybe (fromMaybe)
24import Data.Maybe (fromMaybe)
24import qualified Data.Attoparsec.ByteString.Char8 as A
25import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -77,6 +78,9 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)
77parseDate :: B.ByteString -> Either String Date
78parseDate :: B.ByteString -> Either String Date
78parseDate = A.parseOnly (getDate <* A.endOfInput)
79parseDate = A.parseOnly (getDate <* A.endOfInput)
79
80
81+parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime
82+parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)
83+
80getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
84getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
81getUnbounded getFinite
85getUnbounded getFinite
82 = (pure NegInfinity <* A.string "-infinity")
86 = (pure NegInfinity <* A.string "-infinity")
@@ -125,6 +129,9 @@ getUTCTime = TP.utcTime
125getUTCTimestamp :: A.Parser UTCTimestamp
129getUTCTimestamp :: A.Parser UTCTimestamp
126getUTCTimestamp = getUnbounded getUTCTime
130getUTCTimestamp = getUnbounded getUTCTime
127
131
132+getCalendarDiffTime :: A.Parser CalendarDiffTime
133+getCalendarDiffTime = TP.calendarDiffTime
134+
128dayToBuilder :: Day -> Builder
135dayToBuilder :: Day -> Builder
129dayToBuilder = primBounded TPP.day
136dayToBuilder = primBounded TPP.day
130
137
@@ -164,3 +171,6 @@ dateToBuilder = unboundedToBuilder dayToBuilder
164
171
165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
166nominalDiffTimeToBuilder = TPP.nominalDiffTime
173nominalDiffTimeToBuilder = TPP.nominalDiffTime
174+
175+calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder
176+calendarDiffTimeToBuilder = TPP.calendarDiffTime
src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+12−3
@@ -21,20 +21,24 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser
21 , localToUTCTimeOfDayHMS
21 , localToUTCTimeOfDayHMS
22 , utcTime
22 , utcTime
23 , zonedTime
23 , zonedTime
24+ , calendarDiffTime
24 ) where
25 ) where
25
26
26import Control.Applicative ((<$>), (<*>), (<*), (*>))
27import Control.Applicative ((<$>), (<*>), (<*), (*>))
27import Database.PostgreSQL.Simple.Compat (toPico)
28import Database.PostgreSQL.Simple.Compat (toPico)
28import Data.Attoparsec.ByteString.Char8 as A
29import Data.Attoparsec.ByteString.Char8 as A
29import Data.Bits ((.&.))
30import Data.Bits ((.&.))
31+import Data.ByteString (ByteString)
30import Data.Char (ord)
32import Data.Char (ord)
31import Data.Fixed (Pico)
33import Data.Fixed (Pico)
32import Data.Int (Int64)
34import Data.Int (Int64)
33import Data.Maybe (fromMaybe)
35import Data.Maybe (fromMaybe)
34−import Data.Time.Calendar (Day, fromGregorianValid, addDays)
36+import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)
35−import Data.Time.Clock (UTCTime(..))
37+import Data.Time.Clock.Compat (UTCTime(..))
38+import Data.Time.Format.ISO8601.Compat (iso8601ParseM)
39+import Data.Time.LocalTime.Compat (CalendarDiffTime)
36import qualified Data.ByteString.Char8 as B8
40import qualified Data.ByteString.Char8 as B8
37−import qualified Data.Time.LocalTime as Local
41+import qualified Data.Time.LocalTime.Compat as Local
38
42
39-- | Parse a date of the form @YYYY-MM-DD@.
43-- | Parse a date of the form @YYYY-MM-DD@.
40day :: Parser Day
44day :: Parser Day
@@ -193,3 +197,8 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
193
197
194utc :: Local.TimeZone
198utc :: Local.TimeZone
195utc = Local.TimeZone 0 False ""
199utc = Local.TimeZone 0 False ""
200+
201+calendarDiffTime :: Parser CalendarDiffTime
202+calendarDiffTime = do
203+ contents <- takeByteString
204+ iso8601ParseM $ B8.unpack contents
src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+14−2
@@ -17,19 +17,23 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer
17 , localTime
17 , localTime
18 , zonedTime
18 , zonedTime
19 , nominalDiffTime
19 , nominalDiffTime
20+ , calendarDiffTime
20 ) where
21 ) where
21
22
22import Control.Arrow ((>>>))
23import Control.Arrow ((>>>))
23−import Data.ByteString.Builder (Builder, integerDec)
24+import Data.ByteString.Builder (Builder, byteString, integerDec)
24import Data.ByteString.Builder.Prim
25import Data.ByteString.Builder.Prim
25 ( liftFixedToBounded, (>$<), (>*<)
26 ( liftFixedToBounded, (>$<), (>*<)
26 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
27 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
27import Data.Char ( chr )
28import Data.Char ( chr )
28import Data.Int ( Int32, Int64 )
29import Data.Int ( Int32, Int64 )
29−import Data.Time
30+import Data.String (fromString)
31+import Data.Time.Compat
30 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
32 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
31 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
33 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
32 , TimeZone, timeZoneMinutes )
34 , TimeZone, timeZoneMinutes )
35+import Data.Time.Format.ISO8601.Compat (iso8601Show)
36+import Data.Time.LocalTime.Compat (CalendarDiffTime)
33import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
37import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
34import Unsafe.Coerce (unsafeCoerce)
38import Unsafe.Coerce (unsafeCoerce)
35
39
@@ -121,3 +125,11 @@ nominalDiffTime :: NominalDiffTime -> Builder
121nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
125nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
122 where
126 where
123 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000
127 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000
128+
129+calendarDiffTime :: CalendarDiffTime -> Builder
130+calendarDiffTime = byteString
131+ . fromString
132+ -- from the docs: "Beware: fromString truncates multi-byte characters to octets".
133+ -- However, I think this is a safe usage, because ISO8601-encoding seems restricted
134+ -- to ASCII output.
135+ . iso8601Show
src/Database/PostgreSQL/Simple/ToField.hs+8−8
@@ -36,7 +36,8 @@ import Data.Functor.Identity (Identity(Identity))
36import Data.Int (Int8, Int16, Int32, Int64)
36import Data.Int (Int8, Int16, Int32, Int64)
37import Data.List (intersperse)
37import Data.List (intersperse)
38import Data.Monoid (mappend)
38import Data.Monoid (mappend)
39−import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
39+import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
40+import Data.Time.LocalTime.Compat (CalendarDiffTime)
40import Data.Typeable (Typeable)
41import Data.Typeable (Typeable)
41import Data.Word (Word, Word8, Word16, Word32, Word64)
42import Data.Word (Word, Word8, Word16, Word32, Word64)
42import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
43import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
@@ -58,11 +59,7 @@ import qualified Data.Vector as V
58import qualified Database.PostgreSQL.LibPQ as PQ
59import qualified Database.PostgreSQL.LibPQ as PQ
59import Database.PostgreSQL.Simple.Time
60import Database.PostgreSQL.Simple.Time
60import Data.Scientific (Scientific)
61import Data.Scientific (Scientific)
61−#if MIN_VERSION_scientific(0,3,0)
62import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
62import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
63−#else
64−import Data.Scientific (scientificBuilder)
65−#endif
66import Foreign.C.Types (CUInt(..))
63import Foreign.C.Types (CUInt(..))
67
64
68-- | How to render an element when substituting it into a query.
65-- | How to render an element when substituting it into a query.
@@ -293,6 +290,10 @@ instance ToField NominalDiffTime where
293 toField = Plain . inQuotes . nominalDiffTimeToBuilder
290 toField = Plain . inQuotes . nominalDiffTimeToBuilder
294 {-# INLINE toField #-}
291 {-# INLINE toField #-}
295
292
293+instance ToField CalendarDiffTime where
294+ toField = Plain . inQuotes . calendarDiffTimeToBuilder
295+ {-# INLINE toField #-}
296+
296instance (ToField a) => ToField (PGArray a) where
297instance (ToField a) => ToField (PGArray a) where
297 toField pgArray =
298 toField pgArray =
298 case fromPGArray pgArray of
299 case fromPGArray pgArray of
@@ -313,14 +314,13 @@ instance ToField UUID where
313instance ToField JSON.Value where
314instance ToField JSON.Value where
314 toField = toField . JSON.encode
315 toField = toField . JSON.encode
315
316
316−-- | Convert a Haskell value to a JSON 'JSON.Value' using
317+-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.
317−-- 'JSON.toJSON' and convert that to a field using 'toField'.
318--
318--
319-- This can be used as the default implementation for the 'toField'
319-- This can be used as the default implementation for the 'toField'
320-- method for Haskell types that have a JSON representation in
320-- method for Haskell types that have a JSON representation in
321-- PostgreSQL.
321-- PostgreSQL.
322toJSONField :: JSON.ToJSON a => a -> Action
322toJSONField :: JSON.ToJSON a => a -> Action
323−toJSONField = toField . JSON.toJSON
323+toJSONField = toField . JSON.encode
324
324
325-- | Surround a string with single-quote characters: \"@'@\"
325-- | Surround a string with single-quote characters: \"@'@\"
326--
326--
src/Database/PostgreSQL/Simple/Types.hs−7
@@ -50,10 +50,6 @@ 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−
57-- | A placeholder for the PostgreSQL @DEFAULT@ value.
53-- | A placeholder for the PostgreSQL @DEFAULT@ value.
58data Default = Default
54data Default = Default
59 deriving (Read, Show, Typeable)
55 deriving (Read, Show, Typeable)
@@ -97,9 +93,6 @@ instance Semigroup Query where
97
93
98instance Monoid Query where
94instance Monoid Query where
99 mempty = Query B.empty
95 mempty = Query B.empty
100−#if !(MIN_VERSION_base(4,11,0))
101− mappend = (<>)
102−#endif
103
96
104-- | Wrap a list of values for use in an @IN@ clause. Replaces a
97-- | Wrap a list of values for use in an @IN@ clause. Replaces a
105-- single \"@?@\" character with a parenthesized list of rendered
98-- single \"@?@\" character with a parenthesized list of rendered
test/Exception.hsnew file+70
@@ -0,0 +1,70 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+
5+module Exception (testExceptions) where
6+
7+import Database.PostgreSQL.Simple
8+import Test.Tasty.HUnit (Assertion, assertBool)
9+import Common (TestEnv)
10+import Control.Exception (Exception (..), SomeException)
11+import Data.Maybe (isJust)
12+import Data.Either (isLeft)
13+import Control.Exception (throwIO, try)
14+
15+testExceptions :: TestEnv -> Assertion
16+testExceptions _ = do
17+ let sqlError = SqlError
18+ { sqlState = ""
19+ , sqlExecStatus = FatalError
20+ , sqlErrorMsg = ""
21+ , sqlErrorDetail = ""
22+ , sqlErrorHint = ""
23+ }
24+ let sqlEx :: SomeException = toException sqlError
25+ assertBool "SqlError is SomePostgreSqlException" $ isJust (fromException sqlEx :: Maybe SomePostgreSqlException)
26+ assertBool "SqlError is SqlError" $ isJust (fromException sqlEx :: Maybe SqlError)
27+ eSqlError :: Either SqlError () <- try $ throwIO sqlEx
28+ assertBool "Can catch SqlError" $ isLeft eSqlError
29+ eSqlPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO sqlEx
30+ assertBool "Can catch SomePostgreSqlException from SqlError" $ isLeft eSqlPostgreSqlEx
31+
32+ let formatError = FormatError
33+ { fmtMessage = ""
34+ , fmtQuery = ""
35+ , fmtParams = []
36+ }
37+ let formatEx :: SomeException = toException formatError
38+ assertBool "FormatError is SomePostgreSqlException" $ isJust (fromException formatEx :: Maybe SomePostgreSqlException)
39+ assertBool "FormatError is FormatError" $ isJust (fromException formatEx :: Maybe FormatError)
40+ eFormatError :: Either FormatError () <- try $ throwIO formatEx
41+ assertBool "Can catch FormatError" $ isLeft eFormatError
42+ eFormatPostreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO formatEx
43+ assertBool "Can catch SomePostgreSqlException from FormatError" $ isLeft eFormatPostreSqlEx
44+
45+ let queryError = QueryError
46+ { qeMessage = ""
47+ , qeQuery = ""
48+ }
49+ let queryEx :: SomeException = toException queryError
50+ assertBool "QueryError is SomePostgreSqlException" $ isJust (fromException queryEx :: Maybe SomePostgreSqlException)
51+ assertBool "QueryError is QueryError" $ isJust (fromException queryEx :: Maybe QueryError)
52+ eQueryError :: Either QueryError () <- try $ throwIO queryEx
53+ assertBool "Can catch QueryError" $ isLeft eQueryError
54+ eQueryPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO queryEx
55+ assertBool "Can catch SomePostgreSqlException from QueryError" $ isLeft eQueryPostgreSqlEx
56+
57+ let resultError = Incompatible
58+ { errSQLType = ""
59+ , errSQLTableOid = Nothing
60+ , errSQLField = ""
61+ , errHaskellType = ""
62+ , errMessage = ""
63+ }
64+ let resultEx :: SomeException = toException resultError
65+ assertBool "ResultError is SomePostgreSqlException" $ isJust (fromException resultEx :: Maybe SomePostgreSqlException)
66+ assertBool "ResultError is ResultError" $ isJust (fromException resultEx :: Maybe ResultError)
67+ eResultEx :: Either ResultError () <- try $ throwIO resultEx
68+ assertBool "Can catch ResultError" $ isLeft eResultEx
69+ eResultPostgreSqlEx :: Either SomePostgreSqlException () <- try $ throwIO resultEx
70+ assertBool "Can catch SomePostgreSqlException from ResultError" $ isLeft eResultPostgreSqlEx
test/Interval.hsnew file+176
@@ -0,0 +1,176 @@
1+{-# LANGUAGE QuasiQuotes #-}
2+
3+{-
4+
5+Testing strategies:
6+
7+fromString . toString == id ** Todo?
8+
9+toString . fromString == almost id ** Todo?
10+
11+postgresql -> haskell -> postgresql * Done
12+
13+haskell -> postgresql -> haskell ** Todo?
14+
15+But still, what we really want to establish is that the two values
16+correspond; for example, a conversion that consistently added hour
17+when printed to a string and subtracted an hour when parsed from string
18+would still pass these tests.
19+
20+
21+Right now, we are checking that 1400+ timestamps in the range of 1860 to
22+2060 round trip from postgresql to haskell and back in 5 different timezones.
23+In addition to UTC, the four timezones were selected so that 2 have a positive
24+offset, and 2 have a negative offset, and that 2 have an offset of a
25+whole number of hours, while the other two do not.
26+
27+It may be worth adding a few more timezones to ensure better test coverage.
28+
29+We are checking a handful of selected timestamps to ensure we hit
30+various corner-cases in the code, in addition to 1400 timestamps randomly
31+generated with granularity of seconds down to microseconds in powers of ten.
32+
33+-}
34+
35+module Interval (testInterval) where
36+
37+import Common
38+import Control.Monad(forM_, replicateM_)
39+import Data.Time.Compat
40+import Data.Time.LocalTime.Compat (CalendarDiffTime(..))
41+import Data.ByteString(ByteString)
42+import Database.PostgreSQL.Simple.SqlQQ
43+
44+data IntervalTestCase = IntervalTestCase
45+ { label :: String
46+ , inputMonths :: Integer
47+ , inputSeconds :: NominalDiffTime
48+ , asText :: String
49+ }
50+ deriving (Eq, Show)
51+
52+testInterval :: TestEnv -> Assertion
53+testInterval env@TestEnv{..} = do
54+
55+ initializeTable env
56+
57+ let milliseconds = 0.001
58+ seconds = 1
59+ minutes = 60 * seconds
60+ hours = 60 * minutes
61+ days = 24 * hours
62+ weeks = 7 * days
63+ months = 1
64+ years = 12 * months
65+
66+ mapM (checkRoundTrip env)
67+ [ IntervalTestCase
68+ { label = "zero"
69+ , inputMonths = 0
70+ , inputSeconds = 0
71+ , asText = "PT0"
72+ }
73+ , IntervalTestCase
74+ { label = "1 year"
75+ , inputMonths = 1 * years
76+ , inputSeconds = 0
77+ , asText = "P1Y"
78+ }
79+ , IntervalTestCase
80+ { label = "2 months"
81+ , inputMonths = 2 * months
82+ , inputSeconds = 0
83+ , asText = "P2M"
84+ }
85+ , IntervalTestCase
86+ { label = "3 weeks"
87+ , inputMonths = 0
88+ , inputSeconds = 3 * weeks
89+ , asText = "P3W"
90+ }
91+ , IntervalTestCase
92+ { label = "4 days"
93+ , inputMonths = 0
94+ , inputSeconds = 4 * days
95+ , asText = "P4D"
96+ }
97+ , IntervalTestCase
98+ { label = "5 hours"
99+ , inputMonths = 0
100+ , inputSeconds = 5 * hours
101+ , asText = "PT5H"
102+ }
103+ , IntervalTestCase
104+ { label = "6 minutes"
105+ , inputMonths = 0
106+ , inputSeconds = 6 * minutes
107+ , asText = "PT6M"
108+ }
109+ , IntervalTestCase
110+ { label = "7 seconds"
111+ , inputMonths = 0
112+ , inputSeconds = 7 * seconds
113+ , asText = "PT7S"
114+ }
115+ , IntervalTestCase
116+ { label = "8 milliseconds"
117+ , inputMonths = 0
118+ , inputSeconds = 8 * milliseconds
119+ , asText = "PT0.008S"
120+ }
121+ , IntervalTestCase
122+ { label = "combination of intervals (day-size or bigger)"
123+ , inputMonths = 2 * years + 4 * months
124+ , inputSeconds = 3 * weeks + 5 * days
125+ , asText = "P2Y4M3W5D"
126+ }
127+ , IntervalTestCase
128+ { label = "combination of intervals (smaller than day-size)"
129+ , inputMonths = 0
130+ , inputSeconds = 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds
131+ , asText = "PT18H56M23.563S"
132+ }
133+ , IntervalTestCase
134+ { label = "full combination of intervals"
135+ , inputMonths = 2 * years + 4 * months
136+ , inputSeconds = 3 * weeks + 5 * days + 18 * hours + 56 * minutes + 23 * seconds + 563 * milliseconds
137+ , asText = "P2Y4M3W5DT18H56M23.563S"
138+ }
139+ ]
140+
141+ return ()
142+
143+initializeTable :: TestEnv -> IO ()
144+initializeTable TestEnv{..} = withTransaction conn $ do
145+ execute_ conn
146+ [sql| CREATE TEMPORARY TABLE testinterval
147+ ( id serial, sample interval, PRIMARY KEY(id) ) |]
148+
149+ return ()
150+
151+checkRoundTrip :: TestEnv -> IntervalTestCase -> IO ()
152+checkRoundTrip TestEnv{..} IntervalTestCase{..} = do
153+
154+ let input = CalendarDiffTime
155+ { ctMonths = inputMonths
156+ , ctTime = inputSeconds
157+ }
158+
159+ [(returnedId :: Int, output :: CalendarDiffTime)] <- query conn [sql|
160+ INSERT INTO testinterval (sample)
161+ VALUES (?)
162+ RETURNING id, sample
163+ |] (Only input)
164+
165+ assertBool ("CalendarDiffTime did not round-trip from Haskell to SQL and back (" ++ label ++ ")") $
166+ output == input
167+
168+ [(Only isExpectedIso)] <- query conn [sql|
169+ SELECT sample = (?)::interval
170+ FROM testinterval
171+ WHERE id = ?
172+ |] (asText, returnedId)
173+
174+ assertBool ("CalendarDiffTime inserted did not match ISO8601 equivalent \"" ++ asText ++ "\". (" ++ label ++ ")")
175+ isExpectedIso
176+
test/Main.hs+40−8
@@ -24,6 +24,7 @@ import Control.Applicative
24import Control.Exception as E
24import Control.Exception as E
25import Control.Monad
25import Control.Monad
26import Data.Char
26import Data.Char
27+import Data.Foldable (toList)
27import Data.List (concat, sort)
28import Data.List (concat, sort)
28import Data.IORef
29import Data.IORef
29import Data.Monoid ((<>))
30import Data.Monoid ((<>))
@@ -45,7 +46,7 @@ import qualified Data.Text.Encoding as T
45import qualified Data.Vector as V
46import qualified Data.Vector as V
46import System.FilePath
47import System.FilePath
47import System.Timeout(timeout)
48import System.Timeout(timeout)
48−import Data.Time(getCurrentTime, diffUTCTime)
49+import Data.Time.Compat (getCurrentTime, diffUTCTime)
49import System.Environment (getEnvironment)
50import System.Environment (getEnvironment)
50
51
51import Test.Tasty
52import Test.Tasty
@@ -53,6 +54,8 @@ import Test.Tasty.Golden
53import Notify
54import Notify
54import Serializable
55import Serializable
55import Time
56import Time
57+import Interval
58+import Exception (testExceptions)
56
59
57tests :: TestEnv -> TestTree
60tests :: TestEnv -> TestTree
58tests env = testGroup "tests"
61tests env = testGroup "tests"
@@ -63,6 +66,7 @@ tests env = testGroup "tests"
63 , testCase "Notify" . testNotify
66 , testCase "Notify" . testNotify
64 , testCase "Serializable" . testSerializable
67 , testCase "Serializable" . testSerializable
65 , testCase "Time" . testTime
68 , testCase "Time" . testTime
69+ , testCase "Interval" . testInterval
66 , testCase "Array" . testArray
70 , testCase "Array" . testArray
67 , testCase "Array of nullables" . testNullableArray
71 , testCase "Array of nullables" . testNullableArray
68 , testCase "HStore" . testHStore
72 , testCase "HStore" . testHStore
@@ -81,6 +85,7 @@ tests env = testGroup "tests"
81 , testCase "2-ary generic" . testGeneric2
85 , testCase "2-ary generic" . testGeneric2
82 , testCase "3-ary generic" . testGeneric3
86 , testCase "3-ary generic" . testGeneric3
83 , testCase "Timeout" . testTimeout
87 , testCase "Timeout" . testTimeout
88+ , testCase "Exceptions" . testExceptions
84 ]
89 ]
85
90
86testBytea :: TestEnv -> TestTree
91testBytea :: TestEnv -> TestTree
@@ -134,7 +139,7 @@ testFold TestEnv{..} = do
134 xs <- readIORef ref
139 xs <- readIORef ref
135 writeIORef ref $! (a,b):xs
140 writeIORef ref $! (a,b):xs
136 xs <- readIORef ref
141 xs <- readIORef ref
137− reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
142+ reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]
138
143
139 -- Make sure fold propagates our exception.
144 -- Make sure fold propagates our exception.
140 ref <- newIORef []
145 ref <- newIORef []
@@ -442,6 +447,14 @@ testCopy TestEnv{..} = do
442 -- so that we can issue more queries:
447 -- so that we can issue more queries:
443 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
448 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
444 x @?= 4
449 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
445 where
458 where
446 copyRows = ["1,foo\n"
459 copyRows = ["1,foo\n"
447 ,"2,bar\n"]
460 ,"2,bar\n"]
@@ -461,12 +474,13 @@ testCopyFailures env = testGroup "Copy failures"
461
474
462goldenTest :: TestName -> IO BL.ByteString -> TestTree
475goldenTest :: TestName -> IO BL.ByteString -> TestTree
463goldenTest testName =
476goldenTest testName =
464− goldenVsString testName (resultsDir </> fileName<.>"expected")
477+ goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")
465 where
478 where
466 resultsDir = "test" </> "results"
479 resultsDir = "test" </> "results"
467 fileName = map normalize testName
480 fileName = map normalize testName
468 normalize c | not (isAlpha c) = '-'
481 normalize c | not (isAlpha c) = '-'
469 | otherwise = c
482 | otherwise = c
483+ diff ref new = ["diff", "-u", ref, new]
470
484
471-- | Test that we provide a sensible error message on failure
485-- | Test that we provide a sensible error message on failure
472testCopyUniqueConstraintError :: TestEnv -> TestTree
486testCopyUniqueConstraintError :: TestEnv -> TestTree
@@ -595,7 +609,11 @@ isFormatError i FormatError{..}
595-- that 'testConnect' connects to the same database every time it is called.
609-- that 'testConnect' connects to the same database every time it is called.
596withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a
610withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a
597withTestEnv connstr cb =
611withTestEnv connstr cb =
598− withConn $ \conn ->
612+ withConn $ \conn -> do
613+ -- currently required for interval to work.
614+ -- we also test that this doesn't interfere with anything else
615+ execute_ conn "SET intervalstyle TO 'iso_8601'"
616+
599 cb TestEnv
617 cb TestEnv
600 { conn = conn
618 { conn = conn
601 , withConn = withConn
619 , withConn = withConn
@@ -604,13 +622,27 @@ withTestEnv connstr cb =
604 withConn = bracket (connectPostgreSQL connstr) close
622 withConn = bracket (connectPostgreSQL connstr) close
605
623
606main :: IO ()
624main :: IO ()
607−main = do
625+main = withConnstring $ \connstring -> do
626+ withTestEnv connstring (defaultMain . tests)
627+
628+withConnstring :: (BS8.ByteString -> IO ()) -> IO ()
629+withConnstring kont = do
608 env <- getEnvironment
630 env <- getEnvironment
609 case lookup "DATABASE_CONNSTRING" env of
631 case lookup "DATABASE_CONNSTRING" env of
632+ Just s -> kont (BS8.pack (special s))
633+ Nothing -> case lookup "GITHUB_ACTIONS" env of
634+ Just "true" -> kont (BS8.pack gha)
610− Nothing -> putStrLn "Set DATABASE_CONNSTRING environment variable"
635+ _ -> putStrLn "Set DATABASE_CONNSTRING environment variable"
611− Just s -> withTestEnv (BS8.pack (special s)) (defaultMain . tests)
612− where
636+ where
613 -- https://www.appveyor.com/docs/services-databases/
637 -- https://www.appveyor.com/docs/services-databases/
614 special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"
638 special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"
615 special "travis" = ""
639 special "travis" = ""
616 special s = s
640 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
39+import Data.Time.Compat
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 integer: "z"
2+Connection error: ERROR: invalid input syntax for type 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)