git.iko.soy/typeable/postgresql-simple
on 81bf589 help sign in
3ac2949
swap
0 ahead, 249 behind
59 files changed+1002−4027
since splitsnapshots
unifiedsplit
.ghci+16 .github/workflows/haskell-ci.yml−256 .github/workflows/simple.yml−58 .gitignore−6 .travis.yml+11 CHANGES.md+76−327 CONTRIBUTING.md−13 CONTRIBUTORS−7 README.md+3 bench/Select.hs−32 cabal.haskell-ci−5 cabal.project−4 cabal.project.local.win−4 postgresql-simple.cabal+95−153 sdist.sh−25 src/Database/PostgreSQL/Simple.hs+98−38 src/Database/PostgreSQL/Simple/Arrays.hs+2−2 src/Database/PostgreSQL/Simple/Compat.hs+44 src/Database/PostgreSQL/Simple/Copy.hs+6−36 src/Database/PostgreSQL/Simple/Cursor.hs−98 src/Database/PostgreSQL/Simple/Errors.hs+11−12 src/Database/PostgreSQL/Simple/FromField.hs+77−152 src/Database/PostgreSQL/Simple/FromRow.hs+6−239 src/Database/PostgreSQL/Simple/HStore.hs+2−2 src/Database/PostgreSQL/Simple/HStore/Implementation.hs+11−11 src/Database/PostgreSQL/Simple/HStore/Internal.hs+2 src/Database/PostgreSQL/Simple/Internal.hs+25−84 src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs−123 src/Database/PostgreSQL/Simple/LargeObjects.hs+1−1 src/Database/PostgreSQL/Simple/Newtypes.hs−49 src/Database/PostgreSQL/Simple/Notification.hs+32−62 src/Database/PostgreSQL/Simple/Ok.hs+4−10 src/Database/PostgreSQL/Simple/Range.hs+10−14 src/Database/PostgreSQL/Simple/SqlQQ.hs+9−10 src/Database/PostgreSQL/Simple/Time.hs+50−215 src/Database/PostgreSQL/Simple/Time/Implementation.hs+108−23 src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs−135 src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs → src/Database/PostgreSQL/Simple/Time/Parser.hs+12−24 src/Database/PostgreSQL/Simple/ToField.hs+17−42 src/Database/PostgreSQL/Simple/ToRow.hs−127 src/Database/PostgreSQL/Simple/ToRow.hs-boot+1−10 src/Database/PostgreSQL/Simple/Transaction.hs+17−35 src/Database/PostgreSQL/Simple/TypeInfo.hs+9−9 src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs+3−9 src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+114−684 src/Database/PostgreSQL/Simple/Types.hs+30−54 src/Database/PostgreSQL/Simple/Vector.hs−45 src/Database/PostgreSQL/Simple/Vector/Unboxed.hs−44 test/Common.hs+2−2 test/Exception.hs−70 test/Inspection.hs−79 test/Interval.hs−176 test/Main.hs+59−343 test/Notify.hs+2−1 test/Serializable.hs+2−1 test/Time.hs+10−18 test/results/malformed-input.expected−4 test/results/unique-constraint-violation.expected−5 tools/GenTypeInfo.hs+25−39
.ghcinew file+16
@@ -0,0 +1,16 @@
1+:set -isrc -itest -optP-includedist/build/autogen/cabal_macros.h
2+:set -Wall -fno-warn-name-shadowing
3+
4+:set -XDoAndIfThenElse
5+:set -XOverloadedStrings
6+:set -XBangPatterns
7+:set -XViewPatterns
8+:set -XTypeOperators
9+
10+-- for tests
11+:set -XNamedFieldPuns
12+:set -XRank2Types
13+:set -XRecordWildCards
14+:set -XPatternGuards
15+:set -XScopedTypeVariables
16+:set -fno-warn-unused-do-bind
.github/workflows/haskell-ci.ymldeleted−256
@@ -1,256 +0,0 @@
1−# This GitHub workflow config has been generated by a script via
2−#
3−# haskell-ci 'github' 'cabal.project'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.17.20231110
12−#
13−# REGENDATA ("0.17.20231110",["github","cabal.project"])
14−#
15−name: Haskell-CI
16−on:
17− push:
18− branches:
19− - master
20− pull_request:
21− branches:
22− - master
23−jobs:
24− linux:
25− name: Haskell-CI - Linux - ${{ matrix.compiler }}
26− runs-on: ubuntu-20.04
27− timeout-minutes:
28− 60
29− container:
30− image: buildpack-deps:bionic
31− services:
32− postgres:
33− image: postgres:14
34− env:
35− POSTGRES_PASSWORD: postgres
36− options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5
37− continue-on-error: ${{ matrix.allow-failure }}
38− strategy:
39− matrix:
40− include:
41− - compiler: ghc-9.8.1
42− compilerKind: ghc
43− compilerVersion: 9.8.1
44− setup-method: ghcup
45− allow-failure: false
46− - compiler: ghc-9.6.3
47− compilerKind: ghc
48− compilerVersion: 9.6.3
49− setup-method: ghcup
50− allow-failure: false
51− - compiler: ghc-9.4.8
52− compilerKind: ghc
53− compilerVersion: 9.4.8
54− setup-method: ghcup
55− allow-failure: false
56− - compiler: ghc-9.2.8
57− compilerKind: ghc
58− compilerVersion: 9.2.8
59− setup-method: ghcup
60− allow-failure: false
61− - compiler: ghc-9.0.2
62− compilerKind: ghc
63− compilerVersion: 9.0.2
64− setup-method: ghcup
65− allow-failure: false
66− - compiler: ghc-8.10.7
67− compilerKind: ghc
68− compilerVersion: 8.10.7
69− setup-method: ghcup
70− allow-failure: false
71− - compiler: ghc-8.8.4
72− compilerKind: ghc
73− compilerVersion: 8.8.4
74− setup-method: hvr-ppa
75− allow-failure: false
76− - compiler: ghc-8.6.5
77− compilerKind: ghc
78− compilerVersion: 8.6.5
79− setup-method: hvr-ppa
80− allow-failure: false
81− fail-fast: false
82− steps:
83− - name: apt
84− run: |
85− apt-get update
86− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
87− if [ "${{ matrix.setup-method }}" = ghcup ]; then
88− mkdir -p "$HOME/.ghcup/bin"
89− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
90− chmod a+x "$HOME/.ghcup/bin/ghcup"
91− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
92− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
93− else
94− apt-add-repository -y 'ppa:hvr/ghc'
95− apt-get update
96− apt-get install -y "$HCNAME"
97− mkdir -p "$HOME/.ghcup/bin"
98− curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
99− chmod a+x "$HOME/.ghcup/bin/ghcup"
100− "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
101− fi
102− env:
103− HCKIND: ${{ matrix.compilerKind }}
104− HCNAME: ${{ matrix.compiler }}
105− HCVER: ${{ matrix.compilerVersion }}
106− - name: Set PATH and environment variables
107− run: |
108− echo "$HOME/.cabal/bin" >> $GITHUB_PATH
109− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
110− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
111− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
112− HCDIR=/opt/$HCKIND/$HCVER
113− if [ "${{ matrix.setup-method }}" = ghcup ]; then
114− HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
115− HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
116− HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
117− echo "HC=$HC" >> "$GITHUB_ENV"
118− echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
119− echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
120− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
121− else
122− HC=$HCDIR/bin/$HCKIND
123− echo "HC=$HC" >> "$GITHUB_ENV"
124− echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
125− echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
126− echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
127− fi
128−
129− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
130− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
131− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
132− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
133− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
134− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
135− echo "GHCJSARITH=0" >> "$GITHUB_ENV"
136− env:
137− HCKIND: ${{ matrix.compilerKind }}
138− HCNAME: ${{ matrix.compiler }}
139− HCVER: ${{ matrix.compilerVersion }}
140− - name: env
141− run: |
142− env
143− - name: write cabal config
144− run: |
145− mkdir -p $CABAL_DIR
146− cat >> $CABAL_CONFIG <<EOF
147− remote-build-reporting: anonymous
148− write-ghc-environment-files: never
149− remote-repo-cache: $CABAL_DIR/packages
150− logs-dir: $CABAL_DIR/logs
151− world-file: $CABAL_DIR/world
152− extra-prog-path: $CABAL_DIR/bin
153− symlink-bindir: $CABAL_DIR/bin
154− installdir: $CABAL_DIR/bin
155− build-summary: $CABAL_DIR/logs/build.log
156− store-dir: $CABAL_DIR/store
157− install-dirs user
158− prefix: $CABAL_DIR
159− repository hackage.haskell.org
160− url: http://hackage.haskell.org/
161− EOF
162− cat >> $CABAL_CONFIG <<EOF
163− program-default-options
164− ghc-options: $GHCJOBS +RTS -M3G -RTS
165− EOF
166− cat $CABAL_CONFIG
167− - name: versions
168− run: |
169− $HC --version || true
170− $HC --print-project-git-commit-id || true
171− $CABAL --version || true
172− - name: update cabal index
173− run: |
174− $CABAL v2-update -v
175− - name: install cabal-plan
176− run: |
177− mkdir -p $HOME/.cabal/bin
178− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
179− echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
180− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
181− rm -f cabal-plan.xz
182− chmod a+x $HOME/.cabal/bin/cabal-plan
183− cabal-plan --version
184− - name: checkout
185− uses: actions/checkout@v3
186− with:
187− path: source
188− - name: initial cabal.project for sdist
189− run: |
190− touch cabal.project
191− echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
192− cat cabal.project
193− - name: sdist
194− run: |
195− mkdir -p sdist
196− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
197− - name: unpack
198− run: |
199− mkdir -p unpacked
200− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
201− - name: generate cabal.project
202− run: |
203− PKGDIR_postgresql_simple="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"
204− echo "PKGDIR_postgresql_simple=${PKGDIR_postgresql_simple}" >> "$GITHUB_ENV"
205− rm -f cabal.project cabal.project.local
206− touch cabal.project
207− touch cabal.project.local
208− echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project
209− echo "package postgresql-simple" >> cabal.project
210− echo " ghc-options: -Werror=missing-methods" >> cabal.project
211− cat >> cabal.project <<EOF
212− allow-newer: cryptohash-md5-0.11.100.1:base
213− EOF
214− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(postgresql-simple)$/; }' >> cabal.project.local
215− cat cabal.project
216− cat cabal.project.local
217− - name: dump install plan
218− run: |
219− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
220− cabal-plan
221− - name: restore cache
222− uses: actions/cache/restore@v3
223− with:
224− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
225− path: ~/.cabal/store
226− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
227− - name: install dependencies
228− run: |
229− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
230− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
231− - name: build w/o tests
232− run: |
233− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
234− - name: build
235− run: |
236− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
237− - name: tests
238− run: |
239− $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
240− - name: cabal check
241− run: |
242− cd ${PKGDIR_postgresql_simple} || false
243− ${CABAL} -vnormal check
244− - name: haddock
245− run: |
246− $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
247− - name: unconstrained build
248− run: |
249− rm -f cabal.project.local
250− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
251− - name: save cache
252− uses: actions/cache/save@v3
253− if: always()
254− with:
255− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
256− path: ~/.cabal/store
.github/workflows/simple.ymldeleted−58
@@ -1,58 +0,0 @@
1−name: Simple
2−on:
3− push:
4− branches:
5− - master
6− pull_request:
7− branches:
8− - master
9−
10−jobs:
11− native:
12− name: "Simple: GHC ${{ matrix.ghc }} on ${{ matrix.os }}"
13− runs-on: ${{ matrix.os }}
14− strategy:
15− matrix:
16− os: [macos-latest, windows-latest]
17− ghc: ['8.10','9.0','9.2','9.4.8','9.6.3','9.8.1']
18− fail-fast: false
19− timeout-minutes:
20− 60
21− steps:
22− - name: Set git to use LF
23− run: |
24− git config --global core.autocrlf false
25− git config --global core.eol lf
26−
27− - name: Set up Haskell
28− id: setup-haskell
29− uses: haskell/actions/setup@v2
30− with:
31− ghc-version: ${{ matrix.ghc }}
32− cabal-version: '3.10.2.0'
33−
34− - name: Set up PostgreSQL
35− uses: ikalnytskyi/action-setup-postgres@v3
36− id: postgres
37− with:
38− username: ci
39− password: sw0rdfish
40− database: test
41−
42− - name: Checkout
43− uses: actions/checkout@v3.0.2
44−
45− - name: Cache
46− uses: actions/cache@v2.1.3
47− with:
48− path: ${{ steps.setup-haskell.outputs.cabal-store }}
49− key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }}
50− restore-keys: ${{ runner.os }}-${{ matrix.ghc }}-
51−
52− - name: Build
53− run: cabal build all --enable-tests
54−
55− - name: Test
56− run: cabal test all --enable-tests --test-show-details=direct
57− env:
58− DATABASE_CONNSTRING: ${{ steps.postgres.outputs.connection-uri }}
.gitignore−6
@@ -7,11 +7,5 @@ dist/
77*.o
88\#*\#
99.#*
10−/CHANGELOG.md
1110.cabal-sandbox/
12−.stack-work/
1311cabal.sandbox.config
14−/dist-newstyle
15−.ghc.environment.*
16−cabal.project.local
17−dump-core
.travis.ymlnew file+11
@@ -0,0 +1,11 @@
1+language: haskell
2+
3+ghc:
4+ - 7.6
5+ - 7.8
6+
7+addons:
8+ postgresql: "9.3"
9+
10+before_install:
11+ - createdb `whoami` || true
CHANGES.md+76−327
@@ -1,297 +1,46 @@
1−### Version 0.7.0.0 (2023-07-31)
1+Version 0.5.0.0
2+ * Removed the deprecated BuiltinTypes module.
23
3− * Remove Eq Null instance. (Future `base` may break it, we remove it profilacticly).
4− * Use `postgresql-libpq >=0.10.0.0`. It includes critical fixes,
5− by using `postgresql-simple >=0.7` you won't get older `postgresql-libpq`.
6− * Drop support for GHC prior 8.6
7− * Added a class for `postgresql-simple` exceptions: `SomePostgreSqlException`.
8− This allows to catch all `postgresql-simple` exceptions at once.
9− (c.f. `AsyncException` in `base).
10−
11−### Version 0.6.5.1 (2023-07-09)
12−
13− * Support `aeson-2.2.0.0`
14−
15−### Version 0.6.5 (2022-10-30)
16−
17− * Add `withConnect`
18−
19−### Version 0.6.4 (2021-01-06)
20−
21− * Add foldCopyData helper function
22− Thanks to Sebastián Estrella for the implementation
23− https://github.com/haskellari/postgresql-simple/pull/56
24− * Implement support for postgresql 'interval' type
25− Thanks to Andre Marques Lee for the implementation
26− https://github.com/haskellari/postgresql-simple/pull/60
27− * Depend on `time-compat` to provide uniform `time` related interface.
28−
29−### Version 0.6.3 (2020-11-15)
30−
31− * Add `fromFieldJSONByteString`
32− Thanks to tomjaguarpaw for the implementation
33− https://github.com/haskellari/postgresql-simple/pull/47
34− * Add `attoFieldParser`
35− Thanks to Victor Nawothnig for the implementation
36− https://github.com/haskellari/postgresql-simple/pull/45
37− * Add `Identity` and `Const` instance
38− Thanks to Cary Robbins for the implementation
39− https://github.com/haskellari/postgresql-simple/pull/46
40− * Add `withTransactionModeRetry'`, a variant of `withTransactionModeRetry`
41− for all exception types.
42− Thanks to Elliot Cameron for the implementation
43− https://github.com/haskellari/postgresql-simple/pull/42
44− * Fix spurious aborts when retrying transactions
45− Thanks to Elliot Cameron for the implementation
46− https://github.com/haskellari/postgresql-simple/pull/34
47− * Add `Database.PostgreSQL.Simple.Newtypes` module
48− with `Aeson` newtype.
49− https://github.com/haskellari/postgresql-simple/pull/55
50−
51−### Version 0.6.2 (2019-04-26)
52−
53− * Define `MonadFail Ok`.
54−
55−### Version 0.6.1 (2019-03-04)
56−
57− * Escape double '??' to a literal '?
58− Thanks to Felix Paulusma for the implementation.
59− https://github.com/phadej/postgresql-simple/pull/5
60−
61− * Mention GHC Generics support in the documentation.
62− Thanks to Gabriel Gonzalez for the implementation.
63− https://github.com/phadej/postgresql-simple/pull/6
64−
65− * Better error message for "Query resulted in a command response
66− Thanks to Max Amanshauser for the implementation.
67− https://github.com/phadej/postgresql-simple/pull/7
68−
69− * fromJSONField: Include JSONPath on JSON parse errors
70− Thanks to Simon Hengel for the implementation.
71− https://github.com/phadej/postgresql-simple/pull/2
72−
73− * No TH in implementation
74− https://github.com/phadej/postgresql-simple/pull/4
75−
76−### Version 0.6 (2018-10-16)
77−
78− * *Breaking change*: Use `Only` package's `Only` for a common 1-tuple.
79−
80− Consider a downstream library depending already both on
81− `Only` and `postgresql-simple` package. This library my define
82− a `MyClass` with instances for `Only.Only` and `PostgreSQL.Only`.
83− As now these types are the same, a library would break.
84− Therefore I consider "merging" types a breaking change.
85−
86− There are two ways for adopting this change in that scenario:
87−
88− - Either CPP-guard `PostgreSQL.Only` instance with
89−
90− ```haskell
91− #if !MIN_VERSION_postgresql_simple(0,6,0)
92− instance MyClass (PostgreSQL.Only a) where ...
93− #endif
94− ```
95−
96− - or simply remove it and add `postgresql-simple >=0.6` lower bound,
97− making sure that there's only single `Only`.
98−
99− * Add `ToField` instances for case-insensitive strict and lazy text.
100− Thanks to Max Tagher for the implementation.
101− https://github.com/lpsmith/postgresql-simple/pull/232
102−
103− * Add support to CockroachDB.
104− Thanks to Georte Steel.
105− https://github.com/lpsmith/postgresql-simple/pull/245
106−
107− * Add Generic ConnectInfo instance
108− Thanks to Dmitry Dzhus.
109− https://github.com/lpsmith/postgresql-simple/pull/235
110−
111− * Add `fromFieldRange :: Typeable a => FieldParser a -> FieldParser (PGRange a)`
112− https://github.com/lpsmith/postgresql-simple/pull/221
113−
114− * Add `fromFieldJSONByteString :: FieldParser ByteString`
115− https://github.com/lpsmith/postgresql-simple/pull/222/files
116−
117− * Fix off-by-one error in year builder.
118− Thanks to Nathan Ferris Hunter.
119− https://github.com/lpsmith/postgresql-simple/pull/230
120−
121− * Extend ToRow and FromRow to tuples of size 18
122− Thanks to Bardur Arantsson.
123− https://github.com/lpsmith/postgresql-simple/pull/229
124−
125− * Add `Vector` and `Vector.Unboxed` `query` variants.
126− These are more memory efficient
127− (especially, if you anyway will convert to some vector)
128− https://github.com/phadej/1
129−
130− * Documentation improvements
131− https://github.com/lpsmith/postgresql-simple/pull/227
132− https://github.com/lpsmith/postgresql-simple/pull/236
133−
134−### Version 0.5.4.0 (2018-05-23)
135− * Support GHC-8.4 (Semigroup/Monoid)
136−
137−### Version 0.5.3.0 (2017-05-15)
138− * Refactored some rudimentary cursor handling code out of the
139− implementation of the fold operators, into a new
140− `Database.PostgreSQL.Simple.Cursor` module, thanks to Bardur Arantsson.
141−
142− * Made the `FromField` instance for `Char` compatible with
143− postgresql's `bpchar` type. Thanks to Ivan Lazar Miljenovic for
144− reporting the issue.
145−
146− * Added `Show` and `Eq` instances for `Notification`, thanks to
147− Matvey Aksenov.
148−
149− * Fixed some example code, thanks to Matvey Aksenov.
150−
151− * Fixed a problem with using `conversionError` to throw exceptions
152− of type `SomeException`. Previously, the exception would be
153− wrapped in a second `SomeException` dynamic constructor which
154− would cause normal GHC typecase idioms over `SomeException` to fail.
155−
156−### Version 0.5.2.1 (2016-06-29)
157− * Bumped the lower bound for `base` to 4.6. Thanks to Herbert
158− Valerio Riedel for reporting the issue.
159−
160− * Added an `Eq` instance for `SqlError`, thanks to Chris Allen
161−
162− * Fixed a bug where a all-caps `"NULL"` text value inside a
163− postgresql array would get parsed as the SQL null value. Thanks
164− goes to Edgar Gomes and Silk for finding and fixing this mistake.
165−
166− * Modified `withTransaction` and friends to ignore `IOError`s when
167− attempting to roll back the transaction. This fixes a buggy
168− interaction between `withTransaction` and async exceptions (e.g.
169− `System.Timeout`) on unix platforms. Thanks goes to Erik
170− Hesselink and Silk for providing the test case that exposed this
171− issue.
172−
173− * Added the `testTimeout` regression test for the problem above.
174−
175−### Version 0.5.2.0 (2016-05-25)
176− * Significantly improved the error reporting from
177− `Copy.putCopyData`, thanks to Ben Gamari.
178−
179− * Moved the test suite to use `tasty`, with a big thanks
180− to Ben Gamari.
181−
182− * Added `FromField.optionalField`, and updated the documentation
183− of `FromField.fromJSONField`, as inspired by an email conversation
184− with Ian Wagner.
185−
186− * Updated all links in the haddocks to use https, and added a link
187− to the documentation of `connectPostgreSQL`.
188−
189− * Added a truncated changelog to the source distribution.
190−
191−### Version 0.5.1.3 (2016-04-30)
192− * Implemented the Monad of No Return proposal, future-proofing
193− postgresql-simple against future releases of GHC.
194−
195− * Fixed a rare and usually benign race condition where
196− `getNotification` could end up waiting on a newly reallocated
197− file descriptor index, potentially leading to deadlock if the
198− descriptor does not become readable promptly. This fix only
199− applies to GHC 7.8 or later, as it depends on `threadWaitReadSTM`.
200−
201− * Tweaked the time parsers to accept times of day of the form `hh:mm`,
202− omitting seconds, following changes made to aeson.
203−
204− * Updated the documentation of the `In` type to point out a gotcha
205− when using the SQL fragment `... NOT IN ?` with `In []`. Thanks
206− goes to Simon Michael and Dan Haraj for bringing this issue to
207− my attention.
208−
209−### Version 0.5.1.2 (2015-12-14)
210− * The syntax generated for empty arrays was changed so that
211− postgresql's type inference would work better, thanks to
212− Amit Levy.
213−
214− * Further revision and expansion of the new Time documentation.
215−
216−### Version 0.5.1.1 (2015-12-02)
217− * This is a documentation-only release
218−
219− * The documentation of the `Time` module has been completely
220− rewritten, and is far longer and more informative. It contains
221− a brief overview of civil time, the semantics of postgresql's
222− time types, and their relation to Haskell's time types via
223− postgresql-simple.
224−
225− * The documentation of `connectPostgreSQL` has been modified to
226− mention the effects of environment variables on the connection
227− string parameters.
228−
229− * The documentation of `HStore.Internal` has been unhidden from
230− haddock.
231−
232− * A typo in example code was fixed courtesy of Levi Notik.
233−
234−### Version 0.5.1.0 (2015-10-22)
235− * Optimized the implementation of the streaming operators to avoid
236− creating intermediate lists of rows, thanks to Timo von Holtz.
237−
238− * Added default instances for `ToRow` and `FromRow` that depend on
239− Generics, thanks to Alexey Khudyakov.
240−
241− * Fixed support for bytestring-0.9 and GHC 7.4.
242−
243−### Version 0.5.0.1 (2015-09-21)
244− * Fixed a bug when printing a `ZonedTime` with a negative offset
245− that is not a whole number of hours.
246−
247−### Version 0.5.0.0 (2015-09-19)
248− * Removed the deprecated `BuiltinTypes` module.
249−
250− * Modified the SQL quasiquoter so that it returns a `Query`, not
251− an overloaded string, and so that the `OverloadedStrings` language
4+ * Modified the SQL quasiquoter so that it returns a Query, not
5+ an overloaded string, and so that the OverloadedStrings language
2526 extension is no longer necessary, thanks to Mike Ledger.
2537
254− * Moved away from `blaze-builder` in favor of `bytestring-builder`. This
8+ * Moved away from blaze-builder in favor of bytestring-builder. This
2559 shouldn't affect very many people, but does reduce the transitive
256− dependencies.
257−
258− * Rewrote the timestamp printers to use the new `Prim`
259− infrastructure in `bytestring-builder`. The new printers should
260− be a fair bit faster.
10+ dependencies.
26111
262− * Added support for exclusion violations to the `ConstraintViolation`
12+ * Added support for exclusion violations to the ConstraintViolation
26313 type in the Errors module, thanks to João Cristóvão.
26414
265− * Moved away from the `uuid` package in favor of the `uuid-types` package,
15+ * Moved away from the uuid package in favor of the uuid-types package,
26616 thanks to Bardur Arantsson. This shouldn't affect anybody, but does
26717 reduce the transitive dependencies.
26818
26919 * Postgresql-simple now explicitly assumes the UTF8 character encoding
27020 for communication between the client and server. All database encodings
271− support UTF8 except for Mule Internal Code, the Multilingual
272− Extensions for Emacs. An exception should be raised upon
273− connecting to a database by the backend if the backend cannot
274− accommodate this requirement.
21+ support UTF8 except for Mule Internal Code. An exception should be
22+ raised upon connecting to a database by the backend if the backend cannot
23+ accomodate this requirement.
27524
276− * Added `Eq` and `Typeable` instances for `Connection`.
25+ * Added Eq and Typeable instance for Connection.
27726
278− * Added the `foldWith`, `forEachWith`, and `returningWith` families
279− of functions courtesy of Travis Staton.
27+ * Added the foldWith, forEachWith, and returningWith families of functions
28+ courtesy of Travis Staton.
28029
28130 * Support for Ranged types, with thanks to Leonid Onokhov for his
28231 contributions.
28332
284− * The `FromField` instance for JSON now allows for top-level values that
33+ * The FromField instance for JSON now allows for top-level values that
28534 are not objects or arrays, thanks to Sam Rijs.
28635
287− * The timestamp parsers have been replaced with those now in Aeson.
288− Janne Hellsten adapted the old parsers from postgresql-simple for
289− inclusion in Aeson; Bryan O'Sullivan rewrote those parsers to be
290− faster, with some tweaks contributed by myself. And now to
291− bring the effort full circle, the result has been brought back to
292− postgresql-simple, with some adaptations.
36+ * The timestamp parsers and printers have been replaced with those
37+ now in Aeson. Janne Hellsten adapted the old parsers from
38+ postgresql-simple for inclusion in Aeson; Bryan O'Sullivan
39+ rewrote those parsers to be faster, with some tweaks contributed
40+ by myself. And now to bring the effort full circle, the result
41+ has been brought back to postgresql-simple, with some adaptations.
29342
294− * Fixed a bug in the typeinfo system where postgresql's `_record` type
43+ * Fixed a bug in the typeinfo system where postgresql's _record type
29544 was being reported as a basic type and not an array type. Thanks to
29645 Nickolay Kolev for helping to expose this issue.
29746
@@ -299,13 +48,13 @@
29948 case of parsing subfields of arrays and composites, it would fetch the
30049 `TypeInfo` of the array or composite type and not the subtype.
30150
302−### Version 0.4.10.0 (2015-02-26)
51+Version 0.4.10.0 (2015-02-26)
30352 * Added a blurb about SSL/TLS in the documentation for connectPostgreSQL
30453
30554 * Moved some functions into the Internal module, courtesy of Aleksey
30655 Uimanov.
30756
308−### Version 0.4.9.0 (2014-12-27)
57+Version 0.4.9.0 (2014-12-27)
30958 * Made the fromField method for PGArray available as pgArrayFieldParser,
31059 outside of the typeclass courtesy of Tom Ellis.
31160
@@ -313,13 +62,13 @@
31362
31463 * Fixed deprecation warnings, courtesy of Simon Hengel.
31564
316−### Version 0.4.8.0 (2014-11-24)
65+Version 0.4.8.0 (2014-11-24)
31766 * Added support for postgresql's citext type extension via the
31867 case-insensitive package.
31968
32069 * Added the function parseHStoreList to the HStore module.
32170
322−### Version 0.4.7.0 (2014-10-27)
71+Version 0.4.7.0 (2014-10-27)
32372 * Added support for very old timestamps to UTCTime. Depending on time
32473 zone, very old timestamps can be returned with a offset from UTC that
32574 contains seconds.
@@ -339,24 +88,24 @@
33988
34089 Thanks to Michael Snoyman for his assistance with this issue.
34190
342−### Version 0.4.6.0 (2014-10-07)
91+Version 0.4.6.0 (2014-10-07)
34392 * Added an instance ToField NominalDiffTime.
34493
345−### Version 0.4.5.0 (2014-09-26)
94+Version 0.4.5.0 (2014-09-26)
34695 * Added support for retrieving NaN and ±Infinity floating point values
34796 from postgres to the FromField instances for Float, Double, and Rational.
34897 The instance for Scientific is unchanged due to the fact it has no
34998 way of representing these special values. Thanks goes to Tom Nielsen
35099 for reporting the issue.
351100
352−### Version 0.4.4.1 (2014-09-07)
101+Version 0.4.4.1 (2014-09-07)
353102 * Fixed a rather serious bug that prevented the COPY module from working
354103 at all on unix clients since version 0.4.3.0. Thanks goes to
355104 Dmitry Dzhus for reporting the issue.
356105
357106 * Added a regression test for the COPY module to the test suite.
358107
359−### Version 0.4.4.0 (2014-08-26)
108+Version 0.4.4.0 (2014-08-26)
360109 * Added the jsonb type debuting in PostgreSQL 9.4 to the TypeInfo.Static
361110 and Builtin tables, and extended the out-of-box json instances to
362111 be compatible with the new type. Thanks to Tobias Florek for the
@@ -365,7 +114,7 @@
365114 * Ported some expanded documentation from mysql-simple, and fixed
366115 a documentation typo.
367116
368−### Version 0.4.3.0 (2014-07-10)
117+Version 0.4.3.0 (2014-07-10)
369118 * connect and exec now use libpq asynchronously on non-Windows platforms.
370119 This means we are using threadWaitRead and threadWaitWrite to
371120 have GHC's IO manager schedule non-blocking C calls to libpq,
@@ -379,7 +128,7 @@
379128 that originate from client-side code. However, this goal
380129 isn't perfectly achieved as of yet.
381130
382−### Version 0.4.2.3 (2014-06-04)
131+Version 0.4.2.3 (2014-06-04)
383132 * This is strictly a documentation release, with no code changes.
384133
385134 * Fixed several documentation typos, thanks to Chris Allen and remdezx.
@@ -390,13 +139,13 @@
390139
391140 * De-emphasized connect and ConnectInfo in favor of connectPostgreSQL.
392141
393−### Version 0.4.2.2 (2014-05-15)
394− * Fixed compatibility with scientific-0.3.\*, thanks to Adam Bergmark
142+Version 0.4.2.2 (2014-05-15)
143+ * Fixed compatibility with scientific-0.3.*, thanks to Adam Bergmark
395144
396145 * Improved documentation of the FromField module, as well as the fold,
397146 foldWithOptions, executeMany, and returning operators.
398147
399−### Version 0.4.2.1 (2014-03-27)
148+Version 0.4.2.1 (2014-03-27)
400149 * Fixed bug in Values syntax generation
401150
402151 * Improved documentation, including examples of multi-row update,
@@ -404,17 +153,17 @@
404153 floating point numbers from the database, and the IsString instance
405154 for QualifiedIdentifier.
406155
407−### Version 0.4.2.0 (2014-03-22)
156+Version 0.4.2.0 (2014-03-22)
408157 * Added ToField and FromField instances for the scientific package
409158
410159 * Changed the Identifier and QualifiedIdentifier to use Text in
411160 order to avoid encoding errors. Technically this requires a
412− major version bump, but let's pretend 0.4.1.0 didn't happen.
161+ major verson bump, but let's pretend 0.4.1.0 didn't happen.
413162
414163 * Removed non-exhaustive cases in the ToField instance for Values,
415164 and tweaked error messages.
416165
417−### Version 0.4.1.0 (2014-03-22)
166+Version 0.4.1.0 (2014-03-22)
418167 * Fixed the parsing of arrays containing null values, courtesy of
419168 Francesco Mazzoli
420169
@@ -426,17 +175,17 @@
426175 more general than executeMany and returning. See the
427176 Database.PostgreSQL.Simple.Types.Values data type.
428177
429−### Version 0.4.0.2 (2014-01-12)
178+Version 0.4.0.2 (2014-01-12)
430179 * Tweaked C preprocessor directive to be more portable
431180
432181 * Tweaked testsuite for compatibility with aeson-0.7
433182
434−### Version 0.4.0.1 (2013-12-21)
183+Version 0.4.0.1 (2013-12-21)
435184 * Relaxed dependency on aeson to >= 0.6
436185
437186 * Update the documentation of `fromField`
438187
439−### Version 0.4.0.0 (2013-12-21)
188+Version 0.4.0.0 (2013-12-21)
440189 * Changed the calling code of `fromField` so that it always sends
441190 a copy of the raw data. This should be a small but significant
442191 performance bump for most people most of the time; however it
@@ -452,15 +201,15 @@
452201
453202 * Added FromField instances for IORef, MVar, and IOVector.
454203
455−### Version 0.3.10.0 (2013-12-17)
204+Version 0.3.10.0 (2013-12-17)
456205 * Added the queryWith function, courtesy of Leonid Onokhov
457206
458207 * Added the Default type, for representing postgresql's default values
459208
460−### Version 0.3.9.1 (2013-10-28)
209+Version 0.3.9.1 (2013-10-28)
461210 * Removed dependency on hashable
462211
463−### Version 0.3.9.0 (2013-10-27)
212+Version 0.3.9.0 (2013-10-27)
464213 * Added FromField and ToField instances for the `uuid` package,
465214 courtesy of Bas van Dijk.
466215
@@ -470,16 +219,16 @@
470219 * Added the fromBinary, fromHStoreMap, and fromHStoreList newtype
471220 unwrapper functions, courtesy of Bas van Dijk.
472221
473−### Version 0.3.8.0 (2013-10-11)
222+Version 0.3.8.0 (2013-10-11)
474223 * Fixed the example code in `FromField`, thanks to Adam Bergmark.
475224
476225 * Added `Notification.getBackendPID`.
477226
478−### Version 0.3.7.1 (2013-09-12)
227+Version 0.3.7.1 (2013-09-12)
479228 * Relaxed the dependency on bytestring-0.10 back to bytestring-0.9,
480229 courtesy of Michael Snoyman
481230
482−### Version 0.3.7.0 (2013-09-11)
231+Version 0.3.7.0 (2013-09-11)
483232 * Added `aeson` as a dependency.
484233
485234 * Added ToField and FromField instances for aeson's JSON.Value type,
@@ -500,7 +249,7 @@
500249
501250 * Various documentation fixes.
502251
503−### Version 0.3.6.0 (2013-08-19)
252+Version 0.3.6.0 (2013-08-19)
504253 * Added the json type to BuiltinTypes and TypeInfo.Static, courtesy of
505254 Manuel Gómez.
506255
@@ -511,14 +260,14 @@
511260 months from now. Fixed the example code in FromField to reflect
512261 this change.
513262
514−### Version 0.3.5.0 (2013-08-09)
263+Version 0.3.5.0 (2013-08-09)
515264 * Added an FromRow instance for Vector, semantically identical to the
516265 existing FromRow instance for [], courtesy of Doug Beardsley
517266
518267 * Reworked the documentation for the Copy module, and tweaked the
519268 documentation for the LargeObjects module.
520269
521−### Version 0.3.4.0 (2013-07-23)
270+Version 0.3.4.0 (2013-07-23)
522271 * Added direct support for COPY IN and COPY OUT, without having
523272 to use raw postgresql-libpq calls and postgresql-simple's Internal
524273 module.
@@ -527,49 +276,49 @@
527276 exception instead of an ErrorCall exception when it fails to fetch
528277 the connection's file descriptor from libpq.
529278
530−### Version 0.3.3.2 (2013-06-18)
279+Version 0.3.3.2 (2013-06-18)
531280 * Optimized the definition of `mconcat` in the Monoid instance for
532281 the Query type, courtesy of Joey Adams.
533282
534−### Version 0.3.3.1 (2013-06-06)
283+Version 0.3.3.1 (2013-06-06)
535284 * `getNotification` now works on Windows, albeit using a one-second
536285 polling loop, courtesy of Joey Adams.
537286
538−### Version 0.3.3.0 (2013-05-29)
287+Version 0.3.3.0 (2013-05-29)
539288 * Fixed two issues with the fold operator: fold would raise the wrong
540289 exception, and gave the database cursor a static name preventing
541290 folds from being nested. Thanks to Joey Adams for his
542291 work on these issues.
543292
544−### Version 0.3.2.0 (2013-05-20)
293+Version 0.3.2.0 (2013-05-20)
545294 * Added a savepoint abstraction to the Transaction module, courtesy
546295 of Joey Adams
547296
548−### Version 0.3.1.2 (2013-04-29)
297+Version 0.3.1.2 (2013-04-29)
549298 * Fixed hstore parser to not unnecessarily reverse the key-value pairs
550299
551−### Version 0.3.1.1 (2013-04-29)
300+Version 0.3.1.1 (2013-04-29)
552301 * Fixed hstore parser to recognize empty hstores, courtesy of Simon
553302 Meier
554303
555−### Version 0.3.1.0 (2013-04-26)
304+Version 0.3.1.0 (2013-04-26)
556305 * Added support for Range and Composite types to the TypeInfo system.
557306
558307 * Added support for hstore types in the Simple.HStore module.
559308
560309 * Improved documentation of the FromField module.
561310
562−### Version 0.3.0.1 (2013-03-26)
311+Version 0.3.0.1 (2013-03-26)
563312 * A large chunk of the documentation inside the FromField module had
564313 silently failed to render in Haddock.
565314
566−### Version 0.3.0.0 (2013-03-25)
315+Version 0.3.0.0 (2013-03-25)
567316 * Added support for PostgreSQL's Array Types. Thanks to Jason Dusek
568317 for his work on this feature.
569318
570319 * Added a brand new TypeInfo system that gives FromField instances
571320 convenient and efficient access to the pg_type metatable. This
572− replaced the older typename cache, and was necessary to properly
321+ replaced the older typename cache, and was neccesary to properly
573322 support postgres array types. Thanks to Bas van Dijk for his
574323 work on this feature.
575324
@@ -605,33 +354,33 @@
605354 now stripped out.
606355
607356
608−### Version 0.2.4.1 (2012-08-29)
357+Version 0.2.4.1 (2012-08-29)
609358 * Fixed the documentation of `In`. Thanks to rekado and dstcruz for
610359 pointing this out.
611360
612−### Version 0.2.4.0 (2012-08-23)
361+Version 0.2.4.0 (2012-08-23)
613362 * Added the `withTransactionSerializable` and `withTransactionModeRetry`
614363 operators, thanks to Joey Adams.
615364
616−### Version 0.2.3.0 (2012-08-09)
365+Version 0.2.3.0 (2012-08-09)
617366 * Added the `returning` operator, thanks to Jason Dusek
618367
619−### Version 0.2.2.0 (2012-07-26)
368+Version 0.2.2.0 (2012-07-26)
620369 * Added a ToRow instance for the (:.) type, courtesy of Leonid Onokhov
621370
622371 * Added the type oid for PostgreSQL's `uuid` type to BuiltinTypes
623372
624−### Version 0.2.1.0 (2012-07-23)
373+Version 0.2.1.0 (2012-07-23)
625374 * Added the FromRow.fieldWith operator, thanks to Leonid Onokhov
626375
627376 * Added a type synonym for FieldParser
628377
629−### Version 0.2.0.1 (2012-06-21)
378+Version 0.2.0.1 (2012-06-21)
630379 * Fixed a compatibility problem with PostgreSQL 8.1, which does not allow
631380 clients to set their own value for `standard_conforming_strings`. This
632381 connection variable is still set to `on` for PostgreSQL 8.2 and later.
633382
634−### Version 0.2: (2012-06-19)
383+Version 0.2: (2012-06-19)
635384 * Removed the conversion from `timestamp` to `UTCTime`. Some code will be
636385 broken even though it will still compile.
637386
@@ -640,16 +389,16 @@
640389 * Exported ToRow/FromRow from Database.PostgreSQL.Simple
641390
642391
643−### Version 0.1.4.3: (2012-06-10)
392+Version 0.1.4.3: (2012-06-10)
644393 * Fix language extensions for compatibility with GHC 7.0
645394
646−### Version 0.1.4.2: (2012-06-10)
395+Version 0.1.4.2: (2012-06-10)
647396 * Fix a wayward dependency on Text.
648397
649−### Version 0.1.4.1: (2012-06-10)
398+Version 0.1.4.1: (2012-06-10)
650399 * Added support for timezones with minutes in their UTC offset.
651400
652−### Version 0.1.4: (2012-06-10)
401+Version 0.1.4: (2012-06-10)
653402 * Removed pcre-light dependency, courtesy of Joey Adams.
654403
655404 * Reworked support for the Time types.
@@ -661,7 +410,7 @@
661410 now the preferred way of dealing with `timestamp` (without time zone).
662411
663412 * `Database.PostgreSQL.Simple.Time` is a new module that offers types
664− that accommodate PostgreSQL's infinities.
413+ that accomodate PostgreSQL's infinities.
665414
666415 * All time-related `FromField`/`ToField` instances are now based on new,
667416 higher-speed parsers and printers instead of those provided by the
@@ -674,13 +423,13 @@
674423 * Renaming some of the type names in `BuiltinTypes`.
675424
676425
677−### Version 0.1.3: (2012-05-30)
426+Version 0.1.3: (2012-05-30)
678427 * Made ZonedTime an instance of FromField and ToField
679428
680429 * Added getNotificationNonBlocking
681430
682431
683−### Version 0.1.2: (2012-05-09)
432+Version 0.1.2: (2012-05-09)
684433 * Switched to libpq-based escaping for bytea types; Binary now works with
685434 PostgreSQL 8 courtesy of Joey Adams.
686435
@@ -693,7 +442,7 @@
693442 * Exported (:.) from Database.PostgreSQL.Simple
694443
695444
696−### Version 0.1.1: (2012-05-06)
445+Version 0.1.1: (2012-05-06)
697446 * Added some preliminary documentation for the Ok, Notification, and
698447 LargeObjects modules
699448
@@ -702,7 +451,7 @@
702451 * Fixed a bug relating to handling the transaction level
703452
704453
705−### Version 0.1: (2012-05-04)
454+Version 0.1: (2012-05-04)
706455 * Renamed several modules, typeclasses, and functions:
707456
708457 QueryParams (renderParams) -> ToRow (toRow)
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.
CONTRIBUTORS−7
@@ -27,10 +27,3 @@ Travis Staton <hello@travisstaton.com>
2727Sam Rijs <srijs@airpost.net>
2828Janne Hellsten <jjhellst@gmail.com>
2929Timmy Tofu <timmytofu@users.noreply.github.com>
30−Alexey Khudyakov <alexey.skladnoy@gmail.com>
31−Timo von Holtz <tvh@anchor.com.au>
32−Amit Levy <amit@amitlevy.com>
33−Ben Gamari <ben@smart-cactus.org>
34−Edgar Gomes Araujo <talktoedgar@gmail.com>
35−Erik Hesselink <hesselink@gmail.com>
36−Matvey Aksenov <matvey.aksenov@gmail.com>
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.projectdeleted−4
@@ -1,4 +0,0 @@
1−packages: .
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+95−153
@@ -1,175 +1,117 @@
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.
1+Name: postgresql-simple
2+Version: 0.5.0.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-2013 Leon P Smith
12+Category: Database
13+Build-type: Simple
814
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
15+Cabal-version: >= 1.9.2
1716
18−category: Database
19−build-type: Simple
2017extra-source-files:
21− CHANGES.md
22− CONTRIBUTORS
23− test/results/malformed-input.expected
24− test/results/unique-constraint-violation.expected
18+ CONTRIBUTORS
2519
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
20+Library
21+ hs-source-dirs: src
22+ Exposed-modules:
23+ Database.PostgreSQL.Simple
24+ Database.PostgreSQL.Simple.Arrays
25+ Database.PostgreSQL.Simple.Copy
26+ Database.PostgreSQL.Simple.FromField
27+ Database.PostgreSQL.Simple.FromRow
28+ Database.PostgreSQL.Simple.LargeObjects
29+ Database.PostgreSQL.Simple.HStore
30+ Database.PostgreSQL.Simple.HStore.Internal
31+ Database.PostgreSQL.Simple.Notification
32+ Database.PostgreSQL.Simple.Ok
33+ Database.PostgreSQL.Simple.Range
34+ Database.PostgreSQL.Simple.SqlQQ
35+ Database.PostgreSQL.Simple.Time
36+ Database.PostgreSQL.Simple.Time.Internal
37+ Database.PostgreSQL.Simple.ToField
38+ Database.PostgreSQL.Simple.ToRow
39+ Database.PostgreSQL.Simple.Transaction
40+ Database.PostgreSQL.Simple.TypeInfo
41+ Database.PostgreSQL.Simple.TypeInfo.Macro
42+ Database.PostgreSQL.Simple.TypeInfo.Static
43+ Database.PostgreSQL.Simple.Types
44+ Database.PostgreSQL.Simple.Errors
45+-- Other-modules:
46+ Database.PostgreSQL.Simple.Internal
3547
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
48+ Other-modules:
49+ Database.PostgreSQL.Simple.Compat
50+ Database.PostgreSQL.Simple.HStore.Implementation
51+ Database.PostgreSQL.Simple.Time.Implementation
52+ Database.PostgreSQL.Simple.Time.Parser
53+ Database.PostgreSQL.Simple.TypeInfo.Types
6754
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
55+ Build-depends:
56+ aeson >= 0.6,
57+ attoparsec >= 0.10.3,
58+ base < 5,
59+ bytestring >= 0.9,
60+ bytestring-builder,
61+ case-insensitive,
62+ containers,
63+ hashable,
64+ postgresql-libpq >= 0.9 && < 0.10,
65+ template-haskell,
66+ text >= 0.11.1,
67+ time,
68+ transformers,
69+ uuid-types >= 1.0.0,
70+ scientific,
71+ vector
9972
100− default-extensions:
101− BangPatterns
102− DoAndIfThenElse
103− OverloadedStrings
104− TypeOperators
105− ViewPatterns
73+ extensions: DoAndIfThenElse, OverloadedStrings, BangPatterns, ViewPatterns
74+ TypeOperators
10675
107− ghc-options: -Wall -fno-warn-name-shadowing
76+ ghc-options: -Wall -fno-warn-name-shadowing
10877
10978source-repository head
11079 type: git
111− location: http://github.com/haskellari/postgresql-simple
80+ location: http://github.com/lpsmith/postgresql-simple
11281
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
82+source-repository this
83+ type: git
84+ location: http://github.com/lpsmith/postgresql-simple
85+ tag: v0.5.0.0
12586
12687test-suite test
127− default-language: Haskell2010
128− type: exitcode-stdio-1.0
129− hs-source-dirs: test
130− main-is: Main.hs
88+ type: exitcode-stdio-1.0
89+
90+ hs-source-dirs: test
91+ main-is: Main.hs
13192 other-modules:
13293 Common
133− Exception
134− Interval
13594 Notify
13695 Serializable
13796 Time
13897
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
98+ ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind
14899
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
100+ extensions: NamedFieldPuns
101+ , OverloadedStrings
102+ , Rank2Types
103+ , RecordWildCards
104+ , PatternGuards
105+ , ScopedTypeVariables
166106
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
107+ build-depends: base
108+ , aeson
109+ , base16-bytestring
110+ , bytestring
111+ , containers
112+ , cryptohash
113+ , HUnit
114+ , postgresql-simple
115+ , text
116+ , time
117+ , vector
sdist.shdeleted−25
@@ -1,25 +0,0 @@
1−#!/bin/bash
2−
3−echo "Generating CHANGELOG.md"
4−echo
5−
6−cat <<HEADER > CHANGELOG.md
7−For the full changelog, see
8−<https://github.com/lpsmith/postgresql-simple/blob/master/CHANGES.md>
9−
10−HEADER
11−
12−perl -ne '$n++ if /^###/; exit if $n==2; print' CHANGES.md >> CHANGELOG.md
13−
14−cat CHANGELOG.md
15−rm -f ./dist/*.tar
16−rm -f ./dist/*.tar.gz
17−cabal sdist
18−cd dist
19−wc *.tar.gz
20−gunzip *.gz
21−wc *.tar
22−zopfli *.tar
23−wc *.tar.gz
24−cd ..
25−rm -f ./dist/*.tar
src/Database/PostgreSQL/Simple.hs+98−38
@@ -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
@@ -120,26 +118,30 @@ module Database.PostgreSQL.Simple
120118 , formatQuery
121119 ) where
122120
123−import Data.ByteString.Builder (Builder, byteString, char8)
121+import Data.ByteString.Builder
122+ ( Builder, byteString, char8, intDec )
124123import Control.Applicative ((<$>))
125124import Control.Exception as E
125+import Control.Monad (foldM)
126126import Data.ByteString (ByteString)
127127import Data.Int (Int64)
128128import Data.List (intersperse)
129129import Data.Monoid (mconcat)
130−import Database.PostgreSQL.Simple.Compat ((<>), toByteString)
131−import Database.PostgreSQL.Simple.Cursor
130+import Database.PostgreSQL.Simple.Compat ( (<>), toByteString )
132131import Database.PostgreSQL.Simple.FromField (ResultError(..))
133132import Database.PostgreSQL.Simple.FromRow (FromRow(..))
133+import Database.PostgreSQL.Simple.Ok
134134import Database.PostgreSQL.Simple.ToField (Action(..))
135135import Database.PostgreSQL.Simple.ToRow (ToRow(..))
136136import Database.PostgreSQL.Simple.Types
137137 ( Binary(..), In(..), Only(..), Query(..), (:.)(..) )
138138import Database.PostgreSQL.Simple.Internal as Base
139−import Database.PostgreSQL.Simple.Internal.PQResultUtils
140139import Database.PostgreSQL.Simple.Transaction
140+import Database.PostgreSQL.Simple.TypeInfo
141141import qualified Database.PostgreSQL.LibPQ as PQ
142142import qualified Data.ByteString.Char8 as B
143+import Control.Monad.Trans.Reader
144+import Control.Monad.Trans.State.Strict
143145
144146
145147-- | Format a query string.
@@ -278,31 +280,21 @@ parseTemplate template =
278280 skipSpace = B.dropWhile isSpace_ascii
279281
280282
283+
281284buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder
282285buildQuery conn q template xs =
283286 zipParams (split template) <$> mapM (buildAction conn q xs) xs
284287 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
288+ let (h,t) = B.break (=='?') s
288289 in byteString h
289290 : if B.null t
290291 then []
291292 else split (B.tail t)
292293 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps
293294 zipParams [t] [] = t
294− zipParams _ _ = fmtError (show countSingleQs ++
295− " single '?' characters, but " ++
295+ zipParams _ _ = fmtError (show (B.count '?' template) ++
296+ " '?' characters, but " ++
296297 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
306298
307299-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not
308300-- expected to return results.
@@ -340,10 +332,10 @@ execute conn template qs = do
340332-- @
341333-- executeMany c [sql|
342334-- UPDATE sometable
343−-- SET y = upd.y
335+-- SET sometable.y = upd.y
344336-- FROM (VALUES (?,?)) as upd(x,y)
345337-- WHERE sometable.x = upd.x
346−-- |] [(1, \"hello\"),(2, \"world\")]
338+-- |] [(1, \"hello\"),(2, \"world\")
347339-- @
348340
349341executeMany :: (ToRow q) => Connection -> Query -> [q] -> IO Int64
@@ -367,7 +359,6 @@ executeMany conn q qs = do
367359returning :: (ToRow q, FromRow r) => Connection -> Query -> [q] -> IO [r]
368360returning = returningWith fromRow
369361
370−-- | A version of 'returning' taking parser as argument
371362returningWith :: (ToRow q) => RowParser r -> Connection -> Query -> [q] -> IO [r]
372363returningWith _ _ _ [] = return []
373364returningWith parser conn q qs = do
@@ -517,7 +508,7 @@ fold_ :: (FromRow r) =>
517508 -> IO a
518509fold_ = foldWithOptions_ defaultFoldOptions
519510
520−-- | A version of 'fold_' taking a parser as an argument
511+-- | A version of 'foldWith' taking a parser as an argument
521512foldWith_ :: RowParser r
522513 -> Connection
523514 -> Query
@@ -533,7 +524,7 @@ foldWithOptions_ :: (FromRow r) =>
533524 -> a -- ^ Initial state for result consumer.
534525 -> (a -> r -> IO a) -- ^ Result consumer.
535526 -> IO a
536−foldWithOptions_ opts conn query' a f = doFold opts fromRow conn query' query' a f
527+foldWithOptions_ opts conn query a f = doFold opts fromRow conn query query a f
537528
538529-- | A version of 'foldWithOptions_' taking a parser as an argument
539530foldWithOptionsAndParser_ :: FoldOptions
@@ -543,7 +534,7 @@ foldWithOptionsAndParser_ :: FoldOptions
543534 -> a -- ^ Initial state for result consumer.
544535 -> (a -> r -> IO a) -- ^ Result consumer.
545536 -> IO a
546−foldWithOptionsAndParser_ opts parser conn query' a f = doFold opts parser conn query' query' a f
537+foldWithOptionsAndParser_ opts parser conn query a f = doFold opts parser conn query query a f
547538
548539doFold :: FoldOptions
549540 -> RowParser row
@@ -571,17 +562,28 @@ doFold FoldOptions{..} parser conn _template q a0 f = do
571562 PQ.TransUnknown -> fail "foldWithOpts FIXME: PQ.TransUnknown"
572563 -- Not sure what this means.
573564 where
574− declare =
575− declareCursor conn q
576− fetch cursor a =
577− foldForwardWithParser cursor parser chunkSize f a
578−
579− go = bracket declare closeCursor $ \cursor ->
580− let loop a = fetch cursor a >>=
581− \r -> case r of
582− Left x -> return x
583− Right x -> loop x
584− in loop a0
565+ declare = do
566+ name <- newTempName conn
567+ _ <- execute_ conn $ mconcat
568+ [ "DECLARE ", name, " NO SCROLL CURSOR FOR ", q ]
569+ return name
570+ fetch (Query name) = queryWith_ parser conn $
571+ Query (toByteString (byteString "FETCH FORWARD "
572+ <> intDec chunkSize
573+ <> byteString " FROM "
574+ <> byteString name
575+ ))
576+ close name =
577+ (execute_ conn ("CLOSE " <> name) >> return ()) `E.catch` \ex ->
578+ -- Don't throw exception if CLOSE failed because the transaction is
579+ -- aborted. Otherwise, it will throw away the original error.
580+ if isFailedTransactionError ex then return () else throwIO ex
581+
582+ go = bracket declare close $ \name ->
583+ let loop a = do
584+ rs <- fetch name
585+ if null rs then return a else foldM f a rs >>= loop
586+ in loop a0
585587
586588-- FIXME: choose the Automatic chunkSize more intelligently
587589-- One possibility is to use the type of the results, although this
@@ -631,6 +633,64 @@ forEachWith_ :: RowParser r
631633forEachWith_ parser conn template = foldWith_ parser conn template () . const
632634{-# INLINE forEachWith_ #-}
633635
636+forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]
637+forM' lo hi m = loop hi []
638+ where
639+ loop !n !as
640+ | n < lo = return as
641+ | otherwise = do
642+ a <- m n
643+ loop (n-1) (a:as)
644+
645+finishQuery :: FromRow r => Connection -> Query -> PQ.Result -> IO [r]
646+finishQuery = finishQueryWith fromRow
647+
648+finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]
649+finishQueryWith parser conn q result = do
650+ status <- PQ.resultStatus result
651+ case status of
652+ PQ.EmptyQuery ->
653+ throwIO $ QueryError "query: Empty query" q
654+ PQ.CommandOk -> do
655+ throwIO $ QueryError "query resulted in a command response" q
656+ PQ.TuplesOk -> do
657+ let unCol (PQ.Col x) = fromIntegral x :: Int
658+ nrows <- PQ.ntuples result
659+ ncols <- PQ.nfields result
660+ forM' 0 (nrows-1) $ \row -> do
661+ let rw = Row row result
662+ okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn
663+ case okvc of
664+ Ok (val,col) | col == ncols -> return val
665+ | otherwise -> do
666+ vals <- forM' 0 (ncols-1) $ \c -> do
667+ tinfo <- getTypeInfo conn =<< PQ.ftype result c
668+ v <- PQ.getvalue result row c
669+ return ( tinfo
670+ , fmap ellipsis v )
671+ throw (ConversionFailed
672+ (show (unCol ncols) ++ " values: " ++ show vals)
673+ Nothing
674+ ""
675+ (show (unCol col) ++ " slots in target type")
676+ "mismatch between number of columns to \
677+ \convert and number in target type")
678+ Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"
679+ Errors [x] -> throwIO x
680+ Errors xs -> throwIO $ ManyErrors xs
681+ PQ.CopyOut ->
682+ throwIO $ QueryError "query: COPY TO is not supported" q
683+ PQ.CopyIn ->
684+ throwIO $ QueryError "query: COPY FROM is not supported" q
685+ PQ.BadResponse -> throwResultError "query" result status
686+ PQ.NonfatalError -> throwResultError "query" result status
687+ PQ.FatalError -> throwResultError "query" result status
688+
689+ellipsis :: ByteString -> ByteString
690+ellipsis bs
691+ | B.length bs > 15 = B.take 10 bs `B.append` "[...]"
692+ | otherwise = bs
693+
634694
635695-- $use
636696--
@@ -902,7 +962,7 @@ forEachWith_ parser conn template = foldWith_ parser conn template () . const
902962-- all values of the given PostgreSQL type is considered \"compatible\".
903963-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@
904964-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately
905−-- represent a @SMALLINT@, so it is considered compatible with those types.
965+-- represent a @SMALLINT@, so it is considered compatble with those types.
906966--
907967-- * A numeric compatibility check is based only on the type of a
908968-- 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+44
@@ -12,13 +12,31 @@ module Database.PostgreSQL.Simple.Compat
1212 ) where
1313
1414import qualified Control.Exception as E
15+import Data.Monoid
1516import Data.ByteString (ByteString)
1617import Data.ByteString.Lazy (toStrict)
1718import Data.ByteString.Builder (Builder, toLazyByteString)
19+
20+#if MIN_VERSION_scientific(0,3,0)
1821import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
22+#else
23+import Data.Scientific (scientificBuilder)
24+#endif
25+
26+#if __GLASGOW_HASKELL__ >= 702
1927import System.IO.Unsafe (unsafeDupablePerformIO)
28+#elif __GLASGOW_HASKELL__ >= 611
29+import GHC.IO (unsafeDupablePerformIO)
30+#else
31+import GHC.IOBase (unsafeDupablePerformIO)
32+#endif
33+
2034import Data.Fixed (Pico)
35+#if MIN_VERSION_base(4,7,0)
2136import Data.Fixed (Fixed(MkFixed))
37+#else
38+import Unsafe.Coerce (unsafeCoerce)
39+#endif
2240
2341-- | Like 'E.mask', but backported to base before version 4.3.0.
2442--
@@ -28,14 +46,40 @@ import Data.Fixed (Fixed(MkFixed))
2846-- 'withTransactionMode' function calls the restore callback only once, so we
2947-- don't need that polymorphism.
3048mask :: ((IO a -> IO a) -> IO b) -> IO b
49+#if MIN_VERSION_base(4,3,0)
3150mask io = E.mask $ \restore -> io restore
51+#else
52+mask io = do
53+ b <- E.blocked
54+ E.block $ io $ \m -> if b then m else E.unblock m
55+#endif
3256{-# INLINE mask #-}
3357
58+#if !MIN_VERSION_base(4,5,0)
59+infixr 6 <>
60+
61+(<>) :: Monoid m => m -> m -> m
62+(<>) = mappend
63+{-# INLINE (<>) #-}
64+#endif
65+
3466toByteString :: Builder -> ByteString
3567toByteString x = toStrict (toLazyByteString x)
3668
69+#if MIN_VERSION_base(4,7,0)
70+
3771toPico :: Integer -> Pico
3872toPico = MkFixed
3973
4074fromPico :: Pico -> Integer
4175fromPico (MkFixed i) = i
76+
77+#else
78+
79+toPico :: Integer -> Pico
80+toPico = unsafeCoerce
81+
82+fromPico :: Pico -> Integer
83+fromPico = unsafeCoerce
84+
85+#endif
src/Database/PostgreSQL/Simple/Copy.hs+6−36
@@ -9,7 +9,7 @@
99-- Stability: experimental
1010--
1111-- mid-level support for COPY IN and COPY OUT. See
12−-- <https://www.postgresql.org/docs/9.5/static/sql-copy.html> for
12+-- <http://www.postgresql.org/docs/9.2/static/sql-copy.html> for
1313-- more information.
1414--
1515-- To use this binding, first call 'copy' with an appropriate
@@ -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
@@ -76,18 +75,15 @@ doCopy :: B.ByteString -> Connection -> Query -> B.ByteString -> IO ()
7675doCopy funcName conn template q = do
7776 result <- exec conn q
7877 status <- PQ.resultStatus result
79− let errMsg msg = throwIO $ QueryError
80− (B.unpack funcName ++ " " ++ msg)
78+ let err = throwIO $ QueryError
79+ (B.unpack funcName ++ " " ++ show status)
8180 template
82− let err = errMsg $ show status
8381 case status of
8482 PQ.EmptyQuery -> err
8583 PQ.CommandOk -> err
8684 PQ.TuplesOk -> err
8785 PQ.CopyOut -> return ()
8886 PQ.CopyIn -> return ()
89− PQ.CopyBoth -> errMsg "COPY BOTH is not supported"
90− PQ.SingleTuple -> errMsg "single-row mode is not supported"
9187 PQ.BadResponse -> throwResultError funcName result status
9288 PQ.NonfatalError -> throwResultError funcName result status
9389 PQ.FatalError -> throwResultError funcName result status
@@ -101,30 +97,6 @@ data CopyOutResult
10197 deriving (Eq, Typeable, Show)
10298
10399
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−
128100-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection
129101-- must be in the @CopyOut@ state in order to call this function. If this
130102-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,
@@ -252,9 +224,7 @@ getCopyCommandTag funcName pqconn = do
252224 consumeResults pqconn
253225 let rowCount = P.string "COPY " *> (P.decimal <* P.endOfInput)
254226 case P.parseOnly rowCount cmdStat of
255− Left _ -> do mmsg <- PQ.errorMessage pqconn
256− fail $ errCmdStatusFmt
257− ++ maybe "" (\msg -> "\nConnection error: "++B.unpack msg) mmsg
227+ Left _ -> fail errCmdStatusFmt
258228 Right n -> return $! n
259229 where
260230 errCmdStatus = B.unpack funcName ++ ": failed to fetch command status"
src/Database/PostgreSQL/Simple/Cursor.hsdeleted−98
@@ -1,98 +0,0 @@
1−{-# LANGUAGE OverloadedStrings #-}
2−
3−------------------------------------------------------------------------------
4−-- |
5−-- Module: Database.PostgreSQL.Simple.Cursor
6−-- Copyright: (c) 2011-2012 Leon P Smith
7−-- (c) 2017 Bardur Arantsson
8−-- License: BSD3
9−-- Maintainer: Leon P Smith <leon@melding-monads.com>
10−--
11−------------------------------------------------------------------------------
12−
13−module Database.PostgreSQL.Simple.Cursor
14− (
15− -- * Types
16− Cursor
17− -- * Cursor management
18− , declareCursor
19− , closeCursor
20− -- * Folding over rows from a cursor
21− , foldForward
22− , foldForwardWithParser
23− ) where
24−
25−import Data.ByteString.Builder (intDec)
26−import Control.Applicative ((<$>))
27−import Control.Exception as E
28−import Control.Monad (unless, void)
29−import Data.Monoid (mconcat)
30−import Database.PostgreSQL.Simple.Compat ((<>), toByteString)
31−import Database.PostgreSQL.Simple.FromRow (FromRow(..))
32−import Database.PostgreSQL.Simple.Types (Query(..))
33−import Database.PostgreSQL.Simple.Internal as Base hiding (result, row)
34−import Database.PostgreSQL.Simple.Internal.PQResultUtils
35−import Database.PostgreSQL.Simple.Transaction
36−import qualified Database.PostgreSQL.LibPQ as PQ
37−
38−-- | Cursor within a transaction.
39−data Cursor = Cursor !Query !Connection
40−
41−-- | Declare a temporary cursor. The cursor is given a
42−-- unique name for the given connection.
43−declareCursor :: Connection -> Query -> IO Cursor
44−declareCursor conn q = do
45− name <- newTempName conn
46− void $ execute_ conn $ mconcat ["DECLARE ", name, " NO SCROLL CURSOR FOR ", q]
47− return $ Cursor name conn
48−
49−-- | Close the given cursor.
50−closeCursor :: Cursor -> IO ()
51−closeCursor (Cursor name conn) =
52− (void $ execute_ conn ("CLOSE " <> name)) `E.catch` \ex ->
53− -- Don't throw exception if CLOSE failed because the transaction is
54− -- aborted. Otherwise, it will throw away the original error.
55− unless (isFailedTransactionError ex) $ throwIO ex
56−
57−-- | Fold over a chunk of rows from the given cursor, calling the
58−-- supplied fold-like function on each row as it is received. In case
59−-- the cursor is exhausted, a 'Left' value is returned, otherwise a
60−-- 'Right' value is returned.
61−foldForwardWithParser :: Cursor -> RowParser r -> Int -> (a -> r -> IO a) -> a -> IO (Either a a)
62−foldForwardWithParser (Cursor name conn) parser chunkSize f a0 = do
63− let q = "FETCH FORWARD "
64− <> (toByteString $ intDec chunkSize)
65− <> " FROM "
66− <> fromQuery name
67− result <- exec conn q
68− status <- PQ.resultStatus result
69− case status of
70− PQ.TuplesOk -> do
71− nrows <- PQ.ntuples result
72− ncols <- PQ.nfields result
73− if nrows > 0
74− then do
75− let inner a row = do
76− x <- getRowWith parser row ncols conn result
77− f a x
78− Right <$> foldM' inner a0 0 (nrows - 1)
79− else
80− return $ Left a0
81− _ -> throwResultError "foldForwardWithParser" result status
82−
83−-- | Fold over a chunk of rows, calling the supplied fold-like function
84−-- on each row as it is received. In case the cursor is exhausted,
85−-- a 'Left' value is returned, otherwise a 'Right' value is returned.
86−foldForward :: FromRow r => Cursor -> Int -> (a -> r -> IO a) -> a -> IO (Either a a)
87−foldForward cursor = foldForwardWithParser cursor fromRow
88−
89−
90−foldM' :: (Ord n, Num n) => (a -> n -> IO a) -> a -> n -> n -> IO a
91−foldM' f a lo hi = loop a lo
92− where
93− loop x !n
94− | n > hi = return x
95− | otherwise = do
96− x' <- f x n
97− loop x' (n+1)
98−{-# INLINE foldM' #-}
src/Database/PostgreSQL/Simple/Errors.hs+11−12
@@ -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,18 +60,16 @@ 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--
70−-- > createUser = handleJust constraintViolation handler $ execute conn ...
69+-- > createUser = catchJust constraintViolation catcher $ execute conn ...
7170-- > where
72−-- > handler (UniqueViolation "user_login_key") = ...
73−-- > handler _ = ...
71+-- > catcher UniqueViolation "user_login_key" = ...
72+-- > catcher _ = ...
7473constraintViolation :: SqlError -> Maybe ConstraintViolation
7574constraintViolation e =
7675 case sqlState e of
@@ -85,16 +84,16 @@ constraintViolation e =
8584
8685-- | Like constraintViolation, but also packs original SqlError.
8786--
88−-- > createUser = handleJust constraintViolationE handler $ execute conn ...
87+-- > createUser = catchJust constraintViolationE catcher $ execute conn ...
8988-- > where
90−-- > handler (_, UniqueViolation "user_login_key") = ...
91−-- > handler (e, _) = throwIO e
89+-- > catcher (_, UniqueViolation "user_login_key") = ...
90+-- > catcher (e, _) = throwIO e
9291--
9392constraintViolationE :: SqlError -> Maybe (SqlError, ConstraintViolation)
9493constraintViolationE e = fmap ((,) e) $ constraintViolation e
9594
9695-- | Catches SqlError, tries to convert to ConstraintViolation, re-throws
97−-- on fail. Provides alternative interface to 'E.handleJust'
96+-- on fail. Provides alternative interface to catchJust
9897--
9998-- > createUser = catchViolation catcher $ execute conn ...
10099-- > where
@@ -125,7 +124,7 @@ parseMaybe p b = either (const Nothing) Just $ parseOnly p b
125124------------------------------------------------------------------------
126125-- Error predicates
127126--
128−-- https://www.postgresql.org/docs/9.5/static/errcodes-appendix.html
127+-- http://www.postgresql.org/docs/current/static/errcodes-appendix.html
129128
130129isSerializationError :: SqlError -> Bool
131130isSerializationError = isSqlState "40001"
src/Database/PostgreSQL/Simple/FromField.hs+77−152
@@ -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,24 @@ module Database.PostgreSQL.Simple.FromField
107106 , PQ.Oid(..)
108107 , PQ.Format(..)
109108 , pgArrayFieldParser
110− , attoFieldParser
111109
112− , optionalField
113110 , fromJSONField
114− , fromFieldJSONByteString
115111 ) where
116112
117113#include "MachDeps.h"
118114
119−import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )
115+import Control.Applicative ( (<|>), (<$>), pure, (*>), (<*) )
120116import Control.Concurrent.MVar (MVar, newMVar)
121−import Control.Exception (Exception (toException, fromException))
117+import Control.Exception (Exception)
122118import qualified Data.Aeson as JSON
119+import qualified Data.Aeson.Parser as JSON (value')
123120import Data.Attoparsec.ByteString.Char8 hiding (Result)
124121import Data.ByteString (ByteString)
125122import qualified Data.ByteString.Char8 as B
126−import Data.Functor.Identity (Identity(Identity))
127123import Data.Int (Int16, Int32, Int64)
128124import Data.IORef (IORef, newIORef)
129125import Data.Ratio (Ratio)
130−import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )
126+import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )
131127import Data.Typeable (Typeable, typeOf)
132128import Data.Vector (Vector)
133129import Data.Vector.Mutable (IOVector)
@@ -138,6 +134,7 @@ import Database.PostgreSQL.Simple.Ok
138134import Database.PostgreSQL.Simple.Types
139135import Database.PostgreSQL.Simple.TypeInfo as TI
140136import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI
137+import Database.PostgreSQL.Simple.TypeInfo.Macro as TI
141138import Database.PostgreSQL.Simple.Time
142139import Database.PostgreSQL.Simple.Arrays as Arrays
143140import qualified Database.PostgreSQL.LibPQ as PQ
@@ -154,8 +151,6 @@ import qualified Data.UUID.Types as UUID
154151import Data.Scientific (Scientific)
155152import GHC.Real (infinity, notANumber)
156153
157−import qualified Data.Aeson.Types as JSON
158−
159154-- | Exception thrown if conversion from a SQL value to a Haskell
160155-- value fails.
161156data ResultError = Incompatible { errSQLType :: String
@@ -182,9 +177,7 @@ data ResultError = Incompatible { errSQLType :: String
182177 -- between metadata and actual data in a row).
183178 deriving (Eq, Show, Typeable)
184179
185−instance Exception ResultError where
186− toException = postgresqlExceptionToException
187− fromException = postgresqlExceptionFromException
180+instance Exception ResultError
188181
189182left :: Exception a => a -> Conversion b
190183left = conversionError
@@ -250,11 +243,9 @@ tableOid Field{..} = toMaybeOid (unsafeDupablePerformIO (PQ.ftable result column
250243 then Nothing
251244 else Just x
252245
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@.
246+-- | If the column has a table associated with it, this returns the number
247+-- off the associated table column. Numbering starts from 0. Analogous
248+-- to libpq's @PQftablecol@.
258249
259250tableColumn :: Field -> Int
260251tableColumn Field{..} = fromCol (unsafeDupablePerformIO (PQ.ftablecol result column))
@@ -270,33 +261,16 @@ format Field{..} = unsafeDupablePerformIO (PQ.fformat result column)
270261-- | void
271262instance FromField () where
272263 fromField f _bs
273− | typeOid f /= TI.voidOid = returnError Incompatible f ""
264+ | typeOid f /= $(inlineTypoid TI.void) = returnError Incompatible f ""
274265 | otherwise = pure ()
275266
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−
282267-- | For dealing with null values. Compatible with any postgresql type
283268-- compatible with type @a@. Note that the type is not checked if
284269-- the value is null, although it is inadvisable to rely on this
285270-- behavior.
286−instance FromField a => FromField (Maybe a) where
287− fromField = optionalField fromField
288−
289−-- | For dealing with SQL @null@ values outside of the 'FromField' class.
290−-- Alternatively, one could use 'Control.Applicative.optional', but that
291−-- also turns type and conversion errors into 'Nothing', whereas this is
292−-- more specific and turns only @null@ values into 'Nothing'.
293−
294−optionalField :: FieldParser a -> FieldParser (Maybe a)
295−optionalField p f mv =
296− case mv of
297− Nothing -> pure Nothing
298− Just _ -> Just <$> p f mv
299−{-# INLINE optionalField #-}
271+instance (FromField a) => FromField (Maybe a) where
272+ fromField _ Nothing = pure Nothing
273+ fromField f bs = Just <$> fromField f bs
300274
301275-- | compatible with any data type, but the value must be null
302276instance FromField Null where
@@ -306,30 +280,30 @@ instance FromField Null where
306280-- | bool
307281instance FromField Bool where
308282 fromField f bs
309− | typeOid f /= TI.boolOid = returnError Incompatible f ""
283+ | typeOid f /= $(inlineTypoid TI.bool) = returnError Incompatible f ""
310284 | bs == Nothing = returnError UnexpectedNull f ""
311285 | bs == Just "t" = pure True
312286 | bs == Just "f" = pure False
313287 | otherwise = returnError ConversionFailed f ""
314288
315−-- | \"char\", bpchar
289+-- | \"char\"
316290instance FromField Char where
317− fromField f bs0 =
318− if (eq TI.charOid \/ eq TI.bpcharOid) (typeOid f)
319− then case bs0 of
291+ fromField f bs =
292+ if typeOid f /= $(inlineTypoid TI.char)
293+ then returnError Incompatible f ""
294+ else case bs of
320295 Nothing -> returnError UnexpectedNull f ""
321296 Just bs -> if B.length bs /= 1
322297 then returnError ConversionFailed f "length not 1"
323298 else return $! (B.head bs)
324− else returnError Incompatible f ""
325299
326300-- | int2
327301instance FromField Int16 where
328− fromField = attoFieldParser ok16 $ signed decimal
302+ fromField = atto ok16 $ signed decimal
329303
330304-- | int2, int4
331305instance FromField Int32 where
332− fromField = attoFieldParser ok32 $ signed decimal
306+ fromField = atto ok32 $ signed decimal
333307
334308#if WORD_SIZE_IN_BITS < 64
335309-- | int2, int4, and if compiled as 64-bit code, int8 as well.
@@ -339,37 +313,37 @@ instance FromField Int32 where
339313-- This library was compiled as 64-bit code.
340314#endif
341315instance FromField Int where
342− fromField = attoFieldParser okInt $ signed decimal
316+ fromField = atto okInt $ signed decimal
343317
344318-- | int2, int4, int8
345319instance FromField Int64 where
346− fromField = attoFieldParser ok64 $ signed decimal
320+ fromField = atto ok64 $ signed decimal
347321
348322-- | int2, int4, int8
349323instance FromField Integer where
350− fromField = attoFieldParser ok64 $ signed decimal
324+ fromField = atto ok64 $ signed decimal
351325
352326-- | int2, float4 (Uses attoparsec's 'double' routine, for
353327-- better accuracy convert to 'Scientific' or 'Rational' first)
354328instance FromField Float where
355− fromField = attoFieldParser ok (realToFrac <$> pg_double)
356− where ok = eq TI.float4Oid \/ eq TI.int2Oid
329+ fromField = atto ok (realToFrac <$> pg_double)
330+ where ok = $(mkCompats [TI.float4,TI.int2])
357331
358332-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for
359333-- better accuracy convert to 'Scientific' or 'Rational' first)
360334instance FromField Double where
361− fromField = attoFieldParser ok pg_double
362− where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid
335+ fromField = atto ok pg_double
336+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4])
363337
364338-- | int2, int4, int8, float4, float8, numeric
365339instance 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
340+ fromField = atto ok pg_rational
341+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.int8,TI.numeric])
368342
369343-- | int2, int4, int8, float4, float8, numeric
370344instance 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
345+ fromField = atto ok rational
346+ where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.int8,TI.numeric])
373347
374348unBinary :: Binary t -> t
375349unBinary (Binary x) = x
@@ -390,13 +364,13 @@ pg_rational
390364
391365-- | bytea, name, text, \"char\", bpchar, varchar, unknown
392366instance FromField SB.ByteString where
393− fromField f dat = if typeOid f == TI.byteaOid
367+ fromField f dat = if typeOid f == $(inlineTypoid TI.bytea)
394368 then unBinary <$> fromField f dat
395369 else doFromField f okText' pure dat
396370
397371-- | oid
398372instance FromField PQ.Oid where
399− fromField f dat = PQ.Oid <$> attoFieldParser (== TI.oidOid) decimal f dat
373+ fromField f dat = PQ.Oid <$> atto (== $(inlineTypoid TI.oid)) decimal f dat
400374
401375-- | bytea, name, text, \"char\", bpchar, varchar, unknown
402376instance FromField LB.ByteString where
@@ -404,7 +378,7 @@ instance FromField LB.ByteString where
404378
405379unescapeBytea :: Field -> SB.ByteString
406380 -> Conversion (Binary SB.ByteString)
407−unescapeBytea f str' = case unsafeDupablePerformIO (PQ.unescapeBytea str') of
381+unescapeBytea f str = case unsafeDupablePerformIO (PQ.unescapeBytea str) of
408382 Nothing -> returnError ConversionFailed f "unescapeBytea failed"
409383 Just str -> pure (Binary str)
410384
@@ -455,57 +429,48 @@ instance FromField [Char] where
455429
456430-- | timestamptz
457431instance FromField UTCTime where
458− fromField = ff TI.timestamptzOid "UTCTime" parseUTCTime
432+ fromField = ff $(inlineTypoid TI.timestamptz) "UTCTime" parseUTCTime
459433
460434-- | timestamptz
461435instance FromField ZonedTime where
462− fromField = ff TI.timestamptzOid "ZonedTime" parseZonedTime
436+ fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTime" parseZonedTime
463437
464438-- | timestamp
465439instance FromField LocalTime where
466− fromField = ff TI.timestampOid "LocalTime" parseLocalTime
440+ fromField = ff $(inlineTypoid TI.timestamp) "LocalTime" parseLocalTime
467441
468442-- | date
469443instance FromField Day where
470− fromField = ff TI.dateOid "Day" parseDay
444+ fromField = ff $(inlineTypoid TI.date) "Day" parseDay
471445
472446-- | time
473447instance FromField TimeOfDay where
474− fromField = ff TI.timeOid "TimeOfDay" parseTimeOfDay
448+ fromField = ff $(inlineTypoid TI.time) "TimeOfDay" parseTimeOfDay
475449
476450-- | timestamptz
477451instance FromField UTCTimestamp where
478− fromField = ff TI.timestamptzOid "UTCTimestamp" parseUTCTimestamp
452+ fromField = ff $(inlineTypoid TI.timestamptz) "UTCTimestamp" parseUTCTimestamp
479453
480454-- | timestamptz
481455instance FromField ZonedTimestamp where
482− fromField = ff TI.timestamptzOid "ZonedTimestamp" parseZonedTimestamp
456+ fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTimestamp" parseZonedTimestamp
483457
484458-- | timestamp
485459instance FromField LocalTimestamp where
486− fromField = ff TI.timestampOid "LocalTimestamp" parseLocalTimestamp
460+ fromField = ff $(inlineTypoid TI.timestamp) "LocalTimestamp" parseLocalTimestamp
487461
488462-- | date
489463instance 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
464+ fromField = ff $(inlineTypoid TI.date) "Date" parseDate
500465
501466ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)
502467 -> Field -> Maybe B8.ByteString -> Conversion a
503−ff compatOid hsType parseBS f mstr =
468+ff compatOid hsType parse f mstr =
504469 if typeOid f /= compatOid
505470 then err Incompatible ""
506471 else case mstr of
507472 Nothing -> err UnexpectedNull ""
508− Just str -> case parseBS str of
473+ Just str -> case parse str of
509474 Left msg -> err ConversionFailed msg
510475 Right val -> return val
511476 where
@@ -543,13 +508,13 @@ pgArrayFieldParser fieldParser f mdat = do
543508 _ -> returnError Incompatible f ""
544509
545510fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])
546−fromArray fieldParser typInfo f = sequence . (parseIt <$>) <$> array delim
511+fromArray fieldParser typeInfo f = sequence . (parseIt <$>) <$> array delim
547512 where
548− delim = typdelim (typelem typInfo)
549− fElem = f{ typeOid = typoid (typelem typInfo) }
513+ delim = typdelim (typelem typeInfo)
514+ fElem = f{ typeOid = typoid (typelem typeInfo) }
550515
551516 parseIt item =
552− fieldParser f' $ if item == Arrays.Plain "NULL" then Nothing else Just item'
517+ fieldParser f' $ if item' == "NULL" then Nothing else Just item'
553518 where
554519 item' = fmt delim item
555520 f' | Arrays.Array _ <- item = f
@@ -564,7 +529,7 @@ instance (FromField a, Typeable a) => FromField (IOVector a) where
564529-- | uuid
565530instance FromField UUID where
566531 fromField f mbs =
567− if typeOid f /= TI.uuidOid
532+ if typeOid f /= $(inlineTypoid TI.uuid)
568533 then returnError Incompatible f ""
569534 else case mbs of
570535 Nothing -> returnError UnexpectedNull f ""
@@ -573,26 +538,20 @@ instance FromField UUID where
573538 Nothing -> returnError ConversionFailed f "Invalid UUID"
574539 Just uuid -> pure uuid
575540
576−-- | json, jsonb
541+-- | json
577542instance 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
543+ fromField f mbs =
544+ if typeOid f /= $(inlineTypoid TI.json) && typeOid f /= $(inlineTypoid TI.jsonb)
589545 then returnError Incompatible f ""
590546 else case mbs of
591547 Nothing -> returnError UnexpectedNull f ""
592− Just bs -> pure bs
548+ Just bs ->
549+ case parseOnly (JSON.value' <* endOfInput) bs of
550+ Left err -> returnError ConversionFailed f err
551+ Right val -> pure val
593552
594553-- | Parse a field to a JSON 'JSON.Value' and convert that into a
595−-- Haskell value using the 'JSON.FromJSON' instance.
554+-- Haskell value using 'JSON.fromJSON'.
596555--
597556-- This can be used as the default implementation for the 'fromField'
598557-- method for Haskell types that have a JSON representation in
@@ -600,23 +559,14 @@ fromFieldJSONByteString f mbs =
600559--
601560-- The 'Typeable' constraint is required to show more informative
602561-- error messages when parsing fails.
603−--
604−-- Note that @fromJSONField :: FieldParser ('Maybe' Foo)@ will return
605−-- @'Nothing'@ on the json @null@ value, and return an exception on SQL @null@
606−-- value. Alternatively, one could write @'optionalField' fromJSONField@
607−-- that will return @Nothing@ on SQL @null@, and otherwise will call
608−-- @fromJSONField :: FieldParser Foo@ and then return @'Just'@ the
609−-- result value, or return its exception. If one would
610−-- like to return @Nothing@ on both the SQL @null@ and json @null@ values,
611−-- one way to do it would be to write
612−-- @\\f mv -> 'Control.Monad.join' '<$>' optionalField fromJSONField f mv@
613562fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a
614563fromJSONField f mbBs = do
615564 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
565+ case JSON.fromJSON value of
566+ JSON.Error err -> returnError ConversionFailed f $
567+ "JSON decoding error: " ++ err
568+ JSON.Success x -> pure x
569+
620570
621571-- | Compatible with the same set of types as @a@. Note that
622572-- modifying the 'IORef' does not have any effects outside
@@ -633,33 +583,20 @@ instance FromField a => FromField (MVar a) where
633583type Compat = PQ.Oid -> Bool
634584
635585okText, 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
586+okText = $( mkCompats [ TI.name, TI.text, TI.char,
587+ TI.bpchar, TI.varchar ] )
588+okText' = $( mkCompats [ TI.name, TI.text, TI.char,
589+ TI.bpchar, TI.varchar, TI.unknown ] )
590+okBinary = (== $( inlineTypoid TI.bytea ))
591+ok16 = (== $( inlineTypoid TI.int2 ))
592+ok32 = $( mkCompats [TI.int2,TI.int4] )
593+ok64 = $( mkCompats [TI.int2,TI.int4,TI.int8] )
644594#if WORD_SIZE_IN_BITS < 64
645595okInt = ok32
646596#else
647597okInt = ok64
648598#endif
649599
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−
663600doFromField :: forall a . (Typeable a)
664601 => Field -> Compat -> (ByteString -> Conversion a)
665602 -> Maybe ByteString -> Conversion a
@@ -684,22 +621,10 @@ returnError mkErr f msg = do
684621 (show (typeOf (undefined :: a)))
685622 msg
686623
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
624+atto :: forall a. (Typeable a)
625+ => Compat -> Parser a -> Field -> Maybe ByteString
626+ -> Conversion a
627+atto types p0 f dat = doFromField f types (go p0) dat
703628 where
704629 go :: Parser a -> ByteString -> Conversion a
705630 go p s =
src/Database/PostgreSQL/Simple/FromRow.hs+6−239
@@ -1,6 +1,4 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE RecordWildCards, FlexibleInstances, DefaultSignatures #-}
3−
1+{-# LANGUAGE RecordWildCards, FlexibleInstances #-}
42
53------------------------------------------------------------------------------
64-- |
@@ -29,7 +27,7 @@ module Database.PostgreSQL.Simple.FromRow
2927 ) where
3028
3129import Prelude hiding (null)
32−import Control.Applicative (Applicative(..), (<$>), (<|>), (*>), liftA2)
30+import Control.Applicative (Applicative(..), (<$>), (<|>), (*>))
3331import Control.Monad (replicateM, replicateM_)
3432import Control.Monad.Trans.State.Strict
3533import Control.Monad.Trans.Reader
@@ -47,17 +45,13 @@ import Database.PostgreSQL.Simple.Ok
4745import Database.PostgreSQL.Simple.Types ((:.)(..), Null)
4846import Database.PostgreSQL.Simple.TypeInfo
4947
50−import GHC.Generics
51−
52−
5348-- | A collection type that can be converted from a sequence of fields.
5449-- Instances are provided for tuples up to 10 elements and lists of any length.
5550--
5651-- Note that instances can be defined outside of postgresql-simple, which is
5752-- often useful. For example, here's an instance for a user-defined pair:
5853--
59−-- @
60−-- data User = User { name :: String, fileQuota :: Int }
54+-- @data User = User { name :: String, fileQuota :: Int }
6155--
6256-- instance 'FromRow' User where
6357-- fromRow = User \<$\> 'field' \<*\> 'field'
@@ -67,32 +61,13 @@ import GHC.Generics
6761-- in a single row of the query result. Otherwise, a 'ConversionFailed'
6862-- exception will be thrown.
6963--
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−--
87−-- Note that 'field' evaluates its result to WHNF, so the caveats listed in
64+-- Note that 'field' evaluates it's result to WHNF, so the caveats listed in
8865-- mysql-simple and very early versions of postgresql-simple no longer apply.
8966-- Instead, look at the caveats associated with user-defined implementations
9067-- of 'fromField'.
9168
9269class FromRow a where
9370 fromRow :: RowParser a
94− default fromRow :: (Generic a, GFromRow (Rep a)) => RowParser a
95− fromRow = to <$> gfromRow
9671
9772getvalue :: PQ.Result -> PQ.Row -> PQ.Column -> Maybe ByteString
9873getvalue result row col = unsafeDupablePerformIO (PQ.getvalue' result row col)
@@ -131,8 +106,8 @@ fieldWith fieldP = RP $ do
131106 else do
132107 let !result = rowresult
133108 !typeOid = unsafeDupablePerformIO (PQ.ftype result column)
134− !field' = Field{..}
135− lift (lift (fieldP field' (getvalue result row column)))
109+ !field = Field{..}
110+ lift (lift (fieldP field (getvalue result row column)))
136111
137112field :: FromField a => RowParser a
138113field = fieldWith fromField
@@ -255,196 +230,6 @@ instance (FromField a, FromField b, FromField c, FromField d, FromField e,
255230 null *> null *> null *> null *> null *> pure Nothing)
256231 <|> (Just <$> fromRow)
257232
258−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
259− FromField f, FromField g, FromField h, FromField i, FromField j,
260− FromField k) =>
261− FromRow (a,b,c,d,e,f,g,h,i,j,k) where
262− fromRow = (,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
263− <*> field <*> field <*> field <*> field <*> field
264− <*> field
265−
266−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
267− FromField f, FromField g, FromField h, FromField i, FromField j,
268− FromField k) =>
269− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k)) where
270− fromRow = (null *> null *> null *> null *> null *>
271− null *> null *> null *> null *> null *>
272− null *> pure Nothing)
273− <|> (Just <$> fromRow)
274−
275−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
276− FromField f, FromField g, FromField h, FromField i, FromField j,
277− FromField k, FromField l) =>
278− FromRow (a,b,c,d,e,f,g,h,i,j,k,l) where
279− fromRow = (,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
280− <*> field <*> field <*> field <*> field <*> field
281− <*> field <*> field
282−
283−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
284− FromField f, FromField g, FromField h, FromField i, FromField j,
285− FromField k, FromField l) =>
286− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l)) where
287− fromRow = (null *> null *> null *> null *> null *>
288− null *> null *> null *> null *> null *>
289− null *> null *> pure Nothing)
290− <|> (Just <$> fromRow)
291−
292−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
293− FromField f, FromField g, FromField h, FromField i, FromField j,
294− FromField k, FromField l, FromField m) =>
295− FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m) where
296− fromRow = (,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
297− <*> field <*> field <*> field <*> field <*> field
298− <*> field <*> field <*> field
299−
300−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
301− FromField f, FromField g, FromField h, FromField i, FromField j,
302− FromField k, FromField l, FromField m) =>
303− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m)) where
304− fromRow = (null *> null *> null *> null *> null *>
305− null *> null *> null *> null *> null *>
306− null *> null *> null *> pure Nothing)
307− <|> (Just <$> fromRow)
308−
309−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
310− FromField f, FromField g, FromField h, FromField i, FromField j,
311− FromField k, FromField l, FromField m, FromField n) =>
312− FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
313− fromRow = (,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
314− <*> field <*> field <*> field <*> field <*> field
315− <*> field <*> field <*> field <*> field
316−
317−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
318− FromField f, FromField g, FromField h, FromField i, FromField j,
319− FromField k, FromField l, FromField m, FromField n) =>
320− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n)) where
321− fromRow = (null *> null *> null *> null *> null *>
322− null *> null *> null *> null *> null *>
323− null *> null *> null *> null *> pure Nothing)
324− <|> (Just <$> fromRow)
325−
326−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
327− FromField f, FromField g, FromField h, FromField i, FromField j,
328− FromField k, FromField l, FromField m, FromField n, FromField o) =>
329− FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
330− fromRow = (,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
331− <*> field <*> field <*> field <*> field <*> field
332− <*> field <*> field <*> field <*> field <*> field
333−
334−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
335− FromField f, FromField g, FromField h, FromField i, FromField j,
336− FromField k, FromField l, FromField m, FromField n, FromField o) =>
337− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o)) where
338− fromRow = (null *> null *> null *> null *> null *>
339− null *> null *> null *> null *> null *>
340− null *> null *> null *> null *> null *> pure Nothing)
341− <|> (Just <$> fromRow)
342−
343−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
344− FromField f, FromField g, FromField h, FromField i, FromField j,
345− FromField k, FromField l, FromField m, FromField n, FromField o,
346− FromField p) =>
347− FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where
348− fromRow = (,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
349− <*> field <*> field <*> field <*> field <*> field
350− <*> field <*> field <*> field <*> field <*> field
351− <*> field
352−
353−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
354− FromField f, FromField g, FromField h, FromField i, FromField j,
355− FromField k, FromField l, FromField m, FromField n, FromField o,
356− FromField p) =>
357− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p)) where
358− fromRow = (null *> null *> null *> null *> null *>
359− null *> null *> null *> null *> null *>
360− null *> null *> null *> null *> null *>
361− null *> pure Nothing)
362− <|> (Just <$> fromRow)
363−
364−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
365− FromField f, FromField g, FromField h, FromField i, FromField j,
366− FromField k, FromField l, FromField m, FromField n, FromField o,
367− FromField p, FromField q) =>
368− FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where
369− fromRow = (,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
370− <*> field <*> field <*> field <*> field <*> field
371− <*> field <*> field <*> field <*> field <*> field
372− <*> field <*> field
373−
374−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
375− FromField f, FromField g, FromField h, FromField i, FromField j,
376− FromField k, FromField l, FromField m, FromField n, FromField o,
377− FromField p, FromField q) =>
378− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q)) where
379− fromRow = (null *> null *> null *> null *> null *>
380− null *> null *> null *> null *> null *>
381− null *> null *> null *> null *> null *>
382− null *> null *> pure Nothing)
383− <|> (Just <$> fromRow)
384−
385−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
386− FromField f, FromField g, FromField h, FromField i, FromField j,
387− FromField k, FromField l, FromField m, FromField n, FromField o,
388− FromField p, FromField q, FromField r) =>
389− FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where
390− fromRow = (,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
391− <*> field <*> field <*> field <*> field <*> field
392− <*> field <*> field <*> field <*> field <*> field
393− <*> field <*> field <*> field
394−
395−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
396− FromField f, FromField g, FromField h, FromField i, FromField j,
397− FromField k, FromField l, FromField m, FromField n, FromField o,
398− FromField p, FromField q, FromField r) =>
399− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r)) where
400− fromRow = (null *> null *> null *> null *> null *>
401− null *> null *> null *> null *> null *>
402− null *> null *> null *> null *> null *>
403− null *> null *> null *> pure Nothing)
404− <|> (Just <$> fromRow)
405−
406−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
407− FromField f, FromField g, FromField h, FromField i, FromField j,
408− FromField k, FromField l, FromField m, FromField n, FromField o,
409− FromField p, FromField q, FromField r, FromField s) =>
410− FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) where
411− fromRow = (,,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
412− <*> field <*> field <*> field <*> field <*> field
413− <*> field <*> field <*> field <*> field <*> field
414− <*> field <*> field <*> field <*> field
415−
416−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
417− FromField f, FromField g, FromField h, FromField i, FromField j,
418− FromField k, FromField l, FromField m, FromField n, FromField o,
419− FromField p, FromField q, FromField r, FromField s) =>
420− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s)) where
421− fromRow = (null *> null *> null *> null *> null *>
422− null *> null *> null *> null *> null *>
423− null *> null *> null *> null *> null *>
424− null *> null *> null *> null *> pure Nothing)
425− <|> (Just <$> fromRow)
426−
427−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
428− FromField f, FromField g, FromField h, FromField i, FromField j,
429− FromField k, FromField l, FromField m, FromField n, FromField o,
430− FromField p, FromField q, FromField r, FromField s, FromField t) =>
431− FromRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) where
432− fromRow = (,,,,,,,,,,,,,,,,,,,) <$> field <*> field <*> field <*> field <*> field
433− <*> field <*> field <*> field <*> field <*> field
434− <*> field <*> field <*> field <*> field <*> field
435− <*> field <*> field <*> field <*> field <*> field
436−
437−instance (FromField a, FromField b, FromField c, FromField d, FromField e,
438− FromField f, FromField g, FromField h, FromField i, FromField j,
439− FromField k, FromField l, FromField m, FromField n, FromField o,
440− FromField p, FromField q, FromField r, FromField s, FromField t) =>
441− FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)) where
442− fromRow = (null *> null *> null *> null *> null *>
443− null *> null *> null *> null *> null *>
444− null *> null *> null *> null *> null *>
445− null *> null *> null *> null *> null *> pure Nothing)
446− <|> (Just <$> fromRow)
447−
448233instance FromField a => FromRow [a] where
449234 fromRow = do
450235 n <- numFieldsRemaining
@@ -467,21 +252,3 @@ instance FromField a => FromRow (Maybe (Vector a)) where
467252
468253instance (FromRow a, FromRow b) => FromRow (a :. b) where
469254 fromRow = (:.) <$> fromRow <*> fromRow
470−
471−
472−
473−-- Type class for default implementation of FromRow using generics
474−class GFromRow f where
475− gfromRow :: RowParser (f p)
476−
477−instance GFromRow f => GFromRow (M1 c i f) where
478− gfromRow = M1 <$> gfromRow
479−
480−instance (GFromRow f, GFromRow g) => GFromRow (f :*: g) where
481− gfromRow = liftA2 (:*:) gfromRow gfromRow
482−
483−instance (FromField a) => GFromRow (K1 R a) where
484− gfromRow = K1 <$> field
485−
486−instance GFromRow U1 where
487− gfromRow = pure U1
src/Database/PostgreSQL/Simple/HStore.hs+2−2
@@ -8,14 +8,14 @@
88--
99-- Parsers and printers for hstore, a extended type bundled with
1010-- PostgreSQL providing finite maps from text strings to text strings.
11−-- See <https://www.postgresql.org/docs/9.5/static/hstore.html> for more
11+-- See <http://www.postgresql.org/docs/9.2/static/hstore.html> for more
1212-- information.
1313--
1414-- Note that in order to use this type, a database superuser must
1515-- install it by running a sql script in the share directory. This
1616-- can be done on PostgreSQL 9.1 and later with the command
1717-- @CREATE EXTENSION hstore@. See
18−-- <https://www.postgresql.org/docs/9.5/static/contrib.html> for more
18+-- <http://www.postgresql.org/docs/9.2/static/contrib.html> for more
1919-- information.
2020--
2121------------------------------------------------------------------------------
src/Database/PostgreSQL/Simple/HStore/Implementation.hs+11−11
@@ -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)
@@ -31,7 +34,6 @@ import Data.Text.Encoding.Error(UnicodeException)
3134import qualified Data.Text.Lazy as TL
3235import Data.Typeable
3336import Data.Monoid(Monoid(..))
34−import Data.Semigroup
3537import Database.PostgreSQL.Simple.FromField
3638import Database.PostgreSQL.Simple.ToField
3739
@@ -50,28 +52,26 @@ instance ToHStore HStoreBuilder where
5052toBuilder :: HStoreBuilder -> Builder
5153toBuilder x = case x of
5254 Empty -> mempty
53− Comma c -> c
55+ Comma x -> x
5456
5557toLazyByteString :: HStoreBuilder -> BL.ByteString
5658toLazyByteString x = case x of
5759 Empty -> BL.empty
58− Comma c -> BU.toLazyByteString c
60+ Comma x -> BU.toLazyByteString x
5961
60−instance Semigroup HStoreBuilder where
61− Empty <> x = x
62− Comma a <> x
62+instance Monoid HStoreBuilder where
63+ mempty = Empty
64+ mappend Empty x = x
65+ mappend (Comma a) x
6366 = Comma (a `mappend` case x of
6467 Empty -> mempty
6568 Comma b -> char8 ',' `mappend` b)
6669
67−instance Monoid HStoreBuilder where
68− mempty = Empty
69−
7070class ToHStoreText a where
7171 toHStoreText :: a -> HStoreText
7272
7373-- | Represents escape text, ready to be the key or value to a hstore value
74−newtype HStoreText = HStoreText Builder deriving (Typeable, Semigroup, Monoid)
74+newtype HStoreText = HStoreText Builder deriving (Typeable, Monoid)
7575
7676instance ToHStoreText HStoreText where
7777 toHStoreText = id
@@ -144,7 +144,7 @@ newtype HStoreMap = HStoreMap {fromHStoreMap :: Map Text Text} deriving (Eq, Or
144144
145145instance ToHStore HStoreMap where
146146 toHStore (HStoreMap xs) = Map.foldrWithKey f mempty xs
147− where f k v xs' = hstore k v `mappend` xs'
147+ where f k v xs = hstore k v `mappend` xs
148148
149149instance ToField HStoreMap where
150150 toField xs = toField (toHStore xs)
src/Database/PostgreSQL/Simple/HStore/Internal.hs+2
@@ -1,3 +1,5 @@
1+{-# OPTIONS_HADDOCK hide #-}
2+
13------------------------------------------------------------------------------
24-- |
35-- Module: Database.PostgreSQL.Simple.HStore.Internal
src/Database/PostgreSQL/Simple/Internal.hs+25−84
@@ -1,13 +1,10 @@
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-- |
96-- Module: Database.PostgreSQL.Simple.Internal
10−-- Copyright: (c) 2011-2015 Leon P Smith
7+-- Copyright: (c) 2011-2012 Leon P Smith
118-- License: BSD3
129-- Maintainer: Leon P Smith <leon@melding-monads.com>
1310-- Stability: experimental
@@ -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,40 +80,18 @@ 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
10886 , sqlErrorMsg :: ByteString
10987 , sqlErrorDetail :: ByteString
11088 , sqlErrorHint :: ByteString
111− } deriving (Eq, Show, Typeable)
89+ } deriving (Show, Typeable)
11290
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,20 +153,10 @@ 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.
192−-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>
193−-- for more information. Also note that environment variables also affect
194−-- parameters not provided, parameters provided as the empty string, and a
195−-- few other things; see
196−-- <https://www.postgresql.org/docs/9.5/static/libpq-envars.html>
197−-- for details. Here is an example with some of the most commonly used
198−-- parameters:
157+-- See <http://www.postgresql.org/docs/9.3/static/libpq-connect.html#LIBPQ-CONNSTRING>
158+-- for more information. Here is an example with some
159+-- of the most commonly used parameters:
199160--
200161-- > host='db.somedomain.com' port=5432 ...
201162--
@@ -223,9 +184,8 @@ withConnect connInfo = bracket (connect connInfo) close
223184--
224185-- Omitting @password@ will default to an appropriate password found
225186-- 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
228−-- <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for
187+-- not found. See
188+-- <http://www.postgresql.org/docs/9.3/static/libpq-pgpass.html> for
229189-- more information regarding this file.
230190--
231191-- As all parameters are optional and the defaults are sensible, the
@@ -243,20 +203,18 @@ withConnect connInfo = bracket (connect connInfo) close
243203-- or production machines, or you will need to use a @pgpass@ file
244204-- with the @password@ or @md5@ authentication methods.
245205--
246−-- See <https://www.postgresql.org/docs/9.5/static/client-authentication.html>
206+-- See <http://www.postgresql.org/docs/9.3/static/client-authentication.html>
247207-- for more information regarding the authentication process.
248208--
249209-- SSL/TLS will typically "just work" if your postgresql server supports or
250210-- requires it. However, note that libpq is trivially vulnerable to a MITM
251−-- attack without setting additional SSL connection parameters. In
252−-- particular, @sslmode@ needs to be set to @require@, @verify-ca@, or
211+-- attack without setting additional SSL parameters in the connection string.
212+-- In particular, @sslmode@ needs to be set to @require@, @verify-ca@, or
253213-- @verify-full@ in order to perform certificate validation. When @sslmode@
254214-- is @require@, then you will also need to specify a @sslrootcert@ file,
255215-- otherwise no validation of the server's identity will be performed.
256216-- Client authentication via certificates is also possible via the
257−-- @sslcert@ and @sslkey@ parameters. See
258−-- <https://www.postgresql.org/docs/9.5/static/libpq-ssl.html>
259−-- for detailed information regarding libpq and SSL.
217+-- @sslcert@ and @sslkey@ parameters.
260218
261219connectPostgreSQL :: ByteString -> IO Connection
262220connectPostgreSQL connstr = do
@@ -323,7 +281,7 @@ postgreSQLConnectionString connectInfo = fromString connstr
323281
324282 str name field
325283 | null value = id
326− | otherwise = showString name . addQuotes value . space
284+ | otherwise = showString name . quote value . space
327285 where value = field connectInfo
328286
329287 num name field
@@ -331,7 +289,7 @@ postgreSQLConnectionString connectInfo = fromString connstr
331289 | otherwise = showString name . shows value . space
332290 where value = field connectInfo
333291
334− addQuotes s rest = '\'' : foldr delta ('\'' : rest) s
292+ quote str rest = '\'' : foldr delta ('\'' : rest) str
335293 where
336294 delta c cs = case c of
337295 '\\' -> '\\' : '\\' : cs
@@ -387,7 +345,6 @@ exec conn sql =
387345 Just res -> do
388346 status <- PQ.resultStatus res
389347 case status of
390− -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple
391348 PQ.EmptyQuery -> getResult h mres'
392349 PQ.CommandOk -> getResult h mres'
393350 PQ.TuplesOk -> getResult h mres'
@@ -408,7 +365,6 @@ finishExecute :: Connection -> Query -> PQ.Result -> IO Int64
408365finishExecute _conn q result = do
409366 status <- PQ.resultStatus result
410367 case status of
411− -- FIXME: handle PQ.CopyBoth and PQ.SingleTuple
412368 PQ.EmptyQuery -> throwIO $ QueryError "execute: Empty query" q
413369 PQ.CommandOk -> do
414370 ncols <- PQ.nfields result
@@ -419,7 +375,7 @@ finishExecute _conn q result = do
419375 nstr <- PQ.cmdTuples result
420376 return $ case nstr of
421377 Nothing -> 0 -- is this appropriate?
422− Just str -> mkInteger str
378+ Just str -> toInteger str
423379 PQ.TuplesOk -> do
424380 ncols <- PQ.nfields result
425381 throwIO $ QueryError ("execute resulted in " ++ show ncols ++
@@ -432,7 +388,7 @@ finishExecute _conn q result = do
432388 PQ.NonfatalError -> throwResultError "execute" result status
433389 PQ.FatalError -> throwResultError "execute" result status
434390 where
435− mkInteger str = B8.foldl' delta 0 str
391+ toInteger str = B8.foldl' delta 0 str
436392 where
437393 delta acc c =
438394 if '0' <= c && c <= '9'
@@ -447,8 +403,8 @@ throwResultError _ result status = do
447403 PQ.resultErrorField result PQ.DiagMessageDetail
448404 hint <- fromMaybe "" <$>
449405 PQ.resultErrorField result PQ.DiagMessageHint
450− state' <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate
451− throwIO $ SqlError { sqlState = state'
406+ state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate
407+ throwIO $ SqlError { sqlState = state
452408 , sqlExecStatus = status
453409 , sqlErrorMsg = errormsg
454410 , sqlErrorDetail = detail
@@ -517,6 +473,7 @@ instance Alternative Conversion where
517473 Errors _ -> (oka <|>) <$> runConversion mb conn
518474
519475instance Monad Conversion where
476+ return a = Conversion $ \_conn -> return (return a)
520477 m >>= f = Conversion $ \conn -> do
521478 oka <- runConversion m conn
522479 case oka of
@@ -531,7 +488,7 @@ conversionMap :: (Ok a -> Ok b) -> Conversion a -> Conversion b
531488conversionMap f m = Conversion $ \conn -> f <$> runConversion m conn
532489
533490conversionError :: Exception err => err -> Conversion a
534−conversionError err = Conversion $ \_ -> return (Errors [toException err])
491+conversionError err = Conversion $ \_ -> return (Errors [SomeException err])
535492
536493newTempName :: Connection -> IO Query
537494newTempName Connection{..} = do
@@ -619,19 +576,3 @@ escapeIdentifier = escapeWrap PQ.escapeIdentifier
619576
620577escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)
621578escapeByteaConn = 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.hsdeleted−123
@@ -1,123 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−------------------------------------------------------------------------------
4−-- |
5−-- Module: Database.PostgreSQL.Simple.Internal.PQResultUtils
6−-- Copyright: (c) 2011 MailRank, Inc.
7−-- (c) 2011-2012 Leon P Smith
8−-- License: BSD3
9−-- Maintainer: Leon P Smith <leon@melding-monads.com>
10−-- Stability: experimental
11−--
12−------------------------------------------------------------------------------
13−
14−
15−module Database.PostgreSQL.Simple.Internal.PQResultUtils
16− ( finishQueryWith
17− , finishQueryWithV
18− , finishQueryWithVU
19− , getRowWith
20− ) where
21−
22−import Control.Exception as E
23−import Data.ByteString (ByteString)
24−import Data.Foldable (for_)
25−import Database.PostgreSQL.Simple.FromField (ResultError(..))
26−import Database.PostgreSQL.Simple.Ok
27−import Database.PostgreSQL.Simple.Types (Query(..))
28−import Database.PostgreSQL.Simple.Internal as Base hiding (result, row)
29−import Database.PostgreSQL.Simple.TypeInfo
30−import qualified Database.PostgreSQL.LibPQ as PQ
31−import 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
36−import Control.Monad.Trans.Reader
37−import Control.Monad.Trans.State.Strict
38−
39−finishQueryWith :: 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
72− status <- PQ.resultStatus result
73− case status of
74− PQ.TuplesOk -> k
75− 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?)"
77− PQ.CopyOut -> queryErr "query: COPY TO is not supported"
78− PQ.CopyIn -> queryErr "query: COPY FROM is not supported"
79− PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"
80− PQ.SingleTuple -> queryErr "query: single-row mode is not supported"
81− PQ.BadResponse -> throwResultError "query" result status
82− PQ.NonfatalError -> throwResultError "query" result status
83− PQ.FatalError -> throwResultError "query" result status
84− where
85− queryErr msg = throwIO $ QueryError msg q
86−
87−getRowWith :: RowParser r -> PQ.Row -> PQ.Column -> Connection -> PQ.Result -> IO r
88−getRowWith parser row ncols conn result = do
89− let rw = Row row result
90− let unCol (PQ.Col x) = fromIntegral x :: Int
91− okvc <- runConversion (runStateT (runReaderT (unRP parser) rw) 0) conn
92− case okvc of
93− Ok (val,col) | col == ncols -> return val
94− | otherwise -> do
95− vals <- forM' 0 (ncols-1) $ \c -> do
96− tinfo <- getTypeInfo conn =<< PQ.ftype result c
97− v <- PQ.getvalue result row c
98− return ( tinfo
99− , fmap ellipsis v )
100− throw (ConversionFailed
101− (show (unCol ncols) ++ " values: " ++ show vals)
102− Nothing
103− ""
104− (show (unCol col) ++ " slots in target type")
105− "mismatch between number of columns to convert and number in target type")
106− Errors [] -> throwIO $ ConversionFailed "" Nothing "" "" "unknown error"
107− Errors [x] -> throwIO x
108− Errors xs -> throwIO $ ManyErrors xs
109−
110−ellipsis :: ByteString -> ByteString
111−ellipsis bs
112− | B.length bs > 15 = B.take 10 bs `B.append` "[...]"
113− | otherwise = bs
114−
115−forM' :: (Ord n, Num n) => n -> n -> (n -> IO a) -> IO [a]
116−forM' lo hi m = loop hi []
117− where
118− loop !n !as
119− | n < lo = return as
120− | otherwise = do
121− a <- m n
122− loop (n-1) (a:as)
123−{-# INLINE forM' #-}
src/Database/PostgreSQL/Simple/LargeObjects.hs+1−1
@@ -7,7 +7,7 @@
77-- Maintainer : leon@melding-monads.com
88--
99-- Support for PostgreSQL's Large Objects; see
10−-- <https://www.postgresql.org/docs/9.5/static/largeobjects.html> for more
10+-- <http://www.postgresql.org/docs/9.1/static/largeobjects.html> for more
1111-- information.
1212--
1313-- Note that Large Object File Descriptors are only valid within a single
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+32−62
@@ -5,8 +5,7 @@
55-----------------------------------------------------------------------------
66-- |
77-- Module : Database.PostgreSQL.Simple.Notification
8−-- Copyright : (c) 2011-2015 Leon P Smith
9−-- (c) 2012 Joey Adams
8+-- Copyright : (c) 2011-2012 Leon P Smith
109-- License : BSD3
1110--
1211-- Maintainer : leon@melding-monads.com
@@ -14,7 +13,7 @@
1413--
1514-- Support for receiving asynchronous notifications via PostgreSQL's
1615-- Listen/Notify mechanism. See
17−-- <https://www.postgresql.org/docs/9.5/static/sql-notify.html> for more
16+-- <http://www.postgresql.org/docs/9.1/static/sql-notify.html> for more
1817-- information.
1918--
2019-- Note that on Windows, @getNotification@ currently uses a polling loop
@@ -25,7 +24,7 @@
2524-- Notifications do not create any extra work for the backend, and are
2625-- likely cheaper on the client side as well.
2726--
28−-- <https://hackage.haskell.org/trac/ghc/ticket/7353>
27+-- <http://hackage.haskell.org/trac/ghc/ticket/7353>
2928--
3029-----------------------------------------------------------------------------
3130
@@ -36,27 +35,19 @@ module Database.PostgreSQL.Simple.Notification
3635 , getBackendPID
3736 ) where
3837
39−import Control.Monad ( join, void )
40−import Control.Exception ( throwIO, catch )
38+import Control.Concurrent
39+import Control.Monad ( when )
40+import Control.Exception ( throwIO )
4141import qualified Data.ByteString as B
42−import qualified Data.ByteString.Char8 as B8
4342import Database.PostgreSQL.Simple.Internal
4443import qualified Database.PostgreSQL.LibPQ as PQ
4544import System.Posix.Types ( CPid )
46−import GHC.IO.Exception ( ioe_location )
47−
48−#if defined(mingw32_HOST_OS)
49−import Control.Concurrent ( threadDelay )
50−#else
51−import GHC.Conc ( atomically )
52−import Control.Concurrent ( threadWaitReadSTM )
53−#endif
5445
5546data Notification = Notification
56− { notificationPid :: {-# UNPACK #-} !CPid
57− , notificationChannel :: {-# UNPACK #-} !B.ByteString
58− , notificationData :: {-# UNPACK #-} !B.ByteString
59− } deriving (Show, Eq)
47+ { notificationPid :: !CPid
48+ , notificationChannel :: !B.ByteString
49+ , notificationData :: !B.ByteString
50+ }
6051
6152convertNotice :: PQ.Notify -> Notification
6253convertNotice PQ.Notify{..}
@@ -66,56 +57,35 @@ convertNotice PQ.Notify{..}
6657
6758-- | Returns a single notification. If no notifications are available,
6859-- 'getNotification' blocks until one arrives.
69−--
70−-- It is safe to call 'getNotification' on a connection that is concurrently
71−-- being used for other purposes, note however that PostgreSQL does not
72−-- deliver notifications while a connection is inside a transaction.
7360
7461getNotification :: Connection -> IO Notification
75−getNotification conn = join $ withConnection conn fetch
62+getNotification conn = loop False
7663 where
7764 funcName = "Database.PostgreSQL.Simple.Notification.getNotification"
78−
79− fetch c = do
80− mmsg <- PQ.notifies c
81− case mmsg of
82− Just msg -> return (return $! convertNotice msg)
83− Nothing -> do
84− mfd <- PQ.socket c
85− case mfd of
86− Nothing -> return (throwIO $! fdError funcName)
65+ loop doConsume = do
66+ res <- withConnection conn $ \c -> do
67+ when doConsume (PQ.consumeInput c >> return ())
68+ mmsg <- PQ.notifies c
69+ case mmsg of
70+ Nothing -> do
71+ mfd <- PQ.socket c
72+ case mfd of
73+ Nothing -> throwIO $ fdError funcName
74+ Just fd -> return (Left fd)
75+ Just msg -> return (Right msg)
76+ -- FIXME? what happens if the connection is closed/reset right here?
77+ case res of
8778#if defined(mingw32_HOST_OS)
88− -- threadWaitRead doesn't work for sockets on Windows, so just
89− -- poll for input every second (PQconsumeInput is non-blocking).
90− --
91− -- We could call select(), but FFI calls can't be interrupted
92− -- with async exceptions, whereas threadDelay can.
93− Just _fd -> do
94− return (threadDelay 1000000 >> loop)
79+ -- threadWaitRead doesn't work for sockets on Windows, so just poll
80+ -- for input every second (PQconsumeInput is non-blocking).
81+ --
82+ -- We could call select(), but FFI calls can't be interrupted with
83+ -- async exceptions, whereas threadDelay can.
84+ Left _fd -> threadDelay 1000000 >> loop True
9585#else
96− -- This case fixes the race condition above. By registering
97− -- our interest in the descriptor before we drop the lock,
98− -- there is no opportunity for the descriptor index to be
99− -- reallocated on us.
100− --
101− -- (That is, assuming there isn't concurrently executing
102− -- code that manipulates the descriptor without holding
103− -- the lock... but such a major bug is likely to exhibit
104− -- itself in an at least somewhat more dramatic fashion.)
105− Just fd -> do
106− (waitRead, _) <- threadWaitReadSTM fd
107− return $ do
108− atomically waitRead `catch` (throwIO . setIOErrorLocation)
109− loop
86+ Left fd -> threadWaitRead fd >> loop True
11087#endif
111−
112− loop = join $ withConnection conn $ \c -> do
113− void $ PQ.consumeInput c
114− fetch c
115−
116− setIOErrorLocation :: IOError -> IOError
117− setIOErrorLocation err = err { ioe_location = B8.unpack funcName }
118−
88+ Right msg -> return $! convertNotice msg
11989
12090-- | Non-blocking variant of 'getNotification'. Returns a single notification,
12191-- if available. If no notifications are available, returns 'Nothing'.
src/Database/PostgreSQL/Simple/Ok.hs+4−10
@@ -1,11 +1,10 @@
11{-# LANGUAGE DeriveDataTypeable #-}
22{-# LANGUAGE DeriveFunctor #-}
3−{-# LANGUAGE CPP #-}
43
54------------------------------------------------------------------------------
65-- |
76-- Module : Database.PostgreSQL.Simple.Ok
8−-- Copyright : (c) 2012-2015 Leon P Smith
7+-- Copyright : (c) 2012 Leon P Smith
98-- License : BSD3
109--
1110-- Maintainer : leon@melding-monads.com
@@ -21,7 +20,7 @@
2120-- commonly-used type and typeclass included in @base@.
2221--
2322-- Extending the failure case to a list of 'SomeException's enables a
24−-- more sensible 'Alternative' instance definitions: '<|>' concatenates
23+-- more sensible 'Alternative' instance definitions: '<|>' concatinates
2524-- the list of exceptions when both cases fail, and 'empty' is defined as
2625-- 'Errors []'. Though '<|>' one could pick one of two exceptions, and
2726-- throw away the other, and have 'empty' provide a generic exception,
@@ -37,8 +36,6 @@ import Control.Exception
3736import Control.Monad(MonadPlus(..))
3837import Data.Typeable
3938
40−import qualified Control.Monad.Fail as Fail
41−
4239-- FIXME: [SomeException] should probably be something else, maybe
4340-- a difference list (or a tree?)
4441
@@ -72,14 +69,11 @@ instance MonadPlus Ok where
7269 mplus = (<|>)
7370
7471instance Monad Ok where
72+ return = Ok
73+
7574 Errors es >>= _ = Errors es
7675 Ok a >>= f = f a
7776
78−#if !(MIN_VERSION_base(4,13,0))
79− fail = Fail.fail
80−#endif
81−
82−instance Fail.MonadFail Ok where
8377 fail str = Errors [SomeException (ErrorCall str)]
8478
8579-- | 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+50−215
@@ -1,216 +1,53 @@
1−{- |
2−Module: Database.PostgreSQL.Simple.Time
3−Copyright: (c) 2012-2015 Leon P Smith
4−License: BSD3
5−Maintainer: Leon P Smith <leon@melding-monads.com>
6−Stability: experimental
7−
8−This module provides time types that supports positive and negative
9−infinity, as well as some functions for converting to and from strings.
10−
11−Also, this module also contains commentary regarding postgresql's timestamp
12−types, civil timekeeping in general, and how it relates to
13−postgresql-simple. You can read more about PostgreSQL's date and time types
14−at <https://www.postgresql.org/docs/9.5/static/datatype-datetime.html>,
15−and the IANA time zone database at <https://en.wikipedia.org/wiki/Tz_database>.
16−
17−Stack Overflow also has some excellent commentary on time, if it is a
18−wiki page or a highly upvoted question and answer. If the answer regarding
19−time has not received about a hundred upvotes at least, then the answer is
20−almost invariably completely and painfully wrong, even if it's the chosen
21−answer or the most highly upvoted answer to a question.
22−
23−PostgreSQL's @timestamp with time zone@ (hereafter, @timestamptz@) can be
24−converted to Haskell's 'Data.Time.UTCTime' and 'Data.Time.ZonedTime' types,
25−because values of these types represent a self-contained, unambiguous point
26−in time. PostgreSQL's @timestamp without time zone@ (hereafter, @timestamp@)
27−can be converted to Haskell's 'Data.Time.LocalTime', because values of these
28−types are ambiguous by themselves, and require context to disambiguate.
29−
30−While this behavior may be superficially counterintuitive because the
31−names might suggest otherwise, this behavior is correct. In fact,
32−the \"timezone\" language in both the postgresql and haskell types would
33−be better read as \"offset (from UTC)\", thus we have postgresql's
34−\"timestamp with offset\" corresponding to Haskell's \"time with the
35−offset \'zero\'\" and Haskell's \"time with an offset (that might be
36−nonzero)\". Similarly, postgresql's \"timestamp without an offset\"
37−corresponds to Haskell's \"local time (without an offset)\".
38−
39−It's important to distinguish between an offset, a standard time, and
40−a time zone. An offset is simply a difference of a local time from UTC,
41−such as @+00@, @-05@, or @+05:30@. A standard time specifies an offset
42−(which may vary throughout the year, due to daylight savings) that a
43−region follows, such as Universal Coordinated Time (UTC), Eastern Standard
44−Time\/Eastern Daylight Time (EST\/EDT), or India Standard Time (IST).
45−And a time zone, much like a standard time, is a function from
46−timestamps to offsets.
47−
48−A time zone is different from a standard time because different regions
49−inside a standard time can be governed by different civil authorities with
50−different laws and thus have different histories of civil time. An IANA
51−time zone is any region of the world that has had the same history of
52−civil time since @1970-01-01 00:00+00@.
53−
54−For example, as of today, both @America\/New_York@ and
55−@America\/Indiana\/Indianapolis@ are on the EST\/EDT time standard, but
56−Indiana used to be on Central Standard Time until 1942, and did not observe
57−daylight savings time (EST only) until 2006. Thus, the choice between
58−these two time zones still matters if you are dealing with timestamps
59−prior to 2006, and could become relevant again if (most of) Indiana
60−moves back to Central Time. (Of course, if the Central to Eastern switch
61−was the only difference, then these two time zones would be the same in
62−IANA's eyes, due to their cutoff date of 1970-01-01.)
63−
64−Getting back to practicalities, PostgreSQL's @timestamptz@ type does not
65−actually store an offset; rather, it uses the offset provided to calculate
66−UTC, and stores the timestamp as UTC. If an offset is not provided, the
67−given timestamp is assumed to be a local time for whatever the @timezone@
68−variable is set to, and the IANA TZ database is consulted to calculate an
69−offset from UTC for the time in question.
70−
71−Note that while most (local timestamp, time zone) pairs correspond to exactly
72−one UTC timestamp, some correspond to two UTC timestamps, while others
73−correspond to none at all. The ambiguous case occurs when the civil time
74−is rolled back, making a calendar day longer than 24 hours. In this case,
75−PostgreSQL silently chooses the second, later possibility. The inconsistent
76−case occurs when the civil time is moved forward, making a calendar day less
77−than 24 hours. In this case, PostgreSQL silently assumes the local time
78−was read off a clock that had not been moved forward at the prescribed time,
79−and moves the clock forward for you. Thus, converting from local time
80−to UTC need not be monotonic, if these inconsistent cases are allowed.
81−
82−When retrieving a @timestamptz@, the backend looks at the @time zone@
83−connection variable and then consults the IANA TZ database to calculate
84−an offset for the timestamp in the given time zone.
85−
86−Note that while some of the information contained in the IANA TZ database
87−is a bit of a standardized fiction, the conversion from UTC time to a
88−(local time, offset) pair in a particular time zone is always unambiguous,
89−and the result can always be unambiguously converted back to UTC. Thus,
90−postgresql-simple can interpret such a result as a 'Data.Time.ZonedTime',
91−or use the offset to convert back to 'Data.Time.UTCTime'.
92−
93−By contrast, the @timestamp@ type ignores any offsets provided to it,
94−and never sends back an offset. Thus, postgresql-simple equates this
95−with 'Data.Time.LocalTime', which has no concept of an offset. One can
96−convert between @timestamptz@ and @timestamp@ using the @AT TIME ZONE@
97−operator, whose semantics also demonstrates that @timestamptz@ is
98−'Data.Time.UTCTime' whereas @timestamp@ is 'Data.Time.LocalTime'.
99−
100−PostgreSQL's @timezone@ is a per-connection variable that by default is
101−initialized to @\'localtime\'@, which normally corresponds to the server's
102−time zone. However, this default can be modified on the server side for an
103−entire cluster, or on a per-user or per-database basis. Moreover, a client
104−can modify their instance of the variable at any time, and can apply that
105−change to the remaining duration of the connection, the current transaction,
106−or the execution context of a server-side function. In addition, upon
107−connection initialization, the libpq client checks for the existence of
108−the @PGTZ@ environment variable, and if it exists, modifies @timezone@
109−accordingly.
110−
111−With a few caveats, postgresql-simple is designed so that you can both send
112−and receive timestamps with the server and get a correct result, no matter
113−what the @timezone@ setting is. But it is important to understand the caveats:
114−
115−1. The correctness of server-side computations can depend on the @timezone@
116− setting. Examples include adding an @interval@ to a @timestamptz@, or
117− type casting between @timestamp@ and @timestamptz@, or applying
118− the @DATE@ function to a @timestamptz@.
119−
120−2. The (localtime, offset) pair contained in a 'Data.Time.ZonedTime' result
121− will depend on the @timezone@ setting, although the result will always
122− represent the same instant in time regardless of the time zone.
123−
124−3. Sending a 'Data.Time.LocalTime' and interpreting it as a @timestamptz@
125− can be useful, as it will be converted to UTC via the tz database,
126− but correctness will depend on the @timezone@ setting. You may prefer
127− to use an explicit @AT TIME ZONE@ conversion instead, which would avoid
128− this contextual dependence.
129−
130−Furthermore, although these following points don't involve the @timezone@
131−setting, they are related to the last point above:
132−
133−1. Sending a 'Data.Time.UTCTime' and interpreting it as a @timestamp@ can
134− be useful. In practice, the most common context used to disambiguate
135− @timestamp@ is that it represents UTC, and this coding technique will
136− work as expected in this situation.
137−
138−2. Sending a 'Data.Time.ZonedTime' and interpreting it as a @timestamp@ is
139− almost always the wrong thing to do, as the offset will be ignored and
140− discarded. This is likely to lead to inconsistencies in the database,
141− and may lead to partial data loss.
142−
143−When dealing with local timestamps that refer to the future, it is often
144−useful to store it as a local time in a @timestamp@ column and store the
145−time zone in a second column. One reason to do this is so that you can
146−convert to UTC on the fly as needed, and be protected against future changes
147−to the TZ database due to changes in local time standards. In any case,
148−'Data.Time.ZonedTime' is not suitable for this application, because despite
149−its name, it represents an offset and not a time zone. Time zones can change;
150−offsets do not. In reality, we can't convert a local timestamp that occurs
151−sufficiently far in the future to UTC, because we don't know how to do it yet.
152−
153−There are a few limitations and caveats that one might need to be aware
154−of with the current implementation when dealing with older timestamps:
155−
156−For sufficiently old timestamps in almost all time zones, the IANA TZ
157−database specifies offsets from UTC that is not an integral number of
158−minutes. This corresponds to local mean time; that is, astronomical
159−time in the city that defines the time zone. Different time zones moved
160−away from local mean time to a standard time at different points in
161−history, so \"sufficiently old\" depends on the time zone in question.
162−
163−Thus, when retrieving a @timestamptz@ postgresql will in some cases
164−provide seconds in the offset. For example:
165−
166−@
167−$ psql
168−psql (9.4.5)
169−Type \"help\" for help.
170−
171−lpsmith=> SET timezone TO \'America/New_York\';
172−SET
173−lpsmith=> VALUES (\'1883-11-18 16:59:59+00\'::timestamptz),
174− (\'1883-11-18 17:00:00+00\'::timestamptz);
175− column1
176−------------------------------
177− 1883-11-18 12:03:57-04:56:02
178− 1883-11-18 12:00:00-05
179−(2 rows)
180−@
181−
182−Both of these timestamps can be parsed as a 'Data.Time.UTCTime' type,
183−however 'Data.Time.ZonedTime' will fail on the former timestamp.
184−Because 'Data.Time.ZonedTime' assumes that offsets are an integer number
185−of minutes, there isn't an particularly good solution here.
186−
187−PostgreSQL, like most software, uses the proleptic Gregorian calendar
188−for its date calculations, extending the Gregorian calendar backwards
189−in time before its introduction and pretending that the Julian calendar
190−does not exist. For most purposes, the adoption of the Gregorian calendar
191−ranges from @1582-10-15@ to @1923-03-01@, depending on location and
192−sometimes even political allegiances within a single location.
193−
194−Timestamps BCE are not supported. For example, PostgreSQL
195−will emit \"@0045-01-01 BC@\" for the first proleptic Gregorian day of
196−the year the Roman Empire adopted the Julian Calendar, but
197−postgresql-simple does not (yet?) have the ability to either parse or
198−generate this syntax. Unfortunately this syntax isn't convenient to
199−print or especially parse.
200−
201−Also, postgresql itself cannot parse or print dates before @4714-11-24 BC@,
202−which is the Julian date on the proleptic Gregorian Calendar. Although
203−postgresql's timestamp types are perfectly capable of representing timestamps
204−nearly 300,000 years in the past, using this would require postgresql-simple
205−and other client programs to support binary parameters and results.
206−
207−Dealing with years BCE is also complicated slightly by the fact that
208−Haskell's time library has a year \"0000\", which is a convention often
209−used by astronomers, while postgresql adopts the more historically
210−accurate convention that there is no year zero, but rather \"1 BCE\"
211−was immediately followed by \"1 CE\".
212−
213−-}
1+------------------------------------------------------------------------------
2+-- |
3+-- Module: Database.PostgreSQL.Simple.Time
4+-- Copyright: (c) 2012 Leon P Smith
5+-- License: BSD3
6+-- Maintainer: Leon P Smith <leon@melding-monads.com>
7+-- Stability: experimental
8+--
9+-- Time types that supports positive and negative infinity. Also includes
10+-- new time parsers and printers with better performance than GHC's time
11+-- package.
12+--
13+-- The parsers only understand the specific variant of ISO 8601 that
14+-- PostgreSQL emits, and the printers attempt to duplicate this syntax.
15+-- Thus the @datestyle@ parameter for the connection must be set to @ISO@.
16+--
17+-- These parsers and printers likely have problems and shortcomings. Some
18+-- that I know of:
19+--
20+-- 1 @TimestampTZ@s before a timezone-dependent point in time cannot be
21+-- parsed, because the parsers can only handle timezone offsets of a
22+-- integer number of minutes. However, PostgreSQL will include seconds
23+-- in the offset, depending on the historical time standards for the city
24+-- identifying the time zone.
25+--
26+-- This boundary point often marks an event of some interest. In the US
27+-- for example, @timestamptz@s before @1883-Nov-18 12:00:00@ local time
28+-- cannot be parsed. This is the moment Standard Railway Time went live.
29+-- Concretely, PostgreSQL will emit @1883-11-18 12:03:57-04:56:02@
30+-- instead of @1883-11-18 11:59:59-05@ when the @timezone@ parameter
31+-- for the connection is set to @America/New_York@.
32+--
33+-- 2. Dates and times surrounding @1582-Feb-24@, the date the Gregorian
34+-- Calendar was introduced, should be investigated for conversion errors.
35+--
36+-- 3. Points in time Before Christ are not also not supported. For example,
37+-- PostgreSQL will emit @0045-01-01 BC@ for a value of a @date@ type.
38+-- This is the year that the Julian Calendar was adopted.
39+--
40+-- However, it should be noted that the old parsers also had issues 1 and 3.
41+-- Also, the new parsers now correctly handle time zones that include minutes
42+-- in their offset. Most notably, this includes all of India and parts of
43+-- Canada and Australia.
44+--
45+-- PostgreSQL uses the zoneinfo database for its time zone information.
46+-- You can read more about PostgreSQL's date and time types at
47+-- <http://www.postgresql.org/docs/9.1/static/datatype-datetime.html>,
48+-- and zoneinfo at <http://en.wikipedia.org/wiki/Tz_database>.
49+--
50+------------------------------------------------------------------------------
21451
21552module Database.PostgreSQL.Simple.Time
21653 ( Unbounded(..)
@@ -227,7 +64,6 @@ module Database.PostgreSQL.Simple.Time
22764 , parseUTCTimestamp
22865 , parseZonedTimestamp
22966 , parseLocalTimestamp
230− , parseCalendarDiffTime
23167 , dayToBuilder
23268 , utcTimeToBuilder
23369 , zonedTimeToBuilder
@@ -240,7 +76,6 @@ module Database.PostgreSQL.Simple.Time
24076 , localTimestampToBuilder
24177 , unboundedToBuilder
24278 , nominalDiffTimeToBuilder
243− , calendarDiffTimeToBuilder
24479 ) where
24580
24681import Database.PostgreSQL.Simple.Time.Implementation
src/Database/PostgreSQL/Simple/Time/Implementation.hs+108−23
@@ -1,7 +1,7 @@
11------------------------------------------------------------------------------
22-- |
33-- Module: Database.PostgreSQL.Simple.Time.Implementation
4−-- Copyright: (c) 2012-2015 Leon P Smith
4+-- Copyright: (c) 2012 Leon P Smith
55-- License: BSD3
66-- Maintainer: Leon P Smith <leon@melding-monads.com>
77-- Stability: experimental
@@ -13,19 +13,23 @@
1313module Database.PostgreSQL.Simple.Time.Implementation where
1414
1515import Prelude hiding (take)
16−import Data.ByteString.Builder(Builder, byteString)
17−import Data.ByteString.Builder.Prim(primBounded)
16+import Data.ByteString.Builder(Builder, byteString, char8, integerDec)
1817import Control.Arrow((***))
1918import Control.Applicative
19+import Data.Bits((.&.))
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.ByteString.Internal (c2w, w2c)
22+import Data.Time hiding (getTimeZone, getZonedTime)
2323import Data.Typeable
24+import Data.Word(Word8)
2425import Data.Maybe (fromMaybe)
2526import qualified Data.Attoparsec.ByteString.Char8 as A
2627import Database.PostgreSQL.Simple.Compat ((<>))
27−import qualified Database.PostgreSQL.Simple.Time.Internal.Parser as TP
28−import qualified Database.PostgreSQL.Simple.Time.Internal.Printer as TPP
28+import Data.Monoid(Monoid(..))
29+import Data.Fixed (Pico)
30+import Unsafe.Coerce
31+import qualified Database.PostgreSQL.Simple.Time.Parser as TP
32+import Database.PostgreSQL.Simple.Compat (fromPico)
2933
3034data Unbounded a
3135 = NegInfinity
@@ -78,9 +82,6 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)
7882parseDate :: B.ByteString -> Either String Date
7983parseDate = A.parseOnly (getDate <* A.endOfInput)
8084
81−parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime
82−parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)
83−
8485getUnbounded :: A.Parser a -> A.Parser (Unbounded a)
8586getUnbounded getFinite
8687 = (pure NegInfinity <* A.string "-infinity")
@@ -114,7 +115,7 @@ getTimeZoneHMS = munge <$> TP.timeZoneHMS
114115 munge (Just (TP.UTCOffsetHMS h m s)) = (h,m,s)
115116
116117localToUTCTimeOfDayHMS :: TimeZoneHMS -> TimeOfDay -> (Integer, TimeOfDay)
117−localToUTCTimeOfDayHMS (dh, dm, ds) tod =
118+localToUTCTimeOfDayHMS (dh, dm, ds) tod =
118119 TP.localToUTCTimeOfDayHMS (TP.UTCOffsetHMS dh dm ds) tod
119120
120121getZonedTime :: A.Parser ZonedTime
@@ -129,26 +130,55 @@ getUTCTime = TP.utcTime
129130getUTCTimestamp :: A.Parser UTCTimestamp
130131getUTCTimestamp = getUnbounded getUTCTime
131132
132−getCalendarDiffTime :: A.Parser CalendarDiffTime
133−getCalendarDiffTime = TP.calendarDiffTime
133+toNum :: Num n => B.ByteString -> n
134+toNum = toNum_ 0
135+{-# INLINE toNum #-}
136+
137+toNum_ :: Num n => n -> B.ByteString -> n
138+toNum_ = B.foldl' (\a c -> 10*a + digit c)
139+
140+digit :: Num n => Word8 -> n
141+digit c = fromIntegral (c .&. 0x0f)
142+{-# INLINE digit #-}
143+
144+digits :: Num n => String -> A.Parser n
145+digits msg = do
146+ x <- A.anyChar
147+ y <- A.anyChar
148+ if A.isDigit x && A.isDigit y
149+ then return $! (10 * digit (c2w x) + digit (c2w y))
150+ else fail (msg <> " is not 2 digits")
151+{-# INLINE digits #-}
134152
135153dayToBuilder :: Day -> Builder
136−dayToBuilder = primBounded TPP.day
154+dayToBuilder (toGregorian -> (y,m,d)) = do
155+ pad4 y <> char8 '-' <> pad2 m <> char8 '-' <> pad2 d
137156
138157timeOfDayToBuilder :: TimeOfDay -> Builder
139−timeOfDayToBuilder = primBounded TPP.timeOfDay
158+timeOfDayToBuilder (TimeOfDay h m s) = do
159+ pad2 h <> char8 ':' <> pad2 m <> char8 ':' <> showSeconds s
140160
141161timeZoneToBuilder :: TimeZone -> Builder
142−timeZoneToBuilder = primBounded TPP.timeZone
162+timeZoneToBuilder tz
163+ | m == 0 = sign h <> pad2 (abs h)
164+ | otherwise = sign h <> pad2 (abs h) <> char8 ':' <> pad2 (abs m)
165+ where
166+ (h,m) = timeZoneMinutes tz `quotRem` 60
167+ sign h | h >= 0 = char8 '+'
168+ | otherwise = char8 '-'
143169
144170utcTimeToBuilder :: UTCTime -> Builder
145−utcTimeToBuilder = primBounded TPP.utcTime
171+utcTimeToBuilder (UTCTime day time) =
172+ dayToBuilder day <> char8 ' '
173+ <> timeOfDayToBuilder (timeToTimeOfDay time) <> byteString "+00"
146174
147175zonedTimeToBuilder :: ZonedTime -> Builder
148−zonedTimeToBuilder = primBounded TPP.zonedTime
176+zonedTimeToBuilder (ZonedTime localTime tz) =
177+ localTimeToBuilder localTime <> timeZoneToBuilder tz
149178
150179localTimeToBuilder :: LocalTime -> Builder
151−localTimeToBuilder = primBounded TPP.localTime
180+localTimeToBuilder (LocalTime day tod) =
181+ dayToBuilder day <> char8 ' ' <> timeOfDayToBuilder tod
152182
153183unboundedToBuilder :: (a -> Builder) -> (Unbounded a -> Builder)
154184unboundedToBuilder finiteToBuilder unbounded
@@ -170,7 +200,62 @@ dateToBuilder :: Date -> Builder
170200dateToBuilder = unboundedToBuilder dayToBuilder
171201
172202nominalDiffTimeToBuilder :: NominalDiffTime -> Builder
173−nominalDiffTimeToBuilder = TPP.nominalDiffTime
174−
175−calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder
176−calendarDiffTimeToBuilder = TPP.calendarDiffTime
203+nominalDiffTimeToBuilder xyz
204+ | yz < 500000 = sign <> integerDec x
205+ | otherwise = sign <> integerDec x <> char8 '.' <> showD6 y
206+ where
207+ sign = if xyz >= 0 then mempty else char8 '-'
208+ -- A kludge to work around the fact that Data.Fixed isn't very fast and
209+ -- NominalDiffTime doesn't give the MkNominalDiffTime constructor.
210+ (x,yz) = ((unsafeCoerce (abs xyz) :: Integer) + 500000) `quotRem` 1000000000000
211+ (fromIntegral -> y, _z) = yz `quotRem` 1000000
212+
213+showSeconds :: Pico -> Builder
214+showSeconds xyz
215+ | yz == 0 = pad2 x
216+ | z == 0 = pad2 x <> char8 '.' <> showD6 y
217+ | otherwise = pad2 x <> char8 '.' <> pad6 y <> showD6 z
218+ where
219+ (x_,yz) = fromPico xyz `quotRem` 1000000000000
220+ x = fromIntegral x_ :: Int
221+ (fromIntegral -> y, fromIntegral -> z) = yz `quotRem` 1000000
222+
223+pad6 :: Int -> Builder
224+pad6 xy = let (x,y) = xy `quotRem` 1000
225+ in pad3 x <> pad3 y
226+
227+showD6 :: Int -> Builder
228+showD6 xy = case xy `quotRem` 1000 of
229+ (x,0) -> showD3 x
230+ (x,y) -> pad3 x <> showD3 y
231+
232+pad3 :: Int -> Builder
233+pad3 abc = let (ab,c) = abc `quotRem` 10
234+ (a,b) = ab `quotRem` 10
235+ in p a <> p b <> p c
236+
237+showD3 :: Int -> Builder
238+showD3 abc = case abc `quotRem` 100 of
239+ (a, 0) -> p a
240+ (a,bc) -> case bc `quotRem` 10 of
241+ (b,0) -> p a <> p b
242+ (b,c) -> p a <> p b <> p c
243+
244+-- | p assumes its input is in the range [0..9]
245+p :: Integral n => n -> Builder
246+p n = char8 (w2c (fromIntegral (n + 48)))
247+{-# INLINE p #-}
248+
249+-- | pad2 assumes its input is in the range [0..99]
250+pad2 :: Integral n => n -> Builder
251+pad2 n = let (a,b) = n `quotRem` 10 in p a <> p b
252+{-# INLINE pad2 #-}
253+
254+-- | pad4 assumes its input is positive
255+pad4 :: Integer -> Builder
256+pad4 abcd | abcd >= 10000 = integerDec abcd
257+ | otherwise = p a <> p b <> p c <> p d
258+ where (ab,cd) = abcd `quotRem` 100
259+ (a,b) = ab `quotRem` 10
260+ (c,d) = cd `quotRem` 10
261+{-# INLINE pad4 #-}
src/Database/PostgreSQL/Simple/Time/Internal/Printer.hsdeleted−135
@@ -1,135 +0,0 @@
1−{-# LANGUAGE BangPatterns, ViewPatterns #-}
2−
3−------------------------------------------------------------------------------
4−-- Module: Database.PostgreSQL.Simple.Time.Internal.Printer
5−-- Copyright: (c) 2012-2015 Leon P Smith
6−-- License: BSD3
7−-- Maintainer: Leon P Smith <leon@melding-monads.com>
8−-- Stability: experimental
9−------------------------------------------------------------------------------
10−
11−module Database.PostgreSQL.Simple.Time.Internal.Printer
12− (
13− day
14− , timeOfDay
15− , timeZone
16− , utcTime
17− , localTime
18− , zonedTime
19− , nominalDiffTime
20− , calendarDiffTime
21− ) where
22−
23−import Control.Arrow ((>>>))
24−import Data.ByteString.Builder (Builder, byteString, integerDec)
25−import Data.ByteString.Builder.Prim
26− ( liftFixedToBounded, (>$<), (>*<)
27− , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)
28−import Data.Char ( chr )
29−import Data.Int ( Int32, Int64 )
30−import Data.String (fromString)
31−import Data.Time.Compat
32− ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime
33− , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay
34− , TimeZone, timeZoneMinutes )
35−import Data.Time.Format.ISO8601.Compat (iso8601Show)
36−import Data.Time.LocalTime.Compat (CalendarDiffTime)
37−import Database.PostgreSQL.Simple.Compat ((<>), fromPico)
38−import Unsafe.Coerce (unsafeCoerce)
39−
40−liftB :: FixedPrim a -> BoundedPrim a
41−liftB = liftFixedToBounded
42−
43−digit :: FixedPrim Int
44−digit = (\x -> chr (x + 48)) >$< char8
45−
46−digits2 :: FixedPrim Int
47−digits2 = (`quotRem` 10) >$< (digit >*< digit)
48−
49−digits3 :: FixedPrim Int
50−digits3 = (`quotRem` 10) >$< (digits2 >*< digit)
51−
52−digits4 :: FixedPrim Int
53−digits4 = (`quotRem` 10) >$< (digits3 >*< digit)
54−
55−frac :: BoundedPrim Int64
56−frac = condB (== 0) emptyB ((,) '.' >$< (liftB char8 >*< trunc12))
57− where
58− trunc12 :: BoundedPrim Int64
59− trunc12 = (`quotRem` 1000000) >$<
60− condB (\(_,y) -> y == 0)
61− (fst >$< trunc6)
62− (liftB digits6 >*< trunc6)
63−
64− digitB = liftB digit
65−
66− digits6 = (fromIntegral >>> (`quotRem` 10)) >$< (digits5 >*< digit)
67− digits5 = (`quotRem` 10) >$< (digits4 >*< digit)
68−
69− trunc6 = (fromIntegral >>> (`quotRem` 100000)) >$< (digitB >*< trunc5)
70− trunc5 = condB (== 0) emptyB ((`quotRem` 10000) >$< (digitB >*< trunc4))
71− trunc4 = condB (== 0) emptyB ((`quotRem` 1000) >$< (digitB >*< trunc3))
72− trunc3 = condB (== 0) emptyB ((`quotRem` 100) >$< (digitB >*< trunc2))
73− trunc2 = condB (== 0) emptyB ((`quotRem` 10) >$< (digitB >*< trunc1))
74− trunc1 = condB (== 0) emptyB digitB
75−
76−
77−year :: BoundedPrim Int32
78−year = condB (>= 10000) int32Dec (checkBCE >$< liftB digits4)
79− where
80− checkBCE :: Int32 -> Int
81− checkBCE y
82− | y > 0 = fromIntegral y
83− | otherwise = error msg
84−
85− msg = "Database.PostgreSQL.Simple.Time.Printer.year: years BCE not supported"
86−
87−day :: BoundedPrim Day
88−day = toYMD >$< (year >*< liftB (char8 >*< digits2 >*< char8 >*< digits2))
89− where
90− toYMD (toGregorian -> (fromIntegral -> !y, !m,!d)) = (y,('-',(m,('-',d))))
91−
92−timeOfDay :: BoundedPrim TimeOfDay
93−timeOfDay = f >$< (hh_mm_ >*< ss)
94− where
95− f (TimeOfDay h m s) = ((h,(':',(m,':'))),s)
96−
97− hh_mm_ = liftB (digits2 >*< char8 >*< digits2 >*< char8)
98−
99− ss = (\s -> fromIntegral (fromPico s) `quotRem` 1000000000000) >$<
100− (liftB (fromIntegral >$< digits2) >*< frac)
101−
102−timeZone :: BoundedPrim TimeZone
103−timeZone = timeZoneMinutes >$< tz
104− where
105− tz = condB (>= 0) ((,) '+' >$< tzh) ((,) '-' . negate >$< tzh)
106−
107− tzh = liftB char8 >*< ((`quotRem` 60) >$< (liftB digits2 >*< tzm))
108−
109− tzm = condB (==0) emptyB ((,) ':' >$< liftB (char8 >*< digits2))
110−
111−utcTime :: BoundedPrim UTCTime
112−utcTime = f >$< (day >*< liftB char8 >*< timeOfDay >*< liftB char8)
113− where f (UTCTime d (timeToTimeOfDay -> tod)) = (d,(' ',(tod,'Z')))
114−
115−localTime :: BoundedPrim LocalTime
116−localTime = f >$< (day >*< liftB char8 >*< timeOfDay)
117− where f (LocalTime d tod) = (d, (' ', tod))
118−
119−zonedTime :: BoundedPrim ZonedTime
120−zonedTime = f >$< (localTime >*< timeZone)
121− where f (ZonedTime lt tz) = (lt, tz)
122−
123−
124−nominalDiffTime :: NominalDiffTime -> Builder
125−nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))
126− where
127− (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000
128−
129−calendarDiffTime :: CalendarDiffTime -> Builder
130−calendarDiffTime = byteString
131− . fromString
132− -- from the docs: "Beware: fromString truncates multi-byte characters to octets".
133− -- However, I think this is a safe usage, because ISO8601-encoding seems restricted
134− -- to ASCII output.
135− . iso8601Show
src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs → src/Database/PostgreSQL/Simple/Time/Parser.hsrenamed+12−24
@@ -1,16 +1,17 @@
11{-# LANGUAGE BangPatterns, ScopedTypeVariables #-}
22
33-- |
4−-- Module: Database.PostgreSQL.Simple.Time.Internal.Parser
4+-- Module: Database.PostgreSQL.Simple.Time.Parser
55-- Copyright: (c) 2012-2015 Leon P Smith
66-- (c) 2015 Bryan O'Sullivan
77-- License: BSD3
88-- Maintainer: Leon P Smith <leon@melding-monads.com>
99-- Stability: experimental
10+-- Portability: portable
1011--
1112-- Parsers for parsing dates and times.
1213
13−module Database.PostgreSQL.Simple.Time.Internal.Parser
14+module Database.PostgreSQL.Simple.Time.Parser
1415 (
1516 day
1617 , localTime
@@ -21,24 +22,20 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser
2122 , localToUTCTimeOfDayHMS
2223 , utcTime
2324 , zonedTime
24− , calendarDiffTime
2525 ) where
2626
2727import Control.Applicative ((<$>), (<*>), (<*), (*>))
2828import Database.PostgreSQL.Simple.Compat (toPico)
2929import Data.Attoparsec.ByteString.Char8 as A
3030import Data.Bits ((.&.))
31−import Data.ByteString (ByteString)
3231import Data.Char (ord)
3332import Data.Fixed (Pico)
3433import Data.Int (Int64)
3534import 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)
35+import Data.Time.Calendar (Day, fromGregorianValid, addDays)
36+import Data.Time.Clock (UTCTime(..))
4037import qualified Data.ByteString.Char8 as B8
41−import qualified Data.Time.LocalTime.Compat as Local
38+import qualified Data.Time.LocalTime as Local
4239
4340-- | Parse a date of the form @YYYY-MM-DD@.
4441day :: Parser Day
@@ -56,15 +53,12 @@ twoDigits = do
5653 let c2d c = ord c .&. 15
5754 return $! c2d a * 10 + c2d b
5855
59−-- | Parse a time of the form @HH:MM[:SS[.SSS]]@.
56+-- | Parse a time of the form @HH:MM:SS[.SSS]@.
6057timeOfDay :: Parser Local.TimeOfDay
6158timeOfDay = do
6259 h <- twoDigits <* char ':'
63− m <- twoDigits
64− mc <- peekChar
65− s <- case mc of
66− Just ':' -> anyChar *> seconds
67− _ -> return 0
60+ m <- twoDigits <* char ':'
61+ s <- seconds
6862 if h < 24 && m < 60 && s <= 60
6963 then return (Local.TimeOfDay h m s)
7064 else fail "invalid time"
@@ -78,13 +72,12 @@ seconds = do
7872 case mc of
7973 Just '.' -> do
8074 t <- anyChar *> takeWhile1 isDigit
81− return $! parsePicos (fromIntegral real) t
75+ return $! parsePicos real t
8276 _ -> return $! fromIntegral real
8377 where
84− parsePicos :: Int64 -> B8.ByteString -> Pico
8578 parsePicos a0 t = toPico (fromIntegral (t' * 10^n))
86− where n = max 0 (12 - B8.length t)
87− t' = B8.foldl' (\a c -> 10 * a + fromIntegral (ord c .&. 15)) a0
79+ where n = 12 - B8.length t
80+ t' = B8.foldl' (\a c -> 10 * a + fromIntegral (ord c) .&. 15) a0
8881 (B8.take 12 t)
8982
9083-- | Parse a time zone, and return 'Nothing' if the offset from UTC is
@@ -197,8 +190,3 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)
197190
198191utc :: Local.TimeZone
199192utc = Local.TimeZone 0 False ""
200−
201−calendarDiffTime :: Parser CalendarDiffTime
202−calendarDiffTime = do
203− contents <- takeByteString
204− iso8601ParseM $ B8.unpack contents
src/Database/PostgreSQL/Simple/ToField.hs+17−42
@@ -1,6 +1,5 @@
11{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}
22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
3−{-# LANGUAGE PolyKinds #-}
43
54------------------------------------------------------------------------------
65-- |
@@ -23,7 +22,6 @@ module Database.PostgreSQL.Simple.ToField
2322 , inQuotes
2423 ) where
2524
26−import Control.Applicative (Const(Const))
2725import qualified Data.Aeson as JSON
2826import Data.ByteString (ByteString)
2927import Data.ByteString.Builder
@@ -32,12 +30,10 @@ import Data.ByteString.Builder
3230 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec
3331 , floatDec, doubleDec
3432 )
35−import Data.Functor.Identity (Identity(Identity))
3633import Data.Int (Int8, Int16, Int32, Int64)
3734import Data.List (intersperse)
3835import Data.Monoid (mappend)
39−import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
40−import Data.Time.LocalTime.Compat (CalendarDiffTime)
36+import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)
4137import Data.Typeable (Typeable)
4238import Data.Word (Word, Word8, Word16, Word32, Word64)
4339import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow
@@ -46,8 +42,6 @@ import Database.PostgreSQL.Simple.Compat (toByteString)
4642
4743import qualified Data.ByteString as SB
4844import qualified Data.ByteString.Lazy as LB
49−import Data.CaseInsensitive (CI)
50−import qualified Data.CaseInsensitive as CI
5145import qualified Data.Text as ST
5246import qualified Data.Text.Encoding as ST
5347import qualified Data.Text.Lazy as LT
@@ -59,7 +53,11 @@ import qualified Data.Vector as V
5953import qualified Database.PostgreSQL.LibPQ as PQ
6054import Database.PostgreSQL.Simple.Time
6155import Data.Scientific (Scientific)
56+#if MIN_VERSION_scientific(0,3,0)
6257import Data.Text.Lazy.Builder.Scientific (scientificBuilder)
58+#else
59+import Data.Scientific (scientificBuilder)
60+#endif
6361import Foreign.C.Types (CUInt(..))
6462
6563-- | How to render an element when substituting it into a query.
@@ -100,14 +98,6 @@ instance ToField Action where
10098 toField a = a
10199 {-# INLINE toField #-}
102100
103−instance (ToField a) => ToField (Const a b) where
104− toField (Const a) = toField a
105− {-# INLINE toField #-}
106−
107−instance (ToField a) => ToField (Identity a) where
108− toField (Identity a) = toField a
109− {-# INLINE toField #-}
110−
111101instance (ToField a) => ToField (Maybe a) where
112102 toField Nothing = renderNull
113103 toField (Just a) = toField a
@@ -240,15 +230,6 @@ instance ToField LT.Text where
240230 toField = toField . LT.toStrict
241231 {-# INLINE toField #-}
242232
243−-- | citext
244−instance ToField (CI ST.Text) where
245− toField = toField . CI.original
246− {-# INLINE toField #-}
247−
248−-- | citext
249−instance ToField (CI LT.Text) where
250− toField = toField . LT.toStrict . CI.original
251− {-# INLINE toField #-}
252233
253234instance ToField UTCTime where
254235 toField = Plain . inQuotes . utcTimeToBuilder
@@ -290,20 +271,13 @@ instance ToField NominalDiffTime where
290271 toField = Plain . inQuotes . nominalDiffTimeToBuilder
291272 {-# INLINE toField #-}
292273
293−instance ToField CalendarDiffTime where
294− toField = Plain . inQuotes . calendarDiffTimeToBuilder
295− {-# INLINE toField #-}
296−
297274instance (ToField a) => ToField (PGArray a) where
298− toField pgArray =
299− case fromPGArray pgArray of
300− [] -> Plain (byteString "'{}'")
301− xs -> Many $
302− Plain (byteString "ARRAY[") :
303− (intersperse (Plain (char8 ',')) . map toField $ xs) ++
304− [Plain (char8 ']')]
305− -- Because the ARRAY[...] input syntax is being used, it is possible
306− -- that the use of type-specific separator characters is unnecessary.
275+ toField xs = Many $
276+ Plain (byteString "ARRAY[") :
277+ (intersperse (Plain (char8 ',')) . map toField $ fromPGArray xs) ++
278+ [Plain (char8 ']')]
279+ -- Because the ARRAY[...] input syntax is being used, it is possible
280+ -- that the use of type-specific separator characters is unnecessary.
307281
308282instance (ToField a) => ToField (Vector a) where
309283 toField = toField . PGArray . V.toList
@@ -314,13 +288,14 @@ instance ToField UUID where
314288instance ToField JSON.Value where
315289 toField = toField . JSON.encode
316290
317−-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.
291+-- | Convert a Haskell value to a JSON 'JSON.Value' using
292+-- 'JSON.toJSON' and convert that to a field using 'toField'.
318293--
319294-- This can be used as the default implementation for the 'toField'
320295-- method for Haskell types that have a JSON representation in
321296-- PostgreSQL.
322297toJSONField :: JSON.ToJSON a => a -> Action
323−toJSONField = toField . JSON.encode
298+toJSONField = toField . JSON.toJSON
324299
325300-- | Surround a string with single-quote characters: \"@'@\"
326301--
@@ -330,7 +305,7 @@ inQuotes b = quote `mappend` b `mappend` quote
330305 where quote = char8 '\''
331306
332307interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]
333−interleaveFoldr f b bs' as = foldr (\a bs -> b : f a bs) bs' as
308+interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as
334309{-# INLINE interleaveFoldr #-}
335310
336311instance ToRow a => ToField (Values a) where
@@ -377,8 +352,8 @@ instance ToRow a => ToField (Values a) where
377352
378353 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]
379354 typedRows [] _ _ = error funcname
380− typedRows (val:vals) typs rest =
381− typedRow (toRow val) typs (multiRows vals rest)
355+ typedRows (val:vals) types rest =
356+ typedRow (toRow val) types (multiRows vals rest)
382357
383358 untypedRows :: ToRow a => [a] -> [Action] -> [Action]
384359 untypedRows [] _ = error funcname
src/Database/PostgreSQL/Simple/ToRow.hs−127
@@ -1,4 +1,3 @@
1−{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}
21------------------------------------------------------------------------------
32-- |
43-- Module: Database.PostgreSQL.Simple.ToRow
@@ -23,33 +22,14 @@ module Database.PostgreSQL.Simple.ToRow
2322
2423import Database.PostgreSQL.Simple.ToField (Action(..), ToField(..))
2524import Database.PostgreSQL.Simple.Types (Only(..), (:.)(..))
26−import GHC.Generics
2725
2826-- | A collection type that can be turned into a list of rendering
2927-- 'Action's.
3028--
3129-- Instances should use the 'toField' method of the 'ToField' class
3230-- 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.
4931class ToRow a where
5032 toRow :: a -> [Action]
51− default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]
52− toRow = gtoRow . from
5333 -- ^ ToField a collection of values.
5434
5535instance ToRow () where
@@ -105,115 +85,8 @@ instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
10585 [toField a, toField b, toField c, toField d, toField e, toField f,
10686 toField g, toField h, toField i, toField j]
10787
108−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
109− ToField g, ToField h, ToField i, ToField j, ToField k)
110− => ToRow (a,b,c,d,e,f,g,h,i,j,k) where
111− toRow (a,b,c,d,e,f,g,h,i,j,k) =
112− [toField a, toField b, toField c, toField d, toField e, toField f,
113− toField g, toField h, toField i, toField j, toField k]
114−
115−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
116− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l)
117− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l) where
118− toRow (a,b,c,d,e,f,g,h,i,j,k,l) =
119− [toField a, toField b, toField c, toField d, toField e, toField f,
120− toField g, toField h, toField i, toField j, toField k, toField l]
121−
122−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
123− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
124− ToField m)
125− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m) where
126− toRow (a,b,c,d,e,f,g,h,i,j,k,l,m) =
127− [toField a, toField b, toField c, toField d, toField e, toField f,
128− toField g, toField h, toField i, toField j, toField k, toField l,
129− toField m]
130−
131−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
132− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
133− ToField m, ToField n)
134− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where
135− toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n) =
136− [toField a, toField b, toField c, toField d, toField e, toField f,
137− toField g, toField h, toField i, toField j, toField k, toField l,
138− toField m, toField n]
139−
140−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
141− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
142− ToField m, ToField n, ToField o)
143− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where
144− toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) =
145− [toField a, toField b, toField c, toField d, toField e, toField f,
146− toField g, toField h, toField i, toField j, toField k, toField l,
147− toField m, toField n, toField o]
148−
149−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
150− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
151− ToField m, ToField n, ToField o, ToField p)
152− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) where
153− toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) =
154− [toField a, toField b, toField c, toField d, toField e, toField f,
155− toField g, toField h, toField i, toField j, toField k, toField l,
156− toField m, toField n, toField o, toField p]
157−
158−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
159− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
160− ToField m, ToField n, ToField o, ToField p, ToField q)
161− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) where
162− toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) =
163− [toField a, toField b, toField c, toField d, toField e, toField f,
164− toField g, toField h, toField i, toField j, toField k, toField l,
165− toField m, toField n, toField o, toField p, toField q]
166−
167−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
168− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
169− ToField m, ToField n, ToField o, ToField p, ToField q, ToField r)
170− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) where
171− toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) =
172− [toField a, toField b, toField c, toField d, toField e, toField f,
173− toField g, toField h, toField i, toField j, toField k, toField l,
174− toField m, toField n, toField o, toField p, toField q, toField r]
175−
176−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
177− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
178− ToField m, ToField n, ToField o, ToField p, ToField q, ToField r,
179− ToField s)
180− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) where
181− toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) =
182− [toField a, toField b, toField c, toField d, toField e, toField f,
183− toField g, toField h, toField i, toField j, toField k, toField l,
184− toField m, toField n, toField o, toField p, toField q, toField r,
185− toField s]
186−
187−instance (ToField a, ToField b, ToField c, ToField d, ToField e, ToField f,
188− ToField g, ToField h, ToField i, ToField j, ToField k, ToField l,
189− ToField m, ToField n, ToField o, ToField p, ToField q, ToField r,
190− ToField s, ToField t)
191− => ToRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) where
192− toRow (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) =
193− [toField a, toField b, toField c, toField d, toField e, toField f,
194− toField g, toField h, toField i, toField j, toField k, toField l,
195− toField m, toField n, toField o, toField p, toField q, toField r,
196− toField s, toField t]
197−
19888instance (ToField a) => ToRow [a] where
19989 toRow = map toField
20090
20191instance (ToRow a, ToRow b) => ToRow (a :. b) where
20292 toRow (a :. b) = toRow a ++ toRow b
203−
204−
205−-- Type class for default implementation of ToRow using generics
206−class GToRow f where
207− gtoRow :: f p -> [Action]
208−
209−instance GToRow f => GToRow (M1 c i f) where
210− gtoRow (M1 x) = gtoRow x
211−
212−instance (GToRow f, GToRow g) => GToRow (f :*: g) where
213− gtoRow (f :*: g) = gtoRow f ++ gtoRow g
214−
215−instance (ToField a) => GToRow (K1 R a) where
216− gtoRow (K1 a) = [toField a]
217−
218−instance GToRow U1 where
219− gtoRow _ = []
src/Database/PostgreSQL/Simple/ToRow.hs-boot+1−10
@@ -1,18 +1,9 @@
1−{-# LANGUAGE DefaultSignatures, FlexibleInstances, FlexibleContexts #-}
2−module Database.PostgreSQL.Simple.ToRow (
3− ToRow(..)
4− ) where
1+module Database.PostgreSQL.Simple.ToRow where
52
63import Database.PostgreSQL.Simple.Types
74import {-# SOURCE #-} Database.PostgreSQL.Simple.ToField
8−import GHC.Generics
95
106class ToRow a where
117 toRow :: a -> [Action]
12− default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]
13− toRow = gtoRow . from
14−
15−class GToRow f where
16− gtoRow :: f p -> [Action]
178
189instance ToField a => ToRow (Only a)
src/Database/PostgreSQL/Simple/Transaction.hs+17−35
@@ -1,14 +1,4 @@
1−{-# LANGUAGE RecordWildCards, ScopedTypeVariables #-}
2−
3−------------------------------------------------------------------------------
4−-- |
5−-- Module: Database.PostgreSQL.Simple.Transaction
6−-- Copyright: (c) 2011-2013 Leon P Smith
7−-- (c) 2013 Joey Adams
8−-- License: BSD3
9−-- Maintainer: Leon P Smith <leon@melding-monads.com>
10−--
11−------------------------------------------------------------------------------
1+{-# LANGUAGE RecordWildCards #-}
122
133module Database.PostgreSQL.Simple.Transaction
144 (
@@ -17,7 +7,6 @@ module Database.PostgreSQL.Simple.Transaction
177 , withTransactionLevel
188 , withTransactionMode
199 , withTransactionModeRetry
20− , withTransactionModeRetry'
2110 , withTransactionSerializable
2211 , TransactionMode(..)
2312 , IsolationLevel(..)
@@ -56,7 +45,7 @@ import Database.PostgreSQL.Simple.Compat (mask, (<>))
5645
5746-- | Of the four isolation levels defined by the SQL standard,
5847-- these are the three levels distinguished by PostgreSQL as of version 9.0.
59−-- See <https://www.postgresql.org/docs/9.5/static/transaction-iso.html>
48+-- See <http://www.postgresql.org/docs/9.1/static/transaction-iso.html>
6049-- for more information. Note that prior to PostgreSQL 9.0, 'RepeatableRead'
6150-- was equivalent to 'Serializable'.
6251
@@ -143,48 +132,41 @@ withTransactionMode :: TransactionMode -> Connection -> IO a -> IO a
143132withTransactionMode mode conn act =
144133 mask $ \restore -> do
145134 beginMode mode conn
146− r <- restore act `E.onException` rollback_ conn
135+ r <- restore act `E.onException` rollback conn
147136 commit conn
148137 return r
149138
150−-- | 'withTransactionModeRetry'' but with the exception type pinned to 'SqlError'.
151−withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
152−withTransactionModeRetry = withTransactionModeRetry'
153−
154139-- | 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@
140+-- determine if a transaction should be retried if an 'SqlError' occurs.
141+-- If the callback returns True, then the transaction will be retried.
142+-- If the callback returns False, or an exception other than an 'SqlError'
158143-- occurs then the transaction will be rolled back and the exception rethrown.
159144--
160145-- 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 =
146+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a
147+withTransactionModeRetry mode shouldRetry conn act =
163148 mask $ \restore ->
164149 retryLoop $ E.try $ do
165− a <- restore act `E.onException` rollback_ conn
150+ a <- restore act
166151 commit conn
167152 return a
168153 where
169− retryLoop :: IO (Either e a) -> IO a
154+ retryLoop :: IO (Either E.SomeException a) -> IO a
170155 retryLoop act' = do
171156 beginMode mode conn
172157 r <- act'
173158 case r of
174− Left e ->
175− case shouldRetry e of
176− True -> retryLoop act'
177− False -> E.throwIO e
159+ Left e -> do
160+ rollback conn
161+ case fmap shouldRetry (E.fromException e) of
162+ Just True -> retryLoop act'
163+ _ -> E.throwIO e
178164 Right a ->
179165 return a
180166
181167-- | Rollback a transaction.
182168rollback :: Connection -> IO ()
183−rollback conn = execute_ conn "ROLLBACK" >> return ()
184−
185−-- | Rollback a transaction, ignoring any @IOErrors@
186−rollback_ :: Connection -> IO ()
187−rollback_ conn = rollback conn `E.catch` \(_ :: IOError) -> return ()
169+rollback conn = execute_ conn "ABORT" >> return ()
188170
189171-- | Commit a transaction.
190172commit :: Connection -> IO ()
@@ -221,7 +203,7 @@ beginMode mode conn = do
221203-- be used inside of a transaction, and provides a sort of
222204-- \"nested transaction\".
223205--
224−-- See <https://www.postgresql.org/docs/9.5/static/sql-savepoint.html>
206+-- See <http://www.postgresql.org/docs/current/static/sql-savepoint.html>
225207withSavepoint :: Connection -> IO a -> IO a
226208withSavepoint conn body =
227209 mask $ \restore -> do
src/Database/PostgreSQL/Simple/TypeInfo.hs+9−9
@@ -50,21 +50,21 @@ import Database.PostgreSQL.Simple.TypeInfo.Static
5050-- in the connections's cache.
5151
5252getTypeInfo :: Connection -> PQ.Oid -> IO TypeInfo
53−getTypeInfo conn@Connection{..} oid' =
54− case staticTypeInfo oid' of
55− Just name' -> return name'
56− Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid'
53+getTypeInfo conn@Connection{..} oid =
54+ case staticTypeInfo oid of
55+ Just name -> return name
56+ Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid
5757
5858getTypeInfo' :: Connection -> PQ.Oid -> TypeInfoCache
5959 -> IO (TypeInfoCache, TypeInfo)
60−getTypeInfo' conn oid' oidmap =
61− case IntMap.lookup (oid2int oid') oidmap of
60+getTypeInfo' conn oid oidmap =
61+ case IntMap.lookup (oid2int oid) oidmap of
6262 Just typeinfo -> return (oidmap, typeinfo)
6363 Nothing -> do
6464 names <- query conn "SELECT oid, typcategory, typdelim, typname,\
6565 \ typelem, typrelid\
6666 \ FROM pg_type WHERE oid = ?"
67− (Only oid')
67+ (Only oid)
6868 (oidmap', typeInfo) <-
6969 case names of
7070 [] -> return $ throw (fatalError "invalid type oid")
@@ -78,7 +78,7 @@ getTypeInfo' conn oid' oidmap =
7878 rngsubtypeOids <- query conn "SELECT rngsubtype\
7979 \ FROM pg_range\
8080 \ WHERE rngtypid = ?"
81− (Only oid')
81+ (Only oid)
8282 case rngsubtypeOids of
8383 [Only rngsubtype_] -> do
8484 (oidmap', rngsubtype) <-
@@ -104,7 +104,7 @@ getTypeInfo' conn oid' oidmap =
104104 _ -> fail "typename query returned more than one result"
105105 -- oid is a primary key, so the query should
106106 -- never return more than one result
107− let !oidmap'' = IntMap.insert (oid2int oid') typeInfo oidmap'
107+ let !oidmap'' = IntMap.insert (oid2int oid) typeInfo oidmap'
108108 return $! (oidmap'', typeInfo)
109109
110110getAttInfos :: Connection -> [(B.ByteString, PQ.Oid)] -> TypeInfoCache
src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs+3−9
@@ -1,9 +1,4 @@
1−{-# LANGUAGE CPP #-}
2−#if __GLASGOW_HASKELL__ >= 800
3−{-# LANGUAGE TemplateHaskellQuotes #-}
4−#else
51{-# LANGUAGE TemplateHaskell #-}
6−#endif
72
83------------------------------------------------------------------------------
94-- |
@@ -27,12 +22,11 @@ import Database.PostgreSQL.Simple.TypeInfo.Static
2722import Database.PostgreSQL.Simple.Types (Oid(..))
2823import Language.Haskell.TH
2924
25+
3026-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the
3127-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.
3228mkCompats :: [TypeInfo] -> ExpQ
33−mkCompats tys = do
34− x <- newName "x"
35− lamE [conP 'Oid [varP x]] $ caseE (varE x) (map alt tys ++ [catchAll])
29+mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]
3630 where
3731 alt :: TypeInfo -> MatchQ
3832 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []
@@ -44,7 +38,7 @@ mkCompats tys = do
4438-- Returns an expression of type 'Oid'. Useful because GHC tends
4539-- not to fold constants.
4640inlineTypoid :: TypeInfo -> ExpQ
47−inlineTypoid ty = conE 'Oid `appE` litE (getTypoid ty)
41+inlineTypoid ty = [| Oid $(litE (getTypoid ty)) |]
4842
4943inlineTypoidP :: TypeInfo -> PatQ
5044inlineTypoidP ty = litP (getTypoid ty)
src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+114−684
@@ -19,233 +19,119 @@ module Database.PostgreSQL.Simple.TypeInfo.Static
1919 ( TypeInfo(..)
2020 , staticTypeInfo
2121 , bool
22− , boolOid
2322 , bytea
24− , byteaOid
2523 , char
26− , charOid
2724 , name
28− , nameOid
2925 , int8
30− , int8Oid
3126 , int2
32− , int2Oid
3327 , int4
34− , int4Oid
3528 , regproc
36− , regprocOid
3729 , text
38− , textOid
3930 , oid
40− , oidOid
4131 , tid
42− , tidOid
4332 , xid
44− , xidOid
4533 , cid
46− , cidOid
4734 , xml
48− , xmlOid
4935 , point
50− , pointOid
5136 , lseg
52− , lsegOid
5337 , path
54− , pathOid
5538 , box
56− , boxOid
5739 , polygon
58− , polygonOid
5940 , line
60− , lineOid
6141 , cidr
62− , cidrOid
6342 , float4
64− , float4Oid
6543 , float8
66− , float8Oid
6744 , unknown
68− , unknownOid
6945 , circle
70− , circleOid
7146 , money
72− , moneyOid
7347 , macaddr
74− , macaddrOid
7548 , inet
76− , inetOid
7749 , bpchar
78− , bpcharOid
7950 , varchar
80− , varcharOid
8151 , date
82− , dateOid
8352 , time
84− , timeOid
8553 , timestamp
86− , timestampOid
8754 , timestamptz
88− , timestamptzOid
8955 , interval
90− , intervalOid
9156 , timetz
92− , timetzOid
9357 , bit
94− , bitOid
9558 , varbit
96− , varbitOid
9759 , numeric
98− , numericOid
9960 , refcursor
100− , refcursorOid
10161 , record
102− , recordOid
10362 , void
104− , voidOid
10563 , array_record
106− , array_recordOid
10764 , regprocedure
108− , regprocedureOid
10965 , regoper
110− , regoperOid
11166 , regoperator
112− , regoperatorOid
11367 , regclass
114− , regclassOid
11568 , regtype
116− , regtypeOid
11769 , uuid
118− , uuidOid
11970 , json
120− , jsonOid
12171 , jsonb
122− , jsonbOid
12372 , int2vector
124− , int2vectorOid
12573 , oidvector
126− , oidvectorOid
12774 , array_xml
128− , array_xmlOid
12975 , array_json
130− , array_jsonOid
13176 , array_line
132− , array_lineOid
13377 , array_cidr
134− , array_cidrOid
13578 , array_circle
136− , array_circleOid
13779 , array_money
138− , array_moneyOid
13980 , array_bool
140− , array_boolOid
14181 , array_bytea
142− , array_byteaOid
14382 , array_char
144− , array_charOid
14583 , array_name
146− , array_nameOid
14784 , array_int2
148− , array_int2Oid
14985 , array_int2vector
150− , array_int2vectorOid
15186 , array_int4
152− , array_int4Oid
15387 , array_regproc
154− , array_regprocOid
15588 , array_text
156− , array_textOid
15789 , array_tid
158− , array_tidOid
15990 , array_xid
160− , array_xidOid
16191 , array_cid
162− , array_cidOid
16392 , array_oidvector
164− , array_oidvectorOid
16593 , array_bpchar
166− , array_bpcharOid
16794 , array_varchar
168− , array_varcharOid
16995 , array_int8
170− , array_int8Oid
17196 , array_point
172− , array_pointOid
17397 , array_lseg
174− , array_lsegOid
17598 , array_path
176− , array_pathOid
17799 , array_box
178− , array_boxOid
179100 , array_float4
180− , array_float4Oid
181101 , array_float8
182− , array_float8Oid
183102 , array_polygon
184− , array_polygonOid
185103 , array_oid
186− , array_oidOid
187104 , array_macaddr
188− , array_macaddrOid
189105 , array_inet
190− , array_inetOid
191106 , array_timestamp
192− , array_timestampOid
193107 , array_date
194− , array_dateOid
195108 , array_time
196− , array_timeOid
197109 , array_timestamptz
198− , array_timestamptzOid
199110 , array_interval
200− , array_intervalOid
201111 , array_numeric
202− , array_numericOid
203112 , array_timetz
204− , array_timetzOid
205113 , array_bit
206− , array_bitOid
207114 , array_varbit
208− , array_varbitOid
209115 , array_refcursor
210− , array_refcursorOid
211116 , array_regprocedure
212− , array_regprocedureOid
213117 , array_regoper
214− , array_regoperOid
215118 , array_regoperator
216− , array_regoperatorOid
217119 , array_regclass
218− , array_regclassOid
219120 , array_regtype
220− , array_regtypeOid
221121 , array_uuid
222− , array_uuidOid
223122 , array_jsonb
224− , array_jsonbOid
225123 , int4range
226− , int4rangeOid
227124 , _int4range
228− , _int4rangeOid
229125 , numrange
230− , numrangeOid
231126 , _numrange
232− , _numrangeOid
233127 , tsrange
234− , tsrangeOid
235128 , _tsrange
236− , _tsrangeOid
237129 , tstzrange
238− , tstzrangeOid
239130 , _tstzrange
240− , _tstzrangeOid
241131 , daterange
242− , daterangeOid
243132 , _daterange
244− , _daterangeOid
245133 , int8range
246− , int8rangeOid
247134 , _int8range
248− , _int8rangeOid
249135 ) where
250136
251137import Database.PostgreSQL.LibPQ (Oid(..))
@@ -371,1432 +257,976 @@ staticTypeInfo (Oid x) = case x of
371257
372258bool :: TypeInfo
373259bool = Basic {
374− typoid = boolOid,
260+ typoid = Oid 16,
375261 typcategory = 'B',
376262 typdelim = ',',
377263 typname = "bool"
378264 }
379265
380−boolOid :: Oid
381−boolOid = Oid 16
382−{-# INLINE boolOid #-}
383−
384266bytea :: TypeInfo
385267bytea = Basic {
386− typoid = byteaOid,
268+ typoid = Oid 17,
387269 typcategory = 'U',
388270 typdelim = ',',
389271 typname = "bytea"
390272 }
391273
392−byteaOid :: Oid
393−byteaOid = Oid 17
394−{-# INLINE byteaOid #-}
395−
396274char :: TypeInfo
397275char = Basic {
398− typoid = charOid,
276+ typoid = Oid 18,
399277 typcategory = 'S',
400278 typdelim = ',',
401279 typname = "char"
402280 }
403281
404−charOid :: Oid
405−charOid = Oid 18
406−{-# INLINE charOid #-}
407−
408282name :: TypeInfo
409283name = Basic {
410− typoid = nameOid,
284+ typoid = Oid 19,
411285 typcategory = 'S',
412286 typdelim = ',',
413287 typname = "name"
414288 }
415289
416−nameOid :: Oid
417−nameOid = Oid 19
418−{-# INLINE nameOid #-}
419−
420290int8 :: TypeInfo
421291int8 = Basic {
422− typoid = int8Oid,
292+ typoid = Oid 20,
423293 typcategory = 'N',
424294 typdelim = ',',
425295 typname = "int8"
426296 }
427297
428−int8Oid :: Oid
429−int8Oid = Oid 20
430−{-# INLINE int8Oid #-}
431−
432298int2 :: TypeInfo
433299int2 = Basic {
434− typoid = int2Oid,
300+ typoid = Oid 21,
435301 typcategory = 'N',
436302 typdelim = ',',
437303 typname = "int2"
438304 }
439305
440−int2Oid :: Oid
441−int2Oid = Oid 21
442−{-# INLINE int2Oid #-}
443−
444306int4 :: TypeInfo
445307int4 = Basic {
446− typoid = int4Oid,
308+ typoid = Oid 23,
447309 typcategory = 'N',
448310 typdelim = ',',
449311 typname = "int4"
450312 }
451313
452−int4Oid :: Oid
453−int4Oid = Oid 23
454−{-# INLINE int4Oid #-}
455−
456314regproc :: TypeInfo
457315regproc = Basic {
458− typoid = regprocOid,
316+ typoid = Oid 24,
459317 typcategory = 'N',
460318 typdelim = ',',
461319 typname = "regproc"
462320 }
463321
464−regprocOid :: Oid
465−regprocOid = Oid 24
466−{-# INLINE regprocOid #-}
467−
468322text :: TypeInfo
469323text = Basic {
470− typoid = textOid,
324+ typoid = Oid 25,
471325 typcategory = 'S',
472326 typdelim = ',',
473327 typname = "text"
474328 }
475329
476−textOid :: Oid
477−textOid = Oid 25
478−{-# INLINE textOid #-}
479−
480330oid :: TypeInfo
481331oid = Basic {
482− typoid = oidOid,
332+ typoid = Oid 26,
483333 typcategory = 'N',
484334 typdelim = ',',
485335 typname = "oid"
486336 }
487337
488−oidOid :: Oid
489−oidOid = Oid 26
490−{-# INLINE oidOid #-}
491−
492338tid :: TypeInfo
493339tid = Basic {
494− typoid = tidOid,
340+ typoid = Oid 27,
495341 typcategory = 'U',
496342 typdelim = ',',
497343 typname = "tid"
498344 }
499345
500−tidOid :: Oid
501−tidOid = Oid 27
502−{-# INLINE tidOid #-}
503−
504346xid :: TypeInfo
505347xid = Basic {
506− typoid = xidOid,
348+ typoid = Oid 28,
507349 typcategory = 'U',
508350 typdelim = ',',
509351 typname = "xid"
510352 }
511353
512−xidOid :: Oid
513−xidOid = Oid 28
514−{-# INLINE xidOid #-}
515−
516354cid :: TypeInfo
517355cid = Basic {
518− typoid = cidOid,
356+ typoid = Oid 29,
519357 typcategory = 'U',
520358 typdelim = ',',
521359 typname = "cid"
522360 }
523361
524−cidOid :: Oid
525−cidOid = Oid 29
526−{-# INLINE cidOid #-}
527−
528362xml :: TypeInfo
529363xml = Basic {
530− typoid = xmlOid,
364+ typoid = Oid 142,
531365 typcategory = 'U',
532366 typdelim = ',',
533367 typname = "xml"
534368 }
535369
536−xmlOid :: Oid
537−xmlOid = Oid 142
538−{-# INLINE xmlOid #-}
539−
540370point :: TypeInfo
541371point = Basic {
542− typoid = pointOid,
372+ typoid = Oid 600,
543373 typcategory = 'G',
544374 typdelim = ',',
545375 typname = "point"
546376 }
547377
548−pointOid :: Oid
549−pointOid = Oid 600
550−{-# INLINE pointOid #-}
551−
552378lseg :: TypeInfo
553379lseg = Basic {
554− typoid = lsegOid,
380+ typoid = Oid 601,
555381 typcategory = 'G',
556382 typdelim = ',',
557383 typname = "lseg"
558384 }
559385
560−lsegOid :: Oid
561−lsegOid = Oid 601
562−{-# INLINE lsegOid #-}
563−
564386path :: TypeInfo
565387path = Basic {
566− typoid = pathOid,
388+ typoid = Oid 602,
567389 typcategory = 'G',
568390 typdelim = ',',
569391 typname = "path"
570392 }
571393
572−pathOid :: Oid
573−pathOid = Oid 602
574−{-# INLINE pathOid #-}
575−
576394box :: TypeInfo
577395box = Basic {
578− typoid = boxOid,
396+ typoid = Oid 603,
579397 typcategory = 'G',
580398 typdelim = ';',
581399 typname = "box"
582400 }
583401
584−boxOid :: Oid
585−boxOid = Oid 603
586−{-# INLINE boxOid #-}
587−
588402polygon :: TypeInfo
589403polygon = Basic {
590− typoid = polygonOid,
404+ typoid = Oid 604,
591405 typcategory = 'G',
592406 typdelim = ',',
593407 typname = "polygon"
594408 }
595409
596−polygonOid :: Oid
597−polygonOid = Oid 604
598−{-# INLINE polygonOid #-}
599−
600410line :: TypeInfo
601411line = Basic {
602− typoid = lineOid,
412+ typoid = Oid 628,
603413 typcategory = 'G',
604414 typdelim = ',',
605415 typname = "line"
606416 }
607417
608−lineOid :: Oid
609−lineOid = Oid 628
610−{-# INLINE lineOid #-}
611−
612418cidr :: TypeInfo
613419cidr = Basic {
614− typoid = cidrOid,
420+ typoid = Oid 650,
615421 typcategory = 'I',
616422 typdelim = ',',
617423 typname = "cidr"
618424 }
619425
620−cidrOid :: Oid
621−cidrOid = Oid 650
622−{-# INLINE cidrOid #-}
623−
624426float4 :: TypeInfo
625427float4 = Basic {
626− typoid = float4Oid,
428+ typoid = Oid 700,
627429 typcategory = 'N',
628430 typdelim = ',',
629431 typname = "float4"
630432 }
631433
632−float4Oid :: Oid
633−float4Oid = Oid 700
634−{-# INLINE float4Oid #-}
635−
636434float8 :: TypeInfo
637435float8 = Basic {
638− typoid = float8Oid,
436+ typoid = Oid 701,
639437 typcategory = 'N',
640438 typdelim = ',',
641439 typname = "float8"
642440 }
643441
644−float8Oid :: Oid
645−float8Oid = Oid 701
646−{-# INLINE float8Oid #-}
647−
648442unknown :: TypeInfo
649443unknown = Basic {
650− typoid = unknownOid,
444+ typoid = Oid 705,
651445 typcategory = 'X',
652446 typdelim = ',',
653447 typname = "unknown"
654448 }
655449
656−unknownOid :: Oid
657−unknownOid = Oid 705
658−{-# INLINE unknownOid #-}
659−
660450circle :: TypeInfo
661451circle = Basic {
662− typoid = circleOid,
452+ typoid = Oid 718,
663453 typcategory = 'G',
664454 typdelim = ',',
665455 typname = "circle"
666456 }
667457
668−circleOid :: Oid
669−circleOid = Oid 718
670−{-# INLINE circleOid #-}
671−
672458money :: TypeInfo
673459money = Basic {
674− typoid = moneyOid,
460+ typoid = Oid 790,
675461 typcategory = 'N',
676462 typdelim = ',',
677463 typname = "money"
678464 }
679465
680−moneyOid :: Oid
681−moneyOid = Oid 790
682−{-# INLINE moneyOid #-}
683−
684466macaddr :: TypeInfo
685467macaddr = Basic {
686− typoid = macaddrOid,
468+ typoid = Oid 829,
687469 typcategory = 'U',
688470 typdelim = ',',
689471 typname = "macaddr"
690472 }
691473
692−macaddrOid :: Oid
693−macaddrOid = Oid 829
694−{-# INLINE macaddrOid #-}
695−
696474inet :: TypeInfo
697475inet = Basic {
698− typoid = inetOid,
476+ typoid = Oid 869,
699477 typcategory = 'I',
700478 typdelim = ',',
701479 typname = "inet"
702480 }
703481
704−inetOid :: Oid
705−inetOid = Oid 869
706−{-# INLINE inetOid #-}
707−
708482bpchar :: TypeInfo
709483bpchar = Basic {
710− typoid = bpcharOid,
484+ typoid = Oid 1042,
711485 typcategory = 'S',
712486 typdelim = ',',
713487 typname = "bpchar"
714488 }
715489
716−bpcharOid :: Oid
717−bpcharOid = Oid 1042
718−{-# INLINE bpcharOid #-}
719−
720490varchar :: TypeInfo
721491varchar = Basic {
722− typoid = varcharOid,
492+ typoid = Oid 1043,
723493 typcategory = 'S',
724494 typdelim = ',',
725495 typname = "varchar"
726496 }
727497
728−varcharOid :: Oid
729−varcharOid = Oid 1043
730−{-# INLINE varcharOid #-}
731−
732498date :: TypeInfo
733499date = Basic {
734− typoid = dateOid,
500+ typoid = Oid 1082,
735501 typcategory = 'D',
736502 typdelim = ',',
737503 typname = "date"
738504 }
739505
740−dateOid :: Oid
741−dateOid = Oid 1082
742−{-# INLINE dateOid #-}
743−
744506time :: TypeInfo
745507time = Basic {
746− typoid = timeOid,
508+ typoid = Oid 1083,
747509 typcategory = 'D',
748510 typdelim = ',',
749511 typname = "time"
750512 }
751513
752−timeOid :: Oid
753−timeOid = Oid 1083
754−{-# INLINE timeOid #-}
755−
756514timestamp :: TypeInfo
757515timestamp = Basic {
758− typoid = timestampOid,
516+ typoid = Oid 1114,
759517 typcategory = 'D',
760518 typdelim = ',',
761519 typname = "timestamp"
762520 }
763521
764−timestampOid :: Oid
765−timestampOid = Oid 1114
766−{-# INLINE timestampOid #-}
767−
768522timestamptz :: TypeInfo
769523timestamptz = Basic {
770− typoid = timestamptzOid,
524+ typoid = Oid 1184,
771525 typcategory = 'D',
772526 typdelim = ',',
773527 typname = "timestamptz"
774528 }
775529
776−timestamptzOid :: Oid
777−timestamptzOid = Oid 1184
778−{-# INLINE timestamptzOid #-}
779−
780530interval :: TypeInfo
781531interval = Basic {
782− typoid = intervalOid,
532+ typoid = Oid 1186,
783533 typcategory = 'T',
784534 typdelim = ',',
785535 typname = "interval"
786536 }
787537
788−intervalOid :: Oid
789−intervalOid = Oid 1186
790−{-# INLINE intervalOid #-}
791−
792538timetz :: TypeInfo
793539timetz = Basic {
794− typoid = timetzOid,
540+ typoid = Oid 1266,
795541 typcategory = 'D',
796542 typdelim = ',',
797543 typname = "timetz"
798544 }
799545
800−timetzOid :: Oid
801−timetzOid = Oid 1266
802−{-# INLINE timetzOid #-}
803−
804546bit :: TypeInfo
805547bit = Basic {
806− typoid = bitOid,
548+ typoid = Oid 1560,
807549 typcategory = 'V',
808550 typdelim = ',',
809551 typname = "bit"
810552 }
811553
812−bitOid :: Oid
813−bitOid = Oid 1560
814−{-# INLINE bitOid #-}
815−
816554varbit :: TypeInfo
817555varbit = Basic {
818− typoid = varbitOid,
556+ typoid = Oid 1562,
819557 typcategory = 'V',
820558 typdelim = ',',
821559 typname = "varbit"
822560 }
823561
824−varbitOid :: Oid
825−varbitOid = Oid 1562
826−{-# INLINE varbitOid #-}
827−
828562numeric :: TypeInfo
829563numeric = Basic {
830− typoid = numericOid,
564+ typoid = Oid 1700,
831565 typcategory = 'N',
832566 typdelim = ',',
833567 typname = "numeric"
834568 }
835569
836−numericOid :: Oid
837−numericOid = Oid 1700
838−{-# INLINE numericOid #-}
839−
840570refcursor :: TypeInfo
841571refcursor = Basic {
842− typoid = refcursorOid,
572+ typoid = Oid 1790,
843573 typcategory = 'U',
844574 typdelim = ',',
845575 typname = "refcursor"
846576 }
847577
848−refcursorOid :: Oid
849−refcursorOid = Oid 1790
850−{-# INLINE refcursorOid #-}
851−
852578record :: TypeInfo
853579record = Basic {
854− typoid = recordOid,
580+ typoid = Oid 2249,
855581 typcategory = 'P',
856582 typdelim = ',',
857583 typname = "record"
858584 }
859585
860−recordOid :: Oid
861−recordOid = Oid 2249
862−{-# INLINE recordOid #-}
863−
864586void :: TypeInfo
865587void = Basic {
866− typoid = voidOid,
588+ typoid = Oid 2278,
867589 typcategory = 'P',
868590 typdelim = ',',
869591 typname = "void"
870592 }
871593
872−voidOid :: Oid
873−voidOid = Oid 2278
874−{-# INLINE voidOid #-}
875−
876594array_record :: TypeInfo
877595array_record = Array {
878− typoid = array_recordOid,
596+ typoid = Oid 2287,
879597 typcategory = 'P',
880598 typdelim = ',',
881599 typname = "_record",
882600 typelem = record
883601 }
884602
885−array_recordOid :: Oid
886−array_recordOid = Oid 2287
887−{-# INLINE array_recordOid #-}
888−
889603regprocedure :: TypeInfo
890604regprocedure = Basic {
891− typoid = regprocedureOid,
605+ typoid = Oid 2202,
892606 typcategory = 'N',
893607 typdelim = ',',
894608 typname = "regprocedure"
895609 }
896610
897−regprocedureOid :: Oid
898−regprocedureOid = Oid 2202
899−{-# INLINE regprocedureOid #-}
900−
901611regoper :: TypeInfo
902612regoper = Basic {
903− typoid = regoperOid,
613+ typoid = Oid 2203,
904614 typcategory = 'N',
905615 typdelim = ',',
906616 typname = "regoper"
907617 }
908618
909−regoperOid :: Oid
910−regoperOid = Oid 2203
911−{-# INLINE regoperOid #-}
912−
913619regoperator :: TypeInfo
914620regoperator = Basic {
915− typoid = regoperatorOid,
621+ typoid = Oid 2204,
916622 typcategory = 'N',
917623 typdelim = ',',
918624 typname = "regoperator"
919625 }
920626
921−regoperatorOid :: Oid
922−regoperatorOid = Oid 2204
923−{-# INLINE regoperatorOid #-}
924−
925627regclass :: TypeInfo
926628regclass = Basic {
927− typoid = regclassOid,
629+ typoid = Oid 2205,
928630 typcategory = 'N',
929631 typdelim = ',',
930632 typname = "regclass"
931633 }
932634
933−regclassOid :: Oid
934−regclassOid = Oid 2205
935−{-# INLINE regclassOid #-}
936−
937635regtype :: TypeInfo
938636regtype = Basic {
939− typoid = regtypeOid,
637+ typoid = Oid 2206,
940638 typcategory = 'N',
941639 typdelim = ',',
942640 typname = "regtype"
943641 }
944642
945−regtypeOid :: Oid
946−regtypeOid = Oid 2206
947−{-# INLINE regtypeOid #-}
948−
949643uuid :: TypeInfo
950644uuid = Basic {
951− typoid = uuidOid,
645+ typoid = Oid 2950,
952646 typcategory = 'U',
953647 typdelim = ',',
954648 typname = "uuid"
955649 }
956650
957−uuidOid :: Oid
958−uuidOid = Oid 2950
959−{-# INLINE uuidOid #-}
960−
961651json :: TypeInfo
962652json = Basic {
963− typoid = jsonOid,
653+ typoid = Oid 114,
964654 typcategory = 'U',
965655 typdelim = ',',
966656 typname = "json"
967657 }
968658
969−jsonOid :: Oid
970−jsonOid = Oid 114
971−{-# INLINE jsonOid #-}
972−
973659jsonb :: TypeInfo
974660jsonb = Basic {
975− typoid = jsonbOid,
661+ typoid = Oid 3802,
976662 typcategory = 'U',
977663 typdelim = ',',
978664 typname = "jsonb"
979665 }
980666
981−jsonbOid :: Oid
982−jsonbOid = Oid 3802
983−{-# INLINE jsonbOid #-}
984−
985667int2vector :: TypeInfo
986668int2vector = Array {
987− typoid = int2vectorOid,
669+ typoid = Oid 22,
988670 typcategory = 'A',
989671 typdelim = ',',
990672 typname = "int2vector",
991673 typelem = int2
992674 }
993675
994−int2vectorOid :: Oid
995−int2vectorOid = Oid 22
996−{-# INLINE int2vectorOid #-}
997−
998676oidvector :: TypeInfo
999677oidvector = Array {
1000− typoid = oidvectorOid,
678+ typoid = Oid 30,
1001679 typcategory = 'A',
1002680 typdelim = ',',
1003681 typname = "oidvector",
1004682 typelem = oid
1005683 }
1006684
1007−oidvectorOid :: Oid
1008−oidvectorOid = Oid 30
1009−{-# INLINE oidvectorOid #-}
1010−
1011685array_xml :: TypeInfo
1012686array_xml = Array {
1013− typoid = array_xmlOid,
687+ typoid = Oid 143,
1014688 typcategory = 'A',
1015689 typdelim = ',',
1016690 typname = "_xml",
1017691 typelem = xml
1018692 }
1019693
1020−array_xmlOid :: Oid
1021−array_xmlOid = Oid 143
1022−{-# INLINE array_xmlOid #-}
1023−
1024694array_json :: TypeInfo
1025695array_json = Array {
1026− typoid = array_jsonOid,
696+ typoid = Oid 199,
1027697 typcategory = 'A',
1028698 typdelim = ',',
1029699 typname = "_json",
1030700 typelem = json
1031701 }
1032702
1033−array_jsonOid :: Oid
1034−array_jsonOid = Oid 199
1035−{-# INLINE array_jsonOid #-}
1036−
1037703array_line :: TypeInfo
1038704array_line = Array {
1039− typoid = array_lineOid,
705+ typoid = Oid 629,
1040706 typcategory = 'A',
1041707 typdelim = ',',
1042708 typname = "_line",
1043709 typelem = line
1044710 }
1045711
1046−array_lineOid :: Oid
1047−array_lineOid = Oid 629
1048−{-# INLINE array_lineOid #-}
1049−
1050712array_cidr :: TypeInfo
1051713array_cidr = Array {
1052− typoid = array_cidrOid,
714+ typoid = Oid 651,
1053715 typcategory = 'A',
1054716 typdelim = ',',
1055717 typname = "_cidr",
1056718 typelem = cidr
1057719 }
1058720
1059−array_cidrOid :: Oid
1060−array_cidrOid = Oid 651
1061−{-# INLINE array_cidrOid #-}
1062−
1063721array_circle :: TypeInfo
1064722array_circle = Array {
1065− typoid = array_circleOid,
723+ typoid = Oid 719,
1066724 typcategory = 'A',
1067725 typdelim = ',',
1068726 typname = "_circle",
1069727 typelem = circle
1070728 }
1071729
1072−array_circleOid :: Oid
1073−array_circleOid = Oid 719
1074−{-# INLINE array_circleOid #-}
1075−
1076730array_money :: TypeInfo
1077731array_money = Array {
1078− typoid = array_moneyOid,
732+ typoid = Oid 791,
1079733 typcategory = 'A',
1080734 typdelim = ',',
1081735 typname = "_money",
1082736 typelem = money
1083737 }
1084738
1085−array_moneyOid :: Oid
1086−array_moneyOid = Oid 791
1087−{-# INLINE array_moneyOid #-}
1088−
1089739array_bool :: TypeInfo
1090740array_bool = Array {
1091− typoid = array_boolOid,
741+ typoid = Oid 1000,
1092742 typcategory = 'A',
1093743 typdelim = ',',
1094744 typname = "_bool",
1095745 typelem = bool
1096746 }
1097747
1098−array_boolOid :: Oid
1099−array_boolOid = Oid 1000
1100−{-# INLINE array_boolOid #-}
1101−
1102748array_bytea :: TypeInfo
1103749array_bytea = Array {
1104− typoid = array_byteaOid,
750+ typoid = Oid 1001,
1105751 typcategory = 'A',
1106752 typdelim = ',',
1107753 typname = "_bytea",
1108754 typelem = bytea
1109755 }
1110756
1111−array_byteaOid :: Oid
1112−array_byteaOid = Oid 1001
1113−{-# INLINE array_byteaOid #-}
1114−
1115757array_char :: TypeInfo
1116758array_char = Array {
1117− typoid = array_charOid,
759+ typoid = Oid 1002,
1118760 typcategory = 'A',
1119761 typdelim = ',',
1120762 typname = "_char",
1121763 typelem = char
1122764 }
1123765
1124−array_charOid :: Oid
1125−array_charOid = Oid 1002
1126−{-# INLINE array_charOid #-}
1127−
1128766array_name :: TypeInfo
1129767array_name = Array {
1130− typoid = array_nameOid,
768+ typoid = Oid 1003,
1131769 typcategory = 'A',
1132770 typdelim = ',',
1133771 typname = "_name",
1134772 typelem = name
1135773 }
1136774
1137−array_nameOid :: Oid
1138−array_nameOid = Oid 1003
1139−{-# INLINE array_nameOid #-}
1140−
1141775array_int2 :: TypeInfo
1142776array_int2 = Array {
1143− typoid = array_int2Oid,
777+ typoid = Oid 1005,
1144778 typcategory = 'A',
1145779 typdelim = ',',
1146780 typname = "_int2",
1147781 typelem = int2
1148782 }
1149783
1150−array_int2Oid :: Oid
1151−array_int2Oid = Oid 1005
1152−{-# INLINE array_int2Oid #-}
1153−
1154784array_int2vector :: TypeInfo
1155785array_int2vector = Array {
1156− typoid = array_int2vectorOid,
786+ typoid = Oid 1006,
1157787 typcategory = 'A',
1158788 typdelim = ',',
1159789 typname = "_int2vector",
1160790 typelem = int2vector
1161791 }
1162792
1163−array_int2vectorOid :: Oid
1164−array_int2vectorOid = Oid 1006
1165−{-# INLINE array_int2vectorOid #-}
1166−
1167793array_int4 :: TypeInfo
1168794array_int4 = Array {
1169− typoid = array_int4Oid,
795+ typoid = Oid 1007,
1170796 typcategory = 'A',
1171797 typdelim = ',',
1172798 typname = "_int4",
1173799 typelem = int4
1174800 }
1175801
1176−array_int4Oid :: Oid
1177−array_int4Oid = Oid 1007
1178−{-# INLINE array_int4Oid #-}
1179−
1180802array_regproc :: TypeInfo
1181803array_regproc = Array {
1182− typoid = array_regprocOid,
804+ typoid = Oid 1008,
1183805 typcategory = 'A',
1184806 typdelim = ',',
1185807 typname = "_regproc",
1186808 typelem = regproc
1187809 }
1188810
1189−array_regprocOid :: Oid
1190−array_regprocOid = Oid 1008
1191−{-# INLINE array_regprocOid #-}
1192−
1193811array_text :: TypeInfo
1194812array_text = Array {
1195− typoid = array_textOid,
813+ typoid = Oid 1009,
1196814 typcategory = 'A',
1197815 typdelim = ',',
1198816 typname = "_text",
1199817 typelem = text
1200818 }
1201819
1202−array_textOid :: Oid
1203−array_textOid = Oid 1009
1204−{-# INLINE array_textOid #-}
1205−
1206820array_tid :: TypeInfo
1207821array_tid = Array {
1208− typoid = array_tidOid,
822+ typoid = Oid 1010,
1209823 typcategory = 'A',
1210824 typdelim = ',',
1211825 typname = "_tid",
1212826 typelem = tid
1213827 }
1214828
1215−array_tidOid :: Oid
1216−array_tidOid = Oid 1010
1217−{-# INLINE array_tidOid #-}
1218−
1219829array_xid :: TypeInfo
1220830array_xid = Array {
1221− typoid = array_xidOid,
831+ typoid = Oid 1011,
1222832 typcategory = 'A',
1223833 typdelim = ',',
1224834 typname = "_xid",
1225835 typelem = xid
1226836 }
1227837
1228−array_xidOid :: Oid
1229−array_xidOid = Oid 1011
1230−{-# INLINE array_xidOid #-}
1231−
1232838array_cid :: TypeInfo
1233839array_cid = Array {
1234− typoid = array_cidOid,
840+ typoid = Oid 1012,
1235841 typcategory = 'A',
1236842 typdelim = ',',
1237843 typname = "_cid",
1238844 typelem = cid
1239845 }
1240846
1241−array_cidOid :: Oid
1242−array_cidOid = Oid 1012
1243−{-# INLINE array_cidOid #-}
1244−
1245847array_oidvector :: TypeInfo
1246848array_oidvector = Array {
1247− typoid = array_oidvectorOid,
849+ typoid = Oid 1013,
1248850 typcategory = 'A',
1249851 typdelim = ',',
1250852 typname = "_oidvector",
1251853 typelem = oidvector
1252854 }
1253855
1254−array_oidvectorOid :: Oid
1255−array_oidvectorOid = Oid 1013
1256−{-# INLINE array_oidvectorOid #-}
1257−
1258856array_bpchar :: TypeInfo
1259857array_bpchar = Array {
1260− typoid = array_bpcharOid,
858+ typoid = Oid 1014,
1261859 typcategory = 'A',
1262860 typdelim = ',',
1263861 typname = "_bpchar",
1264862 typelem = bpchar
1265863 }
1266864
1267−array_bpcharOid :: Oid
1268−array_bpcharOid = Oid 1014
1269−{-# INLINE array_bpcharOid #-}
1270−
1271865array_varchar :: TypeInfo
1272866array_varchar = Array {
1273− typoid = array_varcharOid,
867+ typoid = Oid 1015,
1274868 typcategory = 'A',
1275869 typdelim = ',',
1276870 typname = "_varchar",
1277871 typelem = varchar
1278872 }
1279873
1280−array_varcharOid :: Oid
1281−array_varcharOid = Oid 1015
1282−{-# INLINE array_varcharOid #-}
1283−
1284874array_int8 :: TypeInfo
1285875array_int8 = Array {
1286− typoid = array_int8Oid,
876+ typoid = Oid 1016,
1287877 typcategory = 'A',
1288878 typdelim = ',',
1289879 typname = "_int8",
1290880 typelem = int8
1291881 }
1292882
1293−array_int8Oid :: Oid
1294−array_int8Oid = Oid 1016
1295−{-# INLINE array_int8Oid #-}
1296−
1297883array_point :: TypeInfo
1298884array_point = Array {
1299− typoid = array_pointOid,
885+ typoid = Oid 1017,
1300886 typcategory = 'A',
1301887 typdelim = ',',
1302888 typname = "_point",
1303889 typelem = point
1304890 }
1305891
1306−array_pointOid :: Oid
1307−array_pointOid = Oid 1017
1308−{-# INLINE array_pointOid #-}
1309−
1310892array_lseg :: TypeInfo
1311893array_lseg = Array {
1312− typoid = array_lsegOid,
894+ typoid = Oid 1018,
1313895 typcategory = 'A',
1314896 typdelim = ',',
1315897 typname = "_lseg",
1316898 typelem = lseg
1317899 }
1318900
1319−array_lsegOid :: Oid
1320−array_lsegOid = Oid 1018
1321−{-# INLINE array_lsegOid #-}
1322−
1323901array_path :: TypeInfo
1324902array_path = Array {
1325− typoid = array_pathOid,
903+ typoid = Oid 1019,
1326904 typcategory = 'A',
1327905 typdelim = ',',
1328906 typname = "_path",
1329907 typelem = path
1330908 }
1331909
1332−array_pathOid :: Oid
1333−array_pathOid = Oid 1019
1334−{-# INLINE array_pathOid #-}
1335−
1336910array_box :: TypeInfo
1337911array_box = Array {
1338− typoid = array_boxOid,
912+ typoid = Oid 1020,
1339913 typcategory = 'A',
1340914 typdelim = ';',
1341915 typname = "_box",
1342916 typelem = box
1343917 }
1344918
1345−array_boxOid :: Oid
1346−array_boxOid = Oid 1020
1347−{-# INLINE array_boxOid #-}
1348−
1349919array_float4 :: TypeInfo
1350920array_float4 = Array {
1351− typoid = array_float4Oid,
921+ typoid = Oid 1021,
1352922 typcategory = 'A',
1353923 typdelim = ',',
1354924 typname = "_float4",
1355925 typelem = float4
1356926 }
1357927
1358−array_float4Oid :: Oid
1359−array_float4Oid = Oid 1021
1360−{-# INLINE array_float4Oid #-}
1361−
1362928array_float8 :: TypeInfo
1363929array_float8 = Array {
1364− typoid = array_float8Oid,
930+ typoid = Oid 1022,
1365931 typcategory = 'A',
1366932 typdelim = ',',
1367933 typname = "_float8",
1368934 typelem = float8
1369935 }
1370936
1371−array_float8Oid :: Oid
1372−array_float8Oid = Oid 1022
1373−{-# INLINE array_float8Oid #-}
1374−
1375937array_polygon :: TypeInfo
1376938array_polygon = Array {
1377− typoid = array_polygonOid,
939+ typoid = Oid 1027,
1378940 typcategory = 'A',
1379941 typdelim = ',',
1380942 typname = "_polygon",
1381943 typelem = polygon
1382944 }
1383945
1384−array_polygonOid :: Oid
1385−array_polygonOid = Oid 1027
1386−{-# INLINE array_polygonOid #-}
1387−
1388946array_oid :: TypeInfo
1389947array_oid = Array {
1390− typoid = array_oidOid,
948+ typoid = Oid 1028,
1391949 typcategory = 'A',
1392950 typdelim = ',',
1393951 typname = "_oid",
1394952 typelem = oid
1395953 }
1396954
1397−array_oidOid :: Oid
1398−array_oidOid = Oid 1028
1399−{-# INLINE array_oidOid #-}
1400−
1401955array_macaddr :: TypeInfo
1402956array_macaddr = Array {
1403− typoid = array_macaddrOid,
957+ typoid = Oid 1040,
1404958 typcategory = 'A',
1405959 typdelim = ',',
1406960 typname = "_macaddr",
1407961 typelem = macaddr
1408962 }
1409963
1410−array_macaddrOid :: Oid
1411−array_macaddrOid = Oid 1040
1412−{-# INLINE array_macaddrOid #-}
1413−
1414964array_inet :: TypeInfo
1415965array_inet = Array {
1416− typoid = array_inetOid,
966+ typoid = Oid 1041,
1417967 typcategory = 'A',
1418968 typdelim = ',',
1419969 typname = "_inet",
1420970 typelem = inet
1421971 }
1422972
1423−array_inetOid :: Oid
1424−array_inetOid = Oid 1041
1425−{-# INLINE array_inetOid #-}
1426−
1427973array_timestamp :: TypeInfo
1428974array_timestamp = Array {
1429− typoid = array_timestampOid,
975+ typoid = Oid 1115,
1430976 typcategory = 'A',
1431977 typdelim = ',',
1432978 typname = "_timestamp",
1433979 typelem = timestamp
1434980 }
1435981
1436−array_timestampOid :: Oid
1437−array_timestampOid = Oid 1115
1438−{-# INLINE array_timestampOid #-}
1439−
1440982array_date :: TypeInfo
1441983array_date = Array {
1442− typoid = array_dateOid,
984+ typoid = Oid 1182,
1443985 typcategory = 'A',
1444986 typdelim = ',',
1445987 typname = "_date",
1446988 typelem = date
1447989 }
1448990
1449−array_dateOid :: Oid
1450−array_dateOid = Oid 1182
1451−{-# INLINE array_dateOid #-}
1452−
1453991array_time :: TypeInfo
1454992array_time = Array {
1455− typoid = array_timeOid,
993+ typoid = Oid 1183,
1456994 typcategory = 'A',
1457995 typdelim = ',',
1458996 typname = "_time",
1459997 typelem = time
1460998 }
1461999
1462−array_timeOid :: Oid
1463−array_timeOid = Oid 1183
1464−{-# INLINE array_timeOid #-}
1465−
14661000array_timestamptz :: TypeInfo
14671001array_timestamptz = Array {
1468− typoid = array_timestamptzOid,
1002+ typoid = Oid 1185,
14691003 typcategory = 'A',
14701004 typdelim = ',',
14711005 typname = "_timestamptz",
14721006 typelem = timestamptz
14731007 }
14741008
1475−array_timestamptzOid :: Oid
1476−array_timestamptzOid = Oid 1185
1477−{-# INLINE array_timestamptzOid #-}
1478−
14791009array_interval :: TypeInfo
14801010array_interval = Array {
1481− typoid = array_intervalOid,
1011+ typoid = Oid 1187,
14821012 typcategory = 'A',
14831013 typdelim = ',',
14841014 typname = "_interval",
14851015 typelem = interval
14861016 }
14871017
1488−array_intervalOid :: Oid
1489−array_intervalOid = Oid 1187
1490−{-# INLINE array_intervalOid #-}
1491−
14921018array_numeric :: TypeInfo
14931019array_numeric = Array {
1494− typoid = array_numericOid,
1020+ typoid = Oid 1231,
14951021 typcategory = 'A',
14961022 typdelim = ',',
14971023 typname = "_numeric",
14981024 typelem = numeric
14991025 }
15001026
1501−array_numericOid :: Oid
1502−array_numericOid = Oid 1231
1503−{-# INLINE array_numericOid #-}
1504−
15051027array_timetz :: TypeInfo
15061028array_timetz = Array {
1507− typoid = array_timetzOid,
1029+ typoid = Oid 1270,
15081030 typcategory = 'A',
15091031 typdelim = ',',
15101032 typname = "_timetz",
15111033 typelem = timetz
15121034 }
15131035
1514−array_timetzOid :: Oid
1515−array_timetzOid = Oid 1270
1516−{-# INLINE array_timetzOid #-}
1517−
15181036array_bit :: TypeInfo
15191037array_bit = Array {
1520− typoid = array_bitOid,
1038+ typoid = Oid 1561,
15211039 typcategory = 'A',
15221040 typdelim = ',',
15231041 typname = "_bit",
15241042 typelem = bit
15251043 }
15261044
1527−array_bitOid :: Oid
1528−array_bitOid = Oid 1561
1529−{-# INLINE array_bitOid #-}
1530−
15311045array_varbit :: TypeInfo
15321046array_varbit = Array {
1533− typoid = array_varbitOid,
1047+ typoid = Oid 1563,
15341048 typcategory = 'A',
15351049 typdelim = ',',
15361050 typname = "_varbit",
15371051 typelem = varbit
15381052 }
15391053
1540−array_varbitOid :: Oid
1541−array_varbitOid = Oid 1563
1542−{-# INLINE array_varbitOid #-}
1543−
15441054array_refcursor :: TypeInfo
15451055array_refcursor = Array {
1546− typoid = array_refcursorOid,
1056+ typoid = Oid 2201,
15471057 typcategory = 'A',
15481058 typdelim = ',',
15491059 typname = "_refcursor",
15501060 typelem = refcursor
15511061 }
15521062
1553−array_refcursorOid :: Oid
1554−array_refcursorOid = Oid 2201
1555−{-# INLINE array_refcursorOid #-}
1556−
15571063array_regprocedure :: TypeInfo
15581064array_regprocedure = Array {
1559− typoid = array_regprocedureOid,
1065+ typoid = Oid 2207,
15601066 typcategory = 'A',
15611067 typdelim = ',',
15621068 typname = "_regprocedure",
15631069 typelem = regprocedure
15641070 }
15651071
1566−array_regprocedureOid :: Oid
1567−array_regprocedureOid = Oid 2207
1568−{-# INLINE array_regprocedureOid #-}
1569−
15701072array_regoper :: TypeInfo
15711073array_regoper = Array {
1572− typoid = array_regoperOid,
1074+ typoid = Oid 2208,
15731075 typcategory = 'A',
15741076 typdelim = ',',
15751077 typname = "_regoper",
15761078 typelem = regoper
15771079 }
15781080
1579−array_regoperOid :: Oid
1580−array_regoperOid = Oid 2208
1581−{-# INLINE array_regoperOid #-}
1582−
15831081array_regoperator :: TypeInfo
15841082array_regoperator = Array {
1585− typoid = array_regoperatorOid,
1083+ typoid = Oid 2209,
15861084 typcategory = 'A',
15871085 typdelim = ',',
15881086 typname = "_regoperator",
15891087 typelem = regoperator
15901088 }
15911089
1592−array_regoperatorOid :: Oid
1593−array_regoperatorOid = Oid 2209
1594−{-# INLINE array_regoperatorOid #-}
1595−
15961090array_regclass :: TypeInfo
15971091array_regclass = Array {
1598− typoid = array_regclassOid,
1092+ typoid = Oid 2210,
15991093 typcategory = 'A',
16001094 typdelim = ',',
16011095 typname = "_regclass",
16021096 typelem = regclass
16031097 }
16041098
1605−array_regclassOid :: Oid
1606−array_regclassOid = Oid 2210
1607−{-# INLINE array_regclassOid #-}
1608−
16091099array_regtype :: TypeInfo
16101100array_regtype = Array {
1611− typoid = array_regtypeOid,
1101+ typoid = Oid 2211,
16121102 typcategory = 'A',
16131103 typdelim = ',',
16141104 typname = "_regtype",
16151105 typelem = regtype
16161106 }
16171107
1618−array_regtypeOid :: Oid
1619−array_regtypeOid = Oid 2211
1620−{-# INLINE array_regtypeOid #-}
1621−
16221108array_uuid :: TypeInfo
16231109array_uuid = Array {
1624− typoid = array_uuidOid,
1110+ typoid = Oid 2951,
16251111 typcategory = 'A',
16261112 typdelim = ',',
16271113 typname = "_uuid",
16281114 typelem = uuid
16291115 }
16301116
1631−array_uuidOid :: Oid
1632−array_uuidOid = Oid 2951
1633−{-# INLINE array_uuidOid #-}
1634−
16351117array_jsonb :: TypeInfo
16361118array_jsonb = Array {
1637− typoid = array_jsonbOid,
1119+ typoid = Oid 3807,
16381120 typcategory = 'A',
16391121 typdelim = ',',
16401122 typname = "_jsonb",
16411123 typelem = jsonb
16421124 }
16431125
1644−array_jsonbOid :: Oid
1645−array_jsonbOid = Oid 3807
1646−{-# INLINE array_jsonbOid #-}
1647−
16481126int4range :: TypeInfo
16491127int4range = Range {
1650− typoid = int4rangeOid,
1128+ typoid = Oid 3904,
16511129 typcategory = 'R',
16521130 typdelim = ',',
16531131 typname = "int4range",
16541132 rngsubtype = int4
16551133 }
16561134
1657−int4rangeOid :: Oid
1658−int4rangeOid = Oid 3904
1659−{-# INLINE int4rangeOid #-}
1660−
16611135_int4range :: TypeInfo
16621136_int4range = Array {
1663− typoid = _int4rangeOid,
1137+ typoid = Oid 3905,
16641138 typcategory = 'A',
16651139 typdelim = ',',
16661140 typname = "_int4range",
16671141 typelem = int4range
16681142 }
16691143
1670−_int4rangeOid :: Oid
1671−_int4rangeOid = Oid 3905
1672−{-# INLINE _int4rangeOid #-}
1673−
16741144numrange :: TypeInfo
16751145numrange = Range {
1676− typoid = numrangeOid,
1146+ typoid = Oid 3906,
16771147 typcategory = 'R',
16781148 typdelim = ',',
16791149 typname = "numrange",
16801150 rngsubtype = numeric
16811151 }
16821152
1683−numrangeOid :: Oid
1684−numrangeOid = Oid 3906
1685−{-# INLINE numrangeOid #-}
1686−
16871153_numrange :: TypeInfo
16881154_numrange = Array {
1689− typoid = _numrangeOid,
1155+ typoid = Oid 3907,
16901156 typcategory = 'A',
16911157 typdelim = ',',
16921158 typname = "_numrange",
16931159 typelem = numrange
16941160 }
16951161
1696−_numrangeOid :: Oid
1697−_numrangeOid = Oid 3907
1698−{-# INLINE _numrangeOid #-}
1699−
17001162tsrange :: TypeInfo
17011163tsrange = Range {
1702− typoid = tsrangeOid,
1164+ typoid = Oid 3908,
17031165 typcategory = 'R',
17041166 typdelim = ',',
17051167 typname = "tsrange",
17061168 rngsubtype = timestamp
17071169 }
17081170
1709−tsrangeOid :: Oid
1710−tsrangeOid = Oid 3908
1711−{-# INLINE tsrangeOid #-}
1712−
17131171_tsrange :: TypeInfo
17141172_tsrange = Array {
1715− typoid = _tsrangeOid,
1173+ typoid = Oid 3909,
17161174 typcategory = 'A',
17171175 typdelim = ',',
17181176 typname = "_tsrange",
17191177 typelem = tsrange
17201178 }
17211179
1722−_tsrangeOid :: Oid
1723−_tsrangeOid = Oid 3909
1724−{-# INLINE _tsrangeOid #-}
1725−
17261180tstzrange :: TypeInfo
17271181tstzrange = Range {
1728− typoid = tstzrangeOid,
1182+ typoid = Oid 3910,
17291183 typcategory = 'R',
17301184 typdelim = ',',
17311185 typname = "tstzrange",
17321186 rngsubtype = timestamptz
17331187 }
17341188
1735−tstzrangeOid :: Oid
1736−tstzrangeOid = Oid 3910
1737−{-# INLINE tstzrangeOid #-}
1738−
17391189_tstzrange :: TypeInfo
17401190_tstzrange = Array {
1741− typoid = _tstzrangeOid,
1191+ typoid = Oid 3911,
17421192 typcategory = 'A',
17431193 typdelim = ',',
17441194 typname = "_tstzrange",
17451195 typelem = tstzrange
17461196 }
17471197
1748−_tstzrangeOid :: Oid
1749−_tstzrangeOid = Oid 3911
1750−{-# INLINE _tstzrangeOid #-}
1751−
17521198daterange :: TypeInfo
17531199daterange = Range {
1754− typoid = daterangeOid,
1200+ typoid = Oid 3912,
17551201 typcategory = 'R',
17561202 typdelim = ',',
17571203 typname = "daterange",
17581204 rngsubtype = date
17591205 }
17601206
1761−daterangeOid :: Oid
1762−daterangeOid = Oid 3912
1763−{-# INLINE daterangeOid #-}
1764−
17651207_daterange :: TypeInfo
17661208_daterange = Array {
1767− typoid = _daterangeOid,
1209+ typoid = Oid 3913,
17681210 typcategory = 'A',
17691211 typdelim = ',',
17701212 typname = "_daterange",
17711213 typelem = daterange
17721214 }
17731215
1774−_daterangeOid :: Oid
1775−_daterangeOid = Oid 3913
1776−{-# INLINE _daterangeOid #-}
1777−
17781216int8range :: TypeInfo
17791217int8range = Range {
1780− typoid = int8rangeOid,
1218+ typoid = Oid 3926,
17811219 typcategory = 'R',
17821220 typdelim = ',',
17831221 typname = "int8range",
17841222 rngsubtype = int8
17851223 }
17861224
1787−int8rangeOid :: Oid
1788−int8rangeOid = Oid 3926
1789−{-# INLINE int8rangeOid #-}
1790−
17911225_int8range :: TypeInfo
17921226_int8range = Array {
1793− typoid = _int8rangeOid,
1227+ typoid = Oid 3927,
17941228 typcategory = 'A',
17951229 typdelim = ',',
17961230 typname = "_int8range",
17971231 typelem = int8range
17981232 }
1799−
1800−_int8rangeOid :: Oid
1801−_int8rangeOid = Oid 3927
1802−{-# INLINE _int8rangeOid #-}
src/Database/PostgreSQL/Simple/Types.hs+30−54
@@ -1,4 +1,4 @@
1−{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}
1+{-# LANGUAGE DeriveDataTypeable, DeriveFunctor, GeneralizedNewtypeDeriving #-}
22
33------------------------------------------------------------------------------
44-- |
@@ -33,16 +33,13 @@ module Database.PostgreSQL.Simple.Types
3333import Control.Arrow (first)
3434import Data.ByteString (ByteString)
3535import Data.Hashable (Hashable(hashWithSalt))
36−import Data.Foldable (toList)
3736import Data.Monoid (Monoid(..))
38−import Data.Semigroup
3937import Data.String (IsString(..))
4038import Data.Typeable (Typeable)
4139import Data.ByteString.Builder ( stringUtf8 )
4240import qualified Data.ByteString as B
4341import Data.Text (Text)
4442import qualified Data.Text as T
45−import Data.Tuple.Only (Only(..))
4643import Database.PostgreSQL.LibPQ (Oid(..))
4744import Database.PostgreSQL.Simple.Compat (toByteString)
4845
@@ -50,6 +47,10 @@ import Database.PostgreSQL.Simple.Compat (toByteString)
5047data Null = Null
5148 deriving (Read, Show, Typeable)
5249
50+instance Eq Null where
51+ _ == _ = False
52+ _ /= _ = False
53+
5354-- | A placeholder for the PostgreSQL @DEFAULT@ value.
5455data Default = Default
5556 deriving (Read, Show, Typeable)
@@ -86,59 +87,36 @@ instance Read Query where
8687instance IsString Query where
8788 fromString = Query . toByteString . stringUtf8
8889
89−instance Semigroup Query where
90− Query a <> Query b = Query (B.append a b)
91− {-# INLINE (<>) #-}
92− sconcat xs = Query (B.concat $ map fromQuery $ toList xs)
93−
9490instance Monoid Query where
9591 mempty = Query B.empty
92+ mappend (Query a) (Query b) = Query (B.append a b)
93+ {-# INLINE mappend #-}
94+ mconcat xs = Query (B.concat (map fromQuery xs))
9695
97−-- | Wrap a list of values for use in an @IN@ clause. Replaces a
98−-- single \"@?@\" character with a parenthesized list of rendered
99−-- values.
100−--
101−-- Example:
102−--
103−-- > query c "select * from whatever where id in ?" (Only (In [3,4,5]))
96+-- | A single-value \"collection\".
10497--
105−-- Note that @In []@ expands to @(null)@, which works as expected in
106−-- the query above, but evaluates to the logical null value on every
107−-- row instead of @TRUE@. This means that changing the query above
108−-- to @... id NOT in ?@ and supplying the empty list as the parameter
109−-- returns zero rows, instead of all of them as one would expect.
98+-- This is useful if you need to supply a single parameter to a SQL
99+-- query, or extract a single column from a SQL result.
110100--
111−-- Since postgresql doesn't seem to provide a syntax for actually specifying
112−-- an empty list, which could solve this completely, there are two
113−-- workarounds particularly worth mentioning, namely:
101+-- Parameter example:
114102--
115−-- 1. Use postgresql-simple's 'Values' type instead, which can handle the
116−-- empty case correctly. Note however that while specifying the
117−-- postgresql type @"int4"@ is mandatory in the empty case, specifying
118−-- the haskell type @Values (Only Int)@ would not normally be needed in
119−-- realistic use cases.
103+-- @query c \"select x from scores where x > ?\" ('Only' (42::Int))@
120104--
121−-- > query c "select * from whatever where id not in ?"
122−-- > (Only (Values ["int4"] [] :: Values (Only Int)))
105+-- Result example:
123106--
107+-- @xs <- query_ c \"select id from users\"
108+--forM_ xs $ \\('Only' id) -> {- ... -}@
109+newtype Only a = Only {
110+ fromOnly :: a
111+ } deriving (Eq, Ord, Read, Show, Typeable, Functor)
112+
113+-- | Wrap a list of values for use in an @IN@ clause. Replaces a
114+-- single \"@?@\" character with a parenthesized list of rendered
115+-- values.
124116--
125−-- 2. Use sql's @COALESCE@ operator to turn a logical @null@ into the correct
126−-- boolean. Note however that the correct boolean depends on the use
127−-- case:
128−--
129−-- > query c "select * from whatever where coalesce(id NOT in ?, TRUE)"
130−-- > (Only (In [] :: In [Int]))
131−--
132−-- > query c "select * from whatever where coalesce(id IN ?, FALSE)"
133−-- > (Only (In [] :: In [Int]))
117+-- Example:
134118--
135−-- Note that at as of PostgreSQL 9.4, the query planner cannot see inside
136−-- the @COALESCE@ operator, so if you have an index on @id@ then you
137−-- probably don't want to write the last example with @COALESCE@, which
138−-- would result in a table scan. There are further caveats if @id@ can
139−-- be null or you want null treated sensibly as a component of @IN@ or
140−-- @NOT IN@.
141−
119+-- > query c "select * from whatever where id in ?" (Only (In [3,4,5]))
142120newtype In a = In a
143121 deriving (Eq, Ord, Read, Show, Typeable, Functor)
144122
@@ -201,9 +179,8 @@ infixr 3 :.
201179newtype Savepoint = Savepoint Query
202180 deriving (Eq, Ord, Show, Read, Typeable)
203181
204−-- | Represents a @VALUES@ table literal, usable as an alternative to
205−-- 'Database.PostgreSQL.Simple.executeMany' and
206−-- 'Database.PostgreSQL.Simple.returning'. The main advantage is that
182+-- | Represents a @VALUES@ table literal, usable as an alternative
183+-- to @executeMany@ and @returning@. The main advantage is that
207184-- you can parametrize more than just a single @VALUES@ expression.
208185-- For example, here's a query to insert a thing into one table
209186-- and some attributes of that thing into another, returning the
@@ -216,7 +193,7 @@ newtype Savepoint = Savepoint Query
216193-- > ), new_attributes AS (
217194-- > INSERT INTO thing_attributes
218195-- > SELECT new_thing.id, attrs.*
219−-- > FROM new_thing JOIN ? attrs ON TRUE
196+-- > FROM new_thing JOIN ? attrs
220197-- > ) SELECT * FROM new_thing
221198-- > |] ("foo", Values [ "int4", "text" ]
222199-- > [ ( 1 , "hello" )
@@ -242,8 +219,7 @@ newtype Savepoint = Savepoint Query
242219-- is turned into a properly quoted identifier, the type name is case
243220-- sensitive and must be as it appears in the @pg_type@ table. Thus,
244221-- you must write @timestamptz@ instead of @timestamp with time zone@,
245−-- @int4@ instead of @integer@ or @serial@, @_int8@ instead of @bigint[]@,
246−-- etcetera.
222+-- @int4@ instead of @integer@, @_int8@ instead of @bigint[]@, etcetera.
247223--
248224-- You may omit the type names, however, if you do so the list
249225-- of values must be non-empty, and postgresql must be able to infer
@@ -252,7 +228,7 @@ newtype Savepoint = Savepoint Query
252228-- without issuing the query. In the second case, the postgres server
253229-- will return an error which will be turned into a @SqlError@ exception.
254230--
255−-- See <https://www.postgresql.org/docs/9.5/static/sql-values.html> for
231+-- See <http://www.postgresql.org/docs/9.3/static/sql-values.html> for
256232-- more information.
257233data Values a = Values [QualifiedIdentifier] [a]
258234 deriving (Eq, Ord, Show, Read, Typeable)
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/Common.hs+2−2
@@ -1,6 +1,6 @@
11module Common (
22 module Database.PostgreSQL.Simple,
3− module Test.Tasty.HUnit,
3+ module Test.HUnit,
44 TestEnv(..),
55 md5,
66) where
@@ -8,7 +8,7 @@ module Common (
88import Data.ByteString (ByteString)
99import Data.Text (Text)
1010import Database.PostgreSQL.Simple
11−import Test.Tasty.HUnit
11+import Test.HUnit
1212
1313import qualified Crypto.Hash.MD5 as MD5
1414import qualified Data.ByteString.Base16 as Base16
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+59−343
@@ -1,95 +1,53 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DeriveGeneric #-}
31{-# LANGUAGE DeriveDataTypeable #-}
42{-# LANGUAGE DoAndIfThenElse #-}
53{-# LANGUAGE ScopedTypeVariables #-}
6−#if __GLASGOW_HASKELL__ >= 806
7−{-# LANGUAGE DerivingStrategies #-}
8−{-# LANGUAGE DerivingVia #-}
9−{-# LANGUAGE DeriveAnyClass #-}
10−#endif
11−module Main (main) where
12−
134import Common
14−import Database.PostgreSQL.Simple.Copy
15−import Database.PostgreSQL.Simple.ToField (ToField)
165import Database.PostgreSQL.Simple.FromField (FromField)
6+import Database.PostgreSQL.Simple.Types(Query(..),Values(..))
177import 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(..))
8+import Database.PostgreSQL.Simple.Copy
219import qualified Database.PostgreSQL.Simple.Transaction as ST
22−
2310import Control.Applicative
2411import Control.Exception as E
2512import Control.Monad
26−import Data.Char
27−import Data.Foldable (toList)
28−import Data.List (concat, sort)
13+import Data.ByteString (ByteString)
2914import Data.IORef
30−import Data.Monoid ((<>))
31−import Data.String (fromString)
3215import Data.Typeable
33−import GHC.Generics (Generic)
34−
35−import Data.Aeson
36−import Data.ByteString (ByteString)
3716import qualified Data.ByteString as B
38−import qualified Data.ByteString.Char8 as BS8
39−import qualified Data.ByteString.Lazy.Char8 as BL
40−import Data.CaseInsensitive (CI)
41−import qualified Data.CaseInsensitive as CI
4217import Data.Map (Map)
18+import Data.List (sort)
4319import qualified Data.Map as Map
4420import Data.Text(Text)
4521import qualified Data.Text.Encoding as T
22+import System.Exit (exitFailure)
23+import System.IO
4624import qualified Data.Vector as V
47−import System.FilePath
48−import System.Timeout(timeout)
49−import Data.Time.Compat (getCurrentTime, diffUTCTime)
50−import System.Environment (getEnvironment)
25+import Data.Aeson
5126
52−import Test.Tasty
53−import Test.Tasty.Golden
5427import Notify
5528import Serializable
5629import Time
57−import Interval
58−import Exception (testExceptions)
59−
60−tests :: TestEnv -> TestTree
61−tests env = testGroup "tests"
62− $ map ($ env)
63− [ 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
82− , 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
30+
31+tests :: [TestEnv -> Test]
32+tests =
33+ [ TestLabel "Bytea" . testBytea
34+ , TestLabel "ExecuteMany" . testExecuteMany
35+ , TestLabel "Fold" . testFold
36+ , TestLabel "Notify" . testNotify
37+ , TestLabel "Serializable" . testSerializable
38+ , TestLabel "Time" . testTime
39+ , TestLabel "Array" . testArray
40+ , TestLabel "HStore" . testHStore
41+ , TestLabel "JSON" . testJSON
42+ , TestLabel "Savepoint" . testSavepoint
43+ , TestLabel "Unicode" . testUnicode
44+ , TestLabel "Values" . testValues
45+ , TestLabel "Copy" . testCopy
46+ , TestLabel "Double" . testDouble
8947 ]
9048
91−testBytea :: TestEnv -> TestTree
92−testBytea TestEnv{..} = testGroup "Bytea"
49+testBytea :: TestEnv -> Test
50+testBytea TestEnv{..} = TestList
9351 [ testStr "empty" []
9452 , testStr "\"hello\"" $ map (fromIntegral . fromEnum) ("hello" :: String)
9553 , testStr "ascending" [0..255]
@@ -98,7 +56,7 @@ testBytea TestEnv{..} = testGroup "Bytea"
9856 , testStr "descending, doubled up" $ doubleUp [255,254..0]
9957 ]
10058 where
101− testStr label bytes = testCase label $ do
59+ testStr label bytes = TestLabel label $ TestCase $ do
10260 let bs = B.pack bytes
10361
10462 [Only h] <- query conn "SELECT md5(?::bytea)" [Binary bs]
@@ -109,8 +67,8 @@ testBytea TestEnv{..} = testGroup "Bytea"
10967
11068 doubleUp = concatMap (\x -> [x, x])
11169
112−testExecuteMany :: TestEnv -> Assertion
113−testExecuteMany TestEnv{..} = do
70+testExecuteMany :: TestEnv -> Test
71+testExecuteMany TestEnv{..} = TestCase $ do
11472 execute_ conn "CREATE TEMPORARY TABLE tmp_executeMany (i INT, t TEXT, b BYTEA)"
11573
11674 let rows :: [(Int, String, Binary ByteString)]
@@ -127,8 +85,8 @@ testExecuteMany TestEnv{..} = do
12785
12886 return ()
12987
130−testFold :: TestEnv -> Assertion
131−testFold TestEnv{..} = do
88+testFold :: TestEnv -> Test
89+testFold TestEnv{..} = TestCase $ do
13290 xs <- fold_ conn "SELECT generate_series(1,10000)"
13391 [] $ \xs (Only x) -> return (x:xs)
13492 reverse xs @?= ([1..10000] :: [Int])
@@ -139,7 +97,7 @@ testFold TestEnv{..} = do
13997 xs <- readIORef ref
14098 writeIORef ref $! (a,b):xs
14199 xs <- readIORef ref
142− reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]
100+ reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]
143101
144102 -- Make sure fold propagates our exception.
145103 ref <- newIORef []
@@ -197,8 +155,8 @@ queryFailure conn q resultType = do
197155 ++ show (typeOf resultType)
198156 ++ " -> " ++ show val)
199157
200−testArray :: TestEnv -> Assertion
201−testArray TestEnv{..} = do
158+testArray :: TestEnv -> Test
159+testArray TestEnv{..} = TestCase $ do
202160 xs <- query_ conn "SELECT '{1,2,3,4}'::_int4"
203161 xs @?= [Only (V.fromList [1,2,3,4 :: Int])]
204162 xs <- query_ conn "SELECT '{{1,2},{3,4}}'::_int4"
@@ -207,16 +165,8 @@ testArray TestEnv{..} = do
207165 queryFailure conn "SELECT '{1,2,3,4}'::_int4" (undefined :: V.Vector Bool)
208166 queryFailure conn "SELECT '{{1,2},{3,4}}'::_int4" (undefined :: V.Vector Int)
209167
210−testNullableArray :: TestEnv -> Assertion
211−testNullableArray TestEnv{..} = do
212− xs <- query_ conn "SELECT '{sometext, \"NULL\"}'::_text"
213− xs @?= [Only (V.fromList ["sometext", "NULL" :: Text])]
214− xs <- query_ conn "SELECT '{sometext, NULL}'::_text"
215− xs @?= [Only (V.fromList [Just "sometext", Nothing :: Maybe Text])]
216− queryFailure conn "SELECT '{sometext, NULL}'::_text" (undefined :: V.Vector Text)
217−
218−testHStore :: TestEnv -> Assertion
219−testHStore TestEnv{..} = do
168+testHStore :: TestEnv -> Test
169+testHStore TestEnv{..} = TestCase $ do
220170 execute_ conn "CREATE EXTENSION IF NOT EXISTS hstore"
221171 roundTrip []
222172 roundTrip [("foo","bar"),("bar","baz"),("baz","hello")]
@@ -228,21 +178,8 @@ testHStore TestEnv{..} = do
228178 m' <- query conn "SELECT ?::hstore" m
229179 [m] @?= m'
230180
231−testCIText :: TestEnv -> Assertion
232−testCIText TestEnv{..} = do
233− execute_ conn "CREATE EXTENSION IF NOT EXISTS citext"
234− roundTrip (CI.mk "")
235− roundTrip (CI.mk "UPPERCASE")
236− roundTrip (CI.mk "lowercase")
237− where
238− roundTrip :: (CI Text) -> Assertion
239− roundTrip cit = do
240− let toPostgres = Only cit
241− fromPostgres <- query conn "SELECT ?::citext" toPostgres
242− [toPostgres] @?= fromPostgres
243−
244−testJSON :: TestEnv -> Assertion
245−testJSON TestEnv{..} = do
181+testJSON :: TestEnv -> Test
182+testJSON TestEnv{..} = TestCase $ do
246183 roundTrip (Map.fromList [] :: Map Text Text)
247184 roundTrip (Map.fromList [("foo","bar"),("bar","baz"),("baz","hello")] :: Map Text Text)
248185 roundTrip (Map.fromList [("fo\"o","bar"),("b\\ar","baz"),("baz","\"value\\with\"escapes")] :: Map Text Text)
@@ -256,92 +193,8 @@ testJSON TestEnv{..} = do
256193 js' <- query conn "SELECT ?::json" js
257194 [js] @?= js'
258195
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−
343−testSavepoint :: TestEnv -> Assertion
344−testSavepoint TestEnv{..} = do
196+testSavepoint :: TestEnv -> Test
197+testSavepoint TestEnv{..} = TestCase $ do
345198 True <- expectError ST.isNoActiveTransactionError $
346199 withSavepoint conn $ return ()
347200
@@ -401,8 +254,8 @@ testSavepoint TestEnv{..} = do
401254
402255 return ()
403256
404−testUnicode :: TestEnv -> Assertion
405−testUnicode TestEnv{..} = do
257+testUnicode :: TestEnv -> Test
258+testUnicode TestEnv{..} = TestCase $ do
406259 let q = Query . T.encodeUtf8 -- Handle encoding ourselves to ensure
407260 -- the table gets created correctly.
408261 let messages = map Only ["привет","мир"] :: [Only Text]
@@ -411,8 +264,8 @@ testUnicode TestEnv{..} = do
411264 messages' <- query_ conn "SELECT сообщение FROM ру́сский"
412265 sort messages @?= sort messages'
413266
414−testValues :: TestEnv -> Assertion
415−testValues TestEnv{..} = do
267+testValues :: TestEnv -> Test
268+testValues TestEnv{..} = TestCase $ do
416269 execute_ conn "CREATE TEMPORARY TABLE values_test (x int, y text)"
417270 test (Values ["int4","text"] [])
418271 test (Values ["int4","text"] [(1,"hello")])
@@ -429,8 +282,8 @@ testValues TestEnv{..} = do
429282 sort vals @?= sort vals'
430283
431284
432−testCopy :: TestEnv -> Assertion
433−testCopy TestEnv{..} = do
285+testCopy :: TestEnv -> Test
286+testCopy TestEnv{..} = TestCase $ do
434287 execute_ conn "CREATE TEMPORARY TABLE copy_test (x int, y text)"
435288 copy_ conn "COPY copy_test FROM STDIN (FORMAT CSV)"
436289 mapM_ (putCopyData conn) copyRows
@@ -447,14 +300,6 @@ testCopy TestEnv{..} = do
447300 -- so that we can issue more queries:
448301 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"
449302 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
458303 where
459304 copyRows = ["1,foo\n"
460305 ,"2,bar\n"]
@@ -465,70 +310,8 @@ testCopy TestEnv{..} = do
465310 CopyOutDone _ -> return rows
466311 CopyOutRow row -> loop (row:rows)
467312
468−testCopyFailures :: TestEnv -> TestTree
469−testCopyFailures env = testGroup "Copy failures"
470− $ map ($ env)
471− [ testCopyUniqueConstraintError
472− , testCopyMalformedError
473− ]
474−
475−goldenTest :: TestName -> IO BL.ByteString -> TestTree
476−goldenTest testName =
477− goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")
478− where
479− resultsDir = "test" </> "results"
480− fileName = map normalize testName
481− normalize c | not (isAlpha c) = '-'
482− | otherwise = c
483− diff ref new = ["diff", "-u", ref, new]
484−
485−-- | Test that we provide a sensible error message on failure
486−testCopyUniqueConstraintError :: TestEnv -> TestTree
487−testCopyUniqueConstraintError TestEnv{..} =
488− goldenTest "unique constraint violation"
489− $ handle (\(SomeException exc) -> return $ BL.pack $ show exc) $ do
490− execute_ conn "CREATE TEMPORARY TABLE copy_unique_constraint_error_test (x int PRIMARY KEY, y text)"
491− copy_ conn "COPY copy_unique_constraint_error_test FROM STDIN (FORMAT CSV)"
492− mapM_ (putCopyData conn) copyRows
493− _n <- putCopyEnd conn
494− return BL.empty
495− where
496− copyRows = ["1,foo\n"
497− ,"2,bar\n"
498− ,"1,baz\n"]
499−
500−testCopyMalformedError :: TestEnv -> TestTree
501−testCopyMalformedError TestEnv{..} =
502− goldenTest "malformed input"
503− $ handle (\(SomeException exc) -> return $ BL.pack $ show exc) $ do
504− execute_ conn "CREATE TEMPORARY TABLE copy_malformed_input_error_test (x int PRIMARY KEY, y text)"
505− copy_ conn "COPY copy_unique_constraint_error_test FROM STDIN (FORMAT CSV)"
506− mapM_ (putCopyData conn) copyRows
507− _n <- putCopyEnd conn
508− return BL.empty
509− where
510− copyRows = ["1,foo\n"
511− ,"2,bar\n"
512− ,"z,baz\n"]
513−
514−testTimeout :: TestEnv -> Assertion
515−testTimeout TestEnv{..} =
516− withConn $ \c -> do
517− start_t <- getCurrentTime
518− res <- timeout 200000 $ do
519− withTransaction c $ do
520− query_ c "SELECT pg_sleep(1)" :: IO [Only ()]
521− end_t <- getCurrentTime
522− assertBool "Timeout did not occur" (res == Nothing)
523−#if !defined(mingw32_HOST_OS)
524−-- At the moment, you cannot timely abandon queries with async exceptions on
525−-- Windows.
526− let d = end_t `diffUTCTime` start_t
527− assertBool "Timeout didn't work in a timely fashion" (0.1 < d && d < 0.6)
528−#endif
529−
530−testDouble :: TestEnv -> Assertion
531−testDouble TestEnv{..} = do
313+testDouble :: TestEnv -> Test
314+testDouble TestEnv{..} = TestCase $ do
532315 [Only (x :: Double)] <- query_ conn "SELECT 'NaN'::float8"
533316 assertBool "expected NaN" (isNaN x)
534317 [Only (x :: Double)] <- query_ conn "SELECT 'Infinity'::float8"
@@ -537,45 +320,6 @@ testDouble TestEnv{..} = do
537320 x @?= (-1 / 0)
538321
539322
540−testGeneric1 :: TestEnv -> Assertion
541−testGeneric1 TestEnv{..} = do
542− roundTrip conn (Gen1 123)
543− where
544− roundTrip conn x0 = do
545− r <- query conn "SELECT ?::int" (x0 :: Gen1)
546− r @?= [x0]
547−
548−testGeneric2 :: TestEnv -> Assertion
549−testGeneric2 TestEnv{..} = do
550− roundTrip conn (Gen2 123 "asdf")
551− where
552− roundTrip conn x0 = do
553− r <- query conn "SELECT ?::int, ?::text" x0
554− r @?= [x0]
555−
556−testGeneric3 :: TestEnv -> Assertion
557−testGeneric3 TestEnv{..} = do
558− roundTrip conn (Gen3 123 "asdf" True)
559− where
560− roundTrip conn x0 = do
561− r <- query conn "SELECT ?::int, ?::text, ?::bool" x0
562− r @?= [x0]
563−
564−data Gen1 = Gen1 Int
565− deriving (Show,Eq,Generic)
566−instance FromRow Gen1
567−instance ToRow Gen1
568−
569−data Gen2 = Gen2 Int Text
570− deriving (Show,Eq,Generic)
571−instance FromRow Gen2
572−instance ToRow Gen2
573−
574−data Gen3 = Gen3 Int Text Bool
575− deriving (Show,Eq,Generic)
576−instance FromRow Gen3
577−instance ToRow Gen3
578−
579323data TestException
580324 = TestException
581325 deriving (Eq, Show, Typeable)
@@ -593,56 +337,28 @@ isUniqueViolation SqlError{..} = sqlState == "23505"
593337isSyntaxError :: SqlError -> Bool
594338isSyntaxError SqlError{..} = sqlState == "42601"
595339
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− ]
604340------------------------------------------------------------------------
605341
606342-- | Action for connecting to the database that will be used for testing.
607343--
608344-- Note that some tests, such as Notify, use multiple connections, and assume
609345-- 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'"
346+testConnect :: IO Connection
347+testConnect = connectPostgreSQL ""
616348
349+withTestEnv :: (TestEnv -> IO a) -> IO a
350+withTestEnv cb =
351+ withConn $ \conn ->
617352 cb TestEnv
618353 { conn = conn
619354 , withConn = withConn
620355 }
621356 where
622− withConn = bracket (connectPostgreSQL connstr) close
357+ withConn = bracket testConnect close
623358
624359main :: 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− ]
360+main = do
361+ mapM_ (`hSetBuffering` LineBuffering) [stdout, stderr]
362+ Counts{cases, tried, errors, failures} <-
363+ withTestEnv $ \env -> runTestTT $ TestList $ map ($ env) tests
364+ when (cases /= tried || errors /= 0 || failures /= 0) $ exitFailure
test/Notify.hs+2−1
@@ -14,8 +14,9 @@ import qualified Data.ByteString as B
1414-- TODO: Test with payload, but only for PostgreSQL >= 9.0
1515-- (when that feature was introduced).
1616
17−testNotify :: TestEnv -> Assertion
17+testNotify :: TestEnv -> Test
1818testNotify TestEnv{..} =
19+ TestCase $
1920 withConn $ \conn2 -> do
2021 execute_ conn "LISTEN foo"
2122 execute_ conn "LISTEN bar"
test/Serializable.hs+2−1
@@ -23,8 +23,9 @@ putCounter conn n = do
2323 1 <- execute conn "UPDATE testSerializableCounter SET n=?" (Only n)
2424 return ()
2525
26−testSerializable :: TestEnv -> Assertion
26+testSerializable :: TestEnv -> Test
2727testSerializable TestEnv{..} =
28+ TestCase $
2829 withConn $ \conn2 -> do
2930 initCounter conn
3031
test/Time.hs+10−18
@@ -36,26 +36,26 @@ 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
4343numTests :: Int
4444numTests = 200
4545
46−testTime :: TestEnv -> Assertion
47−testTime env@TestEnv{..} = do
46+testTime :: TestEnv -> Test
47+testTime env@TestEnv{..} = TestCase $ do
4848 initializeTable env
4949 execute_ conn "SET timezone TO 'UTC'"
50− checkRoundTrips env "1860-01-01 00:00:00+00"
50+ checkRoundTrips env
5151 execute_ conn "SET timezone TO 'America/Chicago'" -- -5:00
52− checkRoundTrips env "1883-11-18 12:00:00-06"
52+ checkRoundTrips env
5353 execute_ conn "SET timezone TO 'Asia/Tokyo'" -- +9:00
54− checkRoundTrips env "1888-01-01 00:00:00+09"
54+ checkRoundTrips env
5555 execute_ conn "SET timezone TO 'Asia/Kathmandu'" -- +5:45
56− checkRoundTrips env "1919-12-31 23:48:44+05:30"
56+ checkRoundTrips env
5757 execute_ conn "SET timezone TO 'America/St_Johns'" -- -3:30
58− checkRoundTrips env "1935-03-30 00:00:52-03:30"
58+ checkRoundTrips env
5959
6060initializeTable :: TestEnv -> IO ()
6161initializeTable TestEnv{..} = withTransaction conn $ do
@@ -102,18 +102,10 @@ initializeTable TestEnv{..} = withTransaction conn $ do
102102 pop "100 milliseconds" 6.3113904e10
103103 pop "1 second" 6.3113904e9
104104
105−checkRoundTrips :: TestEnv -> ByteString -> IO ()
106−checkRoundTrips TestEnv{..} limit = do
105+checkRoundTrips :: TestEnv -> IO ()
106+checkRoundTrips TestEnv{..} = do
107107 yxs :: [(UTCTime, Int)] <- query_ conn [sql| SELECT y, x FROM testtime |]
108108 forM_ yxs $ \yx -> do
109109 res <- query conn [sql| SELECT y=? FROM testtime WHERE x=? |] yx
110110 assertBool "UTCTime did not round-trip from SQL to Haskell and back" $
111111 res == [Only True]
112−
113− yxs :: [(ZonedTime, Int)] <- query conn [sql|
114− SELECT y, x FROM testtime WHERE y > ?
115− |] (Only limit)
116− forM_ yxs $ \yx -> do
117− res <- query conn [sql| SELECT y=? FROM testtime WHERE x=? |] yx
118− assertBool "ZonedTime did not round-trip from SQL to Haskell and back" $
119− res == [Only True]
test/results/malformed-input.expecteddeleted−4
@@ -1,4 +0,0 @@
1−user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status
2−Connection error: ERROR: invalid input syntax for type integer: "z"
3−CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"
4−)
test/results/unique-constraint-violation.expecteddeleted−5
@@ -1,5 +0,0 @@
1−user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status
2−Connection error: ERROR: duplicate key value violates unique constraint "copy_unique_constraint_error_test_pkey"
3−DETAIL: Key (x)=(1) already exists.
4−CONTEXT: COPY copy_unique_constraint_error_test, line 3
5−)
tools/GenTypeInfo.hs+25−39
@@ -21,9 +21,6 @@
2121-- know about. It then constructs a TypeInfo record and stores it in
2222-- a per-connection cache for later use.
2323--
24−-- @
25−-- runghc -itools tools/GenTypeInfo.hs
26−-- @
2724------------------------------------------------------------------------------
2825
2926{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}
@@ -41,10 +38,12 @@ import Database.PostgreSQL.Simple.FromRow
4138import Database.PostgreSQL.Simple.Ok
4239import Database.PostgreSQL.Simple.Types(Oid(..))
4340import Database.PostgreSQL.Simple.SqlQQ
44−import qualified Data.ByteString.Char8 as B8
41+import qualified Data.ByteString.Char8 as B
4542import Data.ByteString(ByteString)
4643import qualified Data.ByteString.Lazy as L
47−import qualified Data.ByteString.Builder as Blaze
44+import qualified Blaze.ByteString.Builder as Blaze
45+import qualified Blaze.ByteString.Builder.ByteString as Blaze
46+import qualified Blaze.ByteString.Builder.Char8 as Blaze
4847import Data.String
4948import Data.List ( sort, intersperse )
5049import qualified Data.Map as Map
@@ -70,11 +69,11 @@ data TypeInfo = TypeInfo
7069instance FromRow TypeInfo where
7170 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field
7271
73−type NameMap = Map.Map B8.ByteString TypeInfo
72+type NameMap = Map.Map B.ByteString TypeInfo
7473
7574type OidMap = Map.Map Oid TypeInfo
7675
77−type TypeName = (B8.ByteString, B8.ByteString)
76+type TypeName = (B.ByteString, B.ByteString)
7877
7978type TypeNames = [TypeName]
8079
@@ -198,6 +197,9 @@ int8range
198197_int8range
199198|]
200199
200+instance IsString Blaze.Builder where
201+ fromString = Blaze.fromByteString . fromString
202+
201203connectionString = "dbname=postgres"
202204
203205withPostgreSQL = bracket (connectPostgreSQL connectionString) close
@@ -235,7 +237,7 @@ getTypeInfos typnames = withPostgreSQL $ \conn -> do
235237
236238main = do
237239 (oidmap, namemap) <- getTypeInfos typeNames
238− L.writeFile "src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"
240+ L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"
239241 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))
240242
241243
@@ -244,7 +246,7 @@ showOid (Oid n) = show n
244246renderOid :: NameMap -> TypeName -> Blaze.Builder
245247renderOid byName name
246248 = case Map.lookup (pg name) byName of
247− Nothing -> error (B8.unpack (pg name))
249+ Nothing -> error (B.unpack (pg name))
248250 Just (showOid . typoid -> n) -> fromString n
249251 ++ fromString (replicate (4 - length n) ' ')
250252
@@ -262,25 +264,20 @@ renderTypeInfo byOid info name
262264 typelem_hs_name =
263265 case lookup (typname typelem_info) typeNames of
264266 Nothing -> error ( "type not found: "
265− ++ B8.unpack( typname typelem_info)
266− ++ " (typelem of " ++ B8.unpack (typname info)
267+ ++ B.unpack( typname typelem_info)
268+ ++ " (typelem of " ++ B.unpack (typname info)
267269 ++ ")")
268270 Just x -> x
269271 in concat
270272 [ "\n"
271273 , bs (hs name), " :: TypeInfo\n"
272274 , bs (hs name), " = Array {\n"
273− , " typoid = ", bs (hs name), "Oid,\n"
274− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"
275− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"
275+ , " typoid = ", fromString (show (typoid info)), ",\n"
276+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
277+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
276278 , " typname = \"", bs (typname info), "\",\n"
277279 , " typelem = ", bs typelem_hs_name, "\n"
278280 , " }\n"
279− , "\n"
280− , bs (hs name), "Oid :: Oid\n"
281− , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"
282− , "{-# INLINE ", bs (hs name), "Oid #-}"
283− , "\n"
284281 ]
285282 | typcategory info == 'R' =
286283 let (Just rngsubtype_oid) = rngsubtype info
@@ -288,41 +285,31 @@ renderTypeInfo byOid info name
288285 rngsubtype_hs_name =
289286 case lookup (typname rngsubtype_info) typeNames of
290287 Nothing -> error ( "type not found: "
291− ++ B8.unpack (typname rngsubtype_info)
288+ ++ B.unpack (typname rngsubtype_info)
292289 ++ " (rngsubtype of "
293− ++ B8.unpack (typname info) ++ ")")
290+ ++ B.unpack (typname info) ++ ")")
294291 Just x -> x
295292 in concat
296293 [ "\n"
297294 , bs (hs name), " :: TypeInfo\n"
298295 , bs (hs name), " = Range {\n"
299− , " typoid = ", bs (hs name), "Oid,\n"
300− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"
301− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"
296+ , " typoid = ", fromString (show (typoid info)), ",\n"
297+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
298+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
302299 , " typname = \"", bs (typname info), "\",\n"
303300 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"
304301 , " }\n"
305− , "\n"
306− , bs (hs name), "Oid :: Oid\n"
307− , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"
308− , "{-# INLINE ", bs (hs name), "Oid #-}"
309− , "\n"
310302 ]
311303 | otherwise =
312304 concat
313305 [ "\n"
314306 , bs (hs name), " :: TypeInfo\n"
315307 , bs (hs name), " = Basic {\n"
316− , " typoid = ", bs (hs name), "Oid,\n"
317− , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"
318− , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"
308+ , " typoid = ", fromString (show (typoid info)), ",\n"
309+ , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"
310+ , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"
319311 , " typname = \"", bs (typname info), "\"\n"
320312 , " }\n"
321− , "\n"
322− , bs (hs name), "Oid :: Oid\n"
323− , bs (hs name), "Oid = ", fromString (show (typoid info)), "\n"
324− , "{-# INLINE ", bs (hs name), "Oid #-}"
325− , "\n"
326313 ]
327314
328315-- FIXME: add in any names that we need that we didn't specify, (i.e.
@@ -331,7 +318,7 @@ renderTypeInfo byOid info name
331318getNames :: NameMap -> TypeNames -> TypeNames
332319getNames _ x = x
333320
334−bs = Blaze.byteString
321+bs = Blaze.fromByteString
335322
336323pg = fst
337324
@@ -360,7 +347,6 @@ module Database.PostgreSQL.Simple.TypeInfo.Static
360347 ( TypeInfo(..)
361348 , staticTypeInfo
362349|] ++ concat [ " , " ++ bs (hs name) ++ "\n"
363− ++ " , " ++ bs (hs name) ++ "Oid\n"
364350 | name <- names ] ++ [longstring|
365351 ) where
366352