git.iko.soy/typeable/postgresql-simple
on 87c6c2d help sign in
3ac2949
swap
0 ahead, 141 behind
49 files changed+698−2500
since splitsnapshots
unifiedsplit
.ghci+16 .github/workflows/haskell-ci.yml−256 .github/workflows/simple.yml−58 .gitignore+1−4 .travis.yml+73 CHANGES.md+8−138 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+124−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+2−19 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+2−14 src/Database/PostgreSQL/Simple/ToField.hs+11−22 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+134−683 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+32−179 test/Time.hs+1−1 test/results/malformed-input.expected+1−1 tools/GenTypeInfo.hs+28−40
.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+8−138
@@ -1,138 +1,8 @@
1−### Version 0.7.0.0 (2023-07-31)
2−
3− * Remove Eq Null instance. (Future `base` may break it, we remove it profilacticly).
4− * Use `postgresql-libpq >=0.10.0.0`. It includes critical fixes,
5− by using `postgresql-simple >=0.7` you won't get older `postgresql-libpq`.
6− * Drop support for GHC prior 8.6
7− * Added a class for `postgresql-simple` exceptions: `SomePostgreSqlException`.
8− This allows to catch all `postgresql-simple` exceptions at once.
9− (c.f. `AsyncException` in `base).
10−
11−### Version 0.6.5.1 (2023-07-09)
12−
13− * Support `aeson-2.2.0.0`
14−
15−### Version 0.6.5 (2022-10-30)
16−
17− * Add `withConnect`
18−
19−### Version 0.6.4 (2021-01-06)
20−
21− * Add foldCopyData helper function
22− Thanks to Sebastián Estrella for the implementation
23− https://github.com/haskellari/postgresql-simple/pull/56
24− * Implement support for postgresql 'interval' type
25− Thanks to Andre Marques Lee for the implementation
26− https://github.com/haskellari/postgresql-simple/pull/60
27− * Depend on `time-compat` to provide uniform `time` related interface.
28−
29−### Version 0.6.3 (2020-11-15)
30−
31− * Add `fromFieldJSONByteString`
32− Thanks to tomjaguarpaw for the implementation
33− https://github.com/haskellari/postgresql-simple/pull/47
34− * Add `attoFieldParser`
35− Thanks to Victor Nawothnig for the implementation
36− https://github.com/haskellari/postgresql-simple/pull/45
37− * Add `Identity` and `Const` instance
38− Thanks to Cary Robbins for the implementation
39− https://github.com/haskellari/postgresql-simple/pull/46
40− * Add `withTransactionModeRetry'`, a variant of `withTransactionModeRetry`
41− for all exception types.
42− Thanks to Elliot Cameron for the implementation
43− https://github.com/haskellari/postgresql-simple/pull/42
44− * Fix spurious aborts when retrying transactions
45− Thanks to Elliot Cameron for the implementation
46− https://github.com/haskellari/postgresql-simple/pull/34
47− * Add `Database.PostgreSQL.Simple.Newtypes` module
48− with `Aeson` newtype.
49− https://github.com/haskellari/postgresql-simple/pull/55
50−
51−### Version 0.6.2 (2019-04-26)
1+### Unreleased
522
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.
3+ * Added `ToField` instances for case-insensitive strict and lazy text.
4+ Added `citext` and `_citext` to `Database.PostgreSQL.Simple.TypeInfo.Static`.
1005 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)
1366
1377### Version 0.5.3.0 (2017-05-15)
1388 * Refactored some rudimentary cursor handling code out of the
@@ -271,7 +141,7 @@
271141 support UTF8 except for Mule Internal Code, the Multilingual
272142 Extensions for Emacs. An exception should be raised upon
273143 connecting to a database by the backend if the backend cannot
274− accommodate this requirement.
144+ accomodate this requirement.
275145
276146 * Added `Eq` and `Typeable` instances for `Connection`.
277147
@@ -391,7 +261,7 @@
391261 * De-emphasized connect and ConnectInfo in favor of connectPostgreSQL.
392262
393263### Version 0.4.2.2 (2014-05-15)
394− * Fixed compatibility with scientific-0.3.\*, thanks to Adam Bergmark
264+ * Fixed compatibility with scientific-0.3.*, thanks to Adam Bergmark
395265
396266 * Improved documentation of the FromField module, as well as the fold,
397267 foldWithOptions, executeMany, and returning operators.
@@ -409,7 +279,7 @@
409279
410280 * Changed the Identifier and QualifiedIdentifier to use Text in
411281 order to avoid encoding errors. Technically this requires a
412− major version bump, but let's pretend 0.4.1.0 didn't happen.
282+ major verson bump, but let's pretend 0.4.1.0 didn't happen.
413283
414284 * Removed non-exhaustive cases in the ToField instance for Values,
415285 and tweaked error messages.
@@ -569,7 +439,7 @@
569439
570440 * Added a brand new TypeInfo system that gives FromField instances
571441 convenient and efficient access to the pg_type metatable. This
572− replaced the older typename cache, and was necessary to properly
442+ replaced the older typename cache, and was neccesary to properly
573443 support postgres array types. Thanks to Bas van Dijk for his
574444 work on this feature.
575445
@@ -661,7 +531,7 @@
661531 now the preferred way of dealing with `timestamp` (without time zone).
662532
663533 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
664− that accommodate PostgreSQL's infinities.
534+ that accomodate PostgreSQL's infinities.
665535
666536 * All time-related `FromField`/`ToField` instances are now based on new,
667537 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+124−163
@@ -1,175 +1,136 @@
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+ , case-insensitive
133+
134+ if !impl(ghc >= 7.6)
135+ build-depends:
136+ 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+2−19
@@ -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
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+2−14
@@ -17,23 +17,19 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer
1717 , localTime
1818 , zonedTime
1919 , nominalDiffTime
20− , calendarDiffTime
2120 ) where
2221
2322import Control.Arrow ((>>>))
24−import Data.ByteString.Builder (Builder, byteString, integerDec)
23+import Data.ByteString.Builder (Builder, integerDec)
2524import Data.ByteString.Builder.Prim
2625 ( liftFixedToBounded, (>$<), (>*<)
2726 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
2827import Data.Char ( chr )
2928import Data.Int ( Int32, Int64 )
30−import Data.String (fromString)
31−import Data.Time.Compat
29+import Data.Time
3230 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
3331 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
3432 , TimeZone, timeZoneMinutes )
35−import Data.Time.Format.ISO8601.Compat (iso8601Show)
36−import Data.Time.LocalTime.Compat (CalendarDiffTime)
3733import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
3834import Unsafe.Coerce (unsafeCoerce)
3935
@@ -125,11 +121,3 @@ nominalDiffTime :: NominalDiffTime -> Builder
125121nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
126122 where
127123 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000
128−
129−calendarDiffTime :: CalendarDiffTime -> Builder
130−calendarDiffTime = byteString
131− . fromString
132− -- from the docs: "Beware: fromString truncates multi-byte characters to octets".
133− -- However, I think this is a safe usage, because ISO8601-encoding seems restricted
134− -- to ASCII output.
135− . iso8601Show
src/Database/PostgreSQL/Simple/ToField.hs+11−22
@@ -1,6 +1,5 @@
11{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
3−{-# LANGUAGE PolyKinds #-}
43
54------------------------------------------------------------------------------
65-- |
@@ -23,7 +22,6 @@ module Database.PostgreSQL.Simple.ToField
2322 , inQuotes
2423 ) where
2524
26−import Control.Applicative (Const(Const))
2725import qualified Data.Aeson as JSON
2826import Data.ByteString (ByteString)
2927import Data.ByteString.Builder
@@ -32,12 +30,10 @@ import Data.ByteString.Builder
3230 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec
3331 , floatDec, doubleDec
3432 )
35−import Data.Functor.Identity (Identity(Identity))
3633import Data.Int (Int8, Int16, Int32, Int64)
3734import Data.List (intersperse)
3835import Data.Monoid (mappend)
39−import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
40−import Data.Time.LocalTime.Compat (CalendarDiffTime)
36+import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
4137import Data.Typeable (Typeable)
4238import Data.Word (Word, Word8, Word16, Word32, Word64)
4339import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
@@ -59,7 +55,11 @@ import qualified Data.Vector as V
5955import qualified Database.PostgreSQL.LibPQ as PQ
6056import Database.PostgreSQL.Simple.Time
6157import Data.Scientific (Scientific)
58+#if MIN_VERSION_scientific(0,3,0)
6259import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
60+#else
61+import Data.Scientific (scientificBuilder)
62+#endif
6363import Foreign.C.Types (CUInt(..))
6464
6565-- | How to render an element when substituting it into a query.
@@ -100,14 +100,6 @@ instance ToField Action where
100100 toField a = a
101101 {-# INLINE toField #-}
102102
103−instance (ToField a) => ToField (Const a b) where
104− toField (Const a) = toField a
105− {-# INLINE toField #-}
106−
107−instance (ToField a) => ToField (Identity a) where
108− toField (Identity a) = toField a
109− {-# INLINE toField #-}
110−
111103instance (ToField a) => ToField (Maybe a) where
112104 toField Nothing = renderNull
113105 toField (Just a) = toField a
@@ -290,10 +282,6 @@ instance ToField NominalDiffTime where
290282 toField = Plain . inQuotes . nominalDiffTimeToBuilder
291283 {-# INLINE toField #-}
292284
293−instance ToField CalendarDiffTime where
294− toField = Plain . inQuotes . calendarDiffTimeToBuilder
295− {-# INLINE toField #-}
296−
297285instance (ToField a) => ToField (PGArray a) where
298286 toField pgArray =
299287 case fromPGArray pgArray of
@@ -314,13 +302,14 @@ instance ToField UUID where
314302instance ToField JSON.Value where
315303 toField = toField . JSON.encode
316304
317−-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.
305+-- | Convert a Haskell value to a JSON 'JSON.Value' using
306+-- 'JSON.toJSON' and convert that to a field using 'toField'.
318307--
319308-- This can be used as the default implementation for the 'toField'
320309-- method for Haskell types that have a JSON representation in
321310-- PostgreSQL.
322311toJSONField :: JSON.ToJSON a => a -> Action
323−toJSONField = toField . JSON.encode
312+toJSONField = toField . JSON.toJSON
324313
325314-- | Surround a string with single-quote characters: \"@'@\"
326315--
@@ -330,7 +319,7 @@ inQuotes b = quote `mappend` b `mappend` quote
330319 where quote = char8 '\''
331320
332321interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
333−interleaveFoldr f b bs' as = foldr (\a bs -> b : f a bs) bs' as
322+interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as
334323{-# INLINE interleaveFoldr #-}
335324
336325instance ToRow a => ToField (Values a) where
@@ -377,8 +366,8 @@ instance ToRow a => ToField (Values a) where
377366
378367 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]
379368 typedRows [] _ _ = error funcname
380− typedRows (val:vals) typs rest =
381− typedRow (toRow val) typs (multiRows vals rest)
369+ typedRows (val:vals) types rest =
370+ typedRow (toRow val) types (multiRows vals rest)
382371
383372 untypedRows :: ToRow a => [a] -> [Action] -> [Action]
384373 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+134−683
@@ -19,233 +19,121 @@ 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
135+ , citext
136+ , array_citext
249137 ) where
250138
251139import Database.PostgreSQL.LibPQ (Oid(..))
@@ -367,1436 +255,999 @@ staticTypeInfo (Oid x) = case x of
367255 3913 -> Just _daterange
368256 3926 -> Just int8range
369257 3927 -> Just _int8range
258+ 60129 -> Just citext
259+ 60134 -> Just array_citext
370260 _ -> Nothing
371261
372262bool :: TypeInfo
373263bool = Basic {
374− typoid = boolOid,
264+ typoid = Oid 16,
375265 typcategory = 'B',
376266 typdelim = ',',
377267 typname = "bool"
378268 }
379269
380−boolOid :: Oid
381−boolOid = Oid 16
382−{-# INLINE boolOid #-}
383−
384270bytea :: TypeInfo
385271bytea = Basic {
386− typoid = byteaOid,
272+ typoid = Oid 17,
387273 typcategory = 'U',
388274 typdelim = ',',
389275 typname = "bytea"
390276 }
391277
392−byteaOid :: Oid
393−byteaOid = Oid 17
394−{-# INLINE byteaOid #-}
395−
396278char :: TypeInfo
397279char = Basic {
398− typoid = charOid,
280+ typoid = Oid 18,
399281 typcategory = 'S',
400282 typdelim = ',',
401283 typname = "char"
402284 }
403285
404−charOid :: Oid
405−charOid = Oid 18
406−{-# INLINE charOid #-}
407−
408286name :: TypeInfo
409287name = Basic {
410− typoid = nameOid,
288+ typoid = Oid 19,
411289 typcategory = 'S',
412290 typdelim = ',',
413291 typname = "name"
414292 }
415293
416−nameOid :: Oid
417−nameOid = Oid 19
418−{-# INLINE nameOid #-}
419−
420294int8 :: TypeInfo
421295int8 = Basic {
422− typoid = int8Oid,
296+ typoid = Oid 20,
423297 typcategory = 'N',
424298 typdelim = ',',
425299 typname = "int8"
426300 }
427301
428−int8Oid :: Oid
429−int8Oid = Oid 20
430−{-# INLINE int8Oid #-}
431−
432302int2 :: TypeInfo
433303int2 = Basic {
434− typoid = int2Oid,
304+ typoid = Oid 21,
435305 typcategory = 'N',
436306 typdelim = ',',
437307 typname = "int2"
438308 }
439309
440−int2Oid :: Oid
441−int2Oid = Oid 21
442−{-# INLINE int2Oid #-}
443−
444310int4 :: TypeInfo
445311int4 = Basic {
446− typoid = int4Oid,
312+ typoid = Oid 23,
447313 typcategory = 'N',
448314 typdelim = ',',
449315 typname = "int4"
450316 }
451317
452−int4Oid :: Oid
453−int4Oid = Oid 23
454−{-# INLINE int4Oid #-}
455−
456318regproc :: TypeInfo
457319regproc = Basic {
458− typoid = regprocOid,
320+ typoid = Oid 24,
459321 typcategory = 'N',
460322 typdelim = ',',
461323 typname = "regproc"
462324 }
463325
464−regprocOid :: Oid
465−regprocOid = Oid 24
466−{-# INLINE regprocOid #-}
467−
468326text :: TypeInfo
469327text = Basic {
470− typoid = textOid,
328+ typoid = Oid 25,
471329 typcategory = 'S',
472330 typdelim = ',',
473331 typname = "text"
474332 }
475333
476−textOid :: Oid
477−textOid = Oid 25
478−{-# INLINE textOid #-}
479−
480334oid :: TypeInfo
481335oid = Basic {
482− typoid = oidOid,
336+ typoid = Oid 26,
483337 typcategory = 'N',
484338 typdelim = ',',
485339 typname = "oid"
486340 }
487341
488−oidOid :: Oid
489−oidOid = Oid 26
490−{-# INLINE oidOid #-}
491−
492342tid :: TypeInfo
493343tid = Basic {
494− typoid = tidOid,
344+ typoid = Oid 27,
495345 typcategory = 'U',
496346 typdelim = ',',
497347 typname = "tid"
498348 }
499349
500−tidOid :: Oid
501−tidOid = Oid 27
502−{-# INLINE tidOid #-}
503−
504350xid :: TypeInfo
505351xid = Basic {
506− typoid = xidOid,
352+ typoid = Oid 28,
507353 typcategory = 'U',
508354 typdelim = ',',
509355 typname = "xid"
510356 }
511357
512−xidOid :: Oid
513−xidOid = Oid 28
514−{-# INLINE xidOid #-}
515−
516358cid :: TypeInfo
517359cid = Basic {
518− typoid = cidOid,
360+ typoid = Oid 29,
519361 typcategory = 'U',
520362 typdelim = ',',
521363 typname = "cid"
522364 }
523365
524−cidOid :: Oid
525−cidOid = Oid 29
526−{-# INLINE cidOid #-}
527−
528366xml :: TypeInfo
529367xml = Basic {
530− typoid = xmlOid,
368+ typoid = Oid 142,
531369 typcategory = 'U',
532370 typdelim = ',',
533371 typname = "xml"
534372 }
535373
536−xmlOid :: Oid
537−xmlOid = Oid 142
538−{-# INLINE xmlOid #-}
539−
540374point :: TypeInfo
541375point = Basic {
542− typoid = pointOid,
376+ typoid = Oid 600,
543377 typcategory = 'G',
544378 typdelim = ',',
545379 typname = "point"
546380 }
547381
548−pointOid :: Oid
549−pointOid = Oid 600
550−{-# INLINE pointOid #-}
551−
552382lseg :: TypeInfo
553383lseg = Basic {
554− typoid = lsegOid,
384+ typoid = Oid 601,
555385 typcategory = 'G',
556386 typdelim = ',',
557387 typname = "lseg"
558388 }
559389
560−lsegOid :: Oid
561−lsegOid = Oid 601
562−{-# INLINE lsegOid #-}
563−
564390path :: TypeInfo
565391path = Basic {
566− typoid = pathOid,
392+ typoid = Oid 602,
567393 typcategory = 'G',
568394 typdelim = ',',
569395 typname = "path"
570396 }
571397
572−pathOid :: Oid
573−pathOid = Oid 602
574−{-# INLINE pathOid #-}
575−
576398box :: TypeInfo
577399box = Basic {
578− typoid = boxOid,
400+ typoid = Oid 603,
579401 typcategory = 'G',
580402 typdelim = ';',
581403 typname = "box"
582404 }
583405
584−boxOid :: Oid
585−boxOid = Oid 603
586−{-# INLINE boxOid #-}
587−
588406polygon :: TypeInfo
589407polygon = Basic {
590− typoid = polygonOid,
408+ typoid = Oid 604,
591409 typcategory = 'G',
592410 typdelim = ',',
593411 typname = "polygon"
594412 }
595413
596−polygonOid :: Oid
597−polygonOid = Oid 604
598−{-# INLINE polygonOid #-}
599−
600414line :: TypeInfo
601415line = Basic {
602− typoid = lineOid,
416+ typoid = Oid 628,
603417 typcategory = 'G',
604418 typdelim = ',',
605419 typname = "line"
606420 }
607421
608−lineOid :: Oid
609−lineOid = Oid 628
610−{-# INLINE lineOid #-}
611−
612422cidr :: TypeInfo
613423cidr = Basic {
614− typoid = cidrOid,
424+ typoid = Oid 650,
615425 typcategory = 'I',
616426 typdelim = ',',
617427 typname = "cidr"
618428 }
619429
620−cidrOid :: Oid
621−cidrOid = Oid 650
622−{-# INLINE cidrOid #-}
623−
624430float4 :: TypeInfo
625431float4 = Basic {
626− typoid = float4Oid,
432+ typoid = Oid 700,
627433 typcategory = 'N',
628434 typdelim = ',',
629435 typname = "float4"
630436 }
631437
632−float4Oid :: Oid
633−float4Oid = Oid 700
634−{-# INLINE float4Oid #-}
635−
636438float8 :: TypeInfo
637439float8 = Basic {
638− typoid = float8Oid,
440+ typoid = Oid 701,
639441 typcategory = 'N',
640442 typdelim = ',',
641443 typname = "float8"
642444 }
643445
644−float8Oid :: Oid
645−float8Oid = Oid 701
646−{-# INLINE float8Oid #-}
647−
648446unknown :: TypeInfo
649447unknown = Basic {
650− typoid = unknownOid,
448+ typoid = Oid 705,
651449 typcategory = 'X',
652450 typdelim = ',',
653451 typname = "unknown"
654452 }
655453
656−unknownOid :: Oid
657−unknownOid = Oid 705
658−{-# INLINE unknownOid #-}
659−
660454circle :: TypeInfo
661455circle = Basic {
662− typoid = circleOid,
456+ typoid = Oid 718,
663457 typcategory = 'G',
664458 typdelim = ',',
665459 typname = "circle"
666460 }
667461
668−circleOid :: Oid
669−circleOid = Oid 718
670−{-# INLINE circleOid #-}
671−
672462money :: TypeInfo
673463money = Basic {
674− typoid = moneyOid,
464+ typoid = Oid 790,
675465 typcategory = 'N',
676466 typdelim = ',',
677467 typname = "money"
678468 }
679469
680−moneyOid :: Oid
681−moneyOid = Oid 790
682−{-# INLINE moneyOid #-}
683−
684470macaddr :: TypeInfo
685471macaddr = Basic {
686− typoid = macaddrOid,
472+ typoid = Oid 829,
687473 typcategory = 'U',
688474 typdelim = ',',
689475 typname = "macaddr"
690476 }
691477
692−macaddrOid :: Oid
693−macaddrOid = Oid 829
694−{-# INLINE macaddrOid #-}
695−
696478inet :: TypeInfo
697479inet = Basic {
698− typoid = inetOid,
480+ typoid = Oid 869,
699481 typcategory = 'I',
700482 typdelim = ',',
701483 typname = "inet"
702484 }
703485
704−inetOid :: Oid
705−inetOid = Oid 869
706−{-# INLINE inetOid #-}
707−
708486bpchar :: TypeInfo
709487bpchar = Basic {
710− typoid = bpcharOid,
488+ typoid = Oid 1042,
711489 typcategory = 'S',
712490 typdelim = ',',
713491 typname = "bpchar"
714492 }
715493
716−bpcharOid :: Oid
717−bpcharOid = Oid 1042
718−{-# INLINE bpcharOid #-}
719−
720494varchar :: TypeInfo
721495varchar = Basic {
722− typoid = varcharOid,
496+ typoid = Oid 1043,
723497 typcategory = 'S',
724498 typdelim = ',',
725499 typname = "varchar"
726500 }
727501
728−varcharOid :: Oid
729−varcharOid = Oid 1043
730−{-# INLINE varcharOid #-}
731−
732502date :: TypeInfo
733503date = Basic {
734− typoid = dateOid,
504+ typoid = Oid 1082,
735505 typcategory = 'D',
736506 typdelim = ',',
737507 typname = "date"
738508 }
739509
740−dateOid :: Oid
741−dateOid = Oid 1082
742−{-# INLINE dateOid #-}
743−
744510time :: TypeInfo
745511time = Basic {
746− typoid = timeOid,
512+ typoid = Oid 1083,
747513 typcategory = 'D',
748514 typdelim = ',',
749515 typname = "time"
750516 }
751517
752−timeOid :: Oid
753−timeOid = Oid 1083
754−{-# INLINE timeOid #-}
755−
756518timestamp :: TypeInfo
757519timestamp = Basic {
758− typoid = timestampOid,
520+ typoid = Oid 1114,
759521 typcategory = 'D',
760522 typdelim = ',',
761523 typname = "timestamp"
762524 }
763525
764−timestampOid :: Oid
765−timestampOid = Oid 1114
766−{-# INLINE timestampOid #-}
767−
768526timestamptz :: TypeInfo
769527timestamptz = Basic {
770− typoid = timestamptzOid,
528+ typoid = Oid 1184,
771529 typcategory = 'D',
772530 typdelim = ',',
773531 typname = "timestamptz"
774532 }
775533
776−timestamptzOid :: Oid
777−timestamptzOid = Oid 1184
778−{-# INLINE timestamptzOid #-}
779−
780534interval :: TypeInfo
781535interval = Basic {
782− typoid = intervalOid,
536+ typoid = Oid 1186,
783537 typcategory = 'T',
784538 typdelim = ',',
785539 typname = "interval"
786540 }
787541
788−intervalOid :: Oid
789−intervalOid = Oid 1186
790−{-# INLINE intervalOid #-}
791−
792542timetz :: TypeInfo
793543timetz = Basic {
794− typoid = timetzOid,
544+ typoid = Oid 1266,
795545 typcategory = 'D',
796546 typdelim = ',',
797547 typname = "timetz"
798548 }
799549
800−timetzOid :: Oid
801−timetzOid = Oid 1266
802−{-# INLINE timetzOid #-}
803−
804550bit :: TypeInfo
805551bit = Basic {
806− typoid = bitOid,
552+ typoid = Oid 1560,
807553 typcategory = 'V',
808554 typdelim = ',',
809555 typname = "bit"
810556 }
811557
812−bitOid :: Oid
813−bitOid = Oid 1560
814−{-# INLINE bitOid #-}
815−
816558varbit :: TypeInfo
817559varbit = Basic {
818− typoid = varbitOid,
560+ typoid = Oid 1562,
819561 typcategory = 'V',
820562 typdelim = ',',
821563 typname = "varbit"
822564 }
823565
824−varbitOid :: Oid
825−varbitOid = Oid 1562
826−{-# INLINE varbitOid #-}
827−
828566numeric :: TypeInfo
829567numeric = Basic {
830− typoid = numericOid,
568+ typoid = Oid 1700,
831569 typcategory = 'N',
832570 typdelim = ',',
833571 typname = "numeric"
834572 }
835573
836−numericOid :: Oid
837−numericOid = Oid 1700
838−{-# INLINE numericOid #-}
839−
840574refcursor :: TypeInfo
841575refcursor = Basic {
842− typoid = refcursorOid,
576+ typoid = Oid 1790,
843577 typcategory = 'U',
844578 typdelim = ',',
845579 typname = "refcursor"
846580 }
847581
848−refcursorOid :: Oid
849−refcursorOid = Oid 1790
850−{-# INLINE refcursorOid #-}
851−
852582record :: TypeInfo
853583record = Basic {
854− typoid = recordOid,
584+ typoid = Oid 2249,
855585 typcategory = 'P',
856586 typdelim = ',',
857587 typname = "record"
858588 }
859589
860−recordOid :: Oid
861−recordOid = Oid 2249
862−{-# INLINE recordOid #-}
863−
864590void :: TypeInfo
865591void = Basic {
866− typoid = voidOid,
592+ typoid = Oid 2278,
867593 typcategory = 'P',
868594 typdelim = ',',
869595 typname = "void"
870596 }
871597
872−voidOid :: Oid
873−voidOid = Oid 2278
874−{-# INLINE voidOid #-}
875−
876598array_record :: TypeInfo
877599array_record = Array {
878− typoid = array_recordOid,
600+ typoid = Oid 2287,
879601 typcategory = 'P',
880602 typdelim = ',',
881603 typname = "_record",
882604 typelem = record
883605 }
884606
885−array_recordOid :: Oid
886−array_recordOid = Oid 2287
887−{-# INLINE array_recordOid #-}
888−
889607regprocedure :: TypeInfo
890608regprocedure = Basic {
891− typoid = regprocedureOid,
609+ typoid = Oid 2202,
892610 typcategory = 'N',
893611 typdelim = ',',
894612 typname = "regprocedure"
895613 }
896614
897−regprocedureOid :: Oid
898−regprocedureOid = Oid 2202
899−{-# INLINE regprocedureOid #-}
900−
901615regoper :: TypeInfo
902616regoper = Basic {
903− typoid = regoperOid,
617+ typoid = Oid 2203,
904618 typcategory = 'N',
905619 typdelim = ',',
906620 typname = "regoper"
907621 }
908622
909−regoperOid :: Oid
910−regoperOid = Oid 2203
911−{-# INLINE regoperOid #-}
912−
913623regoperator :: TypeInfo
914624regoperator = Basic {
915− typoid = regoperatorOid,
625+ typoid = Oid 2204,
916626 typcategory = 'N',
917627 typdelim = ',',
918628 typname = "regoperator"
919629 }
920630
921−regoperatorOid :: Oid
922−regoperatorOid = Oid 2204
923−{-# INLINE regoperatorOid #-}
924−
925631regclass :: TypeInfo
926632regclass = Basic {
927− typoid = regclassOid,
633+ typoid = Oid 2205,
928634 typcategory = 'N',
929635 typdelim = ',',
930636 typname = "regclass"
931637 }
932638
933−regclassOid :: Oid
934−regclassOid = Oid 2205
935−{-# INLINE regclassOid #-}
936−
937639regtype :: TypeInfo
938640regtype = Basic {
939− typoid = regtypeOid,
641+ typoid = Oid 2206,
940642 typcategory = 'N',
941643 typdelim = ',',
942644 typname = "regtype"
943645 }
944646
945−regtypeOid :: Oid
946−regtypeOid = Oid 2206
947−{-# INLINE regtypeOid #-}
948−
949647uuid :: TypeInfo
950648uuid = Basic {
951− typoid = uuidOid,
649+ typoid = Oid 2950,
952650 typcategory = 'U',
953651 typdelim = ',',
954652 typname = "uuid"
955653 }
956654
957−uuidOid :: Oid
958−uuidOid = Oid 2950
959−{-# INLINE uuidOid #-}
960−
961655json :: TypeInfo
962656json = Basic {
963− typoid = jsonOid,
657+ typoid = Oid 114,
964658 typcategory = 'U',
965659 typdelim = ',',
966660 typname = "json"
967661 }
968662
969−jsonOid :: Oid
970−jsonOid = Oid 114
971−{-# INLINE jsonOid #-}
972−
973663jsonb :: TypeInfo
974664jsonb = Basic {
975− typoid = jsonbOid,
665+ typoid = Oid 3802,
976666 typcategory = 'U',
977667 typdelim = ',',
978668 typname = "jsonb"
979669 }
980670
981−jsonbOid :: Oid
982−jsonbOid = Oid 3802
983−{-# INLINE jsonbOid #-}
984−
985671int2vector :: TypeInfo
986672int2vector = Array {
987− typoid = int2vectorOid,
673+ typoid = Oid 22,
988674 typcategory = 'A',
989675 typdelim = ',',
990676 typname = "int2vector",
991677 typelem = int2
992678 }
993679
994−int2vectorOid :: Oid
995−int2vectorOid = Oid 22
996−{-# INLINE int2vectorOid #-}
997−
998680oidvector :: TypeInfo
999681oidvector = Array {
1000− typoid = oidvectorOid,
682+ typoid = Oid 30,
1001683 typcategory = 'A',
1002684 typdelim = ',',
1003685 typname = "oidvector",
1004686 typelem = oid
1005687 }
1006688
1007−oidvectorOid :: Oid
1008−oidvectorOid = Oid 30
1009−{-# INLINE oidvectorOid #-}
1010−
1011689array_xml :: TypeInfo
1012690array_xml = Array {
1013− typoid = array_xmlOid,
691+ typoid = Oid 143,
1014692 typcategory = 'A',
1015693 typdelim = ',',
1016694 typname = "_xml",
1017695 typelem = xml
1018696 }
1019697
1020−array_xmlOid :: Oid
1021−array_xmlOid = Oid 143
1022−{-# INLINE array_xmlOid #-}
1023−
1024698array_json :: TypeInfo
1025699array_json = Array {
1026− typoid = array_jsonOid,
700+ typoid = Oid 199,
1027701 typcategory = 'A',
1028702 typdelim = ',',
1029703 typname = "_json",
1030704 typelem = json
1031705 }
1032706
1033−array_jsonOid :: Oid
1034−array_jsonOid = Oid 199
1035−{-# INLINE array_jsonOid #-}
1036−
1037707array_line :: TypeInfo
1038708array_line = Array {
1039− typoid = array_lineOid,
709+ typoid = Oid 629,
1040710 typcategory = 'A',
1041711 typdelim = ',',
1042712 typname = "_line",
1043713 typelem = line
1044714 }
1045715
1046−array_lineOid :: Oid
1047−array_lineOid = Oid 629
1048−{-# INLINE array_lineOid #-}
1049−
1050716array_cidr :: TypeInfo
1051717array_cidr = Array {
1052− typoid = array_cidrOid,
718+ typoid = Oid 651,
1053719 typcategory = 'A',
1054720 typdelim = ',',
1055721 typname = "_cidr",
1056722 typelem = cidr
1057723 }
1058724
1059−array_cidrOid :: Oid
1060−array_cidrOid = Oid 651
1061−{-# INLINE array_cidrOid #-}
1062−
1063725array_circle :: TypeInfo
1064726array_circle = Array {
1065− typoid = array_circleOid,
727+ typoid = Oid 719,
1066728 typcategory = 'A',
1067729 typdelim = ',',
1068730 typname = "_circle",
1069731 typelem = circle
1070732 }
1071733
1072−array_circleOid :: Oid
1073−array_circleOid = Oid 719
1074−{-# INLINE array_circleOid #-}
1075−
1076734array_money :: TypeInfo
1077735array_money = Array {
1078− typoid = array_moneyOid,
736+ typoid = Oid 791,
1079737 typcategory = 'A',
1080738 typdelim = ',',
1081739 typname = "_money",
1082740 typelem = money
1083741 }
1084742
1085−array_moneyOid :: Oid
1086−array_moneyOid = Oid 791
1087−{-# INLINE array_moneyOid #-}
1088−
1089743array_bool :: TypeInfo
1090744array_bool = Array {
1091− typoid = array_boolOid,
745+ typoid = Oid 1000,
1092746 typcategory = 'A',
1093747 typdelim = ',',
1094748 typname = "_bool",
1095749 typelem = bool
1096750 }
1097751
1098−array_boolOid :: Oid
1099−array_boolOid = Oid 1000
1100−{-# INLINE array_boolOid #-}
1101−
1102752array_bytea :: TypeInfo
1103753array_bytea = Array {
1104− typoid = array_byteaOid,
754+ typoid = Oid 1001,
1105755 typcategory = 'A',
1106756 typdelim = ',',
1107757 typname = "_bytea",
1108758 typelem = bytea
1109759 }
1110760
1111−array_byteaOid :: Oid
1112−array_byteaOid = Oid 1001
1113−{-# INLINE array_byteaOid #-}
1114−
1115761array_char :: TypeInfo
1116762array_char = Array {
1117− typoid = array_charOid,
763+ typoid = Oid 1002,
1118764 typcategory = 'A',
1119765 typdelim = ',',
1120766 typname = "_char",
1121767 typelem = char
1122768 }
1123769
1124−array_charOid :: Oid
1125−array_charOid = Oid 1002
1126−{-# INLINE array_charOid #-}
1127−
1128770array_name :: TypeInfo
1129771array_name = Array {
1130− typoid = array_nameOid,
772+ typoid = Oid 1003,
1131773 typcategory = 'A',
1132774 typdelim = ',',
1133775 typname = "_name",
1134776 typelem = name
1135777 }
1136778
1137−array_nameOid :: Oid
1138−array_nameOid = Oid 1003
1139−{-# INLINE array_nameOid #-}
1140−
1141779array_int2 :: TypeInfo
1142780array_int2 = Array {
1143− typoid = array_int2Oid,
781+ typoid = Oid 1005,
1144782 typcategory = 'A',
1145783 typdelim = ',',
1146784 typname = "_int2",
1147785 typelem = int2
1148786 }
1149787
1150−array_int2Oid :: Oid
1151−array_int2Oid = Oid 1005
1152−{-# INLINE array_int2Oid #-}
1153−
1154788array_int2vector :: TypeInfo
1155789array_int2vector = Array {
1156− typoid = array_int2vectorOid,
790+ typoid = Oid 1006,
1157791 typcategory = 'A',
1158792 typdelim = ',',
1159793 typname = "_int2vector",
1160794 typelem = int2vector
1161795 }
1162796
1163−array_int2vectorOid :: Oid
1164−array_int2vectorOid = Oid 1006
1165−{-# INLINE array_int2vectorOid #-}
1166−
1167797array_int4 :: TypeInfo
1168798array_int4 = Array {
1169− typoid = array_int4Oid,
799+ typoid = Oid 1007,
1170800 typcategory = 'A',
1171801 typdelim = ',',
1172802 typname = "_int4",
1173803 typelem = int4
1174804 }
1175805
1176−array_int4Oid :: Oid
1177−array_int4Oid = Oid 1007
1178−{-# INLINE array_int4Oid #-}
1179−
1180806array_regproc :: TypeInfo
1181807array_regproc = Array {
1182− typoid = array_regprocOid,
808+ typoid = Oid 1008,
1183809 typcategory = 'A',
1184810 typdelim = ',',
1185811 typname = "_regproc",
1186812 typelem = regproc
1187813 }
1188814
1189−array_regprocOid :: Oid
1190−array_regprocOid = Oid 1008
1191−{-# INLINE array_regprocOid #-}
1192−
1193815array_text :: TypeInfo
1194816array_text = Array {
1195− typoid = array_textOid,
817+ typoid = Oid 1009,
1196818 typcategory = 'A',
1197819 typdelim = ',',
1198820 typname = "_text",
1199821 typelem = text
1200822 }
1201823
1202−array_textOid :: Oid
1203−array_textOid = Oid 1009
1204−{-# INLINE array_textOid #-}
1205−
1206824array_tid :: TypeInfo
1207825array_tid = Array {
1208− typoid = array_tidOid,
826+ typoid = Oid 1010,
1209827 typcategory = 'A',
1210828 typdelim = ',',
1211829 typname = "_tid",
1212830 typelem = tid
1213831 }
1214832
1215−array_tidOid :: Oid
1216−array_tidOid = Oid 1010
1217−{-# INLINE array_tidOid #-}
1218−
1219833array_xid :: TypeInfo
1220834array_xid = Array {
1221− typoid = array_xidOid,
835+ typoid = Oid 1011,
1222836 typcategory = 'A',
1223837 typdelim = ',',
1224838 typname = "_xid",
1225839 typelem = xid
1226840 }
1227841
1228−array_xidOid :: Oid
1229−array_xidOid = Oid 1011
1230−{-# INLINE array_xidOid #-}
1231−
1232842array_cid :: TypeInfo
1233843array_cid = Array {
1234− typoid = array_cidOid,
844+ typoid = Oid 1012,
1235845 typcategory = 'A',
1236846 typdelim = ',',
1237847 typname = "_cid",
1238848 typelem = cid
1239849 }
1240850
1241−array_cidOid :: Oid
1242−array_cidOid = Oid 1012
1243−{-# INLINE array_cidOid #-}
1244−
1245851array_oidvector :: TypeInfo
1246852array_oidvector = Array {
1247− typoid = array_oidvectorOid,
853+ typoid = Oid 1013,
1248854 typcategory = 'A',
1249855 typdelim = ',',
1250856 typname = "_oidvector",
1251857 typelem = oidvector
1252858 }
1253859
1254−array_oidvectorOid :: Oid
1255−array_oidvectorOid = Oid 1013
1256−{-# INLINE array_oidvectorOid #-}
1257−
1258860array_bpchar :: TypeInfo
1259861array_bpchar = Array {
1260− typoid = array_bpcharOid,
862+ typoid = Oid 1014,
1261863 typcategory = 'A',
1262864 typdelim = ',',
1263865 typname = "_bpchar",
1264866 typelem = bpchar
1265867 }
1266868
1267−array_bpcharOid :: Oid
1268−array_bpcharOid = Oid 1014
1269−{-# INLINE array_bpcharOid #-}
1270−
1271869array_varchar :: TypeInfo
1272870array_varchar = Array {
1273− typoid = array_varcharOid,
871+ typoid = Oid 1015,
1274872 typcategory = 'A',
1275873 typdelim = ',',
1276874 typname = "_varchar",
1277875 typelem = varchar
1278876 }
1279877
1280−array_varcharOid :: Oid
1281−array_varcharOid = Oid 1015
1282−{-# INLINE array_varcharOid #-}
1283−
1284878array_int8 :: TypeInfo
1285879array_int8 = Array {
1286− typoid = array_int8Oid,
880+ typoid = Oid 1016,
1287881 typcategory = 'A',
1288882 typdelim = ',',
1289883 typname = "_int8",
1290884 typelem = int8
1291885 }
1292886
1293−array_int8Oid :: Oid
1294−array_int8Oid = Oid 1016
1295−{-# INLINE array_int8Oid #-}
1296−
1297887array_point :: TypeInfo
1298888array_point = Array {
1299− typoid = array_pointOid,
889+ typoid = Oid 1017,
1300890 typcategory = 'A',
1301891 typdelim = ',',
1302892 typname = "_point",
1303893 typelem = point
1304894 }
1305895
1306−array_pointOid :: Oid
1307−array_pointOid = Oid 1017
1308−{-# INLINE array_pointOid #-}
1309−
1310896array_lseg :: TypeInfo
1311897array_lseg = Array {
1312− typoid = array_lsegOid,
898+ typoid = Oid 1018,
1313899 typcategory = 'A',
1314900 typdelim = ',',
1315901 typname = "_lseg",
1316902 typelem = lseg
1317903 }
1318904
1319−array_lsegOid :: Oid
1320−array_lsegOid = Oid 1018
1321−{-# INLINE array_lsegOid #-}
1322−
1323905array_path :: TypeInfo
1324906array_path = Array {
1325− typoid = array_pathOid,
907+ typoid = Oid 1019,
1326908 typcategory = 'A',
1327909 typdelim = ',',
1328910 typname = "_path",
1329911 typelem = path
1330912 }
1331913
1332−array_pathOid :: Oid
1333−array_pathOid = Oid 1019
1334−{-# INLINE array_pathOid #-}
1335−
1336914array_box :: TypeInfo
1337915array_box = Array {
1338− typoid = array_boxOid,
916+ typoid = Oid 1020,
1339917 typcategory = 'A',
1340918 typdelim = ';',
1341919 typname = "_box",
1342920 typelem = box
1343921 }
1344922
1345−array_boxOid :: Oid
1346−array_boxOid = Oid 1020
1347−{-# INLINE array_boxOid #-}
1348−
1349923array_float4 :: TypeInfo
1350924array_float4 = Array {
1351− typoid = array_float4Oid,
925+ typoid = Oid 1021,
1352926 typcategory = 'A',
1353927 typdelim = ',',
1354928 typname = "_float4",
1355929 typelem = float4
1356930 }
1357931
1358−array_float4Oid :: Oid
1359−array_float4Oid = Oid 1021
1360−{-# INLINE array_float4Oid #-}
1361−
1362932array_float8 :: TypeInfo
1363933array_float8 = Array {
1364− typoid = array_float8Oid,
934+ typoid = Oid 1022,
1365935 typcategory = 'A',
1366936 typdelim = ',',
1367937 typname = "_float8",
1368938 typelem = float8
1369939 }
1370940
1371−array_float8Oid :: Oid
1372−array_float8Oid = Oid 1022
1373−{-# INLINE array_float8Oid #-}
1374−
1375941array_polygon :: TypeInfo
1376942array_polygon = Array {
1377− typoid = array_polygonOid,
943+ typoid = Oid 1027,
1378944 typcategory = 'A',
1379945 typdelim = ',',
1380946 typname = "_polygon",
1381947 typelem = polygon
1382948 }
1383949
1384−array_polygonOid :: Oid
1385−array_polygonOid = Oid 1027
1386−{-# INLINE array_polygonOid #-}
1387−
1388950array_oid :: TypeInfo
1389951array_oid = Array {
1390− typoid = array_oidOid,
952+ typoid = Oid 1028,
1391953 typcategory = 'A',
1392954 typdelim = ',',
1393955 typname = "_oid",
1394956 typelem = oid
1395957 }
1396958
1397−array_oidOid :: Oid
1398−array_oidOid = Oid 1028
1399−{-# INLINE array_oidOid #-}
1400−
1401959array_macaddr :: TypeInfo
1402960array_macaddr = Array {
1403− typoid = array_macaddrOid,
961+ typoid = Oid 1040,
1404962 typcategory = 'A',
1405963 typdelim = ',',
1406964 typname = "_macaddr",
1407965 typelem = macaddr
1408966 }
1409967
1410−array_macaddrOid :: Oid
1411−array_macaddrOid = Oid 1040
1412−{-# INLINE array_macaddrOid #-}
1413−
1414968array_inet :: TypeInfo
1415969array_inet = Array {
1416− typoid = array_inetOid,
970+ typoid = Oid 1041,
1417971 typcategory = 'A',
1418972 typdelim = ',',
1419973 typname = "_inet",
1420974 typelem = inet
1421975 }
1422976
1423−array_inetOid :: Oid
1424−array_inetOid = Oid 1041
1425−{-# INLINE array_inetOid #-}
1426−
1427977array_timestamp :: TypeInfo
1428978array_timestamp = Array {
1429− typoid = array_timestampOid,
979+ typoid = Oid 1115,
1430980 typcategory = 'A',
1431981 typdelim = ',',
1432982 typname = "_timestamp",
1433983 typelem = timestamp
1434984 }
1435985
1436−array_timestampOid :: Oid
1437−array_timestampOid = Oid 1115
1438−{-# INLINE array_timestampOid #-}
1439−
1440986array_date :: TypeInfo
1441987array_date = Array {
1442− typoid = array_dateOid,
988+ typoid = Oid 1182,
1443989 typcategory = 'A',
1444990 typdelim = ',',
1445991 typname = "_date",
1446992 typelem = date
1447993 }
1448994
1449−array_dateOid :: Oid
1450−array_dateOid = Oid 1182
1451−{-# INLINE array_dateOid #-}
1452−
1453995array_time :: TypeInfo
1454996array_time = Array {
1455− typoid = array_timeOid,
997+ typoid = Oid 1183,
1456998 typcategory = 'A',
1457999 typdelim = ',',
14581000 typname = "_time",
14591001 typelem = time
14601002 }
14611003
1462−array_timeOid :: Oid
1463−array_timeOid = Oid 1183
1464−{-# INLINE array_timeOid #-}
1465−
14661004array_timestamptz :: TypeInfo
14671005array_timestamptz = Array {
1468− typoid = array_timestamptzOid,
1006+ typoid = Oid 1185,
14691007 typcategory = 'A',
14701008 typdelim = ',',
14711009 typname = "_timestamptz",
14721010 typelem = timestamptz
14731011 }
14741012
1475−array_timestamptzOid :: Oid
1476−array_timestamptzOid = Oid 1185
1477−{-# INLINE array_timestamptzOid #-}
1478−
14791013array_interval :: TypeInfo
14801014array_interval = Array {
1481− typoid = array_intervalOid,
1015+ typoid = Oid 1187,
14821016 typcategory = 'A',
14831017 typdelim = ',',
14841018 typname = "_interval",
14851019 typelem = interval
14861020 }
14871021
1488−array_intervalOid :: Oid
1489−array_intervalOid = Oid 1187
1490−{-# INLINE array_intervalOid #-}
1491−
14921022array_numeric :: TypeInfo
14931023array_numeric = Array {
1494− typoid = array_numericOid,
1024+ typoid = Oid 1231,
14951025 typcategory = 'A',
14961026 typdelim = ',',
14971027 typname = "_numeric",
14981028 typelem = numeric
14991029 }
15001030
1501−array_numericOid :: Oid
1502−array_numericOid = Oid 1231
1503−{-# INLINE array_numericOid #-}
1504−
15051031array_timetz :: TypeInfo
15061032array_timetz = Array {
1507− typoid = array_timetzOid,
1033+ typoid = Oid 1270,
15081034 typcategory = 'A',
15091035 typdelim = ',',
15101036 typname = "_timetz",
15111037 typelem = timetz
15121038 }
15131039
1514−array_timetzOid :: Oid
1515−array_timetzOid = Oid 1270
1516−{-# INLINE array_timetzOid #-}
1517−
15181040array_bit :: TypeInfo
15191041array_bit = Array {
1520− typoid = array_bitOid,
1042+ typoid = Oid 1561,
15211043 typcategory = 'A',
15221044 typdelim = ',',
15231045 typname = "_bit",
15241046 typelem = bit
15251047 }
15261048
1527−array_bitOid :: Oid
1528−array_bitOid = Oid 1561
1529−{-# INLINE array_bitOid #-}
1530−
15311049array_varbit :: TypeInfo
15321050array_varbit = Array {
1533− typoid = array_varbitOid,
1051+ typoid = Oid 1563,
15341052 typcategory = 'A',
15351053 typdelim = ',',
15361054 typname = "_varbit",
15371055 typelem = varbit
15381056 }
15391057
1540−array_varbitOid :: Oid
1541−array_varbitOid = Oid 1563
1542−{-# INLINE array_varbitOid #-}
1543−
15441058array_refcursor :: TypeInfo
15451059array_refcursor = Array {
1546− typoid = array_refcursorOid,
1060+ typoid = Oid 2201,
15471061 typcategory = 'A',
15481062 typdelim = ',',
15491063 typname = "_refcursor",
15501064 typelem = refcursor
15511065 }
15521066
1553−array_refcursorOid :: Oid
1554−array_refcursorOid = Oid 2201
1555−{-# INLINE array_refcursorOid #-}
1556−
15571067array_regprocedure :: TypeInfo
15581068array_regprocedure = Array {
1559− typoid = array_regprocedureOid,
1069+ typoid = Oid 2207,
15601070 typcategory = 'A',
15611071 typdelim = ',',
15621072 typname = "_regprocedure",
15631073 typelem = regprocedure
15641074 }
15651075
1566−array_regprocedureOid :: Oid
1567−array_regprocedureOid = Oid 2207
1568−{-# INLINE array_regprocedureOid #-}
1569−
15701076array_regoper :: TypeInfo
15711077array_regoper = Array {
1572− typoid = array_regoperOid,
1078+ typoid = Oid 2208,
15731079 typcategory = 'A',
15741080 typdelim = ',',
15751081 typname = "_regoper",
15761082 typelem = regoper
15771083 }
15781084
1579−array_regoperOid :: Oid
1580−array_regoperOid = Oid 2208
1581−{-# INLINE array_regoperOid #-}
1582−
15831085array_regoperator :: TypeInfo
15841086array_regoperator = Array {
1585− typoid = array_regoperatorOid,
1087+ typoid = Oid 2209,
15861088 typcategory = 'A',
15871089 typdelim = ',',
15881090 typname = "_regoperator",
15891091 typelem = regoperator
15901092 }
15911093
1592−array_regoperatorOid :: Oid
1593−array_regoperatorOid = Oid 2209
1594−{-# INLINE array_regoperatorOid #-}
1595−
15961094array_regclass :: TypeInfo
15971095array_regclass = Array {
1598− typoid = array_regclassOid,
1096+ typoid = Oid 2210,
15991097 typcategory = 'A',
16001098 typdelim = ',',
16011099 typname = "_regclass",
16021100 typelem = regclass
16031101 }
16041102
1605−array_regclassOid :: Oid
1606−array_regclassOid = Oid 2210
1607−{-# INLINE array_regclassOid #-}
1608−
16091103array_regtype :: TypeInfo
16101104array_regtype = Array {
1611− typoid = array_regtypeOid,
1105+ typoid = Oid 2211,
16121106 typcategory = 'A',
16131107 typdelim = ',',
16141108 typname = "_regtype",
16151109 typelem = regtype
16161110 }
16171111
1618−array_regtypeOid :: Oid
1619−array_regtypeOid = Oid 2211
1620−{-# INLINE array_regtypeOid #-}
1621−
16221112array_uuid :: TypeInfo
16231113array_uuid = Array {
1624− typoid = array_uuidOid,
1114+ typoid = Oid 2951,
16251115 typcategory = 'A',
16261116 typdelim = ',',
16271117 typname = "_uuid",
16281118 typelem = uuid
16291119 }
16301120
1631−array_uuidOid :: Oid
1632−array_uuidOid = Oid 2951
1633−{-# INLINE array_uuidOid #-}
1634−
16351121array_jsonb :: TypeInfo
16361122array_jsonb = Array {
1637− typoid = array_jsonbOid,
1123+ typoid = Oid 3807,
16381124 typcategory = 'A',
16391125 typdelim = ',',
16401126 typname = "_jsonb",
16411127 typelem = jsonb
16421128 }
16431129
1644−array_jsonbOid :: Oid
1645−array_jsonbOid = Oid 3807
1646−{-# INLINE array_jsonbOid #-}
1647−
16481130int4range :: TypeInfo
16491131int4range = Range {
1650− typoid = int4rangeOid,
1132+ typoid = Oid 3904,
16511133 typcategory = 'R',
16521134 typdelim = ',',
16531135 typname = "int4range",
16541136 rngsubtype = int4
16551137 }
16561138
1657−int4rangeOid :: Oid
1658−int4rangeOid = Oid 3904
1659−{-# INLINE int4rangeOid #-}
1660−
16611139_int4range :: TypeInfo
16621140_int4range = Array {
1663− typoid = _int4rangeOid,
1141+ typoid = Oid 3905,
16641142 typcategory = 'A',
16651143 typdelim = ',',
16661144 typname = "_int4range",
16671145 typelem = int4range
16681146 }
16691147
1670−_int4rangeOid :: Oid
1671−_int4rangeOid = Oid 3905
1672−{-# INLINE _int4rangeOid #-}
1673−
16741148numrange :: TypeInfo
16751149numrange = Range {
1676− typoid = numrangeOid,
1150+ typoid = Oid 3906,
16771151 typcategory = 'R',
16781152 typdelim = ',',
16791153 typname = "numrange",
16801154 rngsubtype = numeric
16811155 }
16821156
1683−numrangeOid :: Oid
1684−numrangeOid = Oid 3906
1685−{-# INLINE numrangeOid #-}
1686−
16871157_numrange :: TypeInfo
16881158_numrange = Array {
1689− typoid = _numrangeOid,
1159+ typoid = Oid 3907,
16901160 typcategory = 'A',
16911161 typdelim = ',',
16921162 typname = "_numrange",
16931163 typelem = numrange
16941164 }
16951165
1696−_numrangeOid :: Oid
1697−_numrangeOid = Oid 3907
1698−{-# INLINE _numrangeOid #-}
1699−
17001166tsrange :: TypeInfo
17011167tsrange = Range {
1702− typoid = tsrangeOid,
1168+ typoid = Oid 3908,
17031169 typcategory = 'R',
17041170 typdelim = ',',
17051171 typname = "tsrange",
17061172 rngsubtype = timestamp
17071173 }
17081174
1709−tsrangeOid :: Oid
1710−tsrangeOid = Oid 3908
1711−{-# INLINE tsrangeOid #-}
1712−
17131175_tsrange :: TypeInfo
17141176_tsrange = Array {
1715− typoid = _tsrangeOid,
1177+ typoid = Oid 3909,
17161178 typcategory = 'A',
17171179 typdelim = ',',
17181180 typname = "_tsrange",
17191181 typelem = tsrange
17201182 }
17211183
1722−_tsrangeOid :: Oid
1723−_tsrangeOid = Oid 3909
1724−{-# INLINE _tsrangeOid #-}
1725−
17261184tstzrange :: TypeInfo
17271185tstzrange = Range {
1728− typoid = tstzrangeOid,
1186+ typoid = Oid 3910,
17291187 typcategory = 'R',
17301188 typdelim = ',',
17311189 typname = "tstzrange",
17321190 rngsubtype = timestamptz
17331191 }
17341192
1735−tstzrangeOid :: Oid
1736−tstzrangeOid = Oid 3910
1737−{-# INLINE tstzrangeOid #-}
1738−
17391193_tstzrange :: TypeInfo
17401194_tstzrange = Array {
1741− typoid = _tstzrangeOid,
1195+ typoid = Oid 3911,
17421196 typcategory = 'A',
17431197 typdelim = ',',
17441198 typname = "_tstzrange",
17451199 typelem = tstzrange
17461200 }
17471201
1748−_tstzrangeOid :: Oid
1749−_tstzrangeOid = Oid 3911
1750−{-# INLINE _tstzrangeOid #-}
1751−
17521202daterange :: TypeInfo
17531203daterange = Range {
1754− typoid = daterangeOid,
1204+ typoid = Oid 3912,
17551205 typcategory = 'R',
17561206 typdelim = ',',
17571207 typname = "daterange",
17581208 rngsubtype = date
17591209 }
17601210
1761−daterangeOid :: Oid
1762−daterangeOid = Oid 3912
1763−{-# INLINE daterangeOid #-}
1764−
17651211_daterange :: TypeInfo
17661212_daterange = Array {
1767− typoid = _daterangeOid,
1213+ typoid = Oid 3913,
17681214 typcategory = 'A',
17691215 typdelim = ',',
17701216 typname = "_daterange",
17711217 typelem = daterange
17721218 }
17731219
1774−_daterangeOid :: Oid
1775−_daterangeOid = Oid 3913
1776−{-# INLINE _daterangeOid #-}
1777−
17781220int8range :: TypeInfo
17791221int8range = Range {
1780− typoid = int8rangeOid,
1222+ typoid = Oid 3926,
17811223 typcategory = 'R',
17821224 typdelim = ',',
17831225 typname = "int8range",
17841226 rngsubtype = int8
17851227 }
17861228
1787−int8rangeOid :: Oid
1788−int8rangeOid = Oid 3926
1789−{-# INLINE int8rangeOid #-}
1790−
17911229_int8range :: TypeInfo
17921230_int8range = Array {
1793− typoid = _int8rangeOid,
1231+ typoid = Oid 3927,
17941232 typcategory = 'A',
17951233 typdelim = ',',
17961234 typname = "_int8range",
17971235 typelem = int8range
17981236 }
17991237
1800−_int8rangeOid :: Oid
1801−_int8rangeOid = Oid 3927
1802−{-# INLINE _int8rangeOid #-}
1238+citext :: TypeInfo
1239+citext = Basic {
1240+ typoid = Oid 60129,
1241+ typcategory = 'S',
1242+ typdelim = ',',
1243+ typname = "citext"
1244+ }
1245+
1246+array_citext :: TypeInfo
1247+array_citext = Array {
1248+ typoid = Oid 60134,
1249+ typcategory = 'A',
1250+ typdelim = ',',
1251+ typname = "_citext",
1252+ typelem = citext
1253+ }
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+32−179
@@ -3,39 +3,25 @@
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
4026import Data.CaseInsensitive (CI)
4127import qualified Data.CaseInsensitive as CI
@@ -46,46 +32,38 @@ import qualified Data.Text.Encoding as T
4632import qualified Data.Vector as V
4733import System.FilePath
4834import System.Timeout(timeout)
49−import Data.Time.Compat (getCurrentTime, diffUTCTime)
50−import System.Environment (getEnvironment)
35+import Data.Time(getCurrentTime, diffUTCTime)
5136
5237import Test.Tasty
5338import Test.Tasty.Golden
5439import Notify
5540import Serializable
5641import Time
57−import Interval
58−import Exception (testExceptions)
5942
6043tests :: TestEnv -> TestTree
6144tests env = testGroup "tests"
6245 $ map ($ env)
6346 [ 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
47+ , testCase "ExecuteMany" . testExecuteMany
48+ , testCase "Fold" . testFold
49+ , testCase "Notify" . testNotify
50+ , testCase "Serializable" . testSerializable
51+ , testCase "Time" . testTime
52+ , testCase "Array" . testArray
53+ , testCase "Array of nullables" . testNullableArray
54+ , testCase "HStore" . testHStore
55+ , testCase "citext" . testCIText
56+ , testCase "JSON" . testJSON
57+ , testCase "Savepoint" . testSavepoint
58+ , testCase "Unicode" . testUnicode
59+ , testCase "Values" . testValues
60+ , testCase "Copy" . testCopy
8261 , 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
62+ , testCase "Double" . testDouble
63+ , testCase "1-ary generic" . testGeneric1
64+ , testCase "2-ary generic" . testGeneric2
65+ , testCase "3-ary generic" . testGeneric3
66+ , testCase "Timeout" . testTimeout
8967 ]
9068
9169testBytea :: TestEnv -> TestTree
@@ -139,7 +117,7 @@ testFold TestEnv{..} = do
139117 xs <- readIORef ref
140118 writeIORef ref $! (a,b):xs
141119 xs <- readIORef ref
142− reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]
120+ reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
143121
144122 -- Make sure fold propagates our exception.
145123 ref <- newIORef []
@@ -256,90 +234,6 @@ testJSON TestEnv{..} = do
256234 js' <- query conn "SELECT ?::json" js
257235 [js] @?= js'
258236
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−
343237testSavepoint :: TestEnv -> Assertion
344238testSavepoint TestEnv{..} = do
345239 True <- expectError ST.isNoActiveTransactionError $
@@ -447,14 +341,6 @@ testCopy TestEnv{..} = do
447341 -- so that we can issue more queries:
448342 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
449343 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
458344 where
459345 copyRows = ["1,foo\n"
460346 ,"2,bar\n"]
@@ -474,13 +360,12 @@ testCopyFailures env = testGroup "Copy failures"
474360
475361goldenTest :: TestName -> IO BL.ByteString -> TestTree
476362goldenTest testName =
477− goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")
363+ goldenVsString testName (resultsDir </> fileName<.>"expected")
478364 where
479365 resultsDir = "test" </> "results"
480366 fileName = map normalize testName
481367 normalize c | not (isAlpha c) = '-'
482368 | otherwise = c
483− diff ref new = ["diff", "-u", ref, new]
484369
485370-- | Test that we provide a sensible error message on failure
486371testCopyUniqueConstraintError :: TestEnv -> TestTree
@@ -593,56 +478,24 @@ isUniqueViolation SqlError{..} = sqlState == "23505"
593478isSyntaxError :: SqlError -> Bool
594479isSyntaxError SqlError{..} = sqlState == "42601"
595480
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− ]
604481------------------------------------------------------------------------
605482
606483-- | Action for connecting to the database that will be used for testing.
607484--
608485-- Note that some tests, such as Notify, use multiple connections, and assume
609486-- 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'"
487+testConnect :: IO Connection
488+testConnect = connectPostgreSQL ""
616489
490+withTestEnv :: (TestEnv -> IO a) -> IO a
491+withTestEnv cb =
492+ withConn $ \conn ->
617493 cb TestEnv
618494 { conn = conn
619495 , withConn = withConn
620496 }
621497 where
622− withConn = bracket (connectPostgreSQL connstr) close
498+ withConn = bracket testConnect close
623499
624500main :: 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− ]
501+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+28−40
@@ -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
@@ -196,7 +195,12 @@ daterange
196195_daterange
197196int8range
198197_int8range
199−|]
198+citext
199+_citext array_citext
200+|] -- Note: You must enable the citext extension (CREATE EXTENSION IF NOT EXISTS citext) to generate the citext values
201+
202+instance IsString Blaze.Builder where
203+ fromString = Blaze.fromByteString . fromString
200204
201205connectionString = "dbname=postgres"
202206
@@ -235,7 +239,7 @@ getTypeInfos typnames = withPostgreSQL $ \conn -> do
235239
236240main = do
237241 (oidmap, namemap) <- getTypeInfos typeNames
238− L.writeFile "src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"
242+ L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"
239243 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))
240244
241245
@@ -244,7 +248,7 @@ showOid (Oid n) = show n
244248renderOid :: NameMap -> TypeName -> Blaze.Builder
245249renderOid byName name
246250 = case Map.lookup (pg name) byName of
247− Nothing -> error (B8.unpack (pg name))
251+ Nothing -> error (B.unpack (pg name))
248252 Just (showOid . typoid -> n) -> fromString n
249253 ++ fromString (replicate (4 - length n) ' ')
250254
@@ -262,25 +266,20 @@ renderTypeInfo byOid info name
262266 typelem_hs_name =
263267 case lookup (typname typelem_info) typeNames of
264268 Nothing -> error ( "type not found: "
265− ++ B8.unpack( typname typelem_info)
266− ++ " (typelem of " ++ B8.unpack (typname info)
269+ ++ B.unpack( typname typelem_info)
270+ ++ " (typelem of " ++ B.unpack (typname info)
267271 ++ ")")
268272 Just x -> x
269273 in concat
270274 [ "\n"
271275 , bs (hs name), " :: TypeInfo\n"
272276 , 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"
277+ , " typoid = ", fromString (show (typoid info)), ",\n"
278+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
279+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
276280 , " typname = \"", bs (typname info), "\",\n"
277281 , " typelem = ", bs typelem_hs_name, "\n"
278282 , " }\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"
284283 ]
285284 | typcategory info == 'R' =
286285 let (Just rngsubtype_oid) = rngsubtype info
@@ -288,41 +287,31 @@ renderTypeInfo byOid info name
288287 rngsubtype_hs_name =
289288 case lookup (typname rngsubtype_info) typeNames of
290289 Nothing -> error ( "type not found: "
291− ++ B8.unpack (typname rngsubtype_info)
290+ ++ B.unpack (typname rngsubtype_info)
292291 ++ " (rngsubtype of "
293− ++ B8.unpack (typname info) ++ ")")
292+ ++ B.unpack (typname info) ++ ")")
294293 Just x -> x
295294 in concat
296295 [ "\n"
297296 , bs (hs name), " :: TypeInfo\n"
298297 , 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"
298+ , " typoid = ", fromString (show (typoid info)), ",\n"
299+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
300+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
302301 , " typname = \"", bs (typname info), "\",\n"
303302 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"
304303 , " }\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"
310304 ]
311305 | otherwise =
312306 concat
313307 [ "\n"
314308 , bs (hs name), " :: TypeInfo\n"
315309 , 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"
310+ , " typoid = ", fromString (show (typoid info)), ",\n"
311+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
312+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
319313 , " typname = \"", bs (typname info), "\"\n"
320314 , " }\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"
326315 ]
327316
328317-- FIXME: add in any names that we need that we didn't specify, (i.e.
@@ -331,7 +320,7 @@ renderTypeInfo byOid info name
331320getNames :: NameMap -> TypeNames -> TypeNames
332321getNames _ x = x
333322
334−bs = Blaze.byteString
323+bs = Blaze.fromByteString
335324
336325pg = fst
337326
@@ -360,7 +349,6 @@ module Database.PostgreSQL.Simple.TypeInfo.Static
360349 ( TypeInfo(..)
361350 , staticTypeInfo
362351|] ++ concat [ " , " ++ bs (hs name) ++ "\n"
363− ++ " , " ++ bs (hs name) ++ "Oid\n"
364352 | name <- names ] ++ [longstring|
365353 ) where
366354