git.iko.soy/typeable/postgresql-simple
on e266489 help sign in
3ac2949
swap
0 ahead, 145 behind
49 files changed+673−2531
since splitsnapshots
unifiedsplit
.ghci+16 .github/workflows/haskell-ci.yml−256 .github/workflows/simple.yml−58 .gitignore+1−4 .travis.yml+73 CHANGES.md+5−141 CONTRIBUTING.md−13 README.md+3 bench/Select.hs−32 cabal.haskell-ci−5 cabal.project−3 cabal.project.local.win−4 postgresql-simple.cabal+123−163 src/Database/PostgreSQL/Simple.hs+10−23 src/Database/PostgreSQL/Simple/Arrays.hs+2−2 src/Database/PostgreSQL/Simple/Compat.hs+53 src/Database/PostgreSQL/Simple/Copy.hs+6−27 src/Database/PostgreSQL/Simple/Cursor.hs+5−5 src/Database/PostgreSQL/Simple/Errors.hs+3−4 src/Database/PostgreSQL/Simple/FromField.hs+70−124 src/Database/PostgreSQL/Simple/FromRow.hs+4−20 src/Database/PostgreSQL/Simple/HStore/Implementation.hs+9−3 src/Database/PostgreSQL/Simple/Internal.hs+16−65 src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+12−42 src/Database/PostgreSQL/Simple/Newtypes.hs−49 src/Database/PostgreSQL/Simple/Notification.hs+17 src/Database/PostgreSQL/Simple/Ok.hs+4−7 src/Database/PostgreSQL/Simple/Range.hs+10−14 src/Database/PostgreSQL/Simple/SqlQQ.hs+9−10 src/Database/PostgreSQL/Simple/Time.hs−2 src/Database/PostgreSQL/Simple/Time/Implementation.hs+1−11 src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+3−12 src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+3−15 src/Database/PostgreSQL/Simple/ToField.hs+11−33 src/Database/PostgreSQL/Simple/ToRow.hs−16 src/Database/PostgreSQL/Simple/Transaction.hs+13−17 src/Database/PostgreSQL/Simple/TypeInfo.hs+9−9 src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs+3−9 src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+114−684 src/Database/PostgreSQL/Simple/Types.hs+7 src/Database/PostgreSQL/Simple/Vector.hs−45 src/Database/PostgreSQL/Simple/Vector/Unboxed.hs−44 test/Exception.hs−70 test/Inspection.hs−79 test/Interval.hs−176 test/Main.hs+31−194 test/Time.hs+1−1 test/results/malformed-input.expected+1−1 tools/GenTypeInfo.hs+25−39
.ghcinew file+16
@@ -0,0 +1,16 @@
1+:set -isrc -itest -optP-includedist/build/autogen/cabal_macros.h
2+:set -Wall -fno-warn-name-shadowing
3+
4+:set -XDoAndIfThenElse
5+:set -XOverloadedStrings
6+:set -XBangPatterns
7+:set -XViewPatterns
8+:set -XTypeOperators
9+
10+-- for tests
11+:set -XNamedFieldPuns
12+:set -XRank2Types
13+:set -XRecordWildCards
14+:set -XPatternGuards
15+:set -XScopedTypeVariables
16+:set -fno-warn-unused-do-bind
.github/workflows/haskell-ci.ymldeleted−256
@@ -1,256 +0,0 @@
1−# This GitHub workflow config has been generated by a script via
2−#
3−# haskell-ci 'github' 'cabal.project'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.17.20231110
12−#
13−# REGENDATA ("0.17.20231110",["github","cabal.project"])
14−#
15−name: Haskell-CI
16−on:
17− push:
18− branches:
19− - master
20− pull_request:
21− branches:
22− - master
23−jobs:
24− linux:
25− name: Haskell-CI - Linux - ${{ matrix.compiler }}
26− runs-on: ubuntu-20.04
27− timeout-minutes:
28− 60
29− container:
30− image: buildpack-deps:bionic
31− services:
32− postgres:
33− image: postgres:14
34− env:
35− POSTGRES_PASSWORD: postgres
36− options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5
37− continue-on-error: ${{ matrix.allow-failure }}
38− strategy:
39− matrix:
40− include:
41− - compiler: ghc-9.8.1
42− compilerKind: ghc
43− compilerVersion: 9.8.1
44− setup-method: ghcup
45− allow-failure: false
46− - compiler: ghc-9.6.3
47− compilerKind: ghc
48− compilerVersion: 9.6.3
49− setup-method: ghcup
50− allow-failure: false
51− - compiler: ghc-9.4.8
52− compilerKind: ghc
53− compilerVersion: 9.4.8
54− setup-method: ghcup
55− allow-failure: false
56− - compiler: ghc-9.2.8
57− compilerKind: ghc
58− compilerVersion: 9.2.8
59− setup-method: ghcup
60− allow-failure: false
61− - compiler: ghc-9.0.2
62− compilerKind: ghc
63− compilerVersion: 9.0.2
64− setup-method: ghcup
65− allow-failure: false
66− - compiler: ghc-8.10.7
67− compilerKind: ghc
68− compilerVersion: 8.10.7
69− setup-method: ghcup
70− allow-failure: false
71− - compiler: ghc-8.8.4
72− compilerKind: ghc
73− compilerVersion: 8.8.4
74− setup-method: hvr-ppa
75− allow-failure: false
76− - compiler: ghc-8.6.5
77− compilerKind: ghc
78− compilerVersion: 8.6.5
79− setup-method: hvr-ppa
80− allow-failure: false
81− fail-fast: false
82− steps:
83− - name: apt
84− run: |
85− apt-get update
86− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
87− if [ "${{ matrix.setup-method }}" = ghcup ]; then
88− mkdir -p "$HOME/.ghcup/bin"
89− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
90− chmod a+x "$HOME/.ghcup/bin/ghcup"
91− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
92− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
93− else
94− apt-add-repository -y 'ppa:hvr/ghc'
95− apt-get update
96− apt-get install -y "$HCNAME"
97− mkdir -p "$HOME/.ghcup/bin"
98− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
99− chmod a+x "$HOME/.ghcup/bin/ghcup"
100− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
101− fi
102− env:
103− HCKIND: ${{ matrix.compilerKind }}
104− HCNAME: ${{ matrix.compiler }}
105− HCVER: ${{ matrix.compilerVersion }}
106− - name: Set PATH and environment variables
107− run: |
108− echo "$HOME/.cabal/bin" >> $GITHUB_PATH
109− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
110− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
111− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
112− HCDIR=/opt/$HCKIND/$HCVER
113− if [ "${{ matrix.setup-method }}" = ghcup ]; then
114− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
115− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
116− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
117− echo "HC=$HC" >> "$GITHUB_ENV"
118− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
119− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
120− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
121− else
122− HC=$HCDIR/bin/$HCKIND
123− echo "HC=$HC" >> "$GITHUB_ENV"
124− echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
125− echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
126− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
127− fi
128−
129− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
130− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
131− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
132− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
133− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
134− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
135− echo "GHCJSARITH=0" >> "$GITHUB_ENV"
136− env:
137− HCKIND: ${{ matrix.compilerKind }}
138− HCNAME: ${{ matrix.compiler }}
139− HCVER: ${{ matrix.compilerVersion }}
140− - name: env
141− run: |
142− env
143− - name: write cabal config
144− run: |
145− mkdir -p $CABAL_DIR
146− cat >> $CABAL_CONFIG <<EOF
147− remote-build-reporting: anonymous
148− write-ghc-environment-files: never
149− remote-repo-cache: $CABAL_DIR/packages
150− logs-dir: $CABAL_DIR/logs
151− world-file: $CABAL_DIR/world
152− extra-prog-path: $CABAL_DIR/bin
153− symlink-bindir: $CABAL_DIR/bin
154− installdir: $CABAL_DIR/bin
155− build-summary: $CABAL_DIR/logs/build.log
156− store-dir: $CABAL_DIR/store
157− install-dirs user
158− prefix: $CABAL_DIR
159− repository hackage.haskell.org
160− url: http://hackage.haskell.org/
161− EOF
162− cat >> $CABAL_CONFIG <<EOF
163− program-default-options
164− ghc-options: $GHCJOBS +RTS -M3G -RTS
165− EOF
166− cat $CABAL_CONFIG
167− - name: versions
168− run: |
169− $HC --version || true
170− $HC --print-project-git-commit-id || true
171− $CABAL --version || true
172− - name: update cabal index
173− run: |
174− $CABAL v2-update -v
175− - name: install cabal-plan
176− run: |
177− mkdir -p $HOME/.cabal/bin
178− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
179− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
180− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
181− rm -f cabal-plan.xz
182− chmod a+x $HOME/.cabal/bin/cabal-plan
183− cabal-plan --version
184− - name: checkout
185− uses: actions/checkout@v3
186− with:
187− path: source
188− - name: initial cabal.project for sdist
189− run: |
190− touch cabal.project
191− echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
192− cat cabal.project
193− - name: sdist
194− run: |
195− mkdir -p sdist
196− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
197− - name: unpack
198− run: |
199− mkdir -p unpacked
200− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
201− - name: generate cabal.project
202− run: |
203− PKGDIR_postgresql_simple="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"
204− echo "PKGDIR_postgresql_simple=${PKGDIR_postgresql_simple}" >> "$GITHUB_ENV"
205− rm -f cabal.project cabal.project.local
206− touch cabal.project
207− touch cabal.project.local
208− echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
209− echo "package postgresql-simple" >> cabal.project
210− echo " ghc-options: -Werror=missing-methods" >> cabal.project
211− cat >> cabal.project <<EOF
212− allow-newer: cryptohash-md5-0.11.100.1:base
213− EOF
214− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(postgresql-simple)$/; }' >> cabal.project.local
215− cat cabal.project
216− cat cabal.project.local
217− - name: dump install plan
218− run: |
219− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
220− cabal-plan
221− - name: restore cache
222− uses: actions/cache/restore@v3
223− with:
224− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
225− path: ~/.cabal/store
226− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
227− - name: install dependencies
228− run: |
229− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
230− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
231− - name: build w/o tests
232− run: |
233− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
234− - name: build
235− run: |
236− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
237− - name: tests
238− run: |
239− $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
240− - name: cabal check
241− run: |
242− cd ${PKGDIR_postgresql_simple} || false
243− ${CABAL} -vnormal check
244− - name: haddock
245− run: |
246− $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
247− - name: unconstrained build
248− run: |
249− rm -f cabal.project.local
250− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
251− - name: save cache
252− uses: actions/cache/save@v3
253− if: always()
254− with:
255− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
256− path: ~/.cabal/store
.github/workflows/simple.ymldeleted−58
@@ -1,58 +0,0 @@
1−name: Simple
2−on:
3− push:
4− branches:
5− - master
6− pull_request:
7− branches:
8− - master
9−
10−jobs:
11− native:
12− name: "Simple: GHC ${{ matrix.ghc }} on ${{ matrix.os }}"
13− runs-on: ${{ matrix.os }}
14− strategy:
15− matrix:
16− os: [macos-latest, windows-latest]
17− ghc: ['8.10','9.0','9.2','9.4.8','9.6.3','9.8.1']
18− fail-fast: false
19− timeout-minutes:
20− 60
21− steps:
22− - name: Set git to use LF
23− run: |
24− git config --global core.autocrlf false
25− git config --global core.eol lf
26−
27− - name: Set up Haskell
28− id: setup-haskell
29− uses: haskell/actions/setup@v2
30− with:
31− ghc-version: ${{ matrix.ghc }}
32− cabal-version: '3.10.2.0'
33−
34− - name: Set up PostgreSQL
35− uses: ikalnytskyi/action-setup-postgres@v3
36− id: postgres
37− with:
38− username: ci
39− password: sw0rdfish
40− database: test
41−
42− - name: Checkout
43− uses: actions/checkout@v3.0.2
44−
45− - name: Cache
46− uses: actions/cache@v2.1.3
47− with:
48− path: ${{ steps.setup-haskell.outputs.cabal-store }}
49− key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }}
50− restore-keys: ${{ runner.os }}-${{ matrix.ghc }}-
51−
52− - name: Build
53− run: cabal build all --enable-tests
54−
55− - name: Test
56− run: cabal test all --enable-tests --test-show-details=direct
57− env:
58− DATABASE_CONNSTRING: ${{ steps.postgres.outputs.connection-uri }}
.gitignore+1−4
@@ -11,7 +11,4 @@ dist/
1111.cabal-sandbox/
1212.stack-work/
1313cabal.sandbox.config
14−/dist-newstyle
15−.ghc.environment.*
16−cabal.project.local
17−dump-core
14+/dist-newstyle
.travis.ymlnew file+73
@@ -0,0 +1,73 @@
1+# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
2+language: c
3+sudo: false
4+
5+cache:
6+ directories:
7+ - $HOME/.cabsnap
8+ - $HOME/.cabal/packages
9+
10+before_cache:
11+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
12+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
13+
14+matrix:
15+ include:
16+ - env: CABALVER=1.18 GHCVER=7.8.4
17+ compiler: ": #GHC 7.8.4"
18+ addons: { apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}, postgresql: "9.3"}
19+ - env: CABALVER=1.22 GHCVER=7.10.2
20+ compiler: ": #GHC 7.10.2"
21+ addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}, postgresql: "9.3"}
22+ - env: CABALVER=1.24 GHCVER=8.0.1
23+ compiler: ": #GHC 8.0.1"
24+ addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}, postgresql: "9.3"}
25+
26+before_install:
27+ - unset CC
28+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
29+ - createdb `whoami` || true
30+
31+install:
32+ - cabal --version
33+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
34+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
35+ then
36+ zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
37+ $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
38+ fi
39+ - travis_retry cabal update -v
40+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
41+ - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
42+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
43+
44+# check whether current requested install-plan matches cached package-db snapshot
45+ - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
46+ then
47+ echo "cabal build-cache HIT";
48+ rm -rfv .ghc;
49+ cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
50+ cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
51+ else
52+ echo "cabal build-cache MISS";
53+ rm -rf $HOME/.cabsnap;
54+ mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
55+ cabal install --only-dependencies --enable-tests --enable-benchmarks;
56+ fi
57+
58+# snapshot package-db on cache miss
59+ - if [ ! -d $HOME/.cabsnap ];
60+ then
61+ echo "snapshotting package-db to build-cache";
62+ mkdir $HOME/.cabsnap;
63+ cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
64+ cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
65+ fi
66+
67+# Here starts the actual work to be performed for the package under test;
68+# any command which exits with a non-zero exit code causes the build to fail.
69+script:
70+ - if [ -f configure.ac ]; then autoreconf -i; fi
71+ - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
72+ - cabal build # this builds all libraries and executables (including tests/benchmarks)
73+ - cabal test
CHANGES.md+5−141
@@ -1,139 +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)
52−
53− * Define `MonadFail Ok`.
54−
55−### Version 0.6.1 (2019-03-04)
56−
57− * Escape double '??' to a literal '?
58− Thanks to Felix Paulusma for the implementation.
59− https://github.com/phadej/postgresql-simple/pull/5
60−
61− * Mention GHC Generics support in the documentation.
62− Thanks to Gabriel Gonzalez for the implementation.
63− https://github.com/phadej/postgresql-simple/pull/6
64−
65− * Better error message for "Query resulted in a command response
66− Thanks to Max Amanshauser for the implementation.
67− https://github.com/phadej/postgresql-simple/pull/7
68−
69− * fromJSONField: Include JSONPath on JSON parse errors
70− Thanks to Simon Hengel for the implementation.
71− https://github.com/phadej/postgresql-simple/pull/2
72−
73− * No TH in implementation
74− https://github.com/phadej/postgresql-simple/pull/4
75−
76−### Version 0.6 (2018-10-16)
77−
78− * *Breaking change*: Use `Only` package's `Only` for a common 1-tuple.
79−
80− Consider a downstream library depending already both on
81− `Only` and `postgresql-simple` package. This library my define
82− a `MyClass` with instances for `Only.Only` and `PostgreSQL.Only`.
83− As now these types are the same, a library would break.
84− Therefore I consider "merging" types a breaking change.
85−
86− There are two ways for adopting this change in that scenario:
87−
88− - Either CPP-guard `PostgreSQL.Only` instance with
89−
90− ```haskell
91− #if !MIN_VERSION_postgresql_simple(0,6,0)
92− instance MyClass (PostgreSQL.Only a) where ...
93− #endif
94− ```
95−
96− - or simply remove it and add `postgresql-simple >=0.6` lower bound,
97− making sure that there's only single `Only`.
98−
99− * Add `ToField` instances for case-insensitive strict and lazy text.
100− Thanks to Max Tagher for the implementation.
101− https://github.com/lpsmith/postgresql-simple/pull/232
102−
103− * Add support to CockroachDB.
104− Thanks to Georte Steel.
105− https://github.com/lpsmith/postgresql-simple/pull/245
106−
107− * Add Generic ConnectInfo instance
108− Thanks to Dmitry Dzhus.
109− https://github.com/lpsmith/postgresql-simple/pull/235
110−
111− * Add `fromFieldRange :: Typeable a => FieldParser a -> FieldParser (PGRange a)`
112− https://github.com/lpsmith/postgresql-simple/pull/221
113−
114− * Add `fromFieldJSONByteString :: FieldParser ByteString`
115− https://github.com/lpsmith/postgresql-simple/pull/222/files
116−
117− * Fix off-by-one error in year builder.
118− Thanks to Nathan Ferris Hunter.
119− https://github.com/lpsmith/postgresql-simple/pull/230
120−
121− * Extend ToRow and FromRow to tuples of size 18
122− Thanks to Bardur Arantsson.
123− https://github.com/lpsmith/postgresql-simple/pull/229
124−
125− * Add `Vector` and `Vector.Unboxed` `query` variants.
126− These are more memory efficient
127− (especially, if you anyway will convert to some vector)
128− https://github.com/phadej/1
129−
130− * Documentation improvements
131− https://github.com/lpsmith/postgresql-simple/pull/227
132− https://github.com/lpsmith/postgresql-simple/pull/236
133−
134−### Version 0.5.4.0 (2018-05-23)
135− * Support GHC-8.4 (Semigroup/Monoid)
136−
1371### Version 0.5.3.0 (2017-05-15)
1382 * Refactored some rudimentary cursor handling code out of the
1393 implementation of the fold operators, into a new
@@ -271,7 +135,7 @@
271135 support UTF8 except for Mule Internal Code, the Multilingual
272136 Extensions for Emacs. An exception should be raised upon
273137 connecting to a database by the backend if the backend cannot
274− accommodate this requirement.
138+ accomodate this requirement.
275139
276140 * Added `Eq` and `Typeable` instances for `Connection`.
277141
@@ -391,7 +255,7 @@
391255 * De-emphasized connect and ConnectInfo in favor of connectPostgreSQL.
392256
393257### Version 0.4.2.2 (2014-05-15)
394− * Fixed compatibility with scientific-0.3.\*, thanks to Adam Bergmark
258+ * Fixed compatibility with scientific-0.3.*, thanks to Adam Bergmark
395259
396260 * Improved documentation of the FromField module, as well as the fold,
397261 foldWithOptions, executeMany, and returning operators.
@@ -409,7 +273,7 @@
409273
410274 * Changed the Identifier and QualifiedIdentifier to use Text in
411275 order to avoid encoding errors. Technically this requires a
412− major version bump, but let's pretend 0.4.1.0 didn't happen.
276+ major verson bump, but let's pretend 0.4.1.0 didn't happen.
413277
414278 * Removed non-exhaustive cases in the ToField instance for Values,
415279 and tweaked error messages.
@@ -569,7 +433,7 @@
569433
570434 * Added a brand new TypeInfo system that gives FromField instances
571435 convenient and efficient access to the pg_type metatable. This
572− replaced the older typename cache, and was necessary to properly
436+ replaced the older typename cache, and was neccesary to properly
573437 support postgres array types. Thanks to Bas van Dijk for his
574438 work on this feature.
575439
@@ -661,7 +525,7 @@
661525 now the preferred way of dealing with `timestamp` (without time zone).
662526
663527 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
664− that accommodate PostgreSQL's infinities.
528+ that accomodate PostgreSQL's infinities.
665529
666530 * All time-related `FromField`/`ToField` instances are now based on new,
667531 higher-speed parsers and printers instead of those provided by the
CONTRIBUTING.mddeleted−13
@@ -1,13 +0,0 @@
1−Patches welcome!
2−
3−- If you are only going to bump bounds:
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**:
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))
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.
10−- For the same reason, do not edit `version` or `x-revision`
11−
12−- I use [`stylish-haskell`](https://github.com/jaspervdj/stylish-haskell) to format imports. I encourage you to use it too, when contributing.
13−- General code style is 4 spaces, just look around how it looks, it's not so strict.
README.md+3
@@ -1,4 +1,7 @@
1+[![Continuous Integration status][status-png]][status]
12[![Hackage page (downloads and API reference)][hackage-png]][hackage]
23
4+ [status-png]: https://api.travis-ci.org/lpsmith/postgresql-simple.svg
5+ [status]: http://travis-ci.org/lpsmith/postgresql-simple?branch=master
36 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg
47 [hackage]: http://hackage.haskell.org/package/postgresql-simple
bench/Select.hsdeleted−32
@@ -1,32 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−module Main where
3−
4−import Database.PostgreSQL.Simple
5−import qualified Database.PostgreSQL.Simple.Vector as V
6−import qualified Database.PostgreSQL.Simple.Vector.Unboxed as VU
7−
8−import System.Environment (getArgs)
9−import Data.Foldable (Foldable, foldl')
10−import qualified Data.Vector.Unboxed as VU
11−
12−main :: IO ()
13−main = do
14− args <- getArgs
15− conn <- connectPostgreSQL ""
16− case args of
17− ("vector":_) -> do
18− result <- V.query_ conn "SELECT * FROM generate_series(1, 10000000);"
19− print (process result)
20− ("unboxed":_) -> do
21− -- dummy column
22− result <- VU.query_ conn "SELECT (NULL :: VOID), * FROM generate_series(1, 10000000);"
23− print (process' result)
24− _ -> do
25− result <- query_ conn "SELECT * FROM generate_series(1, 10000000);"
26− print (process result)
27−
28−process :: Foldable f => f (Only Int) -> Int
29−process = foldl' (\x (Only y) -> max x y) 0
30−
31−process' :: VU.Vector ((), Int) -> Int
32−process' = VU.foldl' (\x (_, y) -> max x y) 0
cabal.haskell-cideleted−5
@@ -1,5 +0,0 @@
1−branches: master
2−postgresql: True
3−
4−-- services aren't supported on Travis on macOS
5−-- osx: 8.4.4
cabal.project−3
@@ -1,4 +1 @@
11packages: .
2−tests: true
3−
4−allow-newer: cryptohash-md5-0.11.100.1:base
cabal.project.local.windeleted−4
@@ -1,4 +0,0 @@
1−constraints: these -assoc
2−
3−package postgresql-libpq
4− flags: -use-pkg-config
postgresql-simple.cabal+123−163
@@ -1,175 +1,135 @@
1−cabal-version: 1.12
2−name: postgresql-simple
3−version: 0.7.0.0
4−x-revision: 1
5−synopsis: Mid-Level PostgreSQL client library
6−description:
7− Mid-Level PostgreSQL client library, forked from mysql-simple.
8−
9−license: BSD3
10−license-file: LICENSE
11−author: Bryan O'Sullivan, Leon P Smith
12−maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>
13−copyright:
14− (c) 2011 MailRank, Inc.
15− (c) 2011-2018 Leon P Smith
16− (c) 2018-2020 Oleg Grenrus
17−
18−category: Database
19−build-type: Simple
1+Name: postgresql-simple
2+Version: 0.5.3.0
3+Synopsis: Mid-Level PostgreSQL client library
4+Description:
5+ Mid-Level PostgreSQL client library, forked from mysql-simple.
6+License: BSD3
7+License-file: LICENSE
8+Author: Bryan O'Sullivan, Leon P Smith
9+Maintainer: Leon P Smith <leon@melding-monads.com>
10+Copyright: (c) 2011 MailRank, Inc.
11+ (c) 2011-2015 Leon P Smith
12+Category: Database
13+Build-type: Simple
14+
15+Cabal-version: >= 1.9.2
16+
2017extra-source-files:
21− CHANGES.md
22− CONTRIBUTORS
23− test/results/malformed-input.expected
24− test/results/unique-constraint-violation.expected
25−
26−tested-with:
27− GHC ==8.6.5
28− || ==8.8.4
29− || ==8.10.7
30− || ==9.0.2
31− || ==9.2.8
32− || ==9.4.8
33− || ==9.6.3
34− || ==9.8.1
35−
36−library
37− default-language: Haskell2010
38− hs-source-dirs: src
39− exposed-modules:
40− Database.PostgreSQL.Simple
41− Database.PostgreSQL.Simple.Arrays
42− Database.PostgreSQL.Simple.Copy
43− Database.PostgreSQL.Simple.Cursor
44− Database.PostgreSQL.Simple.Errors
45− Database.PostgreSQL.Simple.FromField
46− Database.PostgreSQL.Simple.FromRow
47− Database.PostgreSQL.Simple.HStore
48− Database.PostgreSQL.Simple.HStore.Internal
49− Database.PostgreSQL.Simple.Internal
50− Database.PostgreSQL.Simple.LargeObjects
51− Database.PostgreSQL.Simple.Newtypes
52− Database.PostgreSQL.Simple.Notification
53− Database.PostgreSQL.Simple.Ok
54− Database.PostgreSQL.Simple.Range
55− Database.PostgreSQL.Simple.SqlQQ
56− Database.PostgreSQL.Simple.Time
57− Database.PostgreSQL.Simple.Time.Internal
58− Database.PostgreSQL.Simple.ToField
59− Database.PostgreSQL.Simple.ToRow
60− Database.PostgreSQL.Simple.Transaction
61− Database.PostgreSQL.Simple.TypeInfo
62− Database.PostgreSQL.Simple.TypeInfo.Macro
63− Database.PostgreSQL.Simple.TypeInfo.Static
64− Database.PostgreSQL.Simple.Types
65− Database.PostgreSQL.Simple.Vector
66− Database.PostgreSQL.Simple.Vector.Unboxed
67−
68− -- Other-modules:
69− other-modules:
70− Database.PostgreSQL.Simple.Compat
71− Database.PostgreSQL.Simple.HStore.Implementation
72− Database.PostgreSQL.Simple.Internal.PQResultUtils
73− Database.PostgreSQL.Simple.Time.Implementation
74− Database.PostgreSQL.Simple.Time.Internal.Parser
75− Database.PostgreSQL.Simple.Time.Internal.Printer
76− Database.PostgreSQL.Simple.TypeInfo.Types
77−
78− -- GHC bundled libs
79− build-depends:
80− base >=4.12.0.0 && <4.20
81− , bytestring >=0.10.8.2 && <0.13
82− , containers >=0.6.0.1 && <0.7
83− , template-haskell >=2.14.0.0 && <2.22
84− , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2
85− , time-compat >=1.9.5 && <1.12
86− , transformers >=0.5.6.2 && <0.7
87−
88− -- Other dependencies
89− build-depends:
90− aeson >=2.1.2.1 && <2.3
91− , attoparsec >=0.14.4 && <0.15
92− , case-insensitive >=1.2.1.0 && <1.3
93− , hashable >=1.4.3.0 && <1.5
94− , Only >=0.1 && <0.1.1
95− , postgresql-libpq >=0.10.0.0 && <0.11
96− , scientific >=0.3.7.0 && <0.4
97− , uuid-types >=1.0.5 && <1.1
98− , vector >=0.13.0.0 && <0.14
99−
100− default-extensions:
101− BangPatterns
102− DoAndIfThenElse
103− OverloadedStrings
104− TypeOperators
105− ViewPatterns
106−
107− ghc-options: -Wall -fno-warn-name-shadowing
18+ CONTRIBUTORS
19+ CHANGELOG.md
20+
21+Library
22+ hs-source-dirs: src
23+ Exposed-modules:
24+ Database.PostgreSQL.Simple
25+ Database.PostgreSQL.Simple.Arrays
26+ Database.PostgreSQL.Simple.Copy
27+ Database.PostgreSQL.Simple.Cursor
28+ Database.PostgreSQL.Simple.FromField
29+ Database.PostgreSQL.Simple.FromRow
30+ Database.PostgreSQL.Simple.LargeObjects
31+ Database.PostgreSQL.Simple.HStore
32+ Database.PostgreSQL.Simple.HStore.Internal
33+ Database.PostgreSQL.Simple.Notification
34+ Database.PostgreSQL.Simple.Ok
35+ Database.PostgreSQL.Simple.Range
36+ Database.PostgreSQL.Simple.SqlQQ
37+ Database.PostgreSQL.Simple.Time
38+ Database.PostgreSQL.Simple.Time.Internal
39+ Database.PostgreSQL.Simple.ToField
40+ Database.PostgreSQL.Simple.ToRow
41+ Database.PostgreSQL.Simple.Transaction
42+ Database.PostgreSQL.Simple.TypeInfo
43+ Database.PostgreSQL.Simple.TypeInfo.Macro
44+ Database.PostgreSQL.Simple.TypeInfo.Static
45+ Database.PostgreSQL.Simple.Types
46+ Database.PostgreSQL.Simple.Errors
47+-- Other-modules:
48+ Database.PostgreSQL.Simple.Internal
49+
50+ Other-modules:
51+ Database.PostgreSQL.Simple.Compat
52+ Database.PostgreSQL.Simple.HStore.Implementation
53+ Database.PostgreSQL.Simple.Internal.PQResultUtils
54+ Database.PostgreSQL.Simple.Time.Implementation
55+ Database.PostgreSQL.Simple.Time.Internal.Parser
56+ Database.PostgreSQL.Simple.Time.Internal.Printer
57+ Database.PostgreSQL.Simple.TypeInfo.Types
58+
59+ Build-depends:
60+ aeson >= 0.6,
61+ attoparsec >= 0.10.3,
62+ base >= 4.6 && < 5,
63+ bytestring >= 0.9,
64+ bytestring-builder,
65+ case-insensitive,
66+ containers,
67+ hashable,
68+ Only,
69+ postgresql-libpq >= 0.9 && < 0.10,
70+ template-haskell,
71+ text >= 0.11.1,
72+ time,
73+ transformers,
74+ uuid-types >= 1.0.0,
75+ scientific,
76+ semigroups,
77+ vector
78+
79+ if !impl(ghc >= 7.6)
80+ Build-depends:
81+ ghc-prim
82+
83+ extensions: DoAndIfThenElse, OverloadedStrings, BangPatterns, ViewPatterns
84+ TypeOperators
85+
86+ ghc-options: -Wall -fno-warn-name-shadowing
10887
10988source-repository head
11089 type: git
111− location: http://github.com/haskellari/postgresql-simple
112−
113−test-suite inspection
114− default-language: Haskell2010
115− type: exitcode-stdio-1.0
116− hs-source-dirs: test
117− main-is: Inspection.hs
118− build-depends:
119− base
120− , inspection-testing >=0.4.1.1 && <0.6
121− , postgresql-libpq
122− , postgresql-simple
123− , tasty
124− , tasty-hunit
90+ location: http://github.com/lpsmith/postgresql-simple
91+
92+source-repository this
93+ type: git
94+ location: http://github.com/lpsmith/postgresql-simple
95+ tag: v0.5.3.0
12596
12697test-suite test
127− default-language: Haskell2010
128− type: exitcode-stdio-1.0
129− hs-source-dirs: test
130− main-is: Main.hs
98+ type: exitcode-stdio-1.0
99+
100+ hs-source-dirs: test
101+ main-is: Main.hs
131102 other-modules:
132103 Common
133− Exception
134− Interval
135104 Notify
136105 Serializable
137106 Time
138107
139− ghc-options: -threaded
140− ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
141− default-extensions:
142− NamedFieldPuns
143− OverloadedStrings
144− PatternGuards
145− Rank2Types
146− RecordWildCards
147− ScopedTypeVariables
148−
149− build-depends:
150− aeson
151− , base
152− , base16-bytestring
153− , bytestring
154− , case-insensitive
155− , containers
156− , cryptohash-md5 >=0.11.100.1 && <0.12
157− , filepath
158− , HUnit
159− , postgresql-simple
160− , tasty
161− , tasty-golden
162− , tasty-hunit
163− , text
164− , time-compat
165− , vector
166−
167−benchmark select
168− default-language: Haskell2010
169− type: exitcode-stdio-1.0
170− hs-source-dirs: bench
171− main-is: Select.hs
172− build-depends:
173− base
174− , postgresql-simple
175− , vector
108+ ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
109+
110+ extensions: NamedFieldPuns
111+ , OverloadedStrings
112+ , Rank2Types
113+ , RecordWildCards
114+ , PatternGuards
115+ , ScopedTypeVariables
116+
117+ build-depends: base
118+ , aeson
119+ , base16-bytestring
120+ , bytestring
121+ , containers
122+ , cryptohash
123+ , filepath
124+ , tasty
125+ , tasty-hunit
126+ , tasty-golden
127+ , HUnit
128+ , postgresql-simple
129+ , text
130+ , time
131+ , vector
132+
133+ if !impl(ghc >= 7.6)
134+ build-depends:
135+ ghc-prim
src/Database/PostgreSQL/Simple.hs+10−23
@@ -64,7 +64,6 @@ module Database.PostgreSQL.Simple
6464 , Only(..)
6565 , (:.)(..)
6666 -- ** Exceptions
67− , SomePostgreSqlException(..)
6867 , SqlError(..)
6968 , PQ.ExecStatus(..)
7069 , FormatError(..)
@@ -74,7 +73,6 @@ module Database.PostgreSQL.Simple
7473 , Base.connectPostgreSQL
7574 , Base.close
7675 , Base.connect
77− , Base.withConnect
7876 , Base.ConnectInfo(..)
7977 , Base.defaultConnectInfo
8078 , Base.postgreSQLConnectionString
@@ -278,31 +276,21 @@ parseTemplate template =
278276 skipSpace = B.dropWhile isSpace_ascii
279277
280278
279+
281280buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
282281buildQuery conn q template xs =
283282 zipParams (split template) <$> mapM (buildAction conn q xs) xs
284283 where split s =
285− -- This part escapes double '??'s to make literal '?'s possible
286− -- in PostgreSQL queries using the JSON operators: @?@, @?|@ and @?&@
287− let (h,t) = breakOnSingleQuestionMark s
284+ let (h,t) = B.break (=='?') s
288285 in byteString h
289286 : if B.null t
290287 then []
291288 else split (B.tail t)
292289 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps
293290 zipParams [t] [] = t
294− zipParams _ _ = fmtError (show countSingleQs ++
295− " single '?' characters, but " ++
291+ zipParams _ _ = fmtError (show (B.count '?' template) ++
292+ " '?' characters, but " ++
296293 show (length xs) ++ " parameters") q xs
297− countSingleQs = go 0 template
298− where go i "" = (i :: Int)
299− go i bs = case qms of
300− ("?","?") -> go i nextQMBS
301− ("?",_) -> go (i+1) nextQMBS
302− _ -> i
303− where qms = B.splitAt 1 qmBS
304− (qmBS,nextQMBS) = B.splitAt 2 qmBS'
305− qmBS' = B.dropWhile (/= '?') bs
306294
307295-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not
308296-- expected to return results.
@@ -340,7 +328,7 @@ execute conn template qs = do
340328-- @
341329-- executeMany c [sql|
342330-- UPDATE sometable
343−-- SET y = upd.y
331+-- SET sometable.y = upd.y
344332-- FROM (VALUES (?,?)) as upd(x,y)
345333-- WHERE sometable.x = upd.x
346334-- |] [(1, \"hello\"),(2, \"world\")]
@@ -367,7 +355,6 @@ executeMany conn q qs = do
367355returning :: (ToRow q, FromRow r) => Connection -> Query -> [q] -> IO [r]
368356returning = returningWith fromRow
369357
370−-- | A version of 'returning' taking parser as argument
371358returningWith :: (ToRow q) => RowParser r -> Connection -> Query -> [q] -> IO [r]
372359returningWith _ _ _ [] = return []
373360returningWith parser conn q qs = do
@@ -533,7 +520,7 @@ foldWithOptions_ :: (FromRow r) =>
533520 -> a -- ^ Initial state for result consumer.
534521 -> (a -> r -> IO a) -- ^ Result consumer.
535522 -> IO a
536−foldWithOptions_ opts conn query' a f = doFold opts fromRow conn query' query' a f
523+foldWithOptions_ opts conn query a f = doFold opts fromRow conn query query a f
537524
538525-- | A version of 'foldWithOptions_' taking a parser as an argument
539526foldWithOptionsAndParser_ :: FoldOptions
@@ -543,7 +530,7 @@ foldWithOptionsAndParser_ :: FoldOptions
543530 -> a -- ^ Initial state for result consumer.
544531 -> (a -> r -> IO a) -- ^ Result consumer.
545532 -> IO a
546−foldWithOptionsAndParser_ opts parser conn query' a f = doFold opts parser conn query' query' a f
533+foldWithOptionsAndParser_ opts parser conn query a f = doFold opts parser conn query query a f
547534
548535doFold :: FoldOptions
549536 -> RowParser row
@@ -579,8 +566,8 @@ doFold FoldOptions{..} parser conn _template q a0 f = do
579566 go = bracket declare closeCursor $ \cursor ->
580567 let loop a = fetch cursor a >>=
581568 \r -> case r of
582− Left x -> return x
583− Right x -> loop x
569+ Left a -> return a
570+ Right a -> loop a
584571 in loop a0
585572
586573-- FIXME: choose the Automatic chunkSize more intelligently
@@ -902,7 +889,7 @@ forEachWith_ parser conn template = foldWith_ parser conn template () . const
902889-- all values of the given PostgreSQL type is considered \"compatible\".
903890-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@
904891-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately
905−-- represent a @SMALLINT@, so it is considered compatible with those types.
892+-- represent a @SMALLINT@, so it is considered compatble with those types.
906893--
907894-- * A numeric compatibility check is based only on the type of a
908895-- column, /not/ on its values. For instance, a PostgreSQL 64-bit
src/Database/PostgreSQL/Simple/Arrays.hs+2−2
@@ -42,9 +42,9 @@ array delim = char '{' *> option [] (arrays <|> strings) <* char '}'
4242quoted :: Parser ByteString
4343quoted = char '"' *> option "" contents <* char '"'
4444 where
45− esc' = char '\\' *> (char '\\' <|> char '"')
45+ esc = char '\\' *> (char '\\' <|> char '"')
4646 unQ = takeWhile1 (notInClass "\"\\")
47− contents = mconcat <$> many (unQ <|> B.singleton <$> esc')
47+ contents = mconcat <$> many (unQ <|> B.singleton <$> esc)
4848
4949-- | Recognizes a plain string literal, not containing quotes or brackets and
5050-- not containing the delimiter character.
src/Database/PostgreSQL/Simple/Compat.hs+53
@@ -12,13 +12,36 @@ module Database.PostgreSQL.Simple.Compat
1212 ) where
1313
1414import qualified Control.Exception as E
15+import Data.Monoid
1516import Data.ByteString (ByteString)
17+#if MIN_VERSION_bytestring(0,10,0)
1618import Data.ByteString.Lazy (toStrict)
19+#else
20+import qualified Data.ByteString as B
21+import Data.ByteString.Lazy (toChunks)
22+#endif
1723import Data.ByteString.Builder (Builder, toLazyByteString)
24+
25+#if MIN_VERSION_scientific(0,3,0)
1826import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
27+#else
28+import Data.Scientific (scientificBuilder)
29+#endif
30+
31+#if __GLASGOW_HASKELL__ >= 702
1932import System.IO.Unsafe (unsafeDupablePerformIO)
33+#elif __GLASGOW_HASKELL__ >= 611
34+import GHC.IO (unsafeDupablePerformIO)
35+#else
36+import GHC.IOBase (unsafeDupablePerformIO)
37+#endif
38+
2039import Data.Fixed (Pico)
40+#if MIN_VERSION_base(4,7,0)
2141import Data.Fixed (Fixed(MkFixed))
42+#else
43+import Unsafe.Coerce (unsafeCoerce)
44+#endif
2245
2346-- | Like 'E.mask', but backported to base before version 4.3.0.
2447--
@@ -28,14 +51,44 @@ import Data.Fixed (Fixed(MkFixed))
2851-- 'withTransactionMode' function calls the restore callback only once, so we
2952-- don't need that polymorphism.
3053mask :: ((IO a -> IO a) -> IO b) -> IO b
54+#if MIN_VERSION_base(4,3,0)
3155mask io = E.mask $ \restore -> io restore
56+#else
57+mask io = do
58+ b <- E.blocked
59+ E.block $ io $ \m -> if b then m else E.unblock m
60+#endif
3261{-# INLINE mask #-}
3362
63+#if !MIN_VERSION_base(4,5,0)
64+infixr 6 <>
65+
66+(<>) :: Monoid m => m -> m -> m
67+(<>) = mappend
68+{-# INLINE (<>) #-}
69+#endif
70+
3471toByteString :: Builder -> ByteString
72+#if MIN_VERSION_bytestring(0,10,0)
3573toByteString x = toStrict (toLazyByteString x)
74+#else
75+toByteString x = B.concat (toChunks (toLazyByteString x))
76+#endif
77+
78+#if MIN_VERSION_base(4,7,0)
3679
3780toPico :: Integer -> Pico
3881toPico = MkFixed
3982
4083fromPico :: Pico -> Integer
4184fromPico (MkFixed i) = i
85+
86+#else
87+
88+toPico :: Integer -> Pico
89+toPico = unsafeCoerce
90+
91+fromPico :: Pico -> Integer
92+fromPico = unsafeCoerce
93+
94+#endif
src/Database/PostgreSQL/Simple/Copy.hs+6−27
@@ -32,7 +32,6 @@ module Database.PostgreSQL.Simple.Copy
3232 ( copy
3333 , copy_
3434 , CopyOutResult(..)
35− , foldCopyData
3635 , getCopyData
3736 , putCopyData
3837 , putCopyEnd
@@ -49,13 +48,13 @@ import qualified Data.ByteString.Char8 as B
4948import qualified Database.PostgreSQL.LibPQ as PQ
5049import Database.PostgreSQL.Simple
5150import Database.PostgreSQL.Simple.Types
52−import Database.PostgreSQL.Simple.Internal hiding (result, row)
51+import Database.PostgreSQL.Simple.Internal
5352
5453
5554-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former
5655-- case, the connection's state will change to @CopyIn@; in the latter,
5756-- @CopyOut@. The connection must be in the ready state in order
58−-- to call this function. Performs parameter substitution.
57+-- to call this function. Performs parameter subsitution.
5958
6059copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()
6160copy conn template qs = do
@@ -86,8 +85,12 @@ doCopy funcName conn template q = do
8685 PQ.TuplesOk -> err
8786 PQ.CopyOut -> return ()
8887 PQ.CopyIn -> return ()
88+#if MIN_VERSION_postgresql_libpq(0,9,3)
8989 PQ.CopyBoth -> errMsg "COPY BOTH is not supported"
90+#endif
91+#if MIN_VERSION_postgresql_libpq(0,9,2)
9092 PQ.SingleTuple -> errMsg "single-row mode is not supported"
93+#endif
9194 PQ.BadResponse -> throwResultError funcName result status
9295 PQ.NonfatalError -> throwResultError funcName result status
9396 PQ.FatalError -> throwResultError funcName result status
@@ -101,30 +104,6 @@ data CopyOutResult
101104 deriving (Eq, Typeable, Show)
102105
103106
104−-- | Fold over @COPY TO STDOUT@ query passing each copied row to an accumulator
105−-- and calling a post-process at the end. A connection must be in the
106−-- @CopyOut@ state in order to call this function.
107−--
108−-- __Example__
109−--
110−-- > (acc, count) <- foldCopyData conn
111−-- > (\acc row -> return (row:acc))
112−-- > (\acc count -> return (acc, count))
113−-- > []
114−
115−foldCopyData
116− :: Connection -- ^ Database connection
117− -> (a -> B.ByteString -> IO a) -- ^ Accumulate one row of the result
118− -> (a -> Int64 -> IO b) -- ^ Post-process accumulator with a count of rows
119− -> a -- ^ Initial accumulator
120− -> IO b -- ^ Result
121−foldCopyData conn f g !acc = do
122− result <- getCopyData conn
123− case result of
124− CopyOutRow row -> f acc row >>= foldCopyData conn f g
125− CopyOutDone count -> g acc count
126−
127−
128107-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
129108-- must be in the @CopyOut@ state in order to call this function. If this
130109-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,
src/Database/PostgreSQL/Simple/Cursor.hs+5−5
@@ -30,7 +30,7 @@ import Data.Monoid (mconcat)
3030import Database.PostgreSQL.Simple.Compat ((<>), toByteString)
3131import Database.PostgreSQL.Simple.FromRow (FromRow(..))
3232import Database.PostgreSQL.Simple.Types (Query(..))
33−import Database.PostgreSQL.Simple.Internal as Base hiding (result, row)
33+import Database.PostgreSQL.Simple.Internal as Base
3434import Database.PostgreSQL.Simple.Internal.PQResultUtils
3535import Database.PostgreSQL.Simple.Transaction
3636import qualified Database.PostgreSQL.LibPQ as PQ
@@ -90,9 +90,9 @@ foldForward cursor = foldForwardWithParser cursor fromRow
9090foldM' :: (Ord n, Num n) => (a -> n -> IO a) -> a -> n -> n -> IO a
9191foldM' f a lo hi = loop a lo
9292 where
93− loop x !n
94− | n > hi = return x
93+ loop a !n
94+ | n > hi = return a
9595 | otherwise = do
96− x' <- f x n
97− loop x' (n+1)
96+ a' <- f a n
97+ loop a' (n+1)
9898{-# INLINE foldM' #-}
src/Database/PostgreSQL/Simple/Errors.hs+3−4
@@ -25,6 +25,7 @@ module Database.PostgreSQL.Simple.Errors
2525 )
2626 where
2727
28+import Control.Applicative
2829import Control.Exception as E
2930
3031import Data.Attoparsec.ByteString.Char8
@@ -59,13 +60,11 @@ data ConstraintViolation
5960 deriving (Show, Eq, Ord, Typeable)
6061
6162-- Default instance should be enough
62−instance Exception ConstraintViolation where
63− toException = postgresqlExceptionToException
64− fromException = postgresqlExceptionFromException
63+instance Exception ConstraintViolation
6564
6665
6766-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and
68−-- succeeds only if able to parse sqlErrorMsg.
67+-- succeedes only if able to parse sqlErrorMsg.
6968--
7069-- > createUser = handleJust constraintViolation handler $ execute conn ...
7170-- > where
src/Database/PostgreSQL/Simple/FromField.hs+70−124
@@ -1,8 +1,7 @@
11{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
33{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}
4−{-# LANGUAGE RecordWildCards #-}
5−{-# LANGUAGE PolyKinds #-}
4+{-# LANGUAGE RecordWildCards, TemplateHaskell #-}
65
76{- |
87Module: Database.PostgreSQL.Simple.FromField
@@ -107,27 +106,25 @@ module Database.PostgreSQL.Simple.FromField
107106 , PQ.Oid(..)
108107 , PQ.Format(..)
109108 , pgArrayFieldParser
110− , attoFieldParser
111109
112110 , optionalField
113111 , fromJSONField
114− , fromFieldJSONByteString
115112 ) where
116113
117114#include "MachDeps.h"
118115
119−import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
116+import Control.Applicative ( (<|>), (<$>), pure, (*>), (<*) )
120117import Control.Concurrent.MVar (MVar, newMVar)
121−import Control.Exception (Exception (toException, fromException))
118+import Control.Exception (Exception)
122119import qualified Data.Aeson as JSON
120+import qualified Data.Aeson.Parser as JSON (value')
123121import Data.Attoparsec.ByteString.Char8 hiding (Result)
124122import Data.ByteString (ByteString)
125123import qualified Data.ByteString.Char8 as B
126−import Data.Functor.Identity (Identity(Identity))
127124import Data.Int (Int16, Int32, Int64)
128125import Data.IORef (IORef, newIORef)
129126import Data.Ratio (Ratio)
130−import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )
127+import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )
131128import Data.Typeable (Typeable, typeOf)
132129import Data.Vector (Vector)
133130import Data.Vector.Mutable (IOVector)
@@ -138,6 +135,7 @@ import Database.PostgreSQL.Simple.Ok
138135import Database.PostgreSQL.Simple.Types
139136import Database.PostgreSQL.Simple.TypeInfo as TI
140137import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI
138+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI
141139import Database.PostgreSQL.Simple.Time
142140import Database.PostgreSQL.Simple.Arrays as Arrays
143141import qualified Database.PostgreSQL.LibPQ as PQ
@@ -154,8 +152,6 @@ import qualified Data.UUID.Types as UUID
154152import Data.Scientific (Scientific)
155153import GHC.Real (infinity, notANumber)
156154
157−import qualified Data.Aeson.Types as JSON
158−
159155-- | Exception thrown if conversion from a SQL value to a Haskell
160156-- value fails.
161157data ResultError = Incompatible { errSQLType :: String
@@ -182,9 +178,7 @@ data ResultError = Incompatible { errSQLType :: String
182178 -- between metadata and actual data in a row).
183179 deriving (Eq, Show, Typeable)
184180
185−instance Exception ResultError where
186− toException = postgresqlExceptionToException
187− fromException = postgresqlExceptionFromException
181+instance Exception ResultError
188182
189183left :: Exception a => a -> Conversion b
190184left = conversionError
@@ -250,11 +244,9 @@ tableOid Field{..} = toMaybeOid (unsafeDupablePerformIO (PQ.ftable result column
250244 then Nothing
251245 else Just x
252246
253−-- | If the column has a table associated with it, this returns the
254−-- number of the associated table column. Table columns have
255−-- nonzero numbers. Zero is returned if the specified column is not
256−-- a simple reference to a table column, or when using pre-3.0
257−-- protocol. Analogous to libpq's @PQftablecol@.
247+-- | If the column has a table associated with it, this returns the number
248+-- off the associated table column. Numbering starts from 0. Analogous
249+-- to libpq's @PQftablecol@.
258250
259251tableColumn :: Field -> Int
260252tableColumn Field{..} = fromCol (unsafeDupablePerformIO (PQ.ftablecol result column))
@@ -270,15 +262,9 @@ format Field{..} = unsafeDupablePerformIO (PQ.fformat result column)
270262-- | void
271263instance FromField () where
272264 fromField f _bs
273− | typeOid f /= TI.voidOid = returnError Incompatible f ""
265+ | typeOid f /= $(inlineTypoid TI.void) = returnError Incompatible f ""
274266 | otherwise = pure ()
275267
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−
282268-- | For dealing with null values. Compatible with any postgresql type
283269-- compatible with type @a@. Note that the type is not checked if
284270-- the value is null, although it is inadvisable to rely on this
@@ -306,7 +292,7 @@ instance FromField Null where
306292-- | bool
307293instance FromField Bool where
308294 fromField f bs
309− | typeOid f /= TI.boolOid = returnError Incompatible f ""
295+ | typeOid f /= $(inlineTypoid TI.bool) = returnError Incompatible f ""
310296 | bs == Nothing = returnError UnexpectedNull f ""
311297 | bs == Just "t" = pure True
312298 | bs == Just "f" = pure False
@@ -314,9 +300,9 @@ instance FromField Bool where
314300
315301-- | \"char\", bpchar
316302instance FromField Char where
317− fromField f bs0 =
318− if (eq TI.charOid \/ eq TI.bpcharOid) (typeOid f)
319− then case bs0 of
303+ fromField f bs =
304+ if $(mkCompats [TI.char,TI.bpchar]) (typeOid f)
305+ then case bs of
320306 Nothing -> returnError UnexpectedNull f ""
321307 Just bs -> if B.length bs /= 1
322308 then returnError ConversionFailed f "length not 1"
@@ -325,11 +311,11 @@ instance FromField Char where
325311
326312-- | int2
327313instance FromField Int16 where
328− fromField = attoFieldParser ok16 $ signed decimal
314+ fromField = atto ok16 $ signed decimal
329315
330316-- | int2, int4
331317instance FromField Int32 where
332− fromField = attoFieldParser ok32 $ signed decimal
318+ fromField = atto ok32 $ signed decimal
333319
334320#if WORD_SIZE_IN_BITS < 64
335321-- | int2, int4, and if compiled as 64-bit code, int8 as well.
@@ -339,37 +325,37 @@ instance FromField Int32 where
339325-- This library was compiled as 64-bit code.
340326#endif
341327instance FromField Int where
342− fromField = attoFieldParser okInt $ signed decimal
328+ fromField = atto okInt $ signed decimal
343329
344330-- | int2, int4, int8
345331instance FromField Int64 where
346− fromField = attoFieldParser ok64 $ signed decimal
332+ fromField = atto ok64 $ signed decimal
347333
348334-- | int2, int4, int8
349335instance FromField Integer where
350− fromField = attoFieldParser ok64 $ signed decimal
336+ fromField = atto ok64 $ signed decimal
351337
352338-- | int2, float4 (Uses attoparsec's 'double' routine, for
353339-- better accuracy convert to 'Scientific' or 'Rational' first)
354340instance FromField Float where
355− fromField = attoFieldParser ok (realToFrac <$> pg_double)
356− where ok = eq TI.float4Oid \/ eq TI.int2Oid
341+ fromField = atto ok (realToFrac <$> pg_double)
342+ where ok = $(mkCompats [TI.float4,TI.int2])
357343
358344-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for
359345-- better accuracy convert to 'Scientific' or 'Rational' first)
360346instance FromField Double where
361− fromField = attoFieldParser ok pg_double
362− where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid
347+ fromField = atto ok pg_double
348+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4])
363349
364350-- | int2, int4, int8, float4, float8, numeric
365351instance FromField (Ratio Integer) where
366− fromField = attoFieldParser ok pg_rational
367− where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
352+ fromField = atto ok pg_rational
353+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.int8,TI.numeric])
368354
369355-- | int2, int4, int8, float4, float8, numeric
370356instance FromField Scientific where
371− fromField = attoFieldParser ok rational
372− where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid
357+ fromField = atto ok rational
358+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.int8,TI.numeric])
373359
374360unBinary :: Binary t -> t
375361unBinary (Binary x) = x
@@ -390,13 +376,13 @@ pg_rational
390376
391377-- | bytea, name, text, \"char\", bpchar, varchar, unknown
392378instance FromField SB.ByteString where
393− fromField f dat = if typeOid f == TI.byteaOid
379+ fromField f dat = if typeOid f == $(inlineTypoid TI.bytea)
394380 then unBinary <$> fromField f dat
395381 else doFromField f okText' pure dat
396382
397383-- | oid
398384instance FromField PQ.Oid where
399− fromField f dat = PQ.Oid <$> attoFieldParser (== TI.oidOid) decimal f dat
385+ fromField f dat = PQ.Oid <$> atto (== $(inlineTypoid TI.oid)) decimal f dat
400386
401387-- | bytea, name, text, \"char\", bpchar, varchar, unknown
402388instance FromField LB.ByteString where
@@ -404,7 +390,7 @@ instance FromField LB.ByteString where
404390
405391unescapeBytea :: Field -> SB.ByteString
406392 -> Conversion (Binary SB.ByteString)
407−unescapeBytea f str' = case unsafeDupablePerformIO (PQ.unescapeBytea str') of
393+unescapeBytea f str = case unsafeDupablePerformIO (PQ.unescapeBytea str) of
408394 Nothing -> returnError ConversionFailed f "unescapeBytea failed"
409395 Just str -> pure (Binary str)
410396
@@ -455,57 +441,48 @@ instance FromField [Char] where
455441
456442-- | timestamptz
457443instance FromField UTCTime where
458− fromField = ff TI.timestamptzOid "UTCTime" parseUTCTime
444+ fromField = ff $(inlineTypoid TI.timestamptz) "UTCTime" parseUTCTime
459445
460446-- | timestamptz
461447instance FromField ZonedTime where
462− fromField = ff TI.timestamptzOid "ZonedTime" parseZonedTime
448+ fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTime" parseZonedTime
463449
464450-- | timestamp
465451instance FromField LocalTime where
466− fromField = ff TI.timestampOid "LocalTime" parseLocalTime
452+ fromField = ff $(inlineTypoid TI.timestamp) "LocalTime" parseLocalTime
467453
468454-- | date
469455instance FromField Day where
470− fromField = ff TI.dateOid "Day" parseDay
456+ fromField = ff $(inlineTypoid TI.date) "Day" parseDay
471457
472458-- | time
473459instance FromField TimeOfDay where
474− fromField = ff TI.timeOid "TimeOfDay" parseTimeOfDay
460+ fromField = ff $(inlineTypoid TI.time) "TimeOfDay" parseTimeOfDay
475461
476462-- | timestamptz
477463instance FromField UTCTimestamp where
478− fromField = ff TI.timestamptzOid "UTCTimestamp" parseUTCTimestamp
464+ fromField = ff $(inlineTypoid TI.timestamptz) "UTCTimestamp" parseUTCTimestamp
479465
480466-- | timestamptz
481467instance FromField ZonedTimestamp where
482− fromField = ff TI.timestamptzOid "ZonedTimestamp" parseZonedTimestamp
468+ fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTimestamp" parseZonedTimestamp
483469
484470-- | timestamp
485471instance FromField LocalTimestamp where
486− fromField = ff TI.timestampOid "LocalTimestamp" parseLocalTimestamp
472+ fromField = ff $(inlineTypoid TI.timestamp) "LocalTimestamp" parseLocalTimestamp
487473
488474-- | date
489475instance FromField Date where
490− fromField = ff TI.dateOid "Date" parseDate
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
476+ fromField = ff $(inlineTypoid TI.date) "Date" parseDate
500477
501478ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
502479 -> Field -> Maybe B8.ByteString -> Conversion a
503−ff compatOid hsType parseBS f mstr =
480+ff compatOid hsType parse f mstr =
504481 if typeOid f /= compatOid
505482 then err Incompatible ""
506483 else case mstr of
507484 Nothing -> err UnexpectedNull ""
508− Just str -> case parseBS str of
485+ Just str -> case parse str of
509486 Left msg -> err ConversionFailed msg
510487 Right val -> return val
511488 where
@@ -543,10 +520,10 @@ pgArrayFieldParser fieldParser f mdat = do
543520 _ -> returnError Incompatible f ""
544521
545522fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])
546−fromArray fieldParser typInfo f = sequence . (parseIt <$>) <$> array delim
523+fromArray fieldParser typeInfo f = sequence . (parseIt <$>) <$> array delim
547524 where
548− delim = typdelim (typelem typInfo)
549− fElem = f{ typeOid = typoid (typelem typInfo) }
525+ delim = typdelim (typelem typeInfo)
526+ fElem = f{ typeOid = typoid (typelem typeInfo) }
550527
551528 parseIt item =
552529 fieldParser f' $ if item == Arrays.Plain "NULL" then Nothing else Just item'
@@ -564,7 +541,7 @@ instance (FromField a, Typeable a) => FromField (IOVector a) where
564541-- | uuid
565542instance FromField UUID where
566543 fromField f mbs =
567− if typeOid f /= TI.uuidOid
544+ if typeOid f /= $(inlineTypoid TI.uuid)
568545 then returnError Incompatible f ""
569546 else case mbs of
570547 Nothing -> returnError UnexpectedNull f ""
@@ -573,26 +550,20 @@ instance FromField UUID where
573550 Nothing -> returnError ConversionFailed f "Invalid UUID"
574551 Just uuid -> pure uuid
575552
576−-- | json, jsonb
553+-- | json
577554instance FromField JSON.Value where
578− fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs
579− where parseBS bs = case JSON.eitherDecodeStrict' bs of
580− Left err -> returnError ConversionFailed f err
581− Right val -> pure val
582−
583−-- | Return the JSON ByteString directly
584−--
585−-- @since 0.6.3
586−fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString
587−fromFieldJSONByteString f mbs =
588− if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid
555+ fromField f mbs =
556+ if typeOid f /= $(inlineTypoid TI.json) && typeOid f /= $(inlineTypoid TI.jsonb)
589557 then returnError Incompatible f ""
590558 else case mbs of
591559 Nothing -> returnError UnexpectedNull f ""
592− Just bs -> pure bs
560+ Just bs ->
561+ case parseOnly (JSON.value' <* endOfInput) bs of
562+ Left err -> returnError ConversionFailed f err
563+ Right val -> pure val
593564
594565-- | Parse a field to a JSON 'JSON.Value' and convert that into a
595−-- Haskell value using the 'JSON.FromJSON' instance.
566+-- Haskell value using 'JSON.fromJSON'.
596567--
597568-- This can be used as the default implementation for the 'fromField'
598569-- method for Haskell types that have a JSON representation in
@@ -613,10 +584,10 @@ fromFieldJSONByteString f mbs =
613584fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a
614585fromJSONField f mbBs = do
615586 value <- fromField f mbBs
616− case JSON.ifromJSON value of
617− JSON.IError path err -> returnError ConversionFailed f $
618− "JSON decoding error: " ++ (JSON.formatError path err)
619− JSON.ISuccess x -> pure x
587+ case JSON.fromJSON value of
588+ JSON.Error err -> returnError ConversionFailed f $
589+ "JSON decoding error: " ++ err
590+ JSON.Success x -> pure x
620591
621592-- | Compatible with the same set of types as @a@. Note that
622593-- modifying the 'IORef' does not have any effects outside
@@ -633,33 +604,20 @@ instance FromField a => FromField (MVar a) where
633604type Compat = PQ.Oid -> Bool
634605
635606okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat
636−okText = eq TI.nameOid \/ eq TI.textOid \/ eq TI.charOid
637− \/ eq TI.bpcharOid \/ eq TI.varcharOid
638−okText' = eq TI.nameOid \/ eq TI.textOid \/ eq TI.charOid
639− \/ eq TI.bpcharOid \/ eq TI.varcharOid \/ eq TI.unknownOid
640−okBinary = eq TI.byteaOid
641−ok16 = eq TI.int2Oid
642−ok32 = eq TI.int2Oid \/ eq TI.int4Oid
643−ok64 = eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid
607+okText = $( mkCompats [ TI.name, TI.text, TI.char,
608+ TI.bpchar, TI.varchar ] )
609+okText' = $( mkCompats [ TI.name, TI.text, TI.char,
610+ TI.bpchar, TI.varchar, TI.unknown ] )
611+okBinary = (== $( inlineTypoid TI.bytea ))
612+ok16 = (== $( inlineTypoid TI.int2 ))
613+ok32 = $( mkCompats [TI.int2,TI.int4] )
614+ok64 = $( mkCompats [TI.int2,TI.int4,TI.int8] )
644615#if WORD_SIZE_IN_BITS < 64
645616okInt = ok32
646617#else
647618okInt = ok64
648619#endif
649620
650−-- | eq and \/ are used to imlement what Macro stuff did,
651−-- i.e. mkCompats and inlineTypoid
652−eq :: PQ.Oid -> PQ.Oid -> Bool
653−eq = (==)
654−{-# INLINE eq #-}
655−
656−infixr 2 \/
657−(\/) :: (PQ.Oid -> Bool)
658− -> (PQ.Oid -> Bool)
659− -> (PQ.Oid -> Bool)
660−f \/ g = \x -> f x || g x
661−{-# INLINE (\/) #-}
662−
663621doFromField :: forall a . (Typeable a)
664622 => Field -> Compat -> (ByteString -> Conversion a)
665623 -> Maybe ByteString -> Conversion a
@@ -684,22 +642,10 @@ returnError mkErr f msg = do
684642 (show (typeOf (undefined :: a)))
685643 msg
686644
687−-- | Construct a field parser from an attoparsec parser. An 'Incompatible' error is thrown if the
688−-- PostgreSQL oid does not match the specified predicate.
689−--
690−-- @
691−-- instance FromField Int16 where
692−-- fromField = attoFieldParser ok16 (signed decimal)
693−-- @
694−--
695−-- @since 0.6.3
696−attoFieldParser :: forall a. (Typeable a)
697− => (PQ.Oid -> Bool)
698− -- ^ Predicate for whether the postgresql type oid is compatible with this parser
699− -> Parser a
700− -- ^ An attoparsec parser.
701− -> FieldParser a
702−attoFieldParser types p0 f dat = doFromField f types (go p0) dat
645+atto :: forall a. (Typeable a)
646+ => Compat -> Parser a -> Field -> Maybe ByteString
647+ -> Conversion a
648+atto types p0 f dat = doFromField f types (go p0) dat
703649 where
704650 go :: Parser a -> ByteString -> Conversion a
705651 go p s =
src/Database/PostgreSQL/Simple/FromRow.hs+4−20
@@ -67,23 +67,6 @@ import GHC.Generics
6767-- in a single row of the query result. Otherwise, a 'ConversionFailed'
6868-- exception will be thrown.
6969--
70−-- You can also derive 'FromRow' for your data type using GHC generics, like
71−-- this:
72−--
73−-- @
74−-- \{-# LANGUAGE DeriveAnyClass \#-}
75−-- \{-# LANGUAGE DeriveGeneric \#-}
76−--
77−-- import "GHC.Generics" ('GHC.Generics.Generic')
78−-- import "Database.PostgreSQL.Simple" ('FromRow')
79−--
80−-- data User = User { name :: String, fileQuota :: Int }
81−-- deriving ('GHC.Generics.Generic', 'FromRow')
82−-- @
83−--
84−-- Note that this only works for product types (e.g. records) and does not
85−-- support sum types or recursive types.
86−--
8770-- Note that 'field' evaluates its result to WHNF, so the caveats listed in
8871-- mysql-simple and very early versions of postgresql-simple no longer apply.
8972-- Instead, look at the caveats associated with user-defined implementations
@@ -131,8 +114,8 @@ fieldWith fieldP = RP $ do
131114 else do
132115 let !result = rowresult
133116 !typeOid = unsafeDupablePerformIO (PQ.ftype result column)
134− !field' = Field{..}
135− lift (lift (fieldP field' (getvalue result row column)))
117+ !field = Field{..}
118+ lift (lift (fieldP field (getvalue result row column)))
136119
137120field :: FromField a => RowParser a
138121field = fieldWith fromField
@@ -437,7 +420,8 @@ instance (FromField a, FromField b, FromField c, FromField d, FromField e,
437420instance (FromField a, FromField b, FromField c, FromField d, FromField e,
438421 FromField f, FromField g, FromField h, FromField i, FromField j,
439422 FromField k, FromField l, FromField m, FromField n, FromField o,
440− FromField p, FromField q, FromField r, FromField s, FromField t) =>
423+ FromField p, FromField q, FromField q, FromField r, FromField s,
424+ FromField t) =>
441425 FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)) where
442426 fromRow = (null *> null *> null *> null *> null *>
443427 null *> null *> null *> null *> null *>
src/Database/PostgreSQL/Simple/HStore/Implementation.hs+9−3
@@ -22,6 +22,9 @@ import Data.ByteString.Builder (Builder, byteString, char8)
2222import qualified Data.ByteString.Builder as BU
2323import Data.ByteString.Internal (c2w, w2c)
2424import qualified Data.ByteString.Lazy as BL
25+#if !MIN_VERSION_bytestring(0,10,0)
26+import qualified Data.ByteString.Lazy.Internal as BL (foldrChunks)
27+#endif
2528import Data.Map(Map)
2629import qualified Data.Map as Map
2730import Data.Text(Text)
@@ -50,12 +53,12 @@ instance ToHStore HStoreBuilder where
5053toBuilder :: HStoreBuilder -> Builder
5154toBuilder x = case x of
5255 Empty -> mempty
53− Comma c -> c
56+ Comma x -> x
5457
5558toLazyByteString :: HStoreBuilder -> BL.ByteString
5659toLazyByteString x = case x of
5760 Empty -> BL.empty
58− Comma c -> BU.toLazyByteString c
61+ Comma x -> BU.toLazyByteString x
5962
6063instance Semigroup HStoreBuilder where
6164 Empty <> x = x
@@ -66,6 +69,9 @@ instance Semigroup HStoreBuilder where
6669
6770instance Monoid HStoreBuilder where
6871 mempty = Empty
72+#if !(MIN_VERSION_base(4,11,0))
73+ mappend = (<>)
74+#endif
6975
7076class ToHStoreText a where
7177 toHStoreText :: a -> HStoreText
@@ -144,7 +150,7 @@ newtype HStoreMap = HStoreMap {fromHStoreMap :: Map Text Text} deriving (Eq, Or
144150
145151instance ToHStore HStoreMap where
146152 toHStore (HStoreMap xs) = Map.foldrWithKey f mempty xs
147− where f k v xs' = hstore k v `mappend` xs'
153+ where f k v xs = hstore k v `mappend` xs
148154
149155instance ToField HStoreMap where
150156 toField xs = toField (toHStore xs)
src/Database/PostgreSQL/Simple/Internal.hs+16−65
@@ -1,8 +1,5 @@
11{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}
2−{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4−{-# LANGUAGE ExistentialQuantification #-}
5−{-# LANGUAGE InstanceSigs #-}
2+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
63
74------------------------------------------------------------------------------
85-- |
@@ -36,6 +33,7 @@ import Data.Int (Int64)
3633import qualified Data.IntMap as IntMap
3734import Data.IORef
3835import Data.Maybe(fromMaybe)
36+import Data.Monoid
3937import Data.String
4038import qualified Data.Text as T
4139import qualified Data.Text.Encoding as TE
@@ -52,7 +50,6 @@ import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)
5250import Control.Monad.Trans.State.Strict
5351import Control.Monad.Trans.Reader
5452import Control.Monad.Trans.Class
55−import GHC.Generics
5653import GHC.IO.Exception
5754#if !defined(mingw32_HOST_OS)
5855import Control.Concurrent(threadWaitRead, threadWaitWrite)
@@ -83,25 +80,6 @@ data Connection = Connection {
8380instance Eq Connection where
8481 x == y = connectionHandle x == connectionHandle y
8582
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−
10583data SqlError = SqlError {
10684 sqlState :: ByteString
10785 , sqlExecStatus :: ExecStatus
@@ -113,10 +91,7 @@ data SqlError = SqlError {
11391fatalError :: ByteString -> SqlError
11492fatalError msg = SqlError "" FatalError msg "" ""
11593
116−instance Exception SqlError where
117− toException = postgresqlExceptionToException
118− fromException = postgresqlExceptionFromException
119−
94+instance Exception SqlError
12095
12196-- | Exception thrown if 'query' is used to perform an @INSERT@-like
12297-- operation, or 'execute' is used to perform a @SELECT@-like operation.
@@ -125,9 +100,7 @@ data QueryError = QueryError {
125100 , qeQuery :: Query
126101 } deriving (Eq, Show, Typeable)
127102
128−instance Exception QueryError where
129− toException = postgresqlExceptionToException
130− fromException = postgresqlExceptionFromException
103+instance Exception QueryError
131104
132105-- | Exception thrown if a 'Query' could not be formatted correctly.
133106-- This may occur if the number of \'@?@\' characters in the query
@@ -138,9 +111,7 @@ data FormatError = FormatError {
138111 , fmtParams :: [ByteString]
139112 } deriving (Eq, Show, Typeable)
140113
141−instance Exception FormatError where
142− toException = postgresqlExceptionToException
143− fromException = postgresqlExceptionFromException
114+instance Exception FormatError
144115
145116data ConnectInfo = ConnectInfo {
146117 connectHost :: String
@@ -148,7 +119,7 @@ data ConnectInfo = ConnectInfo {
148119 , connectUser :: String
149120 , connectPassword :: String
150121 , connectDatabase :: String
151− } deriving (Generic,Eq,Read,Show,Typeable)
122+ } deriving (Eq,Read,Show,Typeable)
152123
153124-- | Default information for setting up a connection.
154125--
@@ -182,12 +153,6 @@ defaultConnectInfo = ConnectInfo {
182153connect :: ConnectInfo -> IO Connection
183154connect = connectPostgreSQL . postgreSQLConnectionString
184155
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−
191156-- | Attempt to make a connection based on a libpq connection string.
192157-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
193158-- for more information. Also note that environment variables also affect
@@ -223,8 +188,7 @@ withConnect connInfo = bracket (connect connInfo) close
223188--
224189-- Omitting @password@ will default to an appropriate password found
225190-- in the @pgpass@ file, or no password at all if a matching line is
226−-- not found. The path of the @pgpass@ file may be specified by setting
227−-- the @PGPASSFILE@ environment variable. See
191+-- not found. See
228192-- <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for
229193-- more information regarding this file.
230194--
@@ -323,7 +287,7 @@ postgreSQLConnectionString connectInfo = fromString connstr
323287
324288 str name field
325289 | null value = id
326− | otherwise = showString name . addQuotes value . space
290+ | otherwise = showString name . quote value . space
327291 where value = field connectInfo
328292
329293 num name field
@@ -331,7 +295,7 @@ postgreSQLConnectionString connectInfo = fromString connstr
331295 | otherwise = showString name . shows value . space
332296 where value = field connectInfo
333297
334− addQuotes s rest = '\'' : foldr delta ('\'' : rest) s
298+ quote str rest = '\'' : foldr delta ('\'' : rest) str
335299 where
336300 delta c cs = case c of
337301 '\\' -> '\\' : '\\' : cs
@@ -419,7 +383,7 @@ finishExecute _conn q result = do
419383 nstr <- PQ.cmdTuples result
420384 return $ case nstr of
421385 Nothing -> 0 -- is this appropriate?
422− Just str -> mkInteger str
386+ Just str -> toInteger str
423387 PQ.TuplesOk -> do
424388 ncols <- PQ.nfields result
425389 throwIO $ QueryError ("execute resulted in " ++ show ncols ++
@@ -432,7 +396,7 @@ finishExecute _conn q result = do
432396 PQ.NonfatalError -> throwResultError "execute" result status
433397 PQ.FatalError -> throwResultError "execute" result status
434398 where
435− mkInteger str = B8.foldl' delta 0 str
399+ toInteger str = B8.foldl' delta 0 str
436400 where
437401 delta acc c =
438402 if '0' <= c && c <= '9'
@@ -447,8 +411,8 @@ throwResultError _ result status = do
447411 PQ.resultErrorField result PQ.DiagMessageDetail
448412 hint <- fromMaybe "" <$>
449413 PQ.resultErrorField result PQ.DiagMessageHint
450− state' <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate
451− throwIO $ SqlError { sqlState = state'
414+ state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate
415+ throwIO $ SqlError { sqlState = state
452416 , sqlExecStatus = status
453417 , sqlErrorMsg = errormsg
454418 , sqlErrorDetail = detail
@@ -517,6 +481,9 @@ instance Alternative Conversion where
517481 Errors _ -> (oka <|>) <$> runConversion mb conn
518482
519483instance Monad Conversion where
484+#if !(MIN_VERSION_base(4,8,0))
485+ return = pure
486+#endif
520487 m >>= f = Conversion $ \conn -> do
521488 oka <- runConversion m conn
522489 case oka of
@@ -619,19 +586,3 @@ escapeIdentifier = escapeWrap PQ.escapeIdentifier
619586
620587escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
621588escapeByteaConn = escapeWrap PQ.escapeByteaConn
622−
623−breakOnSingleQuestionMark :: ByteString -> (ByteString, ByteString)
624−breakOnSingleQuestionMark b = go (B8.empty, b)
625− where go (x,bs) = (x `B8.append` x',bs')
626− -- seperate from first QM
627− where tup@(noQ, restWithQ) = B8.break (=='?') bs
628− -- if end of query, just return
629− -- else check for second QM in 'go2'
630− (x', bs') = maybe tup go2 $
631− -- drop found QM and peek at next char
632− B8.uncons restWithQ >>= B8.uncons . snd
633− -- another QM after the first means:
634− -- take literal QM and keep going.
635− go2 ('?', t2) = go (noQ `B8.snoc` '?',t2)
636− -- Anything else means
637− go2 _ = tup
src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+12−42
@@ -14,70 +14,40 @@
1414
1515module Database.PostgreSQL.Simple.Internal.PQResultUtils
1616 ( finishQueryWith
17− , finishQueryWithV
18− , finishQueryWithVU
1917 , getRowWith
2018 ) where
2119
2220import Control.Exception as E
2321import Data.ByteString (ByteString)
24−import Data.Foldable (for_)
2522import Database.PostgreSQL.Simple.FromField (ResultError(..))
2623import Database.PostgreSQL.Simple.Ok
2724import Database.PostgreSQL.Simple.Types (Query(..))
28−import Database.PostgreSQL.Simple.Internal as Base hiding (result, row)
25+import Database.PostgreSQL.Simple.Internal as Base
2926import Database.PostgreSQL.Simple.TypeInfo
3027import qualified Database.PostgreSQL.LibPQ as PQ
3128import qualified Data.ByteString.Char8 as B
32−import qualified Data.Vector as V
33−import qualified Data.Vector.Mutable as MV
34−import qualified Data.Vector.Unboxed as VU
35−import qualified Data.Vector.Unboxed.Mutable as MVU
3629import Control.Monad.Trans.Reader
3730import Control.Monad.Trans.State.Strict
3831
3932finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]
40−finishQueryWith parser conn q result = finishQueryWith' q result $ do
41− nrows <- PQ.ntuples result
42− ncols <- PQ.nfields result
43− forM' 0 (nrows-1) $ \row ->
44− getRowWith parser row ncols conn result
45−
46−finishQueryWithV :: RowParser r -> Connection -> Query -> PQ.Result -> IO (V.Vector r)
47−finishQueryWithV parser conn q result = finishQueryWith' q result $ do
48− nrows <- PQ.ntuples result
49− let PQ.Row nrows' = nrows
50− ncols <- PQ.nfields result
51− mv <- MV.unsafeNew (fromIntegral nrows')
52− for_ [ 0 .. nrows-1 ] $ \row -> do
53− let PQ.Row row' = row
54− value <- getRowWith parser row ncols conn result
55− MV.unsafeWrite mv (fromIntegral row') value
56− V.unsafeFreeze mv
57−
58−finishQueryWithVU :: VU.Unbox r => RowParser r -> Connection -> Query -> PQ.Result -> IO (VU.Vector r)
59−finishQueryWithVU parser conn q result = finishQueryWith' q result $ do
60− nrows <- PQ.ntuples result
61− let PQ.Row nrows' = nrows
62− ncols <- PQ.nfields result
63− mv <- MVU.unsafeNew (fromIntegral nrows')
64− for_ [ 0 .. nrows-1 ] $ \row -> do
65− let PQ.Row row' = row
66− value <- getRowWith parser row ncols conn result
67− MVU.unsafeWrite mv (fromIntegral row') value
68− VU.unsafeFreeze mv
69−
70−finishQueryWith' :: Query -> PQ.Result -> IO a -> IO a
71−finishQueryWith' q result k = do
33+finishQueryWith parser conn q result = do
7234 status <- PQ.resultStatus result
7335 case status of
74− PQ.TuplesOk -> k
36+ PQ.TuplesOk -> do
37+ nrows <- PQ.ntuples result
38+ ncols <- PQ.nfields result
39+ forM' 0 (nrows-1) $ \row ->
40+ getRowWith parser row ncols conn result
7541 PQ.EmptyQuery -> queryErr "query: Empty query"
76− PQ.CommandOk -> queryErr "query resulted in a command response (did you mean to use `execute` or forget a RETURNING?)"
42+ PQ.CommandOk -> queryErr "query resulted in a command response"
7743 PQ.CopyOut -> queryErr "query: COPY TO is not supported"
7844 PQ.CopyIn -> queryErr "query: COPY FROM is not supported"
45+#if MIN_VERSION_postgresql_libpq(0,9,3)
7946 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"
47+#endif
48+#if MIN_VERSION_postgresql_libpq(0,9,2)
8049 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"
50+#endif
8151 PQ.BadResponse -> throwResultError "query" result status
8252 PQ.NonfatalError -> throwResultError "query" result status
8353 PQ.FatalError -> throwResultError "query" result status
src/Database/PostgreSQL/Simple/Newtypes.hsdeleted−49
@@ -1,49 +0,0 @@
1−{-# LANGUAGE DeriveFunctor #-}
2−{-# LANGUAGE DeriveDataTypeable #-}
3−-- | Module with newtypes suitable to usage with @DerivingVia@ or standalone.
4−--
5−-- The newtypes are named after packages they wrap.
6−module Database.PostgreSQL.Simple.Newtypes (
7− Aeson (..), getAeson,
8−) where
9−
10−import Data.Typeable (Typeable)
11−import Database.PostgreSQL.Simple.ToField (ToField (..))
12−import Database.PostgreSQL.Simple.FromField (FromField (..), fromJSONField)
13−
14−import qualified Data.Aeson as Aeson
15−
16−-------------------------------------------------------------------------------
17−-- aeson
18−-------------------------------------------------------------------------------
19−
20−-- | A newtype wrapper with 'ToField' and 'FromField' instances
21−-- based on 'Aeson.ToJSON' and 'Aeson.FromJSON' type classes from @aeson@.
22−--
23−-- Example using @DerivingVia@:
24−--
25−-- @
26−-- data Foo = Foo Int String
27−-- deriving stock (Eq, Show, Generic) -- GHC built int
28−-- deriving anyclass ('Aeson.FromJSON', 'Aeson.ToJSON') -- Derived using GHC Generics
29−-- deriving ('ToField', 'FromField') via 'Aeson' Foo -- DerivingVia
30−-- @
31−--
32−-- Example using 'Aeson' newtype directly, for more ad-hoc queries
33−--
34−-- @
35−-- execute conn "INSERT INTO tbl (fld) VALUES (?)" (Only ('Aeson' x))
36−-- @
37−--
38−-- @since 0.6.3
39−newtype Aeson a = Aeson a
40− deriving (Eq, Show, Read, Typeable, Functor)
41−
42−getAeson :: Aeson a -> a
43−getAeson (Aeson a) = a
44−
45−instance Aeson.ToJSON a => ToField (Aeson a) where
46− toField = toField . Aeson.encode . getAeson
47−
48−instance (Aeson.FromJSON a, Typeable a) => FromField (Aeson a) where
49− fromField f bs = fmap Aeson (fromJSONField f bs)
src/Database/PostgreSQL/Simple/Notification.hs+17
@@ -47,6 +47,8 @@ import GHC.IO.Exception ( ioe_location )
4747
4848#if defined(mingw32_HOST_OS)
4949import Control.Concurrent ( threadDelay )
50+#elif !MIN_VERSION_base(4,7,0)
51+import Control.Concurrent ( threadWaitRead )
5052#else
5153import GHC.Conc ( atomically )
5254import Control.Concurrent ( threadWaitReadSTM )
@@ -92,6 +94,21 @@ getNotification conn = join $ withConnection conn fetch
9294 -- with async exceptions, whereas threadDelay can.
9395 Just _fd -> do
9496 return (threadDelay 1000000 >> loop)
97+#elif !MIN_VERSION_base(4,7,0)
98+ -- Technically there's a race condition that is usually benign.
99+ -- If the connection is closed or reset after we drop the
100+ -- lock, and then the fd index is reallocated to a new
101+ -- descriptor before we call threadWaitRead, then
102+ -- we could end up waiting on the wrong descriptor.
103+ --
104+ -- Now, if the descriptor becomes readable promptly, then
105+ -- it's no big deal as we'll wake up and notice the change
106+ -- on the next iteration of the loop. But if are very
107+ -- unlucky, then we could end up waiting a long time.
108+ Just fd -> do
109+ return $ do
110+ threadWaitRead fd `catch` (throwIO . setIOErrorLocation)
111+ loop
95112#else
96113 -- This case fixes the race condition above. By registering
97114 -- our interest in the descriptor before we drop the lock,
src/Database/PostgreSQL/Simple/Ok.hs+4−7
@@ -37,8 +37,6 @@ import Control.Exception
3737import Control.Monad(MonadPlus(..))
3838import Data.Typeable
3939
40−import qualified Control.Monad.Fail as Fail
41−
4240-- FIXME: [SomeException] should probably be something else, maybe
4341-- a difference list (or a tree?)
4442
@@ -72,14 +70,13 @@ instance MonadPlus Ok where
7270 mplus = (<|>)
7371
7472instance Monad Ok where
73+#if !(MIN_VERSION_base(4,8,0))
74+ return = pure
75+#endif
76+
7577 Errors es >>= _ = Errors es
7678 Ok a >>= f = f a
7779
78−#if !(MIN_VERSION_base(4,13,0))
79− fail = Fail.fail
80−#endif
81−
82−instance Fail.MonadFail Ok where
8380 fail str = Errors [SomeException (ErrorCall str)]
8481
8582-- | a way to reify a list of exceptions into a single exception
src/Database/PostgreSQL/Simple/Range.hs+10−14
@@ -19,7 +19,6 @@ module Database.PostgreSQL.Simple.Range
1919 , empty
2020 , isEmpty, isEmptyBy
2121 , contains, containsBy
22− , fromFieldRange
2322 ) where
2423
2524import Control.Applicative hiding (empty)
@@ -38,7 +37,7 @@ import Data.Monoid (mempty)
3837import Data.Scientific (Scientific)
3938import qualified Data.Text.Lazy.Builder as LT
4039import qualified Data.Text.Lazy.Encoding as LT
41−import Data.Time.Compat (Day, LocalTime,
40+import Data.Time (Day, LocalTime,
4241 NominalDiffTime,
4342 TimeOfDay, UTCTime,
4443 ZonedTime,
@@ -110,19 +109,19 @@ containsBy cmp rng x =
110109 PGRange _lb NegInfinity -> False
111110 PGRange lb ub -> checkLB lb x && checkUB ub x
112111 where
113− checkLB lb y =
112+ checkLB lb x =
114113 case lb of
115114 NegInfinity -> True
116115 PosInfinity -> False
117− Inclusive a -> cmp a y /= GT
118− Exclusive a -> cmp a y == LT
116+ Inclusive a -> cmp a x /= GT
117+ Exclusive a -> cmp a x == LT
119118
120− checkUB ub y =
119+ checkUB ub x =
121120 case ub of
122121 NegInfinity -> False
123122 PosInfinity -> True
124− Inclusive z -> cmp y z /= GT
125− Exclusive z -> cmp y z == LT
123+ Inclusive z -> cmp x z /= GT
124+ Exclusive z -> cmp x z == LT
126125
127126lowerBound :: Parser (a -> RangeBound a)
128127lowerBound = (A.char '(' *> pure Exclusive) <|> (A.char '[' *> pure Inclusive)
@@ -190,10 +189,7 @@ rangeToBuilderBy cmp f x =
190189
191190
192191instance (FromField a, Typeable a) => FromField (PGRange a) where
193− fromField = fromFieldRange fromField
194−
195−fromFieldRange :: Typeable a => FieldParser a -> FieldParser (PGRange a)
196−fromFieldRange fromField' f mdat = do
192+ fromField f mdat = do
197193 info <- typeInfo f
198194 case info of
199195 Range{} ->
@@ -203,8 +199,8 @@ fromFieldRange fromField' f mdat = do
203199 Just "empty" -> pure $ empty
204200 Just bs ->
205201 let parseIt NegInfinity = pure NegInfinity
206− parseIt (Inclusive v) = Inclusive <$> fromField' f' (Just v)
207− parseIt (Exclusive v) = Exclusive <$> fromField' f' (Just v)
202+ parseIt (Inclusive v) = Inclusive <$> fromField f' (Just v)
203+ parseIt (Exclusive v) = Exclusive <$> fromField f' (Just v)
208204 parseIt PosInfinity = pure PosInfinity
209205 in case parseOnly pgrange bs of
210206 Left e -> returnError ConversionFailed f e
src/Database/PostgreSQL/Simple/SqlQQ.hs+9−10
@@ -1,9 +1,4 @@
1−{-# LANGUAGE CPP #-}
2−#if __GLASGOW_HASKELL__ >= 800
3−{-# LANGUAGE TemplateHaskellQuotes #-}
4−#else
51{-# LANGUAGE TemplateHaskell #-}
6−#endif
72------------------------------------------------------------------------------
83-- |
94-- Module: Database.PostgreSQL.Simple.SqlQQ
@@ -35,7 +30,7 @@ import Data.String
3530-- > (beginTime,endTime,string)
3631--
3732-- This quasiquoter returns a literal string expression of type 'Query',
38−-- and attempts to minimize whitespace; otherwise the above query would
33+-- and attempts to mimimize whitespace; otherwise the above query would
3934-- consist of approximately half whitespace when sent to the database
4035-- backend. It also recognizes and strips out standard sql comments "--".
4136--
@@ -57,10 +52,13 @@ import Data.String
5752
5853sql :: QuasiQuoter
5954sql = QuasiQuoter
60− { quotePat = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in pattern context"
61− , quoteType = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in type context"
55+ { quotePat = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
56+ \ quasiquoter used in pattern context"
57+ , quoteType = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
58+ \ quasiquoter used in type context"
6259 , quoteExp = sqlExp
63− , quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in declaration context"
60+ , quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
61+ \ quasiquoter used in declaration context"
6462 }
6563
6664sqlExp :: String -> Q Exp
@@ -87,4 +85,5 @@ minimizeSpace = drop 1 . reduceSpace
8785 instring ('\'':'\'':xs) = '\'':'\'': instring xs
8886 instring ('\'':xs) = '\'': insql xs
8987 instring (x:xs) = x : instring xs
90− instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql: string literal not terminated"
88+ instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\
89+ \ string literal not terminated"
src/Database/PostgreSQL/Simple/Time.hs−2
@@ -227,7 +227,6 @@ module Database.PostgreSQL.Simple.Time
227227 , parseUTCTimestamp
228228 , parseZonedTimestamp
229229 , parseLocalTimestamp
230− , parseCalendarDiffTime
231230 , dayToBuilder
232231 , utcTimeToBuilder
233232 , zonedTimeToBuilder
@@ -240,7 +239,6 @@ module Database.PostgreSQL.Simple.Time
240239 , localTimestampToBuilder
241240 , unboundedToBuilder
242241 , nominalDiffTimeToBuilder
243− , calendarDiffTimeToBuilder
244242 ) where
245243
246244import Database.PostgreSQL.Simple.Time.Implementation
src/Database/PostgreSQL/Simple/Time/Implementation.hs+1−11
@@ -18,8 +18,7 @@ import Data.ByteString.Builder.Prim(primBounded)
1818import Control.Arrow((***))
1919import Control.Applicative
2020import qualified Data.ByteString as B
21−import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)
22−import Data.Time.LocalTime.Compat (CalendarDiffTime)
21+import Data.Time hiding (getTimeZone, getZonedTime)
2322import Data.Typeable
2423import Data.Maybe (fromMaybe)
2524import qualified Data.Attoparsec.ByteString.Char8 as A
@@ -78,9 +77,6 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)
7877parseDate :: B.ByteString -> Either String Date
7978parseDate = A.parseOnly (getDate <* A.endOfInput)
8079
81−parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime
82−parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)
83−
8480getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
8581getUnbounded getFinite
8682 = (pure NegInfinity <* A.string "-infinity")
@@ -129,9 +125,6 @@ getUTCTime = TP.utcTime
129125getUTCTimestamp :: A.Parser UTCTimestamp
130126getUTCTimestamp = getUnbounded getUTCTime
131127
132−getCalendarDiffTime :: A.Parser CalendarDiffTime
133−getCalendarDiffTime = TP.calendarDiffTime
134−
135128dayToBuilder :: Day -> Builder
136129dayToBuilder = primBounded TPP.day
137130
@@ -171,6 +164,3 @@ dateToBuilder = unboundedToBuilder dayToBuilder
171164
172165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
173166nominalDiffTimeToBuilder = TPP.nominalDiffTime
174−
175−calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder
176−calendarDiffTimeToBuilder = TPP.calendarDiffTime
src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+3−12
@@ -21,24 +21,20 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser
2121 , localToUTCTimeOfDayHMS
2222 , utcTime
2323 , zonedTime
24− , calendarDiffTime
2524 ) where
2625
2726import Control.Applicative ((<$>), (<*>), (<*), (*>))
2827import Database.PostgreSQL.Simple.Compat (toPico)
2928import Data.Attoparsec.ByteString.Char8 as A
3029import Data.Bits ((.&.))
31−import Data.ByteString (ByteString)
3230import Data.Char (ord)
3331import Data.Fixed (Pico)
3432import Data.Int (Int64)
3533import Data.Maybe (fromMaybe)
36−import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)
37−import Data.Time.Clock.Compat (UTCTime(..))
38−import Data.Time.Format.ISO8601.Compat (iso8601ParseM)
39−import Data.Time.LocalTime.Compat (CalendarDiffTime)
34+import Data.Time.Calendar (Day, fromGregorianValid, addDays)
35+import Data.Time.Clock (UTCTime(..))
4036import qualified Data.ByteString.Char8 as B8
41−import qualified Data.Time.LocalTime.Compat as Local
37+import qualified Data.Time.LocalTime as Local
4238
4339-- | Parse a date of the form @YYYY-MM-DD@.
4440day :: Parser Day
@@ -197,8 +193,3 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
197193
198194utc :: Local.TimeZone
199195utc = Local.TimeZone 0 False ""
200−
201−calendarDiffTime :: Parser CalendarDiffTime
202−calendarDiffTime = do
203− contents <- takeByteString
204− iso8601ParseM $ B8.unpack contents
src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+3−15
@@ -17,23 +17,19 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer
1717 , localTime
1818 , zonedTime
1919 , nominalDiffTime
20− , calendarDiffTime
2120 ) where
2221
2322import Control.Arrow ((>>>))
24−import Data.ByteString.Builder (Builder, byteString, integerDec)
23+import Data.ByteString.Builder (Builder, integerDec)
2524import Data.ByteString.Builder.Prim
2625 ( liftFixedToBounded, (>$<), (>*<)
2726 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
2827import Data.Char ( chr )
2928import Data.Int ( Int32, Int64 )
30−import Data.String (fromString)
31−import Data.Time.Compat
29+import Data.Time
3230 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
3331 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
3432 , TimeZone, timeZoneMinutes )
35−import Data.Time.Format.ISO8601.Compat (iso8601Show)
36−import Data.Time.LocalTime.Compat (CalendarDiffTime)
3733import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
3834import Unsafe.Coerce (unsafeCoerce)
3935
@@ -75,7 +71,7 @@ frac = condB (== 0) emptyB ((,) '.' >$< (liftB char8 >*< trunc12))
7571
7672
7773year :: BoundedPrim Int32
78−year = condB (>= 10000) int32Dec (checkBCE >$< liftB digits4)
74+year = condB (> 10000) int32Dec (checkBCE >$< liftB digits4)
7975 where
8076 checkBCE :: Int32 -> Int
8177 checkBCE y
@@ -125,11 +121,3 @@ nominalDiffTime :: NominalDiffTime -> Builder
125121nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
126122 where
127123 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000
128−
129−calendarDiffTime :: CalendarDiffTime -> Builder
130−calendarDiffTime = byteString
131− . fromString
132− -- from the docs: "Beware: fromString truncates multi-byte characters to octets".
133− -- However, I think this is a safe usage, because ISO8601-encoding seems restricted
134− -- to ASCII output.
135− . iso8601Show
src/Database/PostgreSQL/Simple/ToField.hs+11−33
@@ -1,6 +1,5 @@
11{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
3−{-# LANGUAGE PolyKinds #-}
43
54------------------------------------------------------------------------------
65-- |
@@ -23,7 +22,6 @@ module Database.PostgreSQL.Simple.ToField
2322 , inQuotes
2423 ) where
2524
26−import Control.Applicative (Const(Const))
2725import qualified Data.Aeson as JSON
2826import Data.ByteString (ByteString)
2927import Data.ByteString.Builder
@@ -32,12 +30,10 @@ import Data.ByteString.Builder
3230 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec
3331 , floatDec, doubleDec
3432 )
35−import Data.Functor.Identity (Identity(Identity))
3633import Data.Int (Int8, Int16, Int32, Int64)
3734import Data.List (intersperse)
3835import Data.Monoid (mappend)
39−import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
40−import Data.Time.LocalTime.Compat (CalendarDiffTime)
36+import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
4137import Data.Typeable (Typeable)
4238import Data.Word (Word, Word8, Word16, Word32, Word64)
4339import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
@@ -46,8 +42,6 @@ import Database.PostgreSQL.Simple.Compat (toByteString)
4642
4743import qualified Data.ByteString as SB
4844import qualified Data.ByteString.Lazy as LB
49−import Data.CaseInsensitive (CI)
50−import qualified Data.CaseInsensitive as CI
5145import qualified Data.Text as ST
5246import qualified Data.Text.Encoding as ST
5347import qualified Data.Text.Lazy as LT
@@ -59,7 +53,11 @@ import qualified Data.Vector as V
5953import qualified Database.PostgreSQL.LibPQ as PQ
6054import Database.PostgreSQL.Simple.Time
6155import Data.Scientific (Scientific)
56+#if MIN_VERSION_scientific(0,3,0)
6257import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
58+#else
59+import Data.Scientific (scientificBuilder)
60+#endif
6361import Foreign.C.Types (CUInt(..))
6462
6563-- | How to render an element when substituting it into a query.
@@ -100,14 +98,6 @@ instance ToField Action where
10098 toField a = a
10199 {-# INLINE toField #-}
102100
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−
111101instance (ToField a) => ToField (Maybe a) where
112102 toField Nothing = renderNull
113103 toField (Just a) = toField a
@@ -240,15 +230,6 @@ instance ToField LT.Text where
240230 toField = toField . LT.toStrict
241231 {-# INLINE toField #-}
242232
243−-- | citext
244−instance ToField (CI ST.Text) where
245− toField = toField . CI.original
246− {-# INLINE toField #-}
247−
248−-- | citext
249−instance ToField (CI LT.Text) where
250− toField = toField . LT.toStrict . CI.original
251− {-# INLINE toField #-}
252233
253234instance ToField UTCTime where
254235 toField = Plain . inQuotes . utcTimeToBuilder
@@ -290,10 +271,6 @@ instance ToField NominalDiffTime where
290271 toField = Plain . inQuotes . nominalDiffTimeToBuilder
291272 {-# INLINE toField #-}
292273
293−instance ToField CalendarDiffTime where
294− toField = Plain . inQuotes . calendarDiffTimeToBuilder
295− {-# INLINE toField #-}
296−
297274instance (ToField a) => ToField (PGArray a) where
298275 toField pgArray =
299276 case fromPGArray pgArray of
@@ -314,13 +291,14 @@ instance ToField UUID where
314291instance ToField JSON.Value where
315292 toField = toField . JSON.encode
316293
317−-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.
294+-- | Convert a Haskell value to a JSON 'JSON.Value' using
295+-- 'JSON.toJSON' and convert that to a field using 'toField'.
318296--
319297-- This can be used as the default implementation for the 'toField'
320298-- method for Haskell types that have a JSON representation in
321299-- PostgreSQL.
322300toJSONField :: JSON.ToJSON a => a -> Action
323−toJSONField = toField . JSON.encode
301+toJSONField = toField . JSON.toJSON
324302
325303-- | Surround a string with single-quote characters: \"@'@\"
326304--
@@ -330,7 +308,7 @@ inQuotes b = quote `mappend` b `mappend` quote
330308 where quote = char8 '\''
331309
332310interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
333−interleaveFoldr f b bs' as = foldr (\a bs -> b : f a bs) bs' as
311+interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as
334312{-# INLINE interleaveFoldr #-}
335313
336314instance ToRow a => ToField (Values a) where
@@ -377,8 +355,8 @@ instance ToRow a => ToField (Values a) where
377355
378356 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]
379357 typedRows [] _ _ = error funcname
380− typedRows (val:vals) typs rest =
381− typedRow (toRow val) typs (multiRows vals rest)
358+ typedRows (val:vals) types rest =
359+ typedRow (toRow val) types (multiRows vals rest)
382360
383361 untypedRows :: ToRow a => [a] -> [Action] -> [Action]
384362 untypedRows [] _ = error funcname
src/Database/PostgreSQL/Simple/ToRow.hs−16
@@ -30,22 +30,6 @@ import GHC.Generics
3030--
3131-- Instances should use the 'toField' method of the 'ToField' class
3232-- to perform conversion of each element of the collection.
33−--
34−-- You can derive 'ToRow' for your data type using GHC generics, like this:
35−--
36−-- @
37−-- \{-# LANGUAGE DeriveAnyClass \#-}
38−-- \{-# LANGUAGE DeriveGeneric \#-}
39−--
40−-- import "GHC.Generics" ('GHC.Generics.Generic')
41−-- import "Database.PostgreSQL.Simple" ('ToRow')
42−--
43−-- data User = User { name :: String, fileQuota :: Int }
44−-- deriving ('GHC.Generics.Generic', 'ToRow')
45−-- @
46−--
47−-- Note that this only works for product types (e.g. records) and does not
48−-- support sum types or recursive types.
4933class ToRow a where
5034 toRow :: a -> [Action]
5135 default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]
src/Database/PostgreSQL/Simple/Transaction.hs+13−17
@@ -17,7 +17,6 @@ module Database.PostgreSQL.Simple.Transaction
1717 , withTransactionLevel
1818 , withTransactionMode
1919 , withTransactionModeRetry
20− , withTransactionModeRetry'
2120 , withTransactionSerializable
2221 , TransactionMode(..)
2322 , IsolationLevel(..)
@@ -147,40 +146,37 @@ withTransactionMode mode conn act =
147146 commit conn
148147 return r
149148
150−-- | 'withTransactionModeRetry'' but with the exception type pinned to 'SqlError'.
151−withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
152−withTransactionModeRetry = withTransactionModeRetry'
153−
154149-- | Like 'withTransactionMode', but also takes a custom callback to
155−-- determine if a transaction should be retried if an exception occurs.
156−-- If the callback returns 'True', then the transaction will be retried.
157−-- If the callback returns 'False', or an exception other than an @e@
150+-- determine if a transaction should be retried if an 'SqlError' occurs.
151+-- If the callback returns True, then the transaction will be retried.
152+-- If the callback returns False, or an exception other than an 'SqlError'
158153-- occurs then the transaction will be rolled back and the exception rethrown.
159154--
160155-- This is used to implement 'withTransactionSerializable'.
161−withTransactionModeRetry' :: forall a e. E.Exception e => TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a
162−withTransactionModeRetry' mode shouldRetry conn act =
156+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
157+withTransactionModeRetry mode shouldRetry conn act =
163158 mask $ \restore ->
164159 retryLoop $ E.try $ do
165− a <- restore act `E.onException` rollback_ conn
160+ a <- restore act
166161 commit conn
167162 return a
168163 where
169− retryLoop :: IO (Either e a) -> IO a
164+ retryLoop :: IO (Either E.SomeException a) -> IO a
170165 retryLoop act' = do
171166 beginMode mode conn
172167 r <- act'
173168 case r of
174− Left e ->
175− case shouldRetry e of
176− True -> retryLoop act'
177− False -> E.throwIO e
169+ Left e -> do
170+ rollback_ conn
171+ case fmap shouldRetry (E.fromException e) of
172+ Just True -> retryLoop act'
173+ _ -> E.throwIO e
178174 Right a ->
179175 return a
180176
181177-- | Rollback a transaction.
182178rollback :: Connection -> IO ()
183−rollback conn = execute_ conn "ROLLBACK" >> return ()
179+rollback conn = execute_ conn "ABORT" >> return ()
184180
185181-- | Rollback a transaction, ignoring any @IOErrors@
186182rollback_ :: Connection -> IO ()
src/Database/PostgreSQL/Simple/TypeInfo.hs+9−9
@@ -50,21 +50,21 @@ import Database.PostgreSQL.Simple.TypeInfo.Static
5050-- in the connections's cache.
5151
5252getTypeInfo :: Connection -> PQ.Oid -> IO TypeInfo
53−getTypeInfo conn@Connection{..} oid' =
54− case staticTypeInfo oid' of
55− Just name' -> return name'
56− Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid'
53+getTypeInfo conn@Connection{..} oid =
54+ case staticTypeInfo oid of
55+ Just name -> return name
56+ Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid
5757
5858getTypeInfo' :: Connection -> PQ.Oid -> TypeInfoCache
5959 -> IO (TypeInfoCache, TypeInfo)
60−getTypeInfo' conn oid' oidmap =
61− case IntMap.lookup (oid2int oid') oidmap of
60+getTypeInfo' conn oid oidmap =
61+ case IntMap.lookup (oid2int oid) oidmap of
6262 Just typeinfo -> return (oidmap, typeinfo)
6363 Nothing -> do
6464 names <- query conn "SELECT oid, typcategory, typdelim, typname,\
6565 \ typelem, typrelid\
6666 \ FROM pg_type WHERE oid = ?"
67− (Only oid')
67+ (Only oid)
6868 (oidmap', typeInfo) <-
6969 case names of
7070 [] -> return $ throw (fatalError "invalid type oid")
@@ -78,7 +78,7 @@ getTypeInfo' conn oid' oidmap =
7878 rngsubtypeOids <- query conn "SELECT rngsubtype\
7979 \ FROM pg_range\
8080 \ WHERE rngtypid = ?"
81− (Only oid')
81+ (Only oid)
8282 case rngsubtypeOids of
8383 [Only rngsubtype_] -> do
8484 (oidmap', rngsubtype) <-
@@ -104,7 +104,7 @@ getTypeInfo' conn oid' oidmap =
104104 _ -> fail "typename query returned more than one result"
105105 -- oid is a primary key, so the query should
106106 -- never return more than one result
107− let !oidmap'' = IntMap.insert (oid2int oid') typeInfo oidmap'
107+ let !oidmap'' = IntMap.insert (oid2int oid) typeInfo oidmap'
108108 return $! (oidmap'', typeInfo)
109109
110110getAttInfos :: Connection -> [(B.ByteString, PQ.Oid)] -> TypeInfoCache
src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs+3−9
@@ -1,9 +1,4 @@
1−{-# LANGUAGE CPP #-}
2−#if __GLASGOW_HASKELL__ >= 800
3−{-# LANGUAGE TemplateHaskellQuotes #-}
4−#else
51{-# LANGUAGE TemplateHaskell #-}
6−#endif
72
83------------------------------------------------------------------------------
94-- |
@@ -27,12 +22,11 @@ import Database.PostgreSQL.Simple.TypeInfo.Static
2722import Database.PostgreSQL.Simple.Types (Oid(..))
2823import Language.Haskell.TH
2924
25+
3026-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the
3127-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.
3228mkCompats :: [TypeInfo] -> ExpQ
33−mkCompats tys = do
34− x <- newName "x"
35− lamE [conP 'Oid [varP x]] $ caseE (varE x) (map alt tys ++ [catchAll])
29+mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]
3630 where
3731 alt :: TypeInfo -> MatchQ
3832 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []
@@ -44,7 +38,7 @@ mkCompats tys = do
4438-- Returns an expression of type 'Oid'. Useful because GHC tends
4539-- not to fold constants.
4640inlineTypoid :: TypeInfo -> ExpQ
47−inlineTypoid ty = conE 'Oid `appE` litE (getTypoid ty)
41+inlineTypoid ty = [| Oid $(litE (getTypoid ty)) |]
4842
4943inlineTypoidP :: TypeInfo -> PatQ
5044inlineTypoidP ty = litP (getTypoid ty)
src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+114−684
@@ -19,233 +19,119 @@ module Database.PostgreSQL.Simple.TypeInfo.Static
1919 ( TypeInfo(..)
2020 , staticTypeInfo
2121 , bool
22− , boolOid
2322 , bytea
24− , byteaOid
2523 , char
26− , charOid
2724 , name
28− , nameOid
2925 , int8
30− , int8Oid
3126 , int2
32− , int2Oid
3327 , int4
34− , int4Oid
3528 , regproc
36− , regprocOid
3729 , text
38− , textOid
3930 , oid
40− , oidOid
4131 , tid
42− , tidOid
4332 , xid
44− , xidOid
4533 , cid
46− , cidOid
4734 , xml
48− , xmlOid
4935 , point
50− , pointOid
5136 , lseg
52− , lsegOid
5337 , path
54− , pathOid
5538 , box
56− , boxOid
5739 , polygon
58− , polygonOid
5940 , line
60− , lineOid
6141 , cidr
62− , cidrOid
6342 , float4
64− , float4Oid
6543 , float8
66− , float8Oid
6744 , unknown
68− , unknownOid
6945 , circle
70− , circleOid
7146 , money
72− , moneyOid
7347 , macaddr
74− , macaddrOid
7548 , inet
76− , inetOid
7749 , bpchar
78− , bpcharOid
7950 , varchar
80− , varcharOid
8151 , date
82− , dateOid
8352 , time
84− , timeOid
8553 , timestamp
86− , timestampOid
8754 , timestamptz
88− , timestamptzOid
8955 , interval
90− , intervalOid
9156 , timetz
92− , timetzOid
9357 , bit
94− , bitOid
9558 , varbit
96− , varbitOid
9759 , numeric
98− , numericOid
9960 , refcursor
100− , refcursorOid
10161 , record
102− , recordOid
10362 , void
104− , voidOid
10563 , array_record
106− , array_recordOid
10764 , regprocedure
108− , regprocedureOid
10965 , regoper
110− , regoperOid
11166 , regoperator
112− , regoperatorOid
11367 , regclass
114− , regclassOid
11568 , regtype
116− , regtypeOid
11769 , uuid
118− , uuidOid
11970 , json
120− , jsonOid
12171 , jsonb
122− , jsonbOid
12372 , int2vector
124− , int2vectorOid
12573 , oidvector
126− , oidvectorOid
12774 , array_xml
128− , array_xmlOid
12975 , array_json
130− , array_jsonOid
13176 , array_line
132− , array_lineOid
13377 , array_cidr
134− , array_cidrOid
13578 , array_circle
136− , array_circleOid
13779 , array_money
138− , array_moneyOid
13980 , array_bool
140− , array_boolOid
14181 , array_bytea
142− , array_byteaOid
14382 , array_char
144− , array_charOid
14583 , array_name
146− , array_nameOid
14784 , array_int2
148− , array_int2Oid
14985 , array_int2vector
150− , array_int2vectorOid
15186 , array_int4
152− , array_int4Oid
15387 , array_regproc
154− , array_regprocOid
15588 , array_text
156− , array_textOid
15789 , array_tid
158− , array_tidOid
15990 , array_xid
160− , array_xidOid
16191 , array_cid
162− , array_cidOid
16392 , array_oidvector
164− , array_oidvectorOid
16593 , array_bpchar
166− , array_bpcharOid
16794 , array_varchar
168− , array_varcharOid
16995 , array_int8
170− , array_int8Oid
17196 , array_point
172− , array_pointOid
17397 , array_lseg
174− , array_lsegOid
17598 , array_path
176− , array_pathOid
17799 , array_box
178− , array_boxOid
179100 , array_float4
180− , array_float4Oid
181101 , array_float8
182− , array_float8Oid
183102 , array_polygon
184− , array_polygonOid
185103 , array_oid
186− , array_oidOid
187104 , array_macaddr
188− , array_macaddrOid
189105 , array_inet
190− , array_inetOid
191106 , array_timestamp
192− , array_timestampOid
193107 , array_date
194− , array_dateOid
195108 , array_time
196− , array_timeOid
197109 , array_timestamptz
198− , array_timestamptzOid
199110 , array_interval
200− , array_intervalOid
201111 , array_numeric
202− , array_numericOid
203112 , array_timetz
204− , array_timetzOid
205113 , array_bit
206− , array_bitOid
207114 , array_varbit
208− , array_varbitOid
209115 , array_refcursor
210− , array_refcursorOid
211116 , array_regprocedure
212− , array_regprocedureOid
213117 , array_regoper
214− , array_regoperOid
215118 , array_regoperator
216− , array_regoperatorOid
217119 , array_regclass
218− , array_regclassOid
219120 , array_regtype
220− , array_regtypeOid
221121 , array_uuid
222− , array_uuidOid
223122 , array_jsonb
224− , array_jsonbOid
225123 , int4range
226− , int4rangeOid
227124 , _int4range
228− , _int4rangeOid
229125 , numrange
230− , numrangeOid
231126 , _numrange
232− , _numrangeOid
233127 , tsrange
234− , tsrangeOid
235128 , _tsrange
236− , _tsrangeOid
237129 , tstzrange
238− , tstzrangeOid
239130 , _tstzrange
240− , _tstzrangeOid
241131 , daterange
242− , daterangeOid
243132 , _daterange
244− , _daterangeOid
245133 , int8range
246− , int8rangeOid
247134 , _int8range
248− , _int8rangeOid
249135 ) where
250136
251137import Database.PostgreSQL.LibPQ (Oid(..))
@@ -371,1432 +257,976 @@ staticTypeInfo (Oid x) = case x of
371257
372258bool :: TypeInfo
373259bool = Basic {
374− typoid = boolOid,
260+ typoid = Oid 16,
375261 typcategory = 'B',
376262 typdelim = ',',
377263 typname = "bool"
378264 }
379265
380−boolOid :: Oid
381−boolOid = Oid 16
382−{-# INLINE boolOid #-}
383−
384266bytea :: TypeInfo
385267bytea = Basic {
386− typoid = byteaOid,
268+ typoid = Oid 17,
387269 typcategory = 'U',
388270 typdelim = ',',
389271 typname = "bytea"
390272 }
391273
392−byteaOid :: Oid
393−byteaOid = Oid 17
394−{-# INLINE byteaOid #-}
395−
396274char :: TypeInfo
397275char = Basic {
398− typoid = charOid,
276+ typoid = Oid 18,
399277 typcategory = 'S',
400278 typdelim = ',',
401279 typname = "char"
402280 }
403281
404−charOid :: Oid
405−charOid = Oid 18
406−{-# INLINE charOid #-}
407−
408282name :: TypeInfo
409283name = Basic {
410− typoid = nameOid,
284+ typoid = Oid 19,
411285 typcategory = 'S',
412286 typdelim = ',',
413287 typname = "name"
414288 }
415289
416−nameOid :: Oid
417−nameOid = Oid 19
418−{-# INLINE nameOid #-}
419−
420290int8 :: TypeInfo
421291int8 = Basic {
422− typoid = int8Oid,
292+ typoid = Oid 20,
423293 typcategory = 'N',
424294 typdelim = ',',
425295 typname = "int8"
426296 }
427297
428−int8Oid :: Oid
429−int8Oid = Oid 20
430−{-# INLINE int8Oid #-}
431−
432298int2 :: TypeInfo
433299int2 = Basic {
434− typoid = int2Oid,
300+ typoid = Oid 21,
435301 typcategory = 'N',
436302 typdelim = ',',
437303 typname = "int2"
438304 }
439305
440−int2Oid :: Oid
441−int2Oid = Oid 21
442−{-# INLINE int2Oid #-}
443−
444306int4 :: TypeInfo
445307int4 = Basic {
446− typoid = int4Oid,
308+ typoid = Oid 23,
447309 typcategory = 'N',
448310 typdelim = ',',
449311 typname = "int4"
450312 }
451313
452−int4Oid :: Oid
453−int4Oid = Oid 23
454−{-# INLINE int4Oid #-}
455−
456314regproc :: TypeInfo
457315regproc = Basic {
458− typoid = regprocOid,
316+ typoid = Oid 24,
459317 typcategory = 'N',
460318 typdelim = ',',
461319 typname = "regproc"
462320 }
463321
464−regprocOid :: Oid
465−regprocOid = Oid 24
466−{-# INLINE regprocOid #-}
467−
468322text :: TypeInfo
469323text = Basic {
470− typoid = textOid,
324+ typoid = Oid 25,
471325 typcategory = 'S',
472326 typdelim = ',',
473327 typname = "text"
474328 }
475329
476−textOid :: Oid
477−textOid = Oid 25
478−{-# INLINE textOid #-}
479−
480330oid :: TypeInfo
481331oid = Basic {
482− typoid = oidOid,
332+ typoid = Oid 26,
483333 typcategory = 'N',
484334 typdelim = ',',
485335 typname = "oid"
486336 }
487337
488−oidOid :: Oid
489−oidOid = Oid 26
490−{-# INLINE oidOid #-}
491−
492338tid :: TypeInfo
493339tid = Basic {
494− typoid = tidOid,
340+ typoid = Oid 27,
495341 typcategory = 'U',
496342 typdelim = ',',
497343 typname = "tid"
498344 }
499345
500−tidOid :: Oid
501−tidOid = Oid 27
502−{-# INLINE tidOid #-}
503−
504346xid :: TypeInfo
505347xid = Basic {
506− typoid = xidOid,
348+ typoid = Oid 28,
507349 typcategory = 'U',
508350 typdelim = ',',
509351 typname = "xid"
510352 }
511353
512−xidOid :: Oid
513−xidOid = Oid 28
514−{-# INLINE xidOid #-}
515−
516354cid :: TypeInfo
517355cid = Basic {
518− typoid = cidOid,
356+ typoid = Oid 29,
519357 typcategory = 'U',
520358 typdelim = ',',
521359 typname = "cid"
522360 }
523361
524−cidOid :: Oid
525−cidOid = Oid 29
526−{-# INLINE cidOid #-}
527−
528362xml :: TypeInfo
529363xml = Basic {
530− typoid = xmlOid,
364+ typoid = Oid 142,
531365 typcategory = 'U',
532366 typdelim = ',',
533367 typname = "xml"
534368 }
535369
536−xmlOid :: Oid
537−xmlOid = Oid 142
538−{-# INLINE xmlOid #-}
539−
540370point :: TypeInfo
541371point = Basic {
542− typoid = pointOid,
372+ typoid = Oid 600,
543373 typcategory = 'G',
544374 typdelim = ',',
545375 typname = "point"
546376 }
547377
548−pointOid :: Oid
549−pointOid = Oid 600
550−{-# INLINE pointOid #-}
551−
552378lseg :: TypeInfo
553379lseg = Basic {
554− typoid = lsegOid,
380+ typoid = Oid 601,
555381 typcategory = 'G',
556382 typdelim = ',',
557383 typname = "lseg"
558384 }
559385
560−lsegOid :: Oid
561−lsegOid = Oid 601
562−{-# INLINE lsegOid #-}
563−
564386path :: TypeInfo
565387path = Basic {
566− typoid = pathOid,
388+ typoid = Oid 602,
567389 typcategory = 'G',
568390 typdelim = ',',
569391 typname = "path"
570392 }
571393
572−pathOid :: Oid
573−pathOid = Oid 602
574−{-# INLINE pathOid #-}
575−
576394box :: TypeInfo
577395box = Basic {
578− typoid = boxOid,
396+ typoid = Oid 603,
579397 typcategory = 'G',
580398 typdelim = ';',
581399 typname = "box"
582400 }
583401
584−boxOid :: Oid
585−boxOid = Oid 603
586−{-# INLINE boxOid #-}
587−
588402polygon :: TypeInfo
589403polygon = Basic {
590− typoid = polygonOid,
404+ typoid = Oid 604,
591405 typcategory = 'G',
592406 typdelim = ',',
593407 typname = "polygon"
594408 }
595409
596−polygonOid :: Oid
597−polygonOid = Oid 604
598−{-# INLINE polygonOid #-}
599−
600410line :: TypeInfo
601411line = Basic {
602− typoid = lineOid,
412+ typoid = Oid 628,
603413 typcategory = 'G',
604414 typdelim = ',',
605415 typname = "line"
606416 }
607417
608−lineOid :: Oid
609−lineOid = Oid 628
610−{-# INLINE lineOid #-}
611−
612418cidr :: TypeInfo
613419cidr = Basic {
614− typoid = cidrOid,
420+ typoid = Oid 650,
615421 typcategory = 'I',
616422 typdelim = ',',
617423 typname = "cidr"
618424 }
619425
620−cidrOid :: Oid
621−cidrOid = Oid 650
622−{-# INLINE cidrOid #-}
623−
624426float4 :: TypeInfo
625427float4 = Basic {
626− typoid = float4Oid,
428+ typoid = Oid 700,
627429 typcategory = 'N',
628430 typdelim = ',',
629431 typname = "float4"
630432 }
631433
632−float4Oid :: Oid
633−float4Oid = Oid 700
634−{-# INLINE float4Oid #-}
635−
636434float8 :: TypeInfo
637435float8 = Basic {
638− typoid = float8Oid,
436+ typoid = Oid 701,
639437 typcategory = 'N',
640438 typdelim = ',',
641439 typname = "float8"
642440 }
643441
644−float8Oid :: Oid
645−float8Oid = Oid 701
646−{-# INLINE float8Oid #-}
647−
648442unknown :: TypeInfo
649443unknown = Basic {
650− typoid = unknownOid,
444+ typoid = Oid 705,
651445 typcategory = 'X',
652446 typdelim = ',',
653447 typname = "unknown"
654448 }
655449
656−unknownOid :: Oid
657−unknownOid = Oid 705
658−{-# INLINE unknownOid #-}
659−
660450circle :: TypeInfo
661451circle = Basic {
662− typoid = circleOid,
452+ typoid = Oid 718,
663453 typcategory = 'G',
664454 typdelim = ',',
665455 typname = "circle"
666456 }
667457
668−circleOid :: Oid
669−circleOid = Oid 718
670−{-# INLINE circleOid #-}
671−
672458money :: TypeInfo
673459money = Basic {
674− typoid = moneyOid,
460+ typoid = Oid 790,
675461 typcategory = 'N',
676462 typdelim = ',',
677463 typname = "money"
678464 }
679465
680−moneyOid :: Oid
681−moneyOid = Oid 790
682−{-# INLINE moneyOid #-}
683−
684466macaddr :: TypeInfo
685467macaddr = Basic {
686− typoid = macaddrOid,
468+ typoid = Oid 829,
687469 typcategory = 'U',
688470 typdelim = ',',
689471 typname = "macaddr"
690472 }
691473
692−macaddrOid :: Oid
693−macaddrOid = Oid 829
694−{-# INLINE macaddrOid #-}
695−
696474inet :: TypeInfo
697475inet = Basic {
698− typoid = inetOid,
476+ typoid = Oid 869,
699477 typcategory = 'I',
700478 typdelim = ',',
701479 typname = "inet"
702480 }
703481
704−inetOid :: Oid
705−inetOid = Oid 869
706−{-# INLINE inetOid #-}
707−
708482bpchar :: TypeInfo
709483bpchar = Basic {
710− typoid = bpcharOid,
484+ typoid = Oid 1042,
711485 typcategory = 'S',
712486 typdelim = ',',
713487 typname = "bpchar"
714488 }
715489
716−bpcharOid :: Oid
717−bpcharOid = Oid 1042
718−{-# INLINE bpcharOid #-}
719−
720490varchar :: TypeInfo
721491varchar = Basic {
722− typoid = varcharOid,
492+ typoid = Oid 1043,
723493 typcategory = 'S',
724494 typdelim = ',',
725495 typname = "varchar"
726496 }
727497
728−varcharOid :: Oid
729−varcharOid = Oid 1043
730−{-# INLINE varcharOid #-}
731−
732498date :: TypeInfo
733499date = Basic {
734− typoid = dateOid,
500+ typoid = Oid 1082,
735501 typcategory = 'D',
736502 typdelim = ',',
737503 typname = "date"
738504 }
739505
740−dateOid :: Oid
741−dateOid = Oid 1082
742−{-# INLINE dateOid #-}
743−
744506time :: TypeInfo
745507time = Basic {
746− typoid = timeOid,
508+ typoid = Oid 1083,
747509 typcategory = 'D',
748510 typdelim = ',',
749511 typname = "time"
750512 }
751513
752−timeOid :: Oid
753−timeOid = Oid 1083
754−{-# INLINE timeOid #-}
755−
756514timestamp :: TypeInfo
757515timestamp = Basic {
758− typoid = timestampOid,
516+ typoid = Oid 1114,
759517 typcategory = 'D',
760518 typdelim = ',',
761519 typname = "timestamp"
762520 }
763521
764−timestampOid :: Oid
765−timestampOid = Oid 1114
766−{-# INLINE timestampOid #-}
767−
768522timestamptz :: TypeInfo
769523timestamptz = Basic {
770− typoid = timestamptzOid,
524+ typoid = Oid 1184,
771525 typcategory = 'D',
772526 typdelim = ',',
773527 typname = "timestamptz"
774528 }
775529
776−timestamptzOid :: Oid
777−timestamptzOid = Oid 1184
778−{-# INLINE timestamptzOid #-}
779−
780530interval :: TypeInfo
781531interval = Basic {
782− typoid = intervalOid,
532+ typoid = Oid 1186,
783533 typcategory = 'T',
784534 typdelim = ',',
785535 typname = "interval"
786536 }
787537
788−intervalOid :: Oid
789−intervalOid = Oid 1186
790−{-# INLINE intervalOid #-}
791−
792538timetz :: TypeInfo
793539timetz = Basic {
794− typoid = timetzOid,
540+ typoid = Oid 1266,
795541 typcategory = 'D',
796542 typdelim = ',',
797543 typname = "timetz"
798544 }
799545
800−timetzOid :: Oid
801−timetzOid = Oid 1266
802−{-# INLINE timetzOid #-}
803−
804546bit :: TypeInfo
805547bit = Basic {
806− typoid = bitOid,
548+ typoid = Oid 1560,
807549 typcategory = 'V',
808550 typdelim = ',',
809551 typname = "bit"
810552 }
811553
812−bitOid :: Oid
813−bitOid = Oid 1560
814−{-# INLINE bitOid #-}
815−
816554varbit :: TypeInfo
817555varbit = Basic {
818− typoid = varbitOid,
556+ typoid = Oid 1562,
819557 typcategory = 'V',
820558 typdelim = ',',
821559 typname = "varbit"
822560 }
823561
824−varbitOid :: Oid
825−varbitOid = Oid 1562
826−{-# INLINE varbitOid #-}
827−
828562numeric :: TypeInfo
829563numeric = Basic {
830− typoid = numericOid,
564+ typoid = Oid 1700,
831565 typcategory = 'N',
832566 typdelim = ',',
833567 typname = "numeric"
834568 }
835569
836−numericOid :: Oid
837−numericOid = Oid 1700
838−{-# INLINE numericOid #-}
839−
840570refcursor :: TypeInfo
841571refcursor = Basic {
842− typoid = refcursorOid,
572+ typoid = Oid 1790,
843573 typcategory = 'U',
844574 typdelim = ',',
845575 typname = "refcursor"
846576 }
847577
848−refcursorOid :: Oid
849−refcursorOid = Oid 1790
850−{-# INLINE refcursorOid #-}
851−
852578record :: TypeInfo
853579record = Basic {
854− typoid = recordOid,
580+ typoid = Oid 2249,
855581 typcategory = 'P',
856582 typdelim = ',',
857583 typname = "record"
858584 }
859585
860−recordOid :: Oid
861−recordOid = Oid 2249
862−{-# INLINE recordOid #-}
863−
864586void :: TypeInfo
865587void = Basic {
866− typoid = voidOid,
588+ typoid = Oid 2278,
867589 typcategory = 'P',
868590 typdelim = ',',
869591 typname = "void"
870592 }
871593
872−voidOid :: Oid
873−voidOid = Oid 2278
874−{-# INLINE voidOid #-}
875−
876594array_record :: TypeInfo
877595array_record = Array {
878− typoid = array_recordOid,
596+ typoid = Oid 2287,
879597 typcategory = 'P',
880598 typdelim = ',',
881599 typname = "_record",
882600 typelem = record
883601 }
884602
885−array_recordOid :: Oid
886−array_recordOid = Oid 2287
887−{-# INLINE array_recordOid #-}
888−
889603regprocedure :: TypeInfo
890604regprocedure = Basic {
891− typoid = regprocedureOid,
605+ typoid = Oid 2202,
892606 typcategory = 'N',
893607 typdelim = ',',
894608 typname = "regprocedure"
895609 }
896610
897−regprocedureOid :: Oid
898−regprocedureOid = Oid 2202
899−{-# INLINE regprocedureOid #-}
900−
901611regoper :: TypeInfo
902612regoper = Basic {
903− typoid = regoperOid,
613+ typoid = Oid 2203,
904614 typcategory = 'N',
905615 typdelim = ',',
906616 typname = "regoper"
907617 }
908618
909−regoperOid :: Oid
910−regoperOid = Oid 2203
911−{-# INLINE regoperOid #-}
912−
913619regoperator :: TypeInfo
914620regoperator = Basic {
915− typoid = regoperatorOid,
621+ typoid = Oid 2204,
916622 typcategory = 'N',
917623 typdelim = ',',
918624 typname = "regoperator"
919625 }
920626
921−regoperatorOid :: Oid
922−regoperatorOid = Oid 2204
923−{-# INLINE regoperatorOid #-}
924−
925627regclass :: TypeInfo
926628regclass = Basic {
927− typoid = regclassOid,
629+ typoid = Oid 2205,
928630 typcategory = 'N',
929631 typdelim = ',',
930632 typname = "regclass"
931633 }
932634
933−regclassOid :: Oid
934−regclassOid = Oid 2205
935−{-# INLINE regclassOid #-}
936−
937635regtype :: TypeInfo
938636regtype = Basic {
939− typoid = regtypeOid,
637+ typoid = Oid 2206,
940638 typcategory = 'N',
941639 typdelim = ',',
942640 typname = "regtype"
943641 }
944642
945−regtypeOid :: Oid
946−regtypeOid = Oid 2206
947−{-# INLINE regtypeOid #-}
948−
949643uuid :: TypeInfo
950644uuid = Basic {
951− typoid = uuidOid,
645+ typoid = Oid 2950,
952646 typcategory = 'U',
953647 typdelim = ',',
954648 typname = "uuid"
955649 }
956650
957−uuidOid :: Oid
958−uuidOid = Oid 2950
959−{-# INLINE uuidOid #-}
960−
961651json :: TypeInfo
962652json = Basic {
963− typoid = jsonOid,
653+ typoid = Oid 114,
964654 typcategory = 'U',
965655 typdelim = ',',
966656 typname = "json"
967657 }
968658
969−jsonOid :: Oid
970−jsonOid = Oid 114
971−{-# INLINE jsonOid #-}
972−
973659jsonb :: TypeInfo
974660jsonb = Basic {
975− typoid = jsonbOid,
661+ typoid = Oid 3802,
976662 typcategory = 'U',
977663 typdelim = ',',
978664 typname = "jsonb"
979665 }
980666
981−jsonbOid :: Oid
982−jsonbOid = Oid 3802
983−{-# INLINE jsonbOid #-}
984−
985667int2vector :: TypeInfo
986668int2vector = Array {
987− typoid = int2vectorOid,
669+ typoid = Oid 22,
988670 typcategory = 'A',
989671 typdelim = ',',
990672 typname = "int2vector",
991673 typelem = int2
992674 }
993675
994−int2vectorOid :: Oid
995−int2vectorOid = Oid 22
996−{-# INLINE int2vectorOid #-}
997−
998676oidvector :: TypeInfo
999677oidvector = Array {
1000− typoid = oidvectorOid,
678+ typoid = Oid 30,
1001679 typcategory = 'A',
1002680 typdelim = ',',
1003681 typname = "oidvector",
1004682 typelem = oid
1005683 }
1006684
1007−oidvectorOid :: Oid
1008−oidvectorOid = Oid 30
1009−{-# INLINE oidvectorOid #-}
1010−
1011685array_xml :: TypeInfo
1012686array_xml = Array {
1013− typoid = array_xmlOid,
687+ typoid = Oid 143,
1014688 typcategory = 'A',
1015689 typdelim = ',',
1016690 typname = "_xml",
1017691 typelem = xml
1018692 }
1019693
1020−array_xmlOid :: Oid
1021−array_xmlOid = Oid 143
1022−{-# INLINE array_xmlOid #-}
1023−
1024694array_json :: TypeInfo
1025695array_json = Array {
1026− typoid = array_jsonOid,
696+ typoid = Oid 199,
1027697 typcategory = 'A',
1028698 typdelim = ',',
1029699 typname = "_json",
1030700 typelem = json
1031701 }
1032702
1033−array_jsonOid :: Oid
1034−array_jsonOid = Oid 199
1035−{-# INLINE array_jsonOid #-}
1036−
1037703array_line :: TypeInfo
1038704array_line = Array {
1039− typoid = array_lineOid,
705+ typoid = Oid 629,
1040706 typcategory = 'A',
1041707 typdelim = ',',
1042708 typname = "_line",
1043709 typelem = line
1044710 }
1045711
1046−array_lineOid :: Oid
1047−array_lineOid = Oid 629
1048−{-# INLINE array_lineOid #-}
1049−
1050712array_cidr :: TypeInfo
1051713array_cidr = Array {
1052− typoid = array_cidrOid,
714+ typoid = Oid 651,
1053715 typcategory = 'A',
1054716 typdelim = ',',
1055717 typname = "_cidr",
1056718 typelem = cidr
1057719 }
1058720
1059−array_cidrOid :: Oid
1060−array_cidrOid = Oid 651
1061−{-# INLINE array_cidrOid #-}
1062−
1063721array_circle :: TypeInfo
1064722array_circle = Array {
1065− typoid = array_circleOid,
723+ typoid = Oid 719,
1066724 typcategory = 'A',
1067725 typdelim = ',',
1068726 typname = "_circle",
1069727 typelem = circle
1070728 }
1071729
1072−array_circleOid :: Oid
1073−array_circleOid = Oid 719
1074−{-# INLINE array_circleOid #-}
1075−
1076730array_money :: TypeInfo
1077731array_money = Array {
1078− typoid = array_moneyOid,
732+ typoid = Oid 791,
1079733 typcategory = 'A',
1080734 typdelim = ',',
1081735 typname = "_money",
1082736 typelem = money
1083737 }
1084738
1085−array_moneyOid :: Oid
1086−array_moneyOid = Oid 791
1087−{-# INLINE array_moneyOid #-}
1088−
1089739array_bool :: TypeInfo
1090740array_bool = Array {
1091− typoid = array_boolOid,
741+ typoid = Oid 1000,
1092742 typcategory = 'A',
1093743 typdelim = ',',
1094744 typname = "_bool",
1095745 typelem = bool
1096746 }
1097747
1098−array_boolOid :: Oid
1099−array_boolOid = Oid 1000
1100−{-# INLINE array_boolOid #-}
1101−
1102748array_bytea :: TypeInfo
1103749array_bytea = Array {
1104− typoid = array_byteaOid,
750+ typoid = Oid 1001,
1105751 typcategory = 'A',
1106752 typdelim = ',',
1107753 typname = "_bytea",
1108754 typelem = bytea
1109755 }
1110756
1111−array_byteaOid :: Oid
1112−array_byteaOid = Oid 1001
1113−{-# INLINE array_byteaOid #-}
1114−
1115757array_char :: TypeInfo
1116758array_char = Array {
1117− typoid = array_charOid,
759+ typoid = Oid 1002,
1118760 typcategory = 'A',
1119761 typdelim = ',',
1120762 typname = "_char",
1121763 typelem = char
1122764 }
1123765
1124−array_charOid :: Oid
1125−array_charOid = Oid 1002
1126−{-# INLINE array_charOid #-}
1127−
1128766array_name :: TypeInfo
1129767array_name = Array {
1130− typoid = array_nameOid,
768+ typoid = Oid 1003,
1131769 typcategory = 'A',
1132770 typdelim = ',',
1133771 typname = "_name",
1134772 typelem = name
1135773 }
1136774
1137−array_nameOid :: Oid
1138−array_nameOid = Oid 1003
1139−{-# INLINE array_nameOid #-}
1140−
1141775array_int2 :: TypeInfo
1142776array_int2 = Array {
1143− typoid = array_int2Oid,
777+ typoid = Oid 1005,
1144778 typcategory = 'A',
1145779 typdelim = ',',
1146780 typname = "_int2",
1147781 typelem = int2
1148782 }
1149783
1150−array_int2Oid :: Oid
1151−array_int2Oid = Oid 1005
1152−{-# INLINE array_int2Oid #-}
1153−
1154784array_int2vector :: TypeInfo
1155785array_int2vector = Array {
1156− typoid = array_int2vectorOid,
786+ typoid = Oid 1006,
1157787 typcategory = 'A',
1158788 typdelim = ',',
1159789 typname = "_int2vector",
1160790 typelem = int2vector
1161791 }
1162792
1163−array_int2vectorOid :: Oid
1164−array_int2vectorOid = Oid 1006
1165−{-# INLINE array_int2vectorOid #-}
1166−
1167793array_int4 :: TypeInfo
1168794array_int4 = Array {
1169− typoid = array_int4Oid,
795+ typoid = Oid 1007,
1170796 typcategory = 'A',
1171797 typdelim = ',',
1172798 typname = "_int4",
1173799 typelem = int4
1174800 }
1175801
1176−array_int4Oid :: Oid
1177−array_int4Oid = Oid 1007
1178−{-# INLINE array_int4Oid #-}
1179−
1180802array_regproc :: TypeInfo
1181803array_regproc = Array {
1182− typoid = array_regprocOid,
804+ typoid = Oid 1008,
1183805 typcategory = 'A',
1184806 typdelim = ',',
1185807 typname = "_regproc",
1186808 typelem = regproc
1187809 }
1188810
1189−array_regprocOid :: Oid
1190−array_regprocOid = Oid 1008
1191−{-# INLINE array_regprocOid #-}
1192−
1193811array_text :: TypeInfo
1194812array_text = Array {
1195− typoid = array_textOid,
813+ typoid = Oid 1009,
1196814 typcategory = 'A',
1197815 typdelim = ',',
1198816 typname = "_text",
1199817 typelem = text
1200818 }
1201819
1202−array_textOid :: Oid
1203−array_textOid = Oid 1009
1204−{-# INLINE array_textOid #-}
1205−
1206820array_tid :: TypeInfo
1207821array_tid = Array {
1208− typoid = array_tidOid,
822+ typoid = Oid 1010,
1209823 typcategory = 'A',
1210824 typdelim = ',',
1211825 typname = "_tid",
1212826 typelem = tid
1213827 }
1214828
1215−array_tidOid :: Oid
1216−array_tidOid = Oid 1010
1217−{-# INLINE array_tidOid #-}
1218−
1219829array_xid :: TypeInfo
1220830array_xid = Array {
1221− typoid = array_xidOid,
831+ typoid = Oid 1011,
1222832 typcategory = 'A',
1223833 typdelim = ',',
1224834 typname = "_xid",
1225835 typelem = xid
1226836 }
1227837
1228−array_xidOid :: Oid
1229−array_xidOid = Oid 1011
1230−{-# INLINE array_xidOid #-}
1231−
1232838array_cid :: TypeInfo
1233839array_cid = Array {
1234− typoid = array_cidOid,
840+ typoid = Oid 1012,
1235841 typcategory = 'A',
1236842 typdelim = ',',
1237843 typname = "_cid",
1238844 typelem = cid
1239845 }
1240846
1241−array_cidOid :: Oid
1242−array_cidOid = Oid 1012
1243−{-# INLINE array_cidOid #-}
1244−
1245847array_oidvector :: TypeInfo
1246848array_oidvector = Array {
1247− typoid = array_oidvectorOid,
849+ typoid = Oid 1013,
1248850 typcategory = 'A',
1249851 typdelim = ',',
1250852 typname = "_oidvector",
1251853 typelem = oidvector
1252854 }
1253855
1254−array_oidvectorOid :: Oid
1255−array_oidvectorOid = Oid 1013
1256−{-# INLINE array_oidvectorOid #-}
1257−
1258856array_bpchar :: TypeInfo
1259857array_bpchar = Array {
1260− typoid = array_bpcharOid,
858+ typoid = Oid 1014,
1261859 typcategory = 'A',
1262860 typdelim = ',',
1263861 typname = "_bpchar",
1264862 typelem = bpchar
1265863 }
1266864
1267−array_bpcharOid :: Oid
1268−array_bpcharOid = Oid 1014
1269−{-# INLINE array_bpcharOid #-}
1270−
1271865array_varchar :: TypeInfo
1272866array_varchar = Array {
1273− typoid = array_varcharOid,
867+ typoid = Oid 1015,
1274868 typcategory = 'A',
1275869 typdelim = ',',
1276870 typname = "_varchar",
1277871 typelem = varchar
1278872 }
1279873
1280−array_varcharOid :: Oid
1281−array_varcharOid = Oid 1015
1282−{-# INLINE array_varcharOid #-}
1283−
1284874array_int8 :: TypeInfo
1285875array_int8 = Array {
1286− typoid = array_int8Oid,
876+ typoid = Oid 1016,
1287877 typcategory = 'A',
1288878 typdelim = ',',
1289879 typname = "_int8",
1290880 typelem = int8
1291881 }
1292882
1293−array_int8Oid :: Oid
1294−array_int8Oid = Oid 1016
1295−{-# INLINE array_int8Oid #-}
1296−
1297883array_point :: TypeInfo
1298884array_point = Array {
1299− typoid = array_pointOid,
885+ typoid = Oid 1017,
1300886 typcategory = 'A',
1301887 typdelim = ',',
1302888 typname = "_point",
1303889 typelem = point
1304890 }
1305891
1306−array_pointOid :: Oid
1307−array_pointOid = Oid 1017
1308−{-# INLINE array_pointOid #-}
1309−
1310892array_lseg :: TypeInfo
1311893array_lseg = Array {
1312− typoid = array_lsegOid,
894+ typoid = Oid 1018,
1313895 typcategory = 'A',
1314896 typdelim = ',',
1315897 typname = "_lseg",
1316898 typelem = lseg
1317899 }
1318900
1319−array_lsegOid :: Oid
1320−array_lsegOid = Oid 1018
1321−{-# INLINE array_lsegOid #-}
1322−
1323901array_path :: TypeInfo
1324902array_path = Array {
1325− typoid = array_pathOid,
903+ typoid = Oid 1019,
1326904 typcategory = 'A',
1327905 typdelim = ',',
1328906 typname = "_path",
1329907 typelem = path
1330908 }
1331909
1332−array_pathOid :: Oid
1333−array_pathOid = Oid 1019
1334−{-# INLINE array_pathOid #-}
1335−
1336910array_box :: TypeInfo
1337911array_box = Array {
1338− typoid = array_boxOid,
912+ typoid = Oid 1020,
1339913 typcategory = 'A',
1340914 typdelim = ';',
1341915 typname = "_box",
1342916 typelem = box
1343917 }
1344918
1345−array_boxOid :: Oid
1346−array_boxOid = Oid 1020
1347−{-# INLINE array_boxOid #-}
1348−
1349919array_float4 :: TypeInfo
1350920array_float4 = Array {
1351− typoid = array_float4Oid,
921+ typoid = Oid 1021,
1352922 typcategory = 'A',
1353923 typdelim = ',',
1354924 typname = "_float4",
1355925 typelem = float4
1356926 }
1357927
1358−array_float4Oid :: Oid
1359−array_float4Oid = Oid 1021
1360−{-# INLINE array_float4Oid #-}
1361−
1362928array_float8 :: TypeInfo
1363929array_float8 = Array {
1364− typoid = array_float8Oid,
930+ typoid = Oid 1022,
1365931 typcategory = 'A',
1366932 typdelim = ',',
1367933 typname = "_float8",
1368934 typelem = float8
1369935 }
1370936
1371−array_float8Oid :: Oid
1372−array_float8Oid = Oid 1022
1373−{-# INLINE array_float8Oid #-}
1374−
1375937array_polygon :: TypeInfo
1376938array_polygon = Array {
1377− typoid = array_polygonOid,
939+ typoid = Oid 1027,
1378940 typcategory = 'A',
1379941 typdelim = ',',
1380942 typname = "_polygon",
1381943 typelem = polygon
1382944 }
1383945
1384−array_polygonOid :: Oid
1385−array_polygonOid = Oid 1027
1386−{-# INLINE array_polygonOid #-}
1387−
1388946array_oid :: TypeInfo
1389947array_oid = Array {
1390− typoid = array_oidOid,
948+ typoid = Oid 1028,
1391949 typcategory = 'A',
1392950 typdelim = ',',
1393951 typname = "_oid",
1394952 typelem = oid
1395953 }
1396954
1397−array_oidOid :: Oid
1398−array_oidOid = Oid 1028
1399−{-# INLINE array_oidOid #-}
1400−
1401955array_macaddr :: TypeInfo
1402956array_macaddr = Array {
1403− typoid = array_macaddrOid,
957+ typoid = Oid 1040,
1404958 typcategory = 'A',
1405959 typdelim = ',',
1406960 typname = "_macaddr",
1407961 typelem = macaddr
1408962 }
1409963
1410−array_macaddrOid :: Oid
1411−array_macaddrOid = Oid 1040
1412−{-# INLINE array_macaddrOid #-}
1413−
1414964array_inet :: TypeInfo
1415965array_inet = Array {
1416− typoid = array_inetOid,
966+ typoid = Oid 1041,
1417967 typcategory = 'A',
1418968 typdelim = ',',
1419969 typname = "_inet",
1420970 typelem = inet
1421971 }
1422972
1423−array_inetOid :: Oid
1424−array_inetOid = Oid 1041
1425−{-# INLINE array_inetOid #-}
1426−
1427973array_timestamp :: TypeInfo
1428974array_timestamp = Array {
1429− typoid = array_timestampOid,
975+ typoid = Oid 1115,
1430976 typcategory = 'A',
1431977 typdelim = ',',
1432978 typname = "_timestamp",
1433979 typelem = timestamp
1434980 }
1435981
1436−array_timestampOid :: Oid
1437−array_timestampOid = Oid 1115
1438−{-# INLINE array_timestampOid #-}
1439−
1440982array_date :: TypeInfo
1441983array_date = Array {
1442− typoid = array_dateOid,
984+ typoid = Oid 1182,
1443985 typcategory = 'A',
1444986 typdelim = ',',
1445987 typname = "_date",
1446988 typelem = date
1447989 }
1448990
1449−array_dateOid :: Oid
1450−array_dateOid = Oid 1182
1451−{-# INLINE array_dateOid #-}
1452−
1453991array_time :: TypeInfo
1454992array_time = Array {
1455− typoid = array_timeOid,
993+ typoid = Oid 1183,
1456994 typcategory = 'A',
1457995 typdelim = ',',
1458996 typname = "_time",
1459997 typelem = time
1460998 }
1461999
1462−array_timeOid :: Oid
1463−array_timeOid = Oid 1183
1464−{-# INLINE array_timeOid #-}
1465−
14661000array_timestamptz :: TypeInfo
14671001array_timestamptz = Array {
1468− typoid = array_timestamptzOid,
1002+ typoid = Oid 1185,
14691003 typcategory = 'A',
14701004 typdelim = ',',
14711005 typname = "_timestamptz",
14721006 typelem = timestamptz
14731007 }
14741008
1475−array_timestamptzOid :: Oid
1476−array_timestamptzOid = Oid 1185
1477−{-# INLINE array_timestamptzOid #-}
1478−
14791009array_interval :: TypeInfo
14801010array_interval = Array {
1481− typoid = array_intervalOid,
1011+ typoid = Oid 1187,
14821012 typcategory = 'A',
14831013 typdelim = ',',
14841014 typname = "_interval",
14851015 typelem = interval
14861016 }
14871017
1488−array_intervalOid :: Oid
1489−array_intervalOid = Oid 1187
1490−{-# INLINE array_intervalOid #-}
1491−
14921018array_numeric :: TypeInfo
14931019array_numeric = Array {
1494− typoid = array_numericOid,
1020+ typoid = Oid 1231,
14951021 typcategory = 'A',
14961022 typdelim = ',',
14971023 typname = "_numeric",
14981024 typelem = numeric
14991025 }
15001026
1501−array_numericOid :: Oid
1502−array_numericOid = Oid 1231
1503−{-# INLINE array_numericOid #-}
1504−
15051027array_timetz :: TypeInfo
15061028array_timetz = Array {
1507− typoid = array_timetzOid,
1029+ typoid = Oid 1270,
15081030 typcategory = 'A',
15091031 typdelim = ',',
15101032 typname = "_timetz",
15111033 typelem = timetz
15121034 }
15131035
1514−array_timetzOid :: Oid
1515−array_timetzOid = Oid 1270
1516−{-# INLINE array_timetzOid #-}
1517−
15181036array_bit :: TypeInfo
15191037array_bit = Array {
1520− typoid = array_bitOid,
1038+ typoid = Oid 1561,
15211039 typcategory = 'A',
15221040 typdelim = ',',
15231041 typname = "_bit",
15241042 typelem = bit
15251043 }
15261044
1527−array_bitOid :: Oid
1528−array_bitOid = Oid 1561
1529−{-# INLINE array_bitOid #-}
1530−
15311045array_varbit :: TypeInfo
15321046array_varbit = Array {
1533− typoid = array_varbitOid,
1047+ typoid = Oid 1563,
15341048 typcategory = 'A',
15351049 typdelim = ',',
15361050 typname = "_varbit",
15371051 typelem = varbit
15381052 }
15391053
1540−array_varbitOid :: Oid
1541−array_varbitOid = Oid 1563
1542−{-# INLINE array_varbitOid #-}
1543−
15441054array_refcursor :: TypeInfo
15451055array_refcursor = Array {
1546− typoid = array_refcursorOid,
1056+ typoid = Oid 2201,
15471057 typcategory = 'A',
15481058 typdelim = ',',
15491059 typname = "_refcursor",
15501060 typelem = refcursor
15511061 }
15521062
1553−array_refcursorOid :: Oid
1554−array_refcursorOid = Oid 2201
1555−{-# INLINE array_refcursorOid #-}
1556−
15571063array_regprocedure :: TypeInfo
15581064array_regprocedure = Array {
1559− typoid = array_regprocedureOid,
1065+ typoid = Oid 2207,
15601066 typcategory = 'A',
15611067 typdelim = ',',
15621068 typname = "_regprocedure",
15631069 typelem = regprocedure
15641070 }
15651071
1566−array_regprocedureOid :: Oid
1567−array_regprocedureOid = Oid 2207
1568−{-# INLINE array_regprocedureOid #-}
1569−
15701072array_regoper :: TypeInfo
15711073array_regoper = Array {
1572− typoid = array_regoperOid,
1074+ typoid = Oid 2208,
15731075 typcategory = 'A',
15741076 typdelim = ',',
15751077 typname = "_regoper",
15761078 typelem = regoper
15771079 }
15781080
1579−array_regoperOid :: Oid
1580−array_regoperOid = Oid 2208
1581−{-# INLINE array_regoperOid #-}
1582−
15831081array_regoperator :: TypeInfo
15841082array_regoperator = Array {
1585− typoid = array_regoperatorOid,
1083+ typoid = Oid 2209,
15861084 typcategory = 'A',
15871085 typdelim = ',',
15881086 typname = "_regoperator",
15891087 typelem = regoperator
15901088 }
15911089
1592−array_regoperatorOid :: Oid
1593−array_regoperatorOid = Oid 2209
1594−{-# INLINE array_regoperatorOid #-}
1595−
15961090array_regclass :: TypeInfo
15971091array_regclass = Array {
1598− typoid = array_regclassOid,
1092+ typoid = Oid 2210,
15991093 typcategory = 'A',
16001094 typdelim = ',',
16011095 typname = "_regclass",
16021096 typelem = regclass
16031097 }
16041098
1605−array_regclassOid :: Oid
1606−array_regclassOid = Oid 2210
1607−{-# INLINE array_regclassOid #-}
1608−
16091099array_regtype :: TypeInfo
16101100array_regtype = Array {
1611− typoid = array_regtypeOid,
1101+ typoid = Oid 2211,
16121102 typcategory = 'A',
16131103 typdelim = ',',
16141104 typname = "_regtype",
16151105 typelem = regtype
16161106 }
16171107
1618−array_regtypeOid :: Oid
1619−array_regtypeOid = Oid 2211
1620−{-# INLINE array_regtypeOid #-}
1621−
16221108array_uuid :: TypeInfo
16231109array_uuid = Array {
1624− typoid = array_uuidOid,
1110+ typoid = Oid 2951,
16251111 typcategory = 'A',
16261112 typdelim = ',',
16271113 typname = "_uuid",
16281114 typelem = uuid
16291115 }
16301116
1631−array_uuidOid :: Oid
1632−array_uuidOid = Oid 2951
1633−{-# INLINE array_uuidOid #-}
1634−
16351117array_jsonb :: TypeInfo
16361118array_jsonb = Array {
1637− typoid = array_jsonbOid,
1119+ typoid = Oid 3807,
16381120 typcategory = 'A',
16391121 typdelim = ',',
16401122 typname = "_jsonb",
16411123 typelem = jsonb
16421124 }
16431125
1644−array_jsonbOid :: Oid
1645−array_jsonbOid = Oid 3807
1646−{-# INLINE array_jsonbOid #-}
1647−
16481126int4range :: TypeInfo
16491127int4range = Range {
1650− typoid = int4rangeOid,
1128+ typoid = Oid 3904,
16511129 typcategory = 'R',
16521130 typdelim = ',',
16531131 typname = "int4range",
16541132 rngsubtype = int4
16551133 }
16561134
1657−int4rangeOid :: Oid
1658−int4rangeOid = Oid 3904
1659−{-# INLINE int4rangeOid #-}
1660−
16611135_int4range :: TypeInfo
16621136_int4range = Array {
1663− typoid = _int4rangeOid,
1137+ typoid = Oid 3905,
16641138 typcategory = 'A',
16651139 typdelim = ',',
16661140 typname = "_int4range",
16671141 typelem = int4range
16681142 }
16691143
1670−_int4rangeOid :: Oid
1671−_int4rangeOid = Oid 3905
1672−{-# INLINE _int4rangeOid #-}
1673−
16741144numrange :: TypeInfo
16751145numrange = Range {
1676− typoid = numrangeOid,
1146+ typoid = Oid 3906,
16771147 typcategory = 'R',
16781148 typdelim = ',',
16791149 typname = "numrange",
16801150 rngsubtype = numeric
16811151 }
16821152
1683−numrangeOid :: Oid
1684−numrangeOid = Oid 3906
1685−{-# INLINE numrangeOid #-}
1686−
16871153_numrange :: TypeInfo
16881154_numrange = Array {
1689− typoid = _numrangeOid,
1155+ typoid = Oid 3907,
16901156 typcategory = 'A',
16911157 typdelim = ',',
16921158 typname = "_numrange",
16931159 typelem = numrange
16941160 }
16951161
1696−_numrangeOid :: Oid
1697−_numrangeOid = Oid 3907
1698−{-# INLINE _numrangeOid #-}
1699−
17001162tsrange :: TypeInfo
17011163tsrange = Range {
1702− typoid = tsrangeOid,
1164+ typoid = Oid 3908,
17031165 typcategory = 'R',
17041166 typdelim = ',',
17051167 typname = "tsrange",
17061168 rngsubtype = timestamp
17071169 }
17081170
1709−tsrangeOid :: Oid
1710−tsrangeOid = Oid 3908
1711−{-# INLINE tsrangeOid #-}
1712−
17131171_tsrange :: TypeInfo
17141172_tsrange = Array {
1715− typoid = _tsrangeOid,
1173+ typoid = Oid 3909,
17161174 typcategory = 'A',
17171175 typdelim = ',',
17181176 typname = "_tsrange",
17191177 typelem = tsrange
17201178 }
17211179
1722−_tsrangeOid :: Oid
1723−_tsrangeOid = Oid 3909
1724−{-# INLINE _tsrangeOid #-}
1725−
17261180tstzrange :: TypeInfo
17271181tstzrange = Range {
1728− typoid = tstzrangeOid,
1182+ typoid = Oid 3910,
17291183 typcategory = 'R',
17301184 typdelim = ',',
17311185 typname = "tstzrange",
17321186 rngsubtype = timestamptz
17331187 }
17341188
1735−tstzrangeOid :: Oid
1736−tstzrangeOid = Oid 3910
1737−{-# INLINE tstzrangeOid #-}
1738−
17391189_tstzrange :: TypeInfo
17401190_tstzrange = Array {
1741− typoid = _tstzrangeOid,
1191+ typoid = Oid 3911,
17421192 typcategory = 'A',
17431193 typdelim = ',',
17441194 typname = "_tstzrange",
17451195 typelem = tstzrange
17461196 }
17471197
1748−_tstzrangeOid :: Oid
1749−_tstzrangeOid = Oid 3911
1750−{-# INLINE _tstzrangeOid #-}
1751−
17521198daterange :: TypeInfo
17531199daterange = Range {
1754− typoid = daterangeOid,
1200+ typoid = Oid 3912,
17551201 typcategory = 'R',
17561202 typdelim = ',',
17571203 typname = "daterange",
17581204 rngsubtype = date
17591205 }
17601206
1761−daterangeOid :: Oid
1762−daterangeOid = Oid 3912
1763−{-# INLINE daterangeOid #-}
1764−
17651207_daterange :: TypeInfo
17661208_daterange = Array {
1767− typoid = _daterangeOid,
1209+ typoid = Oid 3913,
17681210 typcategory = 'A',
17691211 typdelim = ',',
17701212 typname = "_daterange",
17711213 typelem = daterange
17721214 }
17731215
1774−_daterangeOid :: Oid
1775−_daterangeOid = Oid 3913
1776−{-# INLINE _daterangeOid #-}
1777−
17781216int8range :: TypeInfo
17791217int8range = Range {
1780− typoid = int8rangeOid,
1218+ typoid = Oid 3926,
17811219 typcategory = 'R',
17821220 typdelim = ',',
17831221 typname = "int8range",
17841222 rngsubtype = int8
17851223 }
17861224
1787−int8rangeOid :: Oid
1788−int8rangeOid = Oid 3926
1789−{-# INLINE int8rangeOid #-}
1790−
17911225_int8range :: TypeInfo
17921226_int8range = Array {
1793− typoid = _int8rangeOid,
1227+ typoid = Oid 3927,
17941228 typcategory = 'A',
17951229 typdelim = ',',
17961230 typname = "_int8range",
17971231 typelem = int8range
17981232 }
1799−
1800−_int8rangeOid :: Oid
1801−_int8rangeOid = Oid 3927
1802−{-# INLINE _int8rangeOid #-}
src/Database/PostgreSQL/Simple/Types.hs+7
@@ -50,6 +50,10 @@ import Database.PostgreSQL.Simple.Compat (toByteString)
5050data Null = Null
5151 deriving (Read, Show, Typeable)
5252
53+instance Eq Null where
54+ _ == _ = False
55+ _ /= _ = False
56+
5357-- | A placeholder for the PostgreSQL @DEFAULT@ value.
5458data Default = Default
5559 deriving (Read, Show, Typeable)
@@ -93,6 +97,9 @@ instance Semigroup Query where
9397
9498instance Monoid Query where
9599 mempty = Query B.empty
100+#if !(MIN_VERSION_base(4,11,0))
101+ mappend = (<>)
102+#endif
96103
97104-- | Wrap a list of values for use in an @IN@ clause. Replaces a
98105-- single \"@?@\" character with a parenthesized list of rendered
src/Database/PostgreSQL/Simple/Vector.hsdeleted−45
@@ -1,45 +0,0 @@
1−-- | 'query' variants returning 'V.Vector'.
2−module Database.PostgreSQL.Simple.Vector where
3−
4−import Database.PostgreSQL.Simple (Connection, formatQuery, formatMany)
5−import Database.PostgreSQL.Simple.FromRow (FromRow(..))
6−import Database.PostgreSQL.Simple.ToRow (ToRow(..))
7−import Database.PostgreSQL.Simple.Internal (RowParser, exec)
8−import Database.PostgreSQL.Simple.Internal.PQResultUtils
9−import Database.PostgreSQL.Simple.Types ( Query (..) )
10−
11−import qualified Data.Vector as V
12−
13−-- | Perform a @SELECT@ or other SQL query that is expected to return
14−-- results. All results are retrieved and converted before this
15−-- function returns.
16−query :: (ToRow q, FromRow r) => Connection -> Query -> q -> IO (V.Vector r)
17−query = queryWith fromRow
18−
19−-- | A version of 'query' that does not perform query substitution.
20−query_ :: (FromRow r) => Connection -> Query -> IO (V.Vector r)
21−query_ = queryWith_ fromRow
22−
23−-- | A version of 'query' taking parser as argument
24−queryWith :: ToRow q => RowParser r -> Connection -> Query -> q -> IO (V.Vector r)
25−queryWith parser conn template qs = do
26− result <- exec conn =<< formatQuery conn template qs
27− finishQueryWithV parser conn template result
28−
29−-- | A version of 'query_' taking parser as argument
30−queryWith_ :: RowParser r -> Connection -> Query -> IO (V.Vector r)
31−queryWith_ parser conn q@(Query que) = do
32− result <- exec conn que
33− finishQueryWithV parser conn q result
34−
35−-- | Execute @INSERT ... RETURNING@, @UPDATE ... RETURNING@, or other SQL
36−-- query that accepts multi-row input and is expected to return results.
37−returning :: (ToRow q, FromRow r) => Connection -> Query -> [q] -> IO (V.Vector r)
38−returning = returningWith fromRow
39−
40−-- | A version of 'returning' taking parser as argument
41−returningWith :: (ToRow q) => RowParser r -> Connection -> Query -> [q] -> IO (V.Vector r)
42−returningWith _ _ _ [] = return V.empty
43−returningWith parser conn q qs = do
44− result <- exec conn =<< formatMany conn q qs
45− finishQueryWithV parser conn q result
src/Database/PostgreSQL/Simple/Vector/Unboxed.hsdeleted−44
@@ -1,44 +0,0 @@
1−module Database.PostgreSQL.Simple.Vector.Unboxed where
2−
3−import Database.PostgreSQL.Simple (Connection, formatQuery, formatMany)
4−import Database.PostgreSQL.Simple.FromRow (FromRow(..))
5−import Database.PostgreSQL.Simple.ToRow (ToRow(..))
6−import Database.PostgreSQL.Simple.Internal (RowParser, exec)
7−import Database.PostgreSQL.Simple.Internal.PQResultUtils
8−import Database.PostgreSQL.Simple.Types ( Query (..) )
9−
10−import qualified Data.Vector.Unboxed as VU
11−
12−-- | Perform a @SELECT@ or other SQL query that is expected to return
13−-- results. All results are retrieved and converted before this
14−-- function returns.
15−query :: (ToRow q, FromRow r, VU.Unbox r) => Connection -> Query -> q -> IO (VU.Vector r)
16−query = queryWith fromRow
17−
18−-- | A version of 'query' that does not perform query substitution.
19−query_ :: (FromRow r, VU.Unbox r) => Connection -> Query -> IO (VU.Vector r)
20−query_ = queryWith_ fromRow
21−
22−-- | A version of 'query' taking parser as argument
23−queryWith :: (ToRow q, VU.Unbox r) => RowParser r -> Connection -> Query -> q -> IO (VU.Vector r)
24−queryWith parser conn template qs = do
25− result <- exec conn =<< formatQuery conn template qs
26− finishQueryWithVU parser conn template result
27−
28−-- | A version of 'query_' taking parser as argument
29−queryWith_ :: VU.Unbox r => RowParser r -> Connection -> Query -> IO (VU.Vector r)
30−queryWith_ parser conn q@(Query que) = do
31− result <- exec conn que
32− finishQueryWithVU parser conn q result
33−
34−-- | Execute @INSERT ... RETURNING@, @UPDATE ... RETURNING@, or other SQL
35−-- query that accepts multi-row input and is expected to return results.
36−returning :: (ToRow q, FromRow r, VU.Unbox r) => Connection -> Query -> [q] -> IO (VU.Vector r)
37−returning = returningWith fromRow
38−
39−-- | A version of 'returning' taking parser as argument
40−returningWith :: (ToRow q, VU.Unbox r) => RowParser r -> Connection -> Query -> [q] -> IO (VU.Vector r)
41−returningWith _ _ _ [] = return VU.empty
42−returningWith parser conn q qs = do
43− result <- exec conn =<< formatMany conn q qs
44− finishQueryWithVU parser conn q result
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/Inspection.hsdeleted−79
@@ -1,79 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE TemplateHaskell #-}
3−{-# OPTIONS_GHC -dsuppress-idinfo -dsuppress-coercions -dsuppress-type-applications -dsuppress-module-prefixes -dsuppress-type-signatures #-}
4−-- {-# OPTIONS_GHC -dsuppress-uniques #-}
5−{-# OPTIONS_GHC -fplugin=Test.Inspection.Plugin #-}
6−module Main where
7−
8−import Test.Inspection
9−import Test.Tasty
10−import Test.Tasty.HUnit
11−
12−import qualified Database.PostgreSQL.LibPQ as PQ
13−import Database.PostgreSQL.Simple.FromField
14−import Database.PostgreSQL.Simple.TypeInfo as TI
15−import Database.PostgreSQL.Simple.TypeInfo.Macro
16−import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI
17−
18−-------------------------------------------------------------------------------
19−-- Inspection tests
20−-------------------------------------------------------------------------------
21−
22−-- # doesn't work :(
23−#define TH_MKCOMPATS3(a,b,c) $(mkCompats [TI.a,TI.b,TI.c])
24−#define IN_MKCOMPATS3(a,b,c) (eq TI.a \/ eq TI.b \/ eq TI.c)
25−
26−#define TH_INLINETYPOID(n) eq $(inlineTypoid TI.n)
27−#define IN_INLINETYPOID(n) eq TI.n
28−
29−-- eta-expansion is required
30−lhs01, rhs01 :: PQ.Oid -> Bool
31−lhs01 = TH_MKCOMPATS3(name,text,char)
32−rhs01 = IN_MKCOMPATS3(nameOid,textOid,charOid)
33−
34−lhs02, rhs02 :: PQ.Oid -> Bool
35−lhs02 = TH_INLINETYPOID(name)
36−rhs02 = IN_INLINETYPOID(nameOid)
37−
38−eq :: PQ.Oid -> PQ.Oid -> Bool
39−eq = (==)
40−{-# INLINE eq #-}
41−
42−infixr 2 \/
43−(\/) :: (PQ.Oid -> Bool)
44− -> (PQ.Oid -> Bool)
45− -> (PQ.Oid -> Bool)
46−f \/ g = \x -> f x || g x
47−{-# INLINE (\/) #-}
48−
49−inspectionTests :: TestTree
50−inspectionTests = testGroup "inspection"
51− [ testCase "mkCompats" $
52− assertSuccess $(inspectTest $ 'lhs01 === 'rhs01)
53−
54− -- byteaOid isn't inlined?
55− , testCase "inlineTypoid" $
56−#if __GLASGOW_HASKELL__ >= 808
57− assertSuccess
58−#else
59− assertFailure'
60−#endif
61− $(inspectTest $ 'lhs02 ==- 'rhs02)
62− ]
63−
64−assertSuccess :: Result -> IO ()
65−assertSuccess (Success _) = return ()
66−assertSuccess (Failure err) = assertFailure err
67−
68−assertFailure' :: Result -> IO ()
69−assertFailure' (Success err) = assertFailure err
70−assertFailure' (Failure _) = return ()
71−
72−-------------------------------------------------------------------------------
73−-- Main
74−-------------------------------------------------------------------------------
75−
76−main :: IO ()
77−main = defaultMain $ testGroup "tests"
78− [ inspectionTests
79− ]
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+31−194
@@ -3,42 +3,26 @@
33{-# LANGUAGE DeriveDataTypeable #-}
44{-# LANGUAGE DoAndIfThenElse #-}
55{-# LANGUAGE ScopedTypeVariables #-}
6−#if __GLASGOW_HASKELL__ >= 806
7−{-# LANGUAGE DerivingStrategies #-}
8−{-# LANGUAGE DerivingVia #-}
9−{-# LANGUAGE DeriveAnyClass #-}
10−#endif
11−module Main (main) where
12−
136import Common
14−import Database.PostgreSQL.Simple.Copy
15−import Database.PostgreSQL.Simple.ToField (ToField)
167import Database.PostgreSQL.Simple.FromField (FromField)
8+import Database.PostgreSQL.Simple.Types(Query(..),Values(..))
179import Database.PostgreSQL.Simple.HStore
18−import Database.PostgreSQL.Simple.Newtypes
19−import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)
20−import Database.PostgreSQL.Simple.Types(Query(..),Values(..), PGArray(..))
10+import Database.PostgreSQL.Simple.Copy
2111import qualified Database.PostgreSQL.Simple.Transaction as ST
2212
2313import Control.Applicative
2414import Control.Exception as E
2515import Control.Monad
2616import Data.Char
27−import Data.Foldable (toList)
28−import Data.List (concat, sort)
17+import Data.List (sort)
2918import Data.IORef
30−import Data.Monoid ((<>))
31−import Data.String (fromString)
3219import Data.Typeable
3320import GHC.Generics (Generic)
3421
3522import Data.Aeson
3623import Data.ByteString (ByteString)
3724import qualified Data.ByteString as B
38−import qualified Data.ByteString.Char8 as BS8
3925import qualified Data.ByteString.Lazy.Char8 as BL
40−import Data.CaseInsensitive (CI)
41−import qualified Data.CaseInsensitive as CI
4226import Data.Map (Map)
4327import qualified Data.Map as Map
4428import Data.Text(Text)
@@ -46,46 +30,37 @@ import qualified Data.Text.Encoding as T
4630import qualified Data.Vector as V
4731import System.FilePath
4832import System.Timeout(timeout)
49−import Data.Time.Compat (getCurrentTime, diffUTCTime)
50−import System.Environment (getEnvironment)
33+import Data.Time(getCurrentTime, diffUTCTime)
5134
5235import Test.Tasty
5336import Test.Tasty.Golden
5437import Notify
5538import Serializable
5639import Time
57−import Interval
58−import Exception (testExceptions)
5940
6041tests :: TestEnv -> TestTree
6142tests env = testGroup "tests"
6243 $ map ($ env)
6344 [ testBytea
64− , testCase "ExecuteMany" . testExecuteMany
65− , testCase "Fold" . testFold
66− , testCase "Notify" . testNotify
67− , testCase "Serializable" . testSerializable
68− , testCase "Time" . testTime
69− , testCase "Interval" . testInterval
70− , testCase "Array" . testArray
71− , testCase "Array of nullables" . testNullableArray
72− , testCase "HStore" . testHStore
73− , testCase "citext" . testCIText
74− , testCase "JSON" . testJSON
75− , testCase "Aeson newtype" . testAeson
76− , testCase "DerivingVia" . testDerivingVia
77− , testCase "Question mark escape" . testQM
78− , testCase "Savepoint" . testSavepoint
79− , testCase "Unicode" . testUnicode
80− , testCase "Values" . testValues
81− , testCase "Copy" . testCopy
45+ , testCase "ExecuteMany" . testExecuteMany
46+ , testCase "Fold" . testFold
47+ , testCase "Notify" . testNotify
48+ , testCase "Serializable" . testSerializable
49+ , testCase "Time" . testTime
50+ , testCase "Array" . testArray
51+ , testCase "Array of nullables" . testNullableArray
52+ , testCase "HStore" . testHStore
53+ , testCase "JSON" . testJSON
54+ , testCase "Savepoint" . testSavepoint
55+ , testCase "Unicode" . testUnicode
56+ , testCase "Values" . testValues
57+ , testCase "Copy" . testCopy
8258 , testCopyFailures
83− , testCase "Double" . testDouble
84− , testCase "1-ary generic" . testGeneric1
85− , testCase "2-ary generic" . testGeneric2
86− , testCase "3-ary generic" . testGeneric3
87− , testCase "Timeout" . testTimeout
88− , testCase "Exceptions" . testExceptions
59+ , testCase "Double" . testDouble
60+ , testCase "1-ary generic" . testGeneric1
61+ , testCase "2-ary generic" . testGeneric2
62+ , testCase "3-ary generic" . testGeneric3
63+ , testCase "Timeout" . testTimeout
8964 ]
9065
9166testBytea :: TestEnv -> TestTree
@@ -139,7 +114,7 @@ testFold TestEnv{..} = do
139114 xs <- readIORef ref
140115 writeIORef ref $! (a,b):xs
141116 xs <- readIORef ref
142− reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]
117+ reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
143118
144119 -- Make sure fold propagates our exception.
145120 ref <- newIORef []
@@ -228,19 +203,6 @@ testHStore TestEnv{..} = do
228203 m' <- query conn "SELECT ?::hstore" m
229204 [m] @?= m'
230205
231−testCIText :: TestEnv -> Assertion
232−testCIText TestEnv{..} = do
233− execute_ conn "CREATE EXTENSION IF NOT EXISTS citext"
234− roundTrip (CI.mk "")
235− roundTrip (CI.mk "UPPERCASE")
236− roundTrip (CI.mk "lowercase")
237− where
238− roundTrip :: (CI Text) -> Assertion
239− roundTrip cit = do
240− let toPostgres = Only cit
241− fromPostgres <- query conn "SELECT ?::citext" toPostgres
242− [toPostgres] @?= fromPostgres
243−
244206testJSON :: TestEnv -> Assertion
245207testJSON TestEnv{..} = do
246208 roundTrip (Map.fromList [] :: Map Text Text)
@@ -256,90 +218,6 @@ testJSON TestEnv{..} = do
256218 js' <- query conn "SELECT ?::json" js
257219 [js] @?= js'
258220
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−
293−testQM :: TestEnv -> Assertion
294−testQM TestEnv{..} = do
295− -- Just test on a single string
296− let testQuery' b = "testing for ?" <> b <> " and making sure "
297− testQueryDoubleQM = testQuery' "?"
298− testQueryRest = "? is substituted"
299− testQuery = fromString $ testQueryDoubleQM <> testQueryRest
300− -- expect the entire first part with double QMs replaced with literal '?'
301− expected = (fromString $ testQuery' "", fromString testQueryRest)
302− tried = breakOnSingleQuestionMark testQuery
303− errMsg = concat
304− [ "Failed to break on single question mark exclusively:\n"
305− , "expected: ", show expected
306− , "result: ", show tried
307− ]
308− assertBool errMsg $ tried == expected
309−
310− -- Let's also test the question mark operators in action
311− -- ? -> Does the string exist as a top-level key within the JSON value?
312− positiveQuery "SELECT ?::jsonb ?? ?" (testObj, "foo" :: Text)
313− negativeQuery "SELECT ?::jsonb ?? ?" (testObj, "baz" :: Text)
314− negativeQuery "SELECT ?::jsonb ?? ?" (toJSON numArray, "1" :: Text)
315− -- ?| -> Do any of these array strings exist as top-level keys?
316− positiveQuery "SELECT ?::jsonb ??| ?" (testObj, PGArray ["nope","bar","6" :: Text])
317− negativeQuery "SELECT ?::jsonb ??| ?" (testObj, PGArray ["nope","6" :: Text])
318− negativeQuery "SELECT ?::jsonb ??| ?" (toJSON numArray, PGArray ["1","2","6" :: Text])
319− -- ?& -> Do all of these array strings exist as top-level keys?
320− positiveQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar","quux" :: Text])
321− positiveQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar" :: Text])
322− negativeQuery "SELECT ?::jsonb ??& ?" (testObj, PGArray ["foo","bar","baz" :: Text])
323− negativeQuery "SELECT ?::jsonb ??& ?" (toJSON numArray, PGArray ["1","2","3","4","5" :: Text])
324− -- Format error for 2 question marks, not 4
325− True <- expectError (isFormatError 2) $
326− (query conn "SELECT ?::jsonb ?? ?" $ Only testObj :: IO [Only Bool])
327− return ()
328− where positiveQuery :: ToRow a => Query -> a -> Assertion
329− positiveQuery = boolQuery True
330− negativeQuery :: ToRow a => Query -> a -> Assertion
331− negativeQuery = boolQuery False
332− numArray :: [Int]
333− numArray = [1,2,3,4,5]
334− boolQuery :: ToRow a => Bool -> Query -> a -> Assertion
335− boolQuery b t x = do
336− a <- query conn t x
337− [Only b] @?= a
338− testObj = toJSON (Map.fromList [("foo",toJSON (1 :: Int))
339− ,("bar",String "baz")
340− ,("quux",toJSON [1 :: Int,2,3,4,5])] :: Map Text Value
341− )
342−
343221testSavepoint :: TestEnv -> Assertion
344222testSavepoint TestEnv{..} = do
345223 True <- expectError ST.isNoActiveTransactionError $
@@ -447,14 +325,6 @@ testCopy TestEnv{..} = do
447325 -- so that we can issue more queries:
448326 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
449327 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
458328 where
459329 copyRows = ["1,foo\n"
460330 ,"2,bar\n"]
@@ -474,13 +344,12 @@ testCopyFailures env = testGroup "Copy failures"
474344
475345goldenTest :: TestName -> IO BL.ByteString -> TestTree
476346goldenTest testName =
477− goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")
347+ goldenVsString testName (resultsDir </> fileName<.>"expected")
478348 where
479349 resultsDir = "test" </> "results"
480350 fileName = map normalize testName
481351 normalize c | not (isAlpha c) = '-'
482352 | otherwise = c
483− diff ref new = ["diff", "-u", ref, new]
484353
485354-- | Test that we provide a sensible error message on failure
486355testCopyUniqueConstraintError :: TestEnv -> TestTree
@@ -593,56 +462,24 @@ isUniqueViolation SqlError{..} = sqlState == "23505"
593462isSyntaxError :: SqlError -> Bool
594463isSyntaxError SqlError{..} = sqlState == "42601"
595464
596−isFormatError :: Int -> FormatError -> Bool
597−isFormatError i FormatError{..}
598− | null fmtMessage = False
599− | otherwise = fmtMessage == concat [ show i
600− , " single '?' characters, but "
601− , show (length fmtParams)
602− , " parameters"
603− ]
604465------------------------------------------------------------------------
605466
606467-- | Action for connecting to the database that will be used for testing.
607468--
608469-- Note that some tests, such as Notify, use multiple connections, and assume
609470-- that 'testConnect' connects to the same database every time it is called.
610−withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a
611−withTestEnv connstr cb =
612− withConn $ \conn -> do
613− -- currently required for interval to work.
614− -- we also test that this doesn't interfere with anything else
615− execute_ conn "SET intervalstyle TO 'iso_8601'"
471+testConnect :: IO Connection
472+testConnect = connectPostgreSQL ""
616473
474+withTestEnv :: (TestEnv -> IO a) -> IO a
475+withTestEnv cb =
476+ withConn $ \conn ->
617477 cb TestEnv
618478 { conn = conn
619479 , withConn = withConn
620480 }
621481 where
622− withConn = bracket (connectPostgreSQL connstr) close
482+ withConn = bracket testConnect close
623483
624484main :: IO ()
625−main = withConnstring $ \connstring -> do
626− withTestEnv connstring (defaultMain . tests)
627−
628−withConnstring :: (BS8.ByteString -> IO ()) -> IO ()
629−withConnstring kont = do
630− env <- getEnvironment
631− case lookup "DATABASE_CONNSTRING" env of
632− Just s -> kont (BS8.pack (special s))
633− Nothing -> case lookup "GITHUB_ACTIONS" env of
634− Just "true" -> kont (BS8.pack gha)
635− _ -> putStrLn "Set DATABASE_CONNSTRING environment variable"
636− where
637− -- https://www.appveyor.com/docs/services-databases/
638− special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"
639− special "travis" = ""
640− special s = s
641−
642− gha = unwords
643− [ "dbname='postgres'"
644− , "user='postgres'"
645− , "password='postgres'"
646− , "host='postgres'"
647− , "port=5432"
648− ]
485+main = withTestEnv $ defaultMain . tests
test/Time.hs+1−1
@@ -36,7 +36,7 @@ module Time (testTime) where
3636
3737import Common
3838import Control.Monad(forM_, replicateM_)
39−import Data.Time.Compat
39+import Data.Time
4040import Data.ByteString(ByteString)
4141import Database.PostgreSQL.Simple.SqlQQ
4242
test/results/malformed-input.expected+1−1
@@ -1,4 +1,4 @@
11user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status
2−Connection error: ERROR: invalid input syntax for type integer: "z"
2+Connection error: ERROR: invalid input syntax for integer: "z"
33CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"
44)
tools/GenTypeInfo.hs+25−39
@@ -21,9 +21,6 @@
2121-- know about. It then constructs a TypeInfo record and stores it in
2222-- a per-connection cache for later use.
2323--
24−-- @
25−-- runghc -itools tools/GenTypeInfo.hs
26−-- @
2724------------------------------------------------------------------------------
2825
2926{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}
@@ -41,10 +38,12 @@ import Database.PostgreSQL.Simple.FromRow
4138import Database.PostgreSQL.Simple.Ok
4239import Database.PostgreSQL.Simple.Types(Oid(..))
4340import Database.PostgreSQL.Simple.SqlQQ
44−import qualified Data.ByteString.Char8 as B8
41+import qualified Data.ByteString.Char8 as B
4542import Data.ByteString(ByteString)
4643import qualified Data.ByteString.Lazy as L
47−import qualified Data.ByteString.Builder as Blaze
44+import qualified Blaze.ByteString.Builder as Blaze
45+import qualified Blaze.ByteString.Builder.ByteString as Blaze
46+import qualified Blaze.ByteString.Builder.Char8 as Blaze
4847import Data.String
4948import Data.List ( sort, intersperse )
5049import qualified Data.Map as Map
@@ -70,11 +69,11 @@ data TypeInfo = TypeInfo
7069instance FromRow TypeInfo where
7170 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field
7271
73−type NameMap = Map.Map B8.ByteString TypeInfo
72+type NameMap = Map.Map B.ByteString TypeInfo
7473
7574type OidMap = Map.Map Oid TypeInfo
7675
77−type TypeName = (B8.ByteString, B8.ByteString)
76+type TypeName = (B.ByteString, B.ByteString)
7877
7978type TypeNames = [TypeName]
8079
@@ -198,6 +197,9 @@ int8range
198197_int8range
199198|]
200199
200+instance IsString Blaze.Builder where
201+ fromString = Blaze.fromByteString . fromString
202+
201203connectionString = "dbname=postgres"
202204
203205withPostgreSQL = bracket (connectPostgreSQL connectionString) close
@@ -235,7 +237,7 @@ getTypeInfos typnames = withPostgreSQL $ \conn -> do
235237
236238main = do
237239 (oidmap, namemap) <- getTypeInfos typeNames
238− L.writeFile "src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"
240+ L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"
239241 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))
240242
241243
@@ -244,7 +246,7 @@ showOid (Oid n) = show n
244246renderOid :: NameMap -> TypeName -> Blaze.Builder
245247renderOid byName name
246248 = case Map.lookup (pg name) byName of
247− Nothing -> error (B8.unpack (pg name))
249+ Nothing -> error (B.unpack (pg name))
248250 Just (showOid . typoid -> n) -> fromString n
249251 ++ fromString (replicate (4 - length n) ' ')
250252
@@ -262,25 +264,20 @@ renderTypeInfo byOid info name
262264 typelem_hs_name =
263265 case lookup (typname typelem_info) typeNames of
264266 Nothing -> error ( "type not found: "
265− ++ B8.unpack( typname typelem_info)
266− ++ " (typelem of " ++ B8.unpack (typname info)
267+ ++ B.unpack( typname typelem_info)
268+ ++ " (typelem of " ++ B.unpack (typname info)
267269 ++ ")")
268270 Just x -> x
269271 in concat
270272 [ "\n"
271273 , bs (hs name), " :: TypeInfo\n"
272274 , bs (hs name), " = Array {\n"
273− , " typoid = ", bs (hs name), "Oid,\n"
274− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"
275− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"
275+ , " typoid = ", fromString (show (typoid info)), ",\n"
276+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
277+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
276278 , " typname = \"", bs (typname info), "\",\n"
277279 , " typelem = ", bs typelem_hs_name, "\n"
278280 , " }\n"
279− , "\n"
280− , bs (hs name), "Oid :: Oid\n"
281− , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"
282− , "{-# INLINE ", bs (hs name), "Oid #-}"
283− , "\n"
284281 ]
285282 | typcategory info == 'R' =
286283 let (Just rngsubtype_oid) = rngsubtype info
@@ -288,41 +285,31 @@ renderTypeInfo byOid info name
288285 rngsubtype_hs_name =
289286 case lookup (typname rngsubtype_info) typeNames of
290287 Nothing -> error ( "type not found: "
291− ++ B8.unpack (typname rngsubtype_info)
288+ ++ B.unpack (typname rngsubtype_info)
292289 ++ " (rngsubtype of "
293− ++ B8.unpack (typname info) ++ ")")
290+ ++ B.unpack (typname info) ++ ")")
294291 Just x -> x
295292 in concat
296293 [ "\n"
297294 , bs (hs name), " :: TypeInfo\n"
298295 , bs (hs name), " = Range {\n"
299− , " typoid = ", bs (hs name), "Oid,\n"
300− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"
301− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"
296+ , " typoid = ", fromString (show (typoid info)), ",\n"
297+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
298+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
302299 , " typname = \"", bs (typname info), "\",\n"
303300 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"
304301 , " }\n"
305− , "\n"
306− , bs (hs name), "Oid :: Oid\n"
307− , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"
308− , "{-# INLINE ", bs (hs name), "Oid #-}"
309− , "\n"
310302 ]
311303 | otherwise =
312304 concat
313305 [ "\n"
314306 , bs (hs name), " :: TypeInfo\n"
315307 , bs (hs name), " = Basic {\n"
316− , " typoid = ", bs (hs name), "Oid,\n"
317− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"
318− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"
308+ , " typoid = ", fromString (show (typoid info)), ",\n"
309+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
310+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
319311 , " typname = \"", bs (typname info), "\"\n"
320312 , " }\n"
321− , "\n"
322− , bs (hs name), "Oid :: Oid\n"
323− , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"
324− , "{-# INLINE ", bs (hs name), "Oid #-}"
325− , "\n"
326313 ]
327314
328315-- FIXME: add in any names that we need that we didn't specify, (i.e.
@@ -331,7 +318,7 @@ renderTypeInfo byOid info name
331318getNames :: NameMap -> TypeNames -> TypeNames
332319getNames _ x = x
333320
334−bs = Blaze.byteString
321+bs = Blaze.fromByteString
335322
336323pg = fst
337324
@@ -360,7 +347,6 @@ module Database.PostgreSQL.Simple.TypeInfo.Static
360347 ( TypeInfo(..)
361348 , staticTypeInfo
362349|] ++ concat [ " , " ++ bs (hs name) ++ "\n"
363− ++ " , " ++ bs (hs name) ++ "Oid\n"
364350 | name <- names ] ++ [longstring|
365351 ) where
366352