87c6c2d...master · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

on master help sign in

.ghcideleted−16

since splitsnapshots

unifiedsplit

@@ -1,16 +0,0 @@

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.ymlnew file+256

@@ -0,0 +1,256 @@

1+# This GitHub workflow config has been generated by a script via

2+#

3+# haskell-ci 'github' 'cabal.project'

4+#

5+# To regenerate the script (for example after adjusting tested-with) run

6+#

7+# haskell-ci regenerate

8+#

9+# For more information, see https://github.com/haskell-CI/haskell-ci

10+#

11+# version: 0.17.20231110

12+#

13+# REGENDATA ("0.17.20231110",["github","cabal.project"])

14+#

15+name: Haskell-CI

16+on:

17+ push:

18+ branches:

19+ - master

20+ pull_request:

21+ branches:

22+ - master

23+jobs:

24+ linux:

25+ name: Haskell-CI - Linux - ${{ matrix.compiler }}

26+ runs-on: ubuntu-20.04

27+ timeout-minutes:

28+ 60

29+ container:

30+ image: buildpack-deps:bionic

31+ services:

32+ postgres:

33+ image: postgres:14

34+ env:

35+ POSTGRES_PASSWORD: postgres

36+ options: --health-cmd pg_isready --health-interval 10s --health-timeout 5s --health-retries 5

37+ continue-on-error: ${{ matrix.allow-failure }}

38+ strategy:

39+ matrix:

40+ include:

41+ - compiler: ghc-9.8.1

42+ compilerKind: ghc

43+ compilerVersion: 9.8.1

44+ setup-method: ghcup

45+ allow-failure: false

46+ - compiler: ghc-9.6.3

47+ compilerKind: ghc

48+ compilerVersion: 9.6.3

49+ setup-method: ghcup

50+ allow-failure: false

51+ - compiler: ghc-9.4.8

52+ compilerKind: ghc

53+ compilerVersion: 9.4.8

54+ setup-method: ghcup

55+ allow-failure: false

56+ - compiler: ghc-9.2.8

57+ compilerKind: ghc

58+ compilerVersion: 9.2.8

59+ setup-method: ghcup

60+ allow-failure: false

61+ - compiler: ghc-9.0.2

62+ compilerKind: ghc

63+ compilerVersion: 9.0.2

64+ setup-method: ghcup

65+ allow-failure: false

66+ - compiler: ghc-8.10.7

67+ compilerKind: ghc

68+ compilerVersion: 8.10.7

69+ setup-method: ghcup

70+ allow-failure: false

71+ - compiler: ghc-8.8.4

72+ compilerKind: ghc

73+ compilerVersion: 8.8.4

74+ setup-method: hvr-ppa

75+ allow-failure: false

76+ - compiler: ghc-8.6.5

77+ compilerKind: ghc

78+ compilerVersion: 8.6.5

79+ setup-method: hvr-ppa

80+ allow-failure: false

81+ fail-fast: false

82+ steps:

83+ - name: apt

84+ run: |

85+ apt-get update

86+ apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

87+ if [ "${{ matrix.setup-method }}" = ghcup ]; then

88+ mkdir -p "$HOME/.ghcup/bin"

89+ curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"

90+ chmod a+x "$HOME/.ghcup/bin/ghcup"

91+ "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)

92+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

93+ else

94+ apt-add-repository -y 'ppa:hvr/ghc'

95+ apt-get update

96+ apt-get install -y "$HCNAME"

97+ mkdir -p "$HOME/.ghcup/bin"

98+ curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"

99+ chmod a+x "$HOME/.ghcup/bin/ghcup"

100+ "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)

101+ fi

102+ env:

103+ HCKIND: ${{ matrix.compilerKind }}

104+ HCNAME: ${{ matrix.compiler }}

105+ HCVER: ${{ matrix.compilerVersion }}

106+ - name: Set PATH and environment variables

107+ run: |

108+ echo "$HOME/.cabal/bin" >> $GITHUB_PATH

109+ echo "LANG=C.UTF-8" >> "$GITHUB_ENV"

110+ echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"

111+ echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

112+ HCDIR=/opt/$HCKIND/$HCVER

113+ if [ "${{ matrix.setup-method }}" = ghcup ]; then

114+ HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")

115+ HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')

116+ HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')

117+ echo "HC=$HC" >> "$GITHUB_ENV"

118+ echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"

119+ echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"

120+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

121+ else

122+ HC=$HCDIR/bin/$HCKIND

123+ echo "HC=$HC" >> "$GITHUB_ENV"

124+ echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"

125+ echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"

126+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

127+ fi

128+

129+ HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

130+ echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

131+ echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

132+ echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"

133+ echo "HEADHACKAGE=false" >> "$GITHUB_ENV"

134+ echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"

135+ echo "GHCJSARITH=0" >> "$GITHUB_ENV"

136+ env:

137+ HCKIND: ${{ matrix.compilerKind }}

138+ HCNAME: ${{ matrix.compiler }}

139+ HCVER: ${{ matrix.compilerVersion }}

140+ - name: env

141+ run: |

142+ env

143+ - name: write cabal config

144+ run: |

145+ mkdir -p $CABAL_DIR

146+ cat >> $CABAL_CONFIG <<EOF

147+ remote-build-reporting: anonymous

148+ write-ghc-environment-files: never

149+ remote-repo-cache: $CABAL_DIR/packages

150+ logs-dir: $CABAL_DIR/logs

151+ world-file: $CABAL_DIR/world

152+ extra-prog-path: $CABAL_DIR/bin

153+ symlink-bindir: $CABAL_DIR/bin

154+ installdir: $CABAL_DIR/bin

155+ build-summary: $CABAL_DIR/logs/build.log

156+ store-dir: $CABAL_DIR/store

157+ install-dirs user

158+ prefix: $CABAL_DIR

159+ repository hackage.haskell.org

160+ url: http://hackage.haskell.org/

161+ EOF

162+ cat >> $CABAL_CONFIG <<EOF

163+ program-default-options

164+ ghc-options: $GHCJOBS +RTS -M3G -RTS

165+ EOF

166+ cat $CABAL_CONFIG

167+ - name: versions

168+ run: |

169+ $HC --version || true

170+ $HC --print-project-git-commit-id || true

171+ $CABAL --version || true

172+ - name: update cabal index

173+ run: |

174+ $CABAL v2-update -v

175+ - name: install cabal-plan

176+ run: |

177+ mkdir -p $HOME/.cabal/bin

178+ curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz

179+ echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -

180+ xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan

181+ rm -f cabal-plan.xz

182+ chmod a+x $HOME/.cabal/bin/cabal-plan

183+ cabal-plan --version

184+ - name: checkout

185+ uses: actions/checkout@v3

186+ with:

187+ path: source

188+ - name: initial cabal.project for sdist

189+ run: |

190+ touch cabal.project

191+ echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project

192+ cat cabal.project

193+ - name: sdist

194+ run: |

195+ mkdir -p sdist

196+ $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist

197+ - name: unpack

198+ run: |

199+ mkdir -p unpacked

200+ find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;

201+ - name: generate cabal.project

202+ run: |

203+ PKGDIR_postgresql_simple="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/postgresql-simple-[0-9.]*')"

204+ echo "PKGDIR_postgresql_simple=${PKGDIR_postgresql_simple}" >> "$GITHUB_ENV"

205+ rm -f cabal.project cabal.project.local

206+ touch cabal.project

207+ touch cabal.project.local

208+ echo "packages: ${PKGDIR_postgresql_simple}" >> cabal.project

209+ echo "package postgresql-simple" >> cabal.project

210+ echo " ghc-options: -Werror=missing-methods" >> cabal.project

211+ cat >> cabal.project <<EOF

212+ allow-newer: cryptohash-md5-0.11.100.1:base

213+ EOF

214+ $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(postgresql-simple)$/; }' >> cabal.project.local

215+ cat cabal.project

216+ cat cabal.project.local

217+ - name: dump install plan

218+ run: |

219+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all

220+ cabal-plan

221+ - name: restore cache

222+ uses: actions/cache/restore@v3

223+ with:

224+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

225+ path: ~/.cabal/store

226+ restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-

227+ - name: install dependencies

228+ run: |

229+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all

230+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all

231+ - name: build w/o tests

232+ run: |

233+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

234+ - name: build

235+ run: |

236+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always

237+ - name: tests

238+ run: |

239+ $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct

240+ - name: cabal check

241+ run: |

242+ cd ${PKGDIR_postgresql_simple} || false

243+ ${CABAL} -vnormal check

244+ - name: haddock

245+ run: |

246+ $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

247+ - name: unconstrained build

248+ run: |

249+ rm -f cabal.project.local

250+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

251+ - name: save cache

252+ uses: actions/cache/save@v3

253+ if: always()

254+ with:

255+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

256+ path: ~/.cabal/store

.github/workflows/simple.ymlnew file+58

@@ -0,0 +1,58 @@

1+name: Simple

2+on:

3+ push:

4+ branches:

5+ - master

6+ pull_request:

7+ branches:

8+ - master

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+4−1

@@ -11,4 +11,7 @@ dist/

11.cabal-sandbox/

12.stack-work/

13cabal.sandbox.config

14−/dist-newstyle

14+/dist-newstyle

15+.ghc.environment.*

16+cabal.project.local

17+dump-core

.travis.ymldeleted−73

@@ -1,73 +0,0 @@

1−# This file has been generated -- see https://github.com/hvr/multi-ghc-travis

2−language: c

3−sudo: false

4−

5−cache:

6− directories:

7− - $HOME/.cabsnap

8− - $HOME/.cabal/packages

9−

10−before_cache:

11− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

12− - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar

13−

14−matrix:

15− include:

16− - env: CABALVER=1.18 GHCVER=7.8.4

17− compiler: ": #GHC 7.8.4"

18− addons: { apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}, postgresql: "9.3"}

19− - env: CABALVER=1.22 GHCVER=7.10.2

20− compiler: ": #GHC 7.10.2"

21− addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}, postgresql: "9.3"}

22− - env: CABALVER=1.24 GHCVER=8.0.1

23− compiler: ": #GHC 8.0.1"

24− addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}, postgresql: "9.3"}

25−

26−before_install:

27− - unset CC

28− - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH

29− - createdb `whoami` || true

30−

31−install:

32− - cabal --version

33− - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"

34− - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];

35− then

36− zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >

37− $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;

38− fi

39− - travis_retry cabal update -v

40− - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config

41− - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt

42− - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt

43−

44−# check whether current requested install-plan matches cached package-db snapshot

45− - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;

46− then

47− echo "cabal build-cache HIT";

48− rm -rfv .ghc;

49− cp -a $HOME/.cabsnap/ghc $HOME/.ghc;

50− cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;

51− else

52− echo "cabal build-cache MISS";

53− rm -rf $HOME/.cabsnap;

54− mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;

55− cabal install --only-dependencies --enable-tests --enable-benchmarks;

56− fi

57−

58−# snapshot package-db on cache miss

59− - if [ ! -d $HOME/.cabsnap ];

60− then

61− echo "snapshotting package-db to build-cache";

62− mkdir $HOME/.cabsnap;

63− cp -a $HOME/.ghc $HOME/.cabsnap/ghc;

64− cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;

65− fi

66−

67−# Here starts the actual work to be performed for the package under test;

68−# any command which exits with a non-zero exit code causes the build to fail.

69−script:

70− - if [ -f configure.ac ]; then autoreconf -i; fi

71− - cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging

72− - cabal build # this builds all libraries and executables (including tests/benchmarks)

73− - cabal test

CHANGES.md+138−8

@@ -1,8 +1,138 @@

1−### Unreleased

1+### Version 0.7.0.0 (2023-07-31)

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)

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+

3− * Added `ToField` instances for case-insensitive strict and lazy text.

99+ * Add `ToField` instances for case-insensitive strict and lazy text.

4− Added `citext` and `_citext` to `Database.PostgreSQL.Simple.TypeInfo.Static`.

5 Thanks to Max Tagher for the implementation.

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

7### Version 0.5.3.0 (2017-05-15)

137### Version 0.5.3.0 (2017-05-15)

8 * Refactored some rudimentary cursor handling code out of the

138 * Refactored some rudimentary cursor handling code out of the

@@ -141,7 +271,7 @@

141 support UTF8 except for Mule Internal Code, the Multilingual

271 support UTF8 except for Mule Internal Code, the Multilingual

142 Extensions for Emacs. An exception should be raised upon

272 Extensions for Emacs. An exception should be raised upon

143 connecting to a database by the backend if the backend cannot

273 connecting to a database by the backend if the backend cannot

144− accomodate this requirement.

274+ accommodate this requirement.

145

275

146 * Added `Eq` and `Typeable` instances for `Connection`.

276 * Added `Eq` and `Typeable` instances for `Connection`.

147

277

@@ -261,7 +391,7 @@

261 * De-emphasized connect and ConnectInfo in favor of connectPostgreSQL.

391 * De-emphasized connect and ConnectInfo in favor of connectPostgreSQL.

262

392

263### Version 0.4.2.2 (2014-05-15)

393### Version 0.4.2.2 (2014-05-15)

264− * Fixed compatibility with scientific-0.3.*, thanks to Adam Bergmark

394+ * Fixed compatibility with scientific-0.3.\*, thanks to Adam Bergmark

265

395

266 * Improved documentation of the FromField module, as well as the fold,

396 * Improved documentation of the FromField module, as well as the fold,

267 foldWithOptions, executeMany, and returning operators.

397 foldWithOptions, executeMany, and returning operators.

@@ -279,7 +409,7 @@

279

409

280 * Changed the Identifier and QualifiedIdentifier to use Text in

410 * Changed the Identifier and QualifiedIdentifier to use Text in

281 order to avoid encoding errors. Technically this requires a

411 order to avoid encoding errors. Technically this requires a

282− major verson bump, but let's pretend 0.4.1.0 didn't happen.

412+ major version bump, but let's pretend 0.4.1.0 didn't happen.

283

413

284 * Removed non-exhaustive cases in the ToField instance for Values,

414 * Removed non-exhaustive cases in the ToField instance for Values,

285 and tweaked error messages.

415 and tweaked error messages.

@@ -439,7 +569,7 @@

439

569

440 * Added a brand new TypeInfo system that gives FromField instances

570 * Added a brand new TypeInfo system that gives FromField instances

441 convenient and efficient access to the pg_type metatable. This

571 convenient and efficient access to the pg_type metatable. This

442− replaced the older typename cache, and was neccesary to properly

572+ replaced the older typename cache, and was necessary to properly

443 support postgres array types. Thanks to Bas van Dijk for his

573 support postgres array types. Thanks to Bas van Dijk for his

444 work on this feature.

574 work on this feature.

445

575

@@ -531,7 +661,7 @@

531 now the preferred way of dealing with `timestamp` (without time zone).

661 now the preferred way of dealing with `timestamp` (without time zone).

532

662

533 * `Database.PostgreSQL.Simple.Time` is a new module that offers types

663 * `Database.PostgreSQL.Simple.Time` is a new module that offers types

534− that accomodate PostgreSQL's infinities.

664+ that accommodate PostgreSQL's infinities.

535

665

536 * All time-related `FromField`/`ToField` instances are now based on new,

666 * All time-related `FromField`/`ToField` instances are now based on new,

537 higher-speed parsers and printers instead of those provided by the

667 higher-speed parsers and printers instead of those provided by the

CONTRIBUTING.mdnew file+13

@@ -0,0 +1,13 @@

1+Patches welcome!

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))

9+- Don't edit `CHANGELOG.md`, rather include a copyable entry in your pull request description. I often process pull requests in bulk, and everyone editing the `CHANGELOG.md` causes unnecessary conflicts.

10+- For the same reason, do not edit `version` or `x-revision`

11+

12+- I use [`stylish-haskell`](https://github.com/jaspervdj/stylish-haskell) to format imports. I encourage you to use it too, when contributing.

13+- General code style is 4 spaces, just look around how it looks, it's not so strict.

README.md−3

@@ -1,7 +1,4 @@

1−[![Continuous Integration status][status-png]][status]

2[![Hackage page (downloads and API reference)][hackage-png]][hackage]

1[![Hackage page (downloads and API reference)][hackage-png]][hackage]

4− [status-png]: https://api.travis-ci.org/lpsmith/postgresql-simple.svg

5− [status]: http://travis-ci.org/lpsmith/postgresql-simple?branch=master

6 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg

3 [hackage-png]: http://img.shields.io/hackage/v/postgresql-simple.svg

7 [hackage]: http://hackage.haskell.org/package/postgresql-simple

4 [hackage]: http://hackage.haskell.org/package/postgresql-simple

bench/Select.hsnew file+32

@@ -0,0 +1,32 @@

1+{-# LANGUAGE OverloadedStrings #-}

2+module Main where

4+import Database.PostgreSQL.Simple

5+import qualified Database.PostgreSQL.Simple.Vector as V

6+import qualified Database.PostgreSQL.Simple.Vector.Unboxed as VU

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-cinew file+5

@@ -0,0 +1,5 @@

1+branches: master

2+postgresql: True

4+-- services aren't supported on Travis on macOS

5+-- osx: 8.4.4

cabal.project+3

@@ -1 +1,4 @@

1packages: .

2+tests: true

4+allow-newer: cryptohash-md5-0.11.100.1:base

cabal.project.local.winnew file+4

@@ -0,0 +1,4 @@

1+constraints: these -assoc

3+package postgresql-libpq

4+ flags: -use-pkg-config

postgresql-simple.cabal+163−124

@@ -1,136 +1,175 @@

1+cabal-version: 1.12

1−Name: postgresql-simple

2+name: postgresql-simple

2−Version: 0.5.3.0

3+version: 0.7.0.0

4+x-revision: 1

3−Synopsis: Mid-Level PostgreSQL client library

5+synopsis: Mid-Level PostgreSQL client library

4−Description:

6+description:

5− Mid-Level PostgreSQL client library, forked from mysql-simple.

7+ Mid-Level PostgreSQL client library, forked from mysql-simple.

6−License: BSD3

9+license: BSD3

7−License-file: LICENSE

10+license-file: LICENSE

8−Author: Bryan O'Sullivan, Leon P Smith

11+author: Bryan O'Sullivan, Leon P Smith

9−Maintainer: Leon P Smith <leon@melding-monads.com>

12+maintainer: Oleg Grenrus <oleg.grenrus@iki.fi>

13+copyright:

17+

12−Category: Database

18+category: Database

13−Build-type: Simple

19+build-type: Simple

14−

15−Cabal-version: >= 1.9.2

16−

17extra-source-files:

20extra-source-files:

21+ CHANGES.md

18− CONTRIBUTORS

22+ CONTRIBUTORS

19− CHANGELOG.md

23+ test/results/malformed-input.expected

20−

24+ test/results/unique-constraint-violation.expected

21−Library

25+

26+tested-with:

27+ GHC ==8.6.5

28+ || ==8.8.4

29+ || ==8.10.7

30+ || ==9.0.2

31+ || ==9.2.8

32+ || ==9.4.8

33+ || ==9.6.3

34+ || ==9.8.1

35+

36+library

37+ default-language: Haskell2010

22− hs-source-dirs: src

38+ hs-source-dirs: src

23− Exposed-modules:

39+ exposed-modules:

24− Database.PostgreSQL.Simple

40+ Database.PostgreSQL.Simple

25− Database.PostgreSQL.Simple.Arrays

41+ Database.PostgreSQL.Simple.Arrays

26− Database.PostgreSQL.Simple.Copy

42+ Database.PostgreSQL.Simple.Copy

27− Database.PostgreSQL.Simple.Cursor

43+ Database.PostgreSQL.Simple.Cursor

44+ Database.PostgreSQL.Simple.Errors

28− Database.PostgreSQL.Simple.FromField

45+ Database.PostgreSQL.Simple.FromField

29− Database.PostgreSQL.Simple.FromRow

46+ Database.PostgreSQL.Simple.FromRow

47+ Database.PostgreSQL.Simple.HStore

48+ Database.PostgreSQL.Simple.HStore.Internal

49+ Database.PostgreSQL.Simple.Internal

30− Database.PostgreSQL.Simple.LargeObjects

50+ Database.PostgreSQL.Simple.LargeObjects

31− Database.PostgreSQL.Simple.HStore

32− Database.PostgreSQL.Simple.HStore.Internal

51+ Database.PostgreSQL.Simple.Newtypes

33− Database.PostgreSQL.Simple.Notification

52+ Database.PostgreSQL.Simple.Notification

34− Database.PostgreSQL.Simple.Ok

53+ Database.PostgreSQL.Simple.Ok

35− Database.PostgreSQL.Simple.Range

54+ Database.PostgreSQL.Simple.Range

36− Database.PostgreSQL.Simple.SqlQQ

55+ Database.PostgreSQL.Simple.SqlQQ

37− Database.PostgreSQL.Simple.Time

56+ Database.PostgreSQL.Simple.Time

38− Database.PostgreSQL.Simple.Time.Internal

57+ Database.PostgreSQL.Simple.Time.Internal

39− Database.PostgreSQL.Simple.ToField

58+ Database.PostgreSQL.Simple.ToField

40− Database.PostgreSQL.Simple.ToRow

59+ Database.PostgreSQL.Simple.ToRow

41− Database.PostgreSQL.Simple.Transaction

60+ Database.PostgreSQL.Simple.Transaction

42− Database.PostgreSQL.Simple.TypeInfo

61+ Database.PostgreSQL.Simple.TypeInfo

43− Database.PostgreSQL.Simple.TypeInfo.Macro

62+ Database.PostgreSQL.Simple.TypeInfo.Macro

44− Database.PostgreSQL.Simple.TypeInfo.Static

63+ Database.PostgreSQL.Simple.TypeInfo.Static

45− Database.PostgreSQL.Simple.Types

64+ Database.PostgreSQL.Simple.Types

46− Database.PostgreSQL.Simple.Errors

65+ Database.PostgreSQL.Simple.Vector

47−-- Other-modules:

48− Database.PostgreSQL.Simple.Internal

66+ Database.PostgreSQL.Simple.Vector.Unboxed

49−

67+

50− Other-modules:

68+ -- Other-modules:

69+ other-modules:

51− Database.PostgreSQL.Simple.Compat

70+ Database.PostgreSQL.Simple.Compat

52− Database.PostgreSQL.Simple.HStore.Implementation

71+ Database.PostgreSQL.Simple.HStore.Implementation

53− Database.PostgreSQL.Simple.Internal.PQResultUtils

72+ Database.PostgreSQL.Simple.Internal.PQResultUtils

54− Database.PostgreSQL.Simple.Time.Implementation

73+ Database.PostgreSQL.Simple.Time.Implementation

55− Database.PostgreSQL.Simple.Time.Internal.Parser

74+ Database.PostgreSQL.Simple.Time.Internal.Parser

56− Database.PostgreSQL.Simple.Time.Internal.Printer

75+ Database.PostgreSQL.Simple.Time.Internal.Printer

57− Database.PostgreSQL.Simple.TypeInfo.Types

76+ Database.PostgreSQL.Simple.TypeInfo.Types

58−

77+

78+ -- GHC bundled libs

59− Build-depends:

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:

60− aeson >= 0.6,

90+ aeson >=2.1.2.1 && <2.3

61− attoparsec >= 0.10.3,

91+ , attoparsec >=0.14.4 && <0.15

62− base >= 4.6 && < 5,

63− bytestring >= 0.9,

64− bytestring-builder,

65− case-insensitive,

92+ , case-insensitive >=1.2.1.0 && <1.3

66− containers,

67− hashable,

93+ , hashable >=1.4.3.0 && <1.5

68− Only,

94+ , Only >=0.1 && <0.1.1

69− postgresql-libpq >= 0.9 && < 0.10,

95+ , postgresql-libpq >=0.10.0.0 && <0.11

70− template-haskell,

96+ , scientific >=0.3.7.0 && <0.4

71− text >= 0.11.1,

72− time,

73− transformers,

74− uuid-types >= 1.0.0,

97+ , uuid-types >=1.0.5 && <1.1

75− scientific,

76− semigroups,

77− vector

98+ , vector >=0.13.0.0 && <0.14

78−

99+

79− if !impl(ghc >= 7.6)

100+ default-extensions:

80− Build-depends:

101+ BangPatterns

81− ghc-prim

102+ DoAndIfThenElse

82−

83− extensions: DoAndIfThenElse, OverloadedStrings, BangPatterns, ViewPatterns

103+ OverloadedStrings

84− TypeOperators

104+ TypeOperators

85−

105+ ViewPatterns

106+

86− ghc-options: -Wall -fno-warn-name-shadowing

107+ ghc-options: -Wall -fno-warn-name-shadowing

108

88source-repository head

109source-repository head

89 type: git

110 type: git

90− location: http://github.com/lpsmith/postgresql-simple

111+ location: http://github.com/haskellari/postgresql-simple

91−

112+

92−source-repository this

113+test-suite inspection

93− type: git

114+ default-language: Haskell2010

94− location: http://github.com/lpsmith/postgresql-simple

115+ type: exitcode-stdio-1.0

95− tag: v0.5.3.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

125

97test-suite test

126test-suite test

127+ default-language: Haskell2010

98− type: exitcode-stdio-1.0

128+ type: exitcode-stdio-1.0

99−

100− hs-source-dirs: test

129+ hs-source-dirs: test

101− main-is: Main.hs

130+ main-is: Main.hs

102 other-modules:

131 other-modules:

103 Common

132 Common

133+ Exception

134+ Interval

104 Notify

135 Notify

105 Serializable

136 Serializable

106 Time

137 Time

107

138

139+ ghc-options: -threaded

108− ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind

140+ ghc-options: -Wall -fno-warn-name-shadowing -fno-warn-unused-do-bind

109−

141+ default-extensions:

110− extensions: NamedFieldPuns

142+ NamedFieldPuns

111− , OverloadedStrings

143+ OverloadedStrings

144+ PatternGuards

112− , Rank2Types

145+ Rank2Types

113− , RecordWildCards

146+ RecordWildCards

114− , PatternGuards

115− , ScopedTypeVariables

147+ ScopedTypeVariables

116−

148+

117− build-depends: base

149+ build-depends:

118− , aeson

150+ aeson

151+ , base

119− , base16-bytestring

152+ , base16-bytestring

120− , bytestring

153+ , bytestring

154+ , case-insensitive

121− , containers

155+ , containers

122− , cryptohash

156+ , cryptohash-md5 >=0.11.100.1 && <0.12

123− , filepath

157+ , filepath

124− , tasty

125− , tasty-hunit

126− , tasty-golden

127− , HUnit

158+ , HUnit

128− , postgresql-simple

159+ , postgresql-simple

160+ , tasty

161+ , tasty-golden

162+ , tasty-hunit

129− , text

163+ , text

130− , time

164+ , time-compat

131− , vector

165+ , vector

132− , case-insensitive

166+

133−

167+benchmark select

134− if !impl(ghc >= 7.6)

168+ default-language: Haskell2010

169+ type: exitcode-stdio-1.0

170+ hs-source-dirs: bench

171+ main-is: Select.hs

135− build-depends:

172+ build-depends:

136− ghc-prim

173+ base

174+ , postgresql-simple

175+ , vector

src/Database/PostgreSQL/Simple.hs+23−10

@@ -64,6 +64,7 @@ module Database.PostgreSQL.Simple

64 , Only(..)

65 , (:.)(..)

66 -- ** Exceptions

67+ , SomePostgreSqlException(..)

67 , SqlError(..)

68 , SqlError(..)

68 , PQ.ExecStatus(..)

69 , PQ.ExecStatus(..)

69 , FormatError(..)

70 , FormatError(..)

@@ -73,6 +74,7 @@ module Database.PostgreSQL.Simple

73 , Base.connectPostgreSQL

74 , Base.connectPostgreSQL

74 , Base.close

75 , Base.close

75 , Base.connect

76 , Base.connect

77+ , Base.withConnect

76 , Base.ConnectInfo(..)

78 , Base.ConnectInfo(..)

77 , Base.defaultConnectInfo

79 , Base.defaultConnectInfo

78 , Base.postgreSQLConnectionString

80 , Base.postgreSQLConnectionString

@@ -276,21 +278,31 @@ parseTemplate template =

276 skipSpace = B.dropWhile isSpace_ascii

278 skipSpace = B.dropWhile isSpace_ascii

277

279

278

280

279−

280buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder

281buildQuery :: Connection -> Query -> ByteString -> [Action] -> IO Builder

281buildQuery conn q template xs =

282buildQuery conn q template xs =

282 zipParams (split template) <$> mapM (buildAction conn q xs) xs

283 zipParams (split template) <$> mapM (buildAction conn q xs) xs

283 where split s =

284 where split s =

284− let (h,t) = B.break (=='?') 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

285 in byteString h

288 in byteString h

286 : if B.null t

289 : if B.null t

287 then []

290 then []

288 else split (B.tail t)

291 else split (B.tail t)

289 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps

292 zipParams (t:ts) (p:ps) = t <> p <> zipParams ts ps

290 zipParams [t] [] = t

293 zipParams [t] [] = t

291− zipParams _ _ = fmtError (show (B.count '?' template) ++

294+ zipParams _ _ = fmtError (show countSingleQs ++

292− " '?' characters, but " ++

295+ " single '?' characters, but " ++

293 show (length xs) ++ " parameters") q xs

296 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

294

306

295-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not

307-- | Execute an @INSERT@, @UPDATE@, or other SQL query that is not

296-- expected to return results.

308-- expected to return results.

@@ -328,7 +340,7 @@ execute conn template qs = do

328-- @

340-- @

329-- executeMany c [sql|

341-- executeMany c [sql|

330-- UPDATE sometable

342-- UPDATE sometable

331−-- SET sometable.y = upd.y

343+-- SET y = upd.y

332-- FROM (VALUES (?,?)) as upd(x,y)

344-- FROM (VALUES (?,?)) as upd(x,y)

333-- WHERE sometable.x = upd.x

345-- WHERE sometable.x = upd.x

334-- |] [(1, \"hello\"),(2, \"world\")]

346-- |] [(1, \"hello\"),(2, \"world\")]

@@ -355,6 +367,7 @@ executeMany conn q qs = do

355returning :: (ToRow q, FromRow r) => Connection -> Query -> [q] -> IO [r]

367returning :: (ToRow q, FromRow r) => Connection -> Query -> [q] -> IO [r]

356returning = returningWith fromRow

368returning = returningWith fromRow

357

369

370+-- | A version of 'returning' taking parser as argument

358returningWith :: (ToRow q) => RowParser r -> Connection -> Query -> [q] -> IO [r]

371returningWith :: (ToRow q) => RowParser r -> Connection -> Query -> [q] -> IO [r]

359returningWith _ _ _ [] = return []

372returningWith _ _ _ [] = return []

360returningWith parser conn q qs = do

373returningWith parser conn q qs = do

@@ -520,7 +533,7 @@ foldWithOptions_ :: (FromRow r) =>

520 -> a -- ^ Initial state for result consumer.

533 -> a -- ^ Initial state for result consumer.

521 -> (a -> r -> IO a) -- ^ Result consumer.

534 -> (a -> r -> IO a) -- ^ Result consumer.

522 -> IO a

535 -> IO a

523−foldWithOptions_ opts conn query a f = doFold opts fromRow conn query query a f

536+foldWithOptions_ opts conn query' a f = doFold opts fromRow conn query' query' a f

524

537

525-- | A version of 'foldWithOptions_' taking a parser as an argument

538-- | A version of 'foldWithOptions_' taking a parser as an argument

526foldWithOptionsAndParser_ :: FoldOptions

539foldWithOptionsAndParser_ :: FoldOptions

@@ -530,7 +543,7 @@ foldWithOptionsAndParser_ :: FoldOptions

530 -> a -- ^ Initial state for result consumer.

543 -> a -- ^ Initial state for result consumer.

531 -> (a -> r -> IO a) -- ^ Result consumer.

544 -> (a -> r -> IO a) -- ^ Result consumer.

532 -> IO a

545 -> IO a

533−foldWithOptionsAndParser_ opts parser conn query a f = doFold opts parser conn query query a f

546+foldWithOptionsAndParser_ opts parser conn query' a f = doFold opts parser conn query' query' a f

534

547

535doFold :: FoldOptions

548doFold :: FoldOptions

536 -> RowParser row

549 -> RowParser row

@@ -566,8 +579,8 @@ doFold FoldOptions{..} parser conn _template q a0 f = do

566 go = bracket declare closeCursor $ \cursor ->

579 go = bracket declare closeCursor $ \cursor ->

567 let loop a = fetch cursor a >>=

580 let loop a = fetch cursor a >>=

568 \r -> case r of

581 \r -> case r of

569− Left a -> return a

582+ Left x -> return x

570− Right a -> loop a

583+ Right x -> loop x

571 in loop a0

584 in loop a0

572

585

573-- FIXME: choose the Automatic chunkSize more intelligently

586-- FIXME: choose the Automatic chunkSize more intelligently

@@ -889,7 +902,7 @@ forEachWith_ parser conn template = foldWith_ parser conn template () . const

889-- all values of the given PostgreSQL type is considered \"compatible\".

902-- all values of the given PostgreSQL type is considered \"compatible\".

890-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@

903-- For instance, you can always extract a PostgreSQL 16-bit @SMALLINT@

891-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately

904-- column to a Haskell 'Int'. The Haskell 'Float' type can accurately

892−-- represent a @SMALLINT@, so it is considered compatble with those types.

905+-- represent a @SMALLINT@, so it is considered compatible with those types.

893--

906--

894-- * A numeric compatibility check is based only on the type of a

907-- * A numeric compatibility check is based only on the type of a

895-- column, /not/ on its values. For instance, a PostgreSQL 64-bit

908-- column, /not/ on its values. For instance, a PostgreSQL 64-bit

src/Database/PostgreSQL/Simple/Arrays.hs+2−2

@@ -42,9 +42,9 @@ array delim = char '{' *> option [] (arrays <|> strings) <* char '}'

42quoted :: Parser ByteString

43quoted = char '"' *> option "" contents <* char '"'

44 where

45− esc = char '\\' *> (char '\\' <|> char '"')

45+ esc' = char '\\' *> (char '\\' <|> char '"')

46 unQ = takeWhile1 (notInClass "\"\\")

47− contents = mconcat <$> many (unQ <|> B.singleton <$> esc)

47+ contents = mconcat <$> many (unQ <|> B.singleton <$> esc')

49-- | Recognizes a plain string literal, not containing quotes or brackets and

50-- not containing the delimiter character.

src/Database/PostgreSQL/Simple/Compat.hs−53

@@ -12,36 +12,13 @@ module Database.PostgreSQL.Simple.Compat

12 ) where

14import qualified Control.Exception as E

15−import Data.Monoid

16import Data.ByteString (ByteString)

15import Data.ByteString (ByteString)

17−#if MIN_VERSION_bytestring(0,10,0)

18import Data.ByteString.Lazy (toStrict)

16import Data.ByteString.Lazy (toStrict)

19−#else

20−import qualified Data.ByteString as B

21−import Data.ByteString.Lazy (toChunks)

22−#endif

23import Data.ByteString.Builder (Builder, toLazyByteString)

17import Data.ByteString.Builder (Builder, toLazyByteString)

24−

25−#if MIN_VERSION_scientific(0,3,0)

26import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

18import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

27−#else

28−import Data.Scientific (scientificBuilder)

29−#endif

30−

31−#if __GLASGOW_HASKELL__ >= 702

32import System.IO.Unsafe (unsafeDupablePerformIO)

19import System.IO.Unsafe (unsafeDupablePerformIO)

33−#elif __GLASGOW_HASKELL__ >= 611

34−import GHC.IO (unsafeDupablePerformIO)

35−#else

36−import GHC.IOBase (unsafeDupablePerformIO)

37−#endif

38−

39import Data.Fixed (Pico)

20import Data.Fixed (Pico)

40−#if MIN_VERSION_base(4,7,0)

41import Data.Fixed (Fixed(MkFixed))

21import Data.Fixed (Fixed(MkFixed))

42−#else

43−import Unsafe.Coerce (unsafeCoerce)

44−#endif

46-- | Like 'E.mask', but backported to base before version 4.3.0.

23-- | Like 'E.mask', but backported to base before version 4.3.0.

47--

24--

@@ -51,44 +28,14 @@ import Unsafe.Coerce (unsafeCoerce)

51-- 'withTransactionMode' function calls the restore callback only once, so we

28-- 'withTransactionMode' function calls the restore callback only once, so we

52-- don't need that polymorphism.

29-- don't need that polymorphism.

53mask :: ((IO a -> IO a) -> IO b) -> IO b

30mask :: ((IO a -> IO a) -> IO b) -> IO b

54−#if MIN_VERSION_base(4,3,0)

55mask io = E.mask $ \restore -> io restore

31mask io = E.mask $ \restore -> io restore

56−#else

57−mask io = do

58− b <- E.blocked

59− E.block $ io $ \m -> if b then m else E.unblock m

60−#endif

61{-# INLINE mask #-}

32{-# INLINE mask #-}

63−#if !MIN_VERSION_base(4,5,0)

64−infixr 6 <>

65−

66−(<>) :: Monoid m => m -> m -> m

67−(<>) = mappend

68−{-# INLINE (<>) #-}

69−#endif

70−

71toByteString :: Builder -> ByteString

34toByteString :: Builder -> ByteString

72−#if MIN_VERSION_bytestring(0,10,0)

73toByteString x = toStrict (toLazyByteString x)

35toByteString x = toStrict (toLazyByteString x)

74−#else

75−toByteString x = B.concat (toChunks (toLazyByteString x))

76−#endif

77−

78−#if MIN_VERSION_base(4,7,0)

80toPico :: Integer -> Pico

37toPico :: Integer -> Pico

81toPico = MkFixed

38toPico = MkFixed

83fromPico :: Pico -> Integer

40fromPico :: Pico -> Integer

84fromPico (MkFixed i) = i

41fromPico (MkFixed i) = i

85−

86−#else

87−

88−toPico :: Integer -> Pico

89−toPico = unsafeCoerce

90−

91−fromPico :: Pico -> Integer

92−fromPico = unsafeCoerce

93−

94−#endif

src/Database/PostgreSQL/Simple/Copy.hs+27−6

@@ -32,6 +32,7 @@ module Database.PostgreSQL.Simple.Copy

32 ( copy

33 , copy_

34 , CopyOutResult(..)

35+ , foldCopyData

35 , getCopyData

36 , getCopyData

36 , putCopyData

37 , putCopyData

37 , putCopyEnd

38 , putCopyEnd

@@ -48,13 +49,13 @@ import qualified Data.ByteString.Char8 as B

48import qualified Database.PostgreSQL.LibPQ as PQ

49import qualified Database.PostgreSQL.LibPQ as PQ

49import Database.PostgreSQL.Simple

50import Database.PostgreSQL.Simple

50import Database.PostgreSQL.Simple.Types

51import Database.PostgreSQL.Simple.Types

51−import Database.PostgreSQL.Simple.Internal

52+import Database.PostgreSQL.Simple.Internal hiding (result, row)

54-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former

55-- | Issue a @COPY FROM STDIN@ or @COPY TO STDOUT@ query. In the former

55-- case, the connection's state will change to @CopyIn@; in the latter,

56-- case, the connection's state will change to @CopyIn@; in the latter,

56-- @CopyOut@. The connection must be in the ready state in order

57-- @CopyOut@. The connection must be in the ready state in order

57−-- to call this function. Performs parameter subsitution.

58+-- to call this function. Performs parameter substitution.

59copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()

60copy :: ( ToRow params ) => Connection -> Query -> params -> IO ()

60copy conn template qs = do

61copy conn template qs = do

@@ -85,12 +86,8 @@ doCopy funcName conn template q = do

85 PQ.TuplesOk -> err

86 PQ.TuplesOk -> err

86 PQ.CopyOut -> return ()

87 PQ.CopyOut -> return ()

87 PQ.CopyIn -> return ()

88 PQ.CopyIn -> return ()

88−#if MIN_VERSION_postgresql_libpq(0,9,3)

89 PQ.CopyBoth -> errMsg "COPY BOTH is not supported"

90−#endif

91−#if MIN_VERSION_postgresql_libpq(0,9,2)

92 PQ.SingleTuple -> errMsg "single-row mode is not supported"

90 PQ.SingleTuple -> errMsg "single-row mode is not supported"

93−#endif

94 PQ.BadResponse -> throwResultError funcName result status

91 PQ.BadResponse -> throwResultError funcName result status

95 PQ.NonfatalError -> throwResultError funcName result status

92 PQ.NonfatalError -> throwResultError funcName result status

96 PQ.FatalError -> throwResultError funcName result status

93 PQ.FatalError -> throwResultError funcName result status

@@ -104,6 +101,30 @@ data CopyOutResult

104 deriving (Eq, Typeable, Show)

101 deriving (Eq, Typeable, Show)

105

102

106

103

104+-- | Fold over @COPY TO STDOUT@ query passing each copied row to an accumulator

105+-- and calling a post-process at the end. A connection must be in the

106+-- @CopyOut@ state in order to call this function.

107+--

108+-- __Example__

109+--

110+-- > (acc, count) <- foldCopyData conn

111+-- > (\acc row -> return (row:acc))

112+-- > (\acc count -> return (acc, count))

113+-- > []

114+

115+foldCopyData

116+ :: Connection -- ^ Database connection

117+ -> (a -> B.ByteString -> IO a) -- ^ Accumulate one row of the result

118+ -> (a -> Int64 -> IO b) -- ^ Post-process accumulator with a count of rows

119+ -> a -- ^ Initial accumulator

120+ -> IO b -- ^ Result

121+foldCopyData conn f g !acc = do

122+ result <- getCopyData conn

123+ case result of

124+ CopyOutRow row -> f acc row >>= foldCopyData conn f g

125+ CopyOutDone count -> g acc count

126+

127+

107-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection

128-- | Retrieve some data from a @COPY TO STDOUT@ query. A connection

108-- must be in the @CopyOut@ state in order to call this function. If this

129-- must be in the @CopyOut@ state in order to call this function. If this

109-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,

130-- returns a 'CopyOutRow', the connection remains in the @CopyOut@ state,

src/Database/PostgreSQL/Simple/Cursor.hs+5−5

@@ -30,7 +30,7 @@ import Data.Monoid (mconcat)

30import Database.PostgreSQL.Simple.Compat ((<>), toByteString)

31import Database.PostgreSQL.Simple.FromRow (FromRow(..))

32import Database.PostgreSQL.Simple.Types (Query(..))

33−import Database.PostgreSQL.Simple.Internal as Base

33+import Database.PostgreSQL.Simple.Internal as Base hiding (result, row)

34import Database.PostgreSQL.Simple.Internal.PQResultUtils

35import Database.PostgreSQL.Simple.Transaction

36import qualified Database.PostgreSQL.LibPQ as PQ

@@ -90,9 +90,9 @@ foldForward cursor = foldForwardWithParser cursor fromRow

90foldM' :: (Ord n, Num n) => (a -> n -> IO a) -> a -> n -> n -> IO a

91foldM' f a lo hi = loop a lo

92 where

93− loop a !n

93+ loop x !n

94− | n > hi = return a

94+ | n > hi = return x

95 | otherwise = do

96− a' <- f a n

96+ x' <- f x n

97− loop a' (n+1)

97+ loop x' (n+1)

98{-# INLINE foldM' #-}

src/Database/PostgreSQL/Simple/Errors.hs+4−3

@@ -25,7 +25,6 @@ module Database.PostgreSQL.Simple.Errors

25 )

26 where

28−import Control.Applicative

29import Control.Exception as E

28import Control.Exception as E

31import Data.Attoparsec.ByteString.Char8

30import Data.Attoparsec.ByteString.Char8

@@ -60,11 +59,13 @@ data ConstraintViolation

60 deriving (Show, Eq, Ord, Typeable)

59 deriving (Show, Eq, Ord, Typeable)

62-- Default instance should be enough

61-- Default instance should be enough

63−instance Exception ConstraintViolation

62+instance Exception ConstraintViolation where

63+ toException = postgresqlExceptionToException

64+ fromException = postgresqlExceptionFromException

66-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and

67-- | Tries to convert 'SqlError' to 'ConstrainViolation', checks sqlState and

67−-- succeedes only if able to parse sqlErrorMsg.

68+-- succeeds only if able to parse sqlErrorMsg.

68--

69--

69-- > createUser = handleJust constraintViolation handler $ execute conn ...

70-- > createUser = handleJust constraintViolation handler $ execute conn ...

70-- > where

71-- > where

src/Database/PostgreSQL/Simple/FromField.hs+124−70

@@ -1,7 +1,8 @@

1{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}

2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

4−{-# LANGUAGE RecordWildCards, TemplateHaskell #-}

4+{-# LANGUAGE RecordWildCards #-}

5+{-# LANGUAGE PolyKinds #-}

6{- |

7{- |

7Module: Database.PostgreSQL.Simple.FromField

8Module: Database.PostgreSQL.Simple.FromField

@@ -106,25 +107,27 @@ module Database.PostgreSQL.Simple.FromField

106 , PQ.Oid(..)

107 , PQ.Oid(..)

107 , PQ.Format(..)

108 , PQ.Format(..)

108 , pgArrayFieldParser

109 , pgArrayFieldParser

110+ , attoFieldParser

109

111

110 , optionalField

112 , optionalField

111 , fromJSONField

113 , fromJSONField

114+ , fromFieldJSONByteString

112 ) where

115 ) where

113

116

114#include "MachDeps.h"

117#include "MachDeps.h"

115

118

116−import Control.Applicative ( (<|>), (<$>), pure, (*>), (<*) )

119+import Control.Applicative ( Const(Const), (<|>), (<$>), pure, (*>), (<*) )

117import Control.Concurrent.MVar (MVar, newMVar)

120import Control.Concurrent.MVar (MVar, newMVar)

118−import Control.Exception (Exception)

121+import Control.Exception (Exception (toException, fromException))

119import qualified Data.Aeson as JSON

122import qualified Data.Aeson as JSON

120−import qualified Data.Aeson.Parser as JSON (value')

121import Data.Attoparsec.ByteString.Char8 hiding (Result)

123import Data.Attoparsec.ByteString.Char8 hiding (Result)

122import Data.ByteString (ByteString)

124import Data.ByteString (ByteString)

123import qualified Data.ByteString.Char8 as B

125import qualified Data.ByteString.Char8 as B

126+import Data.Functor.Identity (Identity(Identity))

124import Data.Int (Int16, Int32, Int64)

127import Data.Int (Int16, Int32, Int64)

125import Data.IORef (IORef, newIORef)

128import Data.IORef (IORef, newIORef)

126import Data.Ratio (Ratio)

129import Data.Ratio (Ratio)

127−import Data.Time ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay )

130+import Data.Time.Compat ( UTCTime, ZonedTime, LocalTime, Day, TimeOfDay, CalendarDiffTime )

128import Data.Typeable (Typeable, typeOf)

131import Data.Typeable (Typeable, typeOf)

129import Data.Vector (Vector)

132import Data.Vector (Vector)

130import Data.Vector.Mutable (IOVector)

133import Data.Vector.Mutable (IOVector)

@@ -135,7 +138,6 @@ import Database.PostgreSQL.Simple.Ok

135import Database.PostgreSQL.Simple.Types

138import Database.PostgreSQL.Simple.Types

136import Database.PostgreSQL.Simple.TypeInfo as TI

139import Database.PostgreSQL.Simple.TypeInfo as TI

137import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI

140import qualified Database.PostgreSQL.Simple.TypeInfo.Static as TI

138−import Database.PostgreSQL.Simple.TypeInfo.Macro as TI

139import Database.PostgreSQL.Simple.Time

141import Database.PostgreSQL.Simple.Time

140import Database.PostgreSQL.Simple.Arrays as Arrays

142import Database.PostgreSQL.Simple.Arrays as Arrays

141import qualified Database.PostgreSQL.LibPQ as PQ

143import qualified Database.PostgreSQL.LibPQ as PQ

@@ -152,6 +154,8 @@ import qualified Data.UUID.Types as UUID

152import Data.Scientific (Scientific)

154import Data.Scientific (Scientific)

153import GHC.Real (infinity, notANumber)

155import GHC.Real (infinity, notANumber)

154

156

157+import qualified Data.Aeson.Types as JSON

158+

155-- | Exception thrown if conversion from a SQL value to a Haskell

159-- | Exception thrown if conversion from a SQL value to a Haskell

156-- value fails.

160-- value fails.

157data ResultError = Incompatible { errSQLType :: String

161data ResultError = Incompatible { errSQLType :: String

@@ -178,7 +182,9 @@ data ResultError = Incompatible { errSQLType :: String

178 -- between metadata and actual data in a row).

182 -- between metadata and actual data in a row).

179 deriving (Eq, Show, Typeable)

183 deriving (Eq, Show, Typeable)

180

184

181−instance Exception ResultError

185+instance Exception ResultError where

186+ toException = postgresqlExceptionToException

187+ fromException = postgresqlExceptionFromException

182

188

183left :: Exception a => a -> Conversion b

189left :: Exception a => a -> Conversion b

184left = conversionError

190left = conversionError

@@ -244,9 +250,11 @@ tableOid Field{..} = toMaybeOid (unsafeDupablePerformIO (PQ.ftable result column

244 then Nothing

250 then Nothing

245 else Just x

251 else Just x

246

252

247−-- | If the column has a table associated with it, this returns the number

253+-- | If the column has a table associated with it, this returns the

248−-- off the associated table column. Numbering starts from 0. Analogous

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

249−-- to libpq's @PQftablecol@.

257+-- protocol. Analogous to libpq's @PQftablecol@.

250

258

251tableColumn :: Field -> Int

259tableColumn :: Field -> Int

252tableColumn Field{..} = fromCol (unsafeDupablePerformIO (PQ.ftablecol result column))

260tableColumn Field{..} = fromCol (unsafeDupablePerformIO (PQ.ftablecol result column))

@@ -262,9 +270,15 @@ format Field{..} = unsafeDupablePerformIO (PQ.fformat result column)

262-- | void

270-- | void

263instance FromField () where

271instance FromField () where

264 fromField f _bs

272 fromField f _bs

265− | typeOid f /= $(inlineTypoid TI.void) = returnError Incompatible f ""

273+ | typeOid f /= TI.voidOid = returnError Incompatible f ""

266 | otherwise = pure ()

274 | otherwise = pure ()

267

275

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+

268-- | For dealing with null values. Compatible with any postgresql type

282-- | For dealing with null values. Compatible with any postgresql type

269-- compatible with type @a@. Note that the type is not checked if

283-- compatible with type @a@. Note that the type is not checked if

270-- the value is null, although it is inadvisable to rely on this

284-- the value is null, although it is inadvisable to rely on this

@@ -292,7 +306,7 @@ instance FromField Null where

292-- | bool

306-- | bool

293instance FromField Bool where

307instance FromField Bool where

294 fromField f bs

308 fromField f bs

295− | typeOid f /= $(inlineTypoid TI.bool) = returnError Incompatible f ""

309+ | typeOid f /= TI.boolOid = returnError Incompatible f ""

296 | bs == Nothing = returnError UnexpectedNull f ""

310 | bs == Nothing = returnError UnexpectedNull f ""

297 | bs == Just "t" = pure True

311 | bs == Just "t" = pure True

298 | bs == Just "f" = pure False

312 | bs == Just "f" = pure False

@@ -300,9 +314,9 @@ instance FromField Bool where

300

314

301-- | \"char\", bpchar

315-- | \"char\", bpchar

302instance FromField Char where

316instance FromField Char where

303− fromField f bs =

317+ fromField f bs0 =

304− if $(mkCompats [TI.char,TI.bpchar]) (typeOid f)

318+ if (eq TI.charOid \/ eq TI.bpcharOid) (typeOid f)

305− then case bs of

319+ then case bs0 of

306 Nothing -> returnError UnexpectedNull f ""

320 Nothing -> returnError UnexpectedNull f ""

307 Just bs -> if B.length bs /= 1

321 Just bs -> if B.length bs /= 1

308 then returnError ConversionFailed f "length not 1"

322 then returnError ConversionFailed f "length not 1"

@@ -311,11 +325,11 @@ instance FromField Char where

311

325

312-- | int2

326-- | int2

313instance FromField Int16 where

327instance FromField Int16 where

314− fromField = atto ok16 $ signed decimal

328+ fromField = attoFieldParser ok16 $ signed decimal

315

329

316-- | int2, int4

330-- | int2, int4

317instance FromField Int32 where

331instance FromField Int32 where

318− fromField = atto ok32 $ signed decimal

332+ fromField = attoFieldParser ok32 $ signed decimal

319

333

320#if WORD_SIZE_IN_BITS < 64

334#if WORD_SIZE_IN_BITS < 64

321-- | int2, int4, and if compiled as 64-bit code, int8 as well.

335-- | int2, int4, and if compiled as 64-bit code, int8 as well.

@@ -325,37 +339,37 @@ instance FromField Int32 where

325-- This library was compiled as 64-bit code.

339-- This library was compiled as 64-bit code.

326#endif

340#endif

327instance FromField Int where

341instance FromField Int where

328− fromField = atto okInt $ signed decimal

342+ fromField = attoFieldParser okInt $ signed decimal

329

343

330-- | int2, int4, int8

344-- | int2, int4, int8

331instance FromField Int64 where

345instance FromField Int64 where

332− fromField = atto ok64 $ signed decimal

346+ fromField = attoFieldParser ok64 $ signed decimal

333

347

334-- | int2, int4, int8

348-- | int2, int4, int8

335instance FromField Integer where

349instance FromField Integer where

336− fromField = atto ok64 $ signed decimal

350+ fromField = attoFieldParser ok64 $ signed decimal

337

351

338-- | int2, float4 (Uses attoparsec's 'double' routine, for

352-- | int2, float4 (Uses attoparsec's 'double' routine, for

339-- better accuracy convert to 'Scientific' or 'Rational' first)

353-- better accuracy convert to 'Scientific' or 'Rational' first)

340instance FromField Float where

354instance FromField Float where

341− fromField = atto ok (realToFrac <$> pg_double)

355+ fromField = attoFieldParser ok (realToFrac <$> pg_double)

342− where ok = $(mkCompats [TI.float4,TI.int2])

356+ where ok = eq TI.float4Oid \/ eq TI.int2Oid

343

357

344-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for

358-- | int2, int4, float4, float8 (Uses attoparsec's 'double' routine, for

345-- better accuracy convert to 'Scientific' or 'Rational' first)

359-- better accuracy convert to 'Scientific' or 'Rational' first)

346instance FromField Double where

360instance FromField Double where

347− fromField = atto ok pg_double

361+ fromField = attoFieldParser ok pg_double

348− where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4])

362+ where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid

349

363

350-- | int2, int4, int8, float4, float8, numeric

364-- | int2, int4, int8, float4, float8, numeric

351instance FromField (Ratio Integer) where

365instance FromField (Ratio Integer) where

352− fromField = atto ok pg_rational

366+ fromField = attoFieldParser ok pg_rational

353− where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.int8,TI.numeric])

367+ where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid

354

368

355-- | int2, int4, int8, float4, float8, numeric

369-- | int2, int4, int8, float4, float8, numeric

356instance FromField Scientific where

370instance FromField Scientific where

357− fromField = atto ok rational

371+ fromField = attoFieldParser ok rational

358− where ok = $(mkCompats [TI.float4,TI.float8,TI.int2,TI.int4,TI.int8,TI.numeric])

372+ where ok = eq TI.float4Oid \/ eq TI.float8Oid \/ eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid \/ eq TI.numericOid

359

373

360unBinary :: Binary t -> t

374unBinary :: Binary t -> t

361unBinary (Binary x) = x

375unBinary (Binary x) = x

@@ -376,13 +390,13 @@ pg_rational

376

390

377-- | bytea, name, text, \"char\", bpchar, varchar, unknown

391-- | bytea, name, text, \"char\", bpchar, varchar, unknown

378instance FromField SB.ByteString where

392instance FromField SB.ByteString where

379− fromField f dat = if typeOid f == $(inlineTypoid TI.bytea)

393+ fromField f dat = if typeOid f == TI.byteaOid

380 then unBinary <$> fromField f dat

394 then unBinary <$> fromField f dat

381 else doFromField f okText' pure dat

395 else doFromField f okText' pure dat

382

396

383-- | oid

397-- | oid

384instance FromField PQ.Oid where

398instance FromField PQ.Oid where

385− fromField f dat = PQ.Oid <$> atto (== $(inlineTypoid TI.oid)) decimal f dat

399+ fromField f dat = PQ.Oid <$> attoFieldParser (== TI.oidOid) decimal f dat

386

400

387-- | bytea, name, text, \"char\", bpchar, varchar, unknown

401-- | bytea, name, text, \"char\", bpchar, varchar, unknown

388instance FromField LB.ByteString where

402instance FromField LB.ByteString where

@@ -390,7 +404,7 @@ instance FromField LB.ByteString where

390

404

391unescapeBytea :: Field -> SB.ByteString

405unescapeBytea :: Field -> SB.ByteString

392 -> Conversion (Binary SB.ByteString)

406 -> Conversion (Binary SB.ByteString)

393−unescapeBytea f str = case unsafeDupablePerformIO (PQ.unescapeBytea str) of

407+unescapeBytea f str' = case unsafeDupablePerformIO (PQ.unescapeBytea str') of

394 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

408 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

395 Just str -> pure (Binary str)

409 Just str -> pure (Binary str)

396

410

@@ -441,48 +455,57 @@ instance FromField [Char] where

441

455

442-- | timestamptz

456-- | timestamptz

443instance FromField UTCTime where

457instance FromField UTCTime where

444− fromField = ff $(inlineTypoid TI.timestamptz) "UTCTime" parseUTCTime

458+ fromField = ff TI.timestamptzOid "UTCTime" parseUTCTime

445

459

446-- | timestamptz

460-- | timestamptz

447instance FromField ZonedTime where

461instance FromField ZonedTime where

448− fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTime" parseZonedTime

462+ fromField = ff TI.timestamptzOid "ZonedTime" parseZonedTime

449

463

450-- | timestamp

464-- | timestamp

451instance FromField LocalTime where

465instance FromField LocalTime where

452− fromField = ff $(inlineTypoid TI.timestamp) "LocalTime" parseLocalTime

466+ fromField = ff TI.timestampOid "LocalTime" parseLocalTime

453

467

454-- | date

468-- | date

455instance FromField Day where

469instance FromField Day where

456− fromField = ff $(inlineTypoid TI.date) "Day" parseDay

470+ fromField = ff TI.dateOid "Day" parseDay

457

471

458-- | time

472-- | time

459instance FromField TimeOfDay where

473instance FromField TimeOfDay where

460− fromField = ff $(inlineTypoid TI.time) "TimeOfDay" parseTimeOfDay

474+ fromField = ff TI.timeOid "TimeOfDay" parseTimeOfDay

461

475

462-- | timestamptz

476-- | timestamptz

463instance FromField UTCTimestamp where

477instance FromField UTCTimestamp where

464− fromField = ff $(inlineTypoid TI.timestamptz) "UTCTimestamp" parseUTCTimestamp

478+ fromField = ff TI.timestamptzOid "UTCTimestamp" parseUTCTimestamp

465

479

466-- | timestamptz

480-- | timestamptz

467instance FromField ZonedTimestamp where

481instance FromField ZonedTimestamp where

468− fromField = ff $(inlineTypoid TI.timestamptz) "ZonedTimestamp" parseZonedTimestamp

482+ fromField = ff TI.timestamptzOid "ZonedTimestamp" parseZonedTimestamp

469

483

470-- | timestamp

484-- | timestamp

471instance FromField LocalTimestamp where

485instance FromField LocalTimestamp where

472− fromField = ff $(inlineTypoid TI.timestamp) "LocalTimestamp" parseLocalTimestamp

486+ fromField = ff TI.timestampOid "LocalTimestamp" parseLocalTimestamp

473

487

474-- | date

488-- | date

475instance FromField Date where

489instance FromField Date where

476− fromField = ff $(inlineTypoid TI.date) "Date" parseDate

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

477

500

478ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)

501ff :: PQ.Oid -> String -> (B8.ByteString -> Either String a)

479 -> Field -> Maybe B8.ByteString -> Conversion a

502 -> Field -> Maybe B8.ByteString -> Conversion a

480−ff compatOid hsType parse f mstr =

503+ff compatOid hsType parseBS f mstr =

481 if typeOid f /= compatOid

504 if typeOid f /= compatOid

482 then err Incompatible ""

505 then err Incompatible ""

483 else case mstr of

506 else case mstr of

484 Nothing -> err UnexpectedNull ""

507 Nothing -> err UnexpectedNull ""

485− Just str -> case parse str of

508+ Just str -> case parseBS str of

486 Left msg -> err ConversionFailed msg

509 Left msg -> err ConversionFailed msg

487 Right val -> return val

510 Right val -> return val

488 where

511 where

@@ -520,10 +543,10 @@ pgArrayFieldParser fieldParser f mdat = do

520 _ -> returnError Incompatible f ""

543 _ -> returnError Incompatible f ""

521

544

522fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])

545fromArray :: FieldParser a -> TypeInfo -> Field -> Parser (Conversion [a])

523−fromArray fieldParser typeInfo f = sequence . (parseIt <$>) <$> array delim

546+fromArray fieldParser typInfo f = sequence . (parseIt <$>) <$> array delim

524 where

547 where

525− delim = typdelim (typelem typeInfo)

548+ delim = typdelim (typelem typInfo)

526− fElem = f{ typeOid = typoid (typelem typeInfo) }

549+ fElem = f{ typeOid = typoid (typelem typInfo) }

527

550

528 parseIt item =

551 parseIt item =

529 fieldParser f' $ if item == Arrays.Plain "NULL" then Nothing else Just item'

552 fieldParser f' $ if item == Arrays.Plain "NULL" then Nothing else Just item'

@@ -541,7 +564,7 @@ instance (FromField a, Typeable a) => FromField (IOVector a) where

541-- | uuid

564-- | uuid

542instance FromField UUID where

565instance FromField UUID where

543 fromField f mbs =

566 fromField f mbs =

544− if typeOid f /= $(inlineTypoid TI.uuid)

567+ if typeOid f /= TI.uuidOid

545 then returnError Incompatible f ""

568 then returnError Incompatible f ""

546 else case mbs of

569 else case mbs of

547 Nothing -> returnError UnexpectedNull f ""

570 Nothing -> returnError UnexpectedNull f ""

@@ -550,20 +573,26 @@ instance FromField UUID where

550 Nothing -> returnError ConversionFailed f "Invalid UUID"

573 Nothing -> returnError ConversionFailed f "Invalid UUID"

551 Just uuid -> pure uuid

574 Just uuid -> pure uuid

552

575

553−-- | json

576+-- | json, jsonb

554instance FromField JSON.Value where

577instance FromField JSON.Value where

555− fromField f mbs =

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 =

556− if typeOid f /= $(inlineTypoid TI.json) && typeOid f /= $(inlineTypoid TI.jsonb)

588+ if typeOid f /= TI.jsonOid && typeOid f /= TI.jsonbOid

557 then returnError Incompatible f ""

589 then returnError Incompatible f ""

558 else case mbs of

590 else case mbs of

559 Nothing -> returnError UnexpectedNull f ""

591 Nothing -> returnError UnexpectedNull f ""

560− Just bs ->

592+ Just bs -> pure bs

561− case parseOnly (JSON.value' <* endOfInput) bs of

562− Left err -> returnError ConversionFailed f err

563− Right val -> pure val

564

593

565-- | Parse a field to a JSON 'JSON.Value' and convert that into a

594-- | Parse a field to a JSON 'JSON.Value' and convert that into a

566−-- Haskell value using 'JSON.fromJSON'.

595+-- Haskell value using the 'JSON.FromJSON' instance.

567--

596--

568-- This can be used as the default implementation for the 'fromField'

597-- This can be used as the default implementation for the 'fromField'

569-- method for Haskell types that have a JSON representation in

598-- method for Haskell types that have a JSON representation in

@@ -584,10 +613,10 @@ instance FromField JSON.Value where

584fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a

613fromJSONField :: (JSON.FromJSON a, Typeable a) => FieldParser a

585fromJSONField f mbBs = do

614fromJSONField f mbBs = do

586 value <- fromField f mbBs

615 value <- fromField f mbBs

587− case JSON.fromJSON value of

616+ case JSON.ifromJSON value of

588− JSON.Error err -> returnError ConversionFailed f $

617+ JSON.IError path err -> returnError ConversionFailed f $

589− "JSON decoding error: " ++ err

618+ "JSON decoding error: " ++ (JSON.formatError path err)

590− JSON.Success x -> pure x

619+ JSON.ISuccess x -> pure x

591

620

592-- | Compatible with the same set of types as @a@. Note that

621-- | Compatible with the same set of types as @a@. Note that

593-- modifying the 'IORef' does not have any effects outside

622-- modifying the 'IORef' does not have any effects outside

@@ -604,20 +633,33 @@ instance FromField a => FromField (MVar a) where

604type Compat = PQ.Oid -> Bool

633type Compat = PQ.Oid -> Bool

605

634

606okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat

635okText, okText', okBinary, ok16, ok32, ok64, okInt :: Compat

607−okText = $( mkCompats [ TI.name, TI.text, TI.char,

636+okText = eq TI.nameOid \/ eq TI.textOid \/ eq TI.charOid

608− TI.bpchar, TI.varchar ] )

637+ \/ eq TI.bpcharOid \/ eq TI.varcharOid

609−okText' = $( mkCompats [ TI.name, TI.text, TI.char,

638+okText' = eq TI.nameOid \/ eq TI.textOid \/ eq TI.charOid

610− TI.bpchar, TI.varchar, TI.unknown ] )

639+ \/ eq TI.bpcharOid \/ eq TI.varcharOid \/ eq TI.unknownOid

611−okBinary = (== $( inlineTypoid TI.bytea ))

640+okBinary = eq TI.byteaOid

612−ok16 = (== $( inlineTypoid TI.int2 ))

641+ok16 = eq TI.int2Oid

613−ok32 = $( mkCompats [TI.int2,TI.int4] )

642+ok32 = eq TI.int2Oid \/ eq TI.int4Oid

614−ok64 = $( mkCompats [TI.int2,TI.int4,TI.int8] )

643+ok64 = eq TI.int2Oid \/ eq TI.int4Oid \/ eq TI.int8Oid

615#if WORD_SIZE_IN_BITS < 64

644#if WORD_SIZE_IN_BITS < 64

616okInt = ok32

645okInt = ok32

617#else

646#else

618okInt = ok64

647okInt = ok64

619#endif

648#endif

620

649

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+

621doFromField :: forall a . (Typeable a)

663doFromField :: forall a . (Typeable a)

622 => Field -> Compat -> (ByteString -> Conversion a)

664 => Field -> Compat -> (ByteString -> Conversion a)

623 -> Maybe ByteString -> Conversion a

665 -> Maybe ByteString -> Conversion a

@@ -642,10 +684,22 @@ returnError mkErr f msg = do

642 (show (typeOf (undefined :: a)))

684 (show (typeOf (undefined :: a)))

643 msg

685 msg

644

686

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

645−atto :: forall a. (Typeable a)

696+attoFieldParser :: forall a. (Typeable a)

646− => Compat -> Parser a -> Field -> Maybe ByteString

697+ => (PQ.Oid -> Bool)

647− -> Conversion a

698+ -- ^ Predicate for whether the postgresql type oid is compatible with this parser

699+ -> Parser a

700+ -- ^ An attoparsec parser.

701+ -> FieldParser a

648−atto types p0 f dat = doFromField f types (go p0) dat

702+attoFieldParser types p0 f dat = doFromField f types (go p0) dat

649 where

703 where

650 go :: Parser a -> ByteString -> Conversion a

704 go :: Parser a -> ByteString -> Conversion a

651 go p s =

705 go p s =

src/Database/PostgreSQL/Simple/FromRow.hs+19−2

@@ -67,6 +67,23 @@ import GHC.Generics

67-- in a single row of the query result. Otherwise, a 'ConversionFailed'

68-- exception will be thrown.

69--

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+--

70-- Note that 'field' evaluates its result to WHNF, so the caveats listed in

87-- Note that 'field' evaluates its result to WHNF, so the caveats listed in

71-- mysql-simple and very early versions of postgresql-simple no longer apply.

88-- mysql-simple and very early versions of postgresql-simple no longer apply.

72-- Instead, look at the caveats associated with user-defined implementations

89-- Instead, look at the caveats associated with user-defined implementations

@@ -114,8 +131,8 @@ fieldWith fieldP = RP $ do

114 else do

131 else do

115 let !result = rowresult

132 let !result = rowresult

116 !typeOid = unsafeDupablePerformIO (PQ.ftype result column)

133 !typeOid = unsafeDupablePerformIO (PQ.ftype result column)

117− !field = Field{..}

134+ !field' = Field{..}

118− lift (lift (fieldP field (getvalue result row column)))

135+ lift (lift (fieldP field' (getvalue result row column)))

119

136

120field :: FromField a => RowParser a

137field :: FromField a => RowParser a

121field = fieldWith fromField

138field = fieldWith fromField

src/Database/PostgreSQL/Simple/HStore/Implementation.hs+3−9

@@ -22,9 +22,6 @@ import Data.ByteString.Builder (Builder, byteString, char8)

22import qualified Data.ByteString.Builder as BU

23import Data.ByteString.Internal (c2w, w2c)

24import qualified Data.ByteString.Lazy as BL

25−#if !MIN_VERSION_bytestring(0,10,0)

26−import qualified Data.ByteString.Lazy.Internal as BL (foldrChunks)

27−#endif

28import Data.Map(Map)

25import Data.Map(Map)

29import qualified Data.Map as Map

26import qualified Data.Map as Map

30import Data.Text(Text)

27import Data.Text(Text)

@@ -53,12 +50,12 @@ instance ToHStore HStoreBuilder where

53toBuilder :: HStoreBuilder -> Builder

50toBuilder :: HStoreBuilder -> Builder

54toBuilder x = case x of

51toBuilder x = case x of

55 Empty -> mempty

52 Empty -> mempty

56− Comma x -> x

53+ Comma c -> c

58toLazyByteString :: HStoreBuilder -> BL.ByteString

55toLazyByteString :: HStoreBuilder -> BL.ByteString

59toLazyByteString x = case x of

56toLazyByteString x = case x of

60 Empty -> BL.empty

57 Empty -> BL.empty

61− Comma x -> BU.toLazyByteString x

58+ Comma c -> BU.toLazyByteString c

63instance Semigroup HStoreBuilder where

60instance Semigroup HStoreBuilder where

64 Empty <> x = x

61 Empty <> x = x

@@ -69,9 +66,6 @@ instance Semigroup HStoreBuilder where

70instance Monoid HStoreBuilder where

67instance Monoid HStoreBuilder where

71 mempty = Empty

68 mempty = Empty

72−#if !(MIN_VERSION_base(4,11,0))

73− mappend = (<>)

74−#endif

76class ToHStoreText a where

70class ToHStoreText a where

77 toHStoreText :: a -> HStoreText

71 toHStoreText :: a -> HStoreText

@@ -150,7 +144,7 @@ newtype HStoreMap = HStoreMap {fromHStoreMap :: Map Text Text} deriving (Eq, Or

150

144

151instance ToHStore HStoreMap where

145instance ToHStore HStoreMap where

152 toHStore (HStoreMap xs) = Map.foldrWithKey f mempty xs

146 toHStore (HStoreMap xs) = Map.foldrWithKey f mempty xs

153− where f k v xs = hstore k v `mappend` xs

147+ where f k v xs' = hstore k v `mappend` xs'

154

148

155instance ToField HStoreMap where

149instance ToField HStoreMap where

156 toField xs = toField (toHStore xs)

150 toField xs = toField (toHStore xs)

src/Database/PostgreSQL/Simple/Internal.hs+65−16

@@ -1,5 +1,8 @@

1{-# LANGUAGE CPP, BangPatterns, DoAndIfThenElse, RecordWildCards #-}

2+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}

2−{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE ExistentialQuantification #-}

5+{-# LANGUAGE InstanceSigs #-}

4------------------------------------------------------------------------------

7------------------------------------------------------------------------------

5-- |

8-- |

@@ -33,7 +36,6 @@ import Data.Int (Int64)

33import qualified Data.IntMap as IntMap

36import qualified Data.IntMap as IntMap

34import Data.IORef

37import Data.IORef

35import Data.Maybe(fromMaybe)

38import Data.Maybe(fromMaybe)

36−import Data.Monoid

37import Data.String

39import Data.String

38import qualified Data.Text as T

40import qualified Data.Text as T

39import qualified Data.Text.Encoding as TE

41import qualified Data.Text.Encoding as TE

@@ -50,6 +52,7 @@ import Database.PostgreSQL.Simple.TypeInfo.Types(TypeInfo)

50import Control.Monad.Trans.State.Strict

52import Control.Monad.Trans.State.Strict

51import Control.Monad.Trans.Reader

53import Control.Monad.Trans.Reader

52import Control.Monad.Trans.Class

54import Control.Monad.Trans.Class

55+import GHC.Generics

53import GHC.IO.Exception

56import GHC.IO.Exception

54#if !defined(mingw32_HOST_OS)

57#if !defined(mingw32_HOST_OS)

55import Control.Concurrent(threadWaitRead, threadWaitWrite)

58import Control.Concurrent(threadWaitRead, threadWaitWrite)

@@ -80,6 +83,25 @@ data Connection = Connection {

80instance Eq Connection where

83instance Eq Connection where

81 x == y = connectionHandle x == connectionHandle y

84 x == y = connectionHandle x == connectionHandle y

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+

83data SqlError = SqlError {

105data SqlError = SqlError {

84 sqlState :: ByteString

106 sqlState :: ByteString

85 , sqlExecStatus :: ExecStatus

107 , sqlExecStatus :: ExecStatus

@@ -91,7 +113,10 @@ data SqlError = SqlError {

91fatalError :: ByteString -> SqlError

113fatalError :: ByteString -> SqlError

92fatalError msg = SqlError "" FatalError msg "" ""

114fatalError msg = SqlError "" FatalError msg "" ""

115

94−instance Exception SqlError

116+instance Exception SqlError where

117+ toException = postgresqlExceptionToException

118+ fromException = postgresqlExceptionFromException

119+

120

96-- | Exception thrown if 'query' is used to perform an @INSERT@-like

121-- | Exception thrown if 'query' is used to perform an @INSERT@-like

97-- operation, or 'execute' is used to perform a @SELECT@-like operation.

122-- operation, or 'execute' is used to perform a @SELECT@-like operation.

@@ -100,7 +125,9 @@ data QueryError = QueryError {

100 , qeQuery :: Query

125 , qeQuery :: Query

101 } deriving (Eq, Show, Typeable)

126 } deriving (Eq, Show, Typeable)

102

127

103−instance Exception QueryError

128+instance Exception QueryError where

129+ toException = postgresqlExceptionToException

130+ fromException = postgresqlExceptionFromException

104

131

105-- | Exception thrown if a 'Query' could not be formatted correctly.

132-- | Exception thrown if a 'Query' could not be formatted correctly.

106-- This may occur if the number of \'@?@\' characters in the query

133-- This may occur if the number of \'@?@\' characters in the query

@@ -111,7 +138,9 @@ data FormatError = FormatError {

111 , fmtParams :: [ByteString]

138 , fmtParams :: [ByteString]

112 } deriving (Eq, Show, Typeable)

139 } deriving (Eq, Show, Typeable)

113

140

114−instance Exception FormatError

141+instance Exception FormatError where

142+ toException = postgresqlExceptionToException

143+ fromException = postgresqlExceptionFromException

115

144

116data ConnectInfo = ConnectInfo {

145data ConnectInfo = ConnectInfo {

117 connectHost :: String

146 connectHost :: String

@@ -119,7 +148,7 @@ data ConnectInfo = ConnectInfo {

119 , connectUser :: String

148 , connectUser :: String

120 , connectPassword :: String

149 , connectPassword :: String

121 , connectDatabase :: String

150 , connectDatabase :: String

122− } deriving (Eq,Read,Show,Typeable)

151+ } deriving (Generic,Eq,Read,Show,Typeable)

123

152

124-- | Default information for setting up a connection.

153-- | Default information for setting up a connection.

125--

154--

@@ -153,6 +182,12 @@ defaultConnectInfo = ConnectInfo {

153connect :: ConnectInfo -> IO Connection

182connect :: ConnectInfo -> IO Connection

154connect = connectPostgreSQL . postgreSQLConnectionString

183connect = connectPostgreSQL . postgreSQLConnectionString

155

184

185+-- | Memory bracket around 'connect' and 'close'.

186+--

187+-- @since 0.6.5

188+withConnect :: ConnectInfo -> (Connection -> IO c) -> IO c

189+withConnect connInfo = bracket (connect connInfo) close

190+

156-- | Attempt to make a connection based on a libpq connection string.

191-- | Attempt to make a connection based on a libpq connection string.

157-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>

192-- See <https://www.postgresql.org/docs/9.5/static/libpq-connect.html#LIBPQ-CONNSTRING>

158-- for more information. Also note that environment variables also affect

193-- for more information. Also note that environment variables also affect

@@ -188,7 +223,8 @@ connect = connectPostgreSQL . postgreSQLConnectionString

188--

223--

189-- Omitting @password@ will default to an appropriate password found

224-- Omitting @password@ will default to an appropriate password found

190-- in the @pgpass@ file, or no password at all if a matching line is

225-- in the @pgpass@ file, or no password at all if a matching line is

191−-- not found. See

226+-- not found. The path of the @pgpass@ file may be specified by setting

227+-- the @PGPASSFILE@ environment variable. See

192-- <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for

228-- <https://www.postgresql.org/docs/9.5/static/libpq-pgpass.html> for

193-- more information regarding this file.

229-- more information regarding this file.

194--

230--

@@ -287,7 +323,7 @@ postgreSQLConnectionString connectInfo = fromString connstr

287

323

288 str name field

324 str name field

289 | null value = id

325 | null value = id

290− | otherwise = showString name . quote value . space

326+ | otherwise = showString name . addQuotes value . space

291 where value = field connectInfo

327 where value = field connectInfo

292

328

293 num name field

329 num name field

@@ -295,7 +331,7 @@ postgreSQLConnectionString connectInfo = fromString connstr

295 | otherwise = showString name . shows value . space

331 | otherwise = showString name . shows value . space

296 where value = field connectInfo

332 where value = field connectInfo

297

333

298− quote str rest = '\'' : foldr delta ('\'' : rest) str

334+ addQuotes s rest = '\'' : foldr delta ('\'' : rest) s

299 where

335 where

300 delta c cs = case c of

336 delta c cs = case c of

301 '\\' -> '\\' : '\\' : cs

337 '\\' -> '\\' : '\\' : cs

@@ -383,7 +419,7 @@ finishExecute _conn q result = do

383 nstr <- PQ.cmdTuples result

419 nstr <- PQ.cmdTuples result

384 return $ case nstr of

420 return $ case nstr of

385 Nothing -> 0 -- is this appropriate?

421 Nothing -> 0 -- is this appropriate?

386− Just str -> toInteger str

422+ Just str -> mkInteger str

387 PQ.TuplesOk -> do

423 PQ.TuplesOk -> do

388 ncols <- PQ.nfields result

424 ncols <- PQ.nfields result

389 throwIO $ QueryError ("execute resulted in " ++ show ncols ++

425 throwIO $ QueryError ("execute resulted in " ++ show ncols ++

@@ -396,7 +432,7 @@ finishExecute _conn q result = do

396 PQ.NonfatalError -> throwResultError "execute" result status

432 PQ.NonfatalError -> throwResultError "execute" result status

397 PQ.FatalError -> throwResultError "execute" result status

433 PQ.FatalError -> throwResultError "execute" result status

398 where

434 where

399− toInteger str = B8.foldl' delta 0 str

435+ mkInteger str = B8.foldl' delta 0 str

400 where

436 where

401 delta acc c =

437 delta acc c =

402 if '0' <= c && c <= '9'

438 if '0' <= c && c <= '9'

@@ -411,8 +447,8 @@ throwResultError _ result status = do

411 PQ.resultErrorField result PQ.DiagMessageDetail

447 PQ.resultErrorField result PQ.DiagMessageDetail

412 hint <- fromMaybe "" <$>

448 hint <- fromMaybe "" <$>

413 PQ.resultErrorField result PQ.DiagMessageHint

449 PQ.resultErrorField result PQ.DiagMessageHint

414− state <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate

450+ state' <- maybe "" id <$> PQ.resultErrorField result PQ.DiagSqlstate

415− throwIO $ SqlError { sqlState = state

451+ throwIO $ SqlError { sqlState = state'

416 , sqlExecStatus = status

452 , sqlExecStatus = status

417 , sqlErrorMsg = errormsg

453 , sqlErrorMsg = errormsg

418 , sqlErrorDetail = detail

454 , sqlErrorDetail = detail

@@ -481,9 +517,6 @@ instance Alternative Conversion where

481 Errors _ -> (oka <|>) <$> runConversion mb conn

517 Errors _ -> (oka <|>) <$> runConversion mb conn

482

518

483instance Monad Conversion where

519instance Monad Conversion where

484−#if !(MIN_VERSION_base(4,8,0))

485− return = pure

486−#endif

487 m >>= f = Conversion $ \conn -> do

520 m >>= f = Conversion $ \conn -> do

488 oka <- runConversion m conn

521 oka <- runConversion m conn

489 case oka of

522 case oka of

@@ -586,3 +619,19 @@ escapeIdentifier = escapeWrap PQ.escapeIdentifier

586

619

587escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

620escapeByteaConn :: Connection -> ByteString -> IO (Either ByteString ByteString)

588escapeByteaConn = escapeWrap PQ.escapeByteaConn

621escapeByteaConn = escapeWrap PQ.escapeByteaConn

622+

623+breakOnSingleQuestionMark :: ByteString -> (ByteString, ByteString)

624+breakOnSingleQuestionMark b = go (B8.empty, b)

625+ where go (x,bs) = (x `B8.append` x',bs')

626+ -- seperate from first QM

627+ where tup@(noQ, restWithQ) = B8.break (=='?') bs

628+ -- if end of query, just return

629+ -- else check for second QM in 'go2'

630+ (x', bs') = maybe tup go2 $

631+ -- drop found QM and peek at next char

632+ B8.uncons restWithQ >>= B8.uncons . snd

633+ -- another QM after the first means:

634+ -- take literal QM and keep going.

635+ go2 ('?', t2) = go (noQ `B8.snoc` '?',t2)

636+ -- Anything else means

637+ go2 _ = tup

src/Database/PostgreSQL/Simple/Internal/PQResultUtils.hs+42−12

@@ -14,40 +14,70 @@

15module Database.PostgreSQL.Simple.Internal.PQResultUtils

16 ( finishQueryWith

17+ , finishQueryWithV

18+ , finishQueryWithVU

17 , getRowWith

19 , getRowWith

18 ) where

20 ) where

20import Control.Exception as E

22import Control.Exception as E

21import Data.ByteString (ByteString)

23import Data.ByteString (ByteString)

24+import Data.Foldable (for_)

22import Database.PostgreSQL.Simple.FromField (ResultError(..))

25import Database.PostgreSQL.Simple.FromField (ResultError(..))

23import Database.PostgreSQL.Simple.Ok

26import Database.PostgreSQL.Simple.Ok

24import Database.PostgreSQL.Simple.Types (Query(..))

27import Database.PostgreSQL.Simple.Types (Query(..))

25−import Database.PostgreSQL.Simple.Internal as Base

28+import Database.PostgreSQL.Simple.Internal as Base hiding (result, row)

26import Database.PostgreSQL.Simple.TypeInfo

29import Database.PostgreSQL.Simple.TypeInfo

27import qualified Database.PostgreSQL.LibPQ as PQ

30import qualified Database.PostgreSQL.LibPQ as PQ

28import qualified Data.ByteString.Char8 as B

31import 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

29import Control.Monad.Trans.Reader

36import Control.Monad.Trans.Reader

30import Control.Monad.Trans.State.Strict

37import Control.Monad.Trans.State.Strict

32finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]

39finishQueryWith :: RowParser r -> Connection -> Query -> PQ.Result -> IO [r]

33−finishQueryWith parser conn q result = do

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

34 status <- PQ.resultStatus result

72 status <- PQ.resultStatus result

35 case status of

73 case status of

36− PQ.TuplesOk -> do

74+ PQ.TuplesOk -> k

37− nrows <- PQ.ntuples result

38− ncols <- PQ.nfields result

39− forM' 0 (nrows-1) $ \row ->

40− getRowWith parser row ncols conn result

41 PQ.EmptyQuery -> queryErr "query: Empty query"

75 PQ.EmptyQuery -> queryErr "query: Empty query"

42− PQ.CommandOk -> queryErr "query resulted in a command response"

76+ PQ.CommandOk -> queryErr "query resulted in a command response (did you mean to use `execute` or forget a RETURNING?)"

43 PQ.CopyOut -> queryErr "query: COPY TO is not supported"

77 PQ.CopyOut -> queryErr "query: COPY TO is not supported"

44 PQ.CopyIn -> queryErr "query: COPY FROM is not supported"

78 PQ.CopyIn -> queryErr "query: COPY FROM is not supported"

45−#if MIN_VERSION_postgresql_libpq(0,9,3)

46 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"

79 PQ.CopyBoth -> queryErr "query: COPY BOTH is not supported"

47−#endif

48−#if MIN_VERSION_postgresql_libpq(0,9,2)

49 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"

80 PQ.SingleTuple -> queryErr "query: single-row mode is not supported"

50−#endif

51 PQ.BadResponse -> throwResultError "query" result status

81 PQ.BadResponse -> throwResultError "query" result status

52 PQ.NonfatalError -> throwResultError "query" result status

82 PQ.NonfatalError -> throwResultError "query" result status

53 PQ.FatalError -> throwResultError "query" result status

83 PQ.FatalError -> throwResultError "query" result status

src/Database/PostgreSQL/Simple/Newtypes.hsnew file+49

@@ -0,0 +1,49 @@

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

10+import Data.Typeable (Typeable)

11+import Database.PostgreSQL.Simple.ToField (ToField (..))

12+import Database.PostgreSQL.Simple.FromField (FromField (..), fromJSONField)

13+

14+import qualified Data.Aeson as Aeson

15+

16+-------------------------------------------------------------------------------

17+-- aeson

18+-------------------------------------------------------------------------------

19+

20+-- | A newtype wrapper with 'ToField' and 'FromField' instances

21+-- based on 'Aeson.ToJSON' and 'Aeson.FromJSON' type classes from @aeson@.

22+--

23+-- Example using @DerivingVia@:

24+--

25+-- @

26+-- data Foo = Foo Int String

27+-- deriving stock (Eq, Show, Generic) -- GHC built int

28+-- deriving anyclass ('Aeson.FromJSON', 'Aeson.ToJSON') -- Derived using GHC Generics

29+-- deriving ('ToField', 'FromField') via 'Aeson' Foo -- DerivingVia

30+-- @

31+--

32+-- Example using 'Aeson' newtype directly, for more ad-hoc queries

33+--

34+-- @

35+-- execute conn "INSERT INTO tbl (fld) VALUES (?)" (Only ('Aeson' x))

36+-- @

37+--

38+-- @since 0.6.3

39+newtype Aeson a = Aeson a

40+ deriving (Eq, Show, Read, Typeable, Functor)

41+

42+getAeson :: Aeson a -> a

43+getAeson (Aeson a) = a

44+

45+instance Aeson.ToJSON a => ToField (Aeson a) where

46+ toField = toField . Aeson.encode . getAeson

47+

48+instance (Aeson.FromJSON a, Typeable a) => FromField (Aeson a) where

49+ fromField f bs = fmap Aeson (fromJSONField f bs)

src/Database/PostgreSQL/Simple/Notification.hs−17

@@ -47,8 +47,6 @@ import GHC.IO.Exception ( ioe_location )

48#if defined(mingw32_HOST_OS)

49import Control.Concurrent ( threadDelay )

50−#elif !MIN_VERSION_base(4,7,0)

51−import Control.Concurrent ( threadWaitRead )

52#else

50#else

53import GHC.Conc ( atomically )

51import GHC.Conc ( atomically )

54import Control.Concurrent ( threadWaitReadSTM )

52import Control.Concurrent ( threadWaitReadSTM )

@@ -94,21 +92,6 @@ getNotification conn = join $ withConnection conn fetch

94 -- with async exceptions, whereas threadDelay can.

92 -- with async exceptions, whereas threadDelay can.

95 Just _fd -> do

93 Just _fd -> do

96 return (threadDelay 1000000 >> loop)

94 return (threadDelay 1000000 >> loop)

97−#elif !MIN_VERSION_base(4,7,0)

98− -- Technically there's a race condition that is usually benign.

99− -- If the connection is closed or reset after we drop the

100− -- lock, and then the fd index is reallocated to a new

101− -- descriptor before we call threadWaitRead, then

102− -- we could end up waiting on the wrong descriptor.

103− --

104− -- Now, if the descriptor becomes readable promptly, then

105− -- it's no big deal as we'll wake up and notice the change

106− -- on the next iteration of the loop. But if are very

107− -- unlucky, then we could end up waiting a long time.

108− Just fd -> do

109− return $ do

110− threadWaitRead fd `catch` (throwIO . setIOErrorLocation)

111− loop

112#else

95#else

113 -- This case fixes the race condition above. By registering

96 -- This case fixes the race condition above. By registering

114 -- our interest in the descriptor before we drop the lock,

97 -- our interest in the descriptor before we drop the lock,

src/Database/PostgreSQL/Simple/Ok.hs+7−4

@@ -37,6 +37,8 @@ import Control.Exception

37import Control.Monad(MonadPlus(..))

38import Data.Typeable

40+import qualified Control.Monad.Fail as Fail

41+

40-- FIXME: [SomeException] should probably be something else, maybe

42-- FIXME: [SomeException] should probably be something else, maybe

41-- a difference list (or a tree?)

43-- a difference list (or a tree?)

@@ -70,13 +72,14 @@ instance MonadPlus Ok where

70 mplus = (<|>)

72 mplus = (<|>)

72instance Monad Ok where

74instance Monad Ok where

73−#if !(MIN_VERSION_base(4,8,0))

74− return = pure

75−#endif

76−

77 Errors es >>= _ = Errors es

75 Errors es >>= _ = Errors es

78 Ok a >>= f = f a

76 Ok a >>= f = f a

78+#if !(MIN_VERSION_base(4,13,0))

79+ fail = Fail.fail

80+#endif

81+

82+instance Fail.MonadFail Ok where

80 fail str = Errors [SomeException (ErrorCall str)]

83 fail str = Errors [SomeException (ErrorCall str)]

82-- | a way to reify a list of exceptions into a single exception

85-- | a way to reify a list of exceptions into a single exception

src/Database/PostgreSQL/Simple/Range.hs+14−10

@@ -19,6 +19,7 @@ module Database.PostgreSQL.Simple.Range

19 , empty

20 , isEmpty, isEmptyBy

21 , contains, containsBy

22+ , fromFieldRange

22 ) where

23 ) where

24import Control.Applicative hiding (empty)

25import Control.Applicative hiding (empty)

@@ -37,7 +38,7 @@ import Data.Monoid (mempty)

37import Data.Scientific (Scientific)

38import Data.Scientific (Scientific)

38import qualified Data.Text.Lazy.Builder as LT

39import qualified Data.Text.Lazy.Builder as LT

39import qualified Data.Text.Lazy.Encoding as LT

40import qualified Data.Text.Lazy.Encoding as LT

40−import Data.Time (Day, LocalTime,

41+import Data.Time.Compat (Day, LocalTime,

41 NominalDiffTime,

42 NominalDiffTime,

42 TimeOfDay, UTCTime,

43 TimeOfDay, UTCTime,

43 ZonedTime,

44 ZonedTime,

@@ -109,19 +110,19 @@ containsBy cmp rng x =

109 PGRange _lb NegInfinity -> False

110 PGRange _lb NegInfinity -> False

110 PGRange lb ub -> checkLB lb x && checkUB ub x

111 PGRange lb ub -> checkLB lb x && checkUB ub x

111 where

112 where

112− checkLB lb x =

113+ checkLB lb y =

113 case lb of

114 case lb of

114 NegInfinity -> True

115 NegInfinity -> True

115 PosInfinity -> False

116 PosInfinity -> False

116− Inclusive a -> cmp a x /= GT

117+ Inclusive a -> cmp a y /= GT

117− Exclusive a -> cmp a x == LT

118+ Exclusive a -> cmp a y == LT

118

119

119− checkUB ub x =

120+ checkUB ub y =

120 case ub of

121 case ub of

121 NegInfinity -> False

122 NegInfinity -> False

122 PosInfinity -> True

123 PosInfinity -> True

123− Inclusive z -> cmp x z /= GT

124+ Inclusive z -> cmp y z /= GT

124− Exclusive z -> cmp x z == LT

125+ Exclusive z -> cmp y z == LT

125

126

126lowerBound :: Parser (a -> RangeBound a)

127lowerBound :: Parser (a -> RangeBound a)

127lowerBound = (A.char '(' *> pure Exclusive) <|> (A.char '[' *> pure Inclusive)

128lowerBound = (A.char '(' *> pure Exclusive) <|> (A.char '[' *> pure Inclusive)

@@ -189,7 +190,10 @@ rangeToBuilderBy cmp f x =

189

190

191

191instance (FromField a, Typeable a) => FromField (PGRange a) where

192instance (FromField a, Typeable a) => FromField (PGRange a) where

192− fromField f mdat = do

193+ fromField = fromFieldRange fromField

194+

195+fromFieldRange :: Typeable a => FieldParser a -> FieldParser (PGRange a)

196+fromFieldRange fromField' f mdat = do

193 info <- typeInfo f

197 info <- typeInfo f

194 case info of

198 case info of

195 Range{} ->

199 Range{} ->

@@ -199,8 +203,8 @@ instance (FromField a, Typeable a) => FromField (PGRange a) where

199 Just "empty" -> pure $ empty

203 Just "empty" -> pure $ empty

200 Just bs ->

204 Just bs ->

201 let parseIt NegInfinity = pure NegInfinity

205 let parseIt NegInfinity = pure NegInfinity

202− parseIt (Inclusive v) = Inclusive <$> fromField f' (Just v)

206+ parseIt (Inclusive v) = Inclusive <$> fromField' f' (Just v)

203− parseIt (Exclusive v) = Exclusive <$> fromField f' (Just v)

207+ parseIt (Exclusive v) = Exclusive <$> fromField' f' (Just v)

204 parseIt PosInfinity = pure PosInfinity

208 parseIt PosInfinity = pure PosInfinity

205 in case parseOnly pgrange bs of

209 in case parseOnly pgrange bs of

206 Left e -> returnError ConversionFailed f e

210 Left e -> returnError ConversionFailed f e

src/Database/PostgreSQL/Simple/SqlQQ.hs+10−9

@@ -1,4 +1,9 @@

1+{-# LANGUAGE CPP #-}

2+#if __GLASGOW_HASKELL__ >= 800

3+{-# LANGUAGE TemplateHaskellQuotes #-}

4+#else

1{-# LANGUAGE TemplateHaskell #-}

5{-# LANGUAGE TemplateHaskell #-}

6+#endif

2------------------------------------------------------------------------------

7------------------------------------------------------------------------------

3-- |

8-- |

4-- Module: Database.PostgreSQL.Simple.SqlQQ

9-- Module: Database.PostgreSQL.Simple.SqlQQ

@@ -30,7 +35,7 @@ import Data.String

30-- > (beginTime,endTime,string)

35-- > (beginTime,endTime,string)

31--

36--

32-- This quasiquoter returns a literal string expression of type 'Query',

37-- This quasiquoter returns a literal string expression of type 'Query',

33−-- and attempts to mimimize whitespace; otherwise the above query would

38+-- and attempts to minimize whitespace; otherwise the above query would

34-- consist of approximately half whitespace when sent to the database

39-- consist of approximately half whitespace when sent to the database

35-- backend. It also recognizes and strips out standard sql comments "--".

40-- backend. It also recognizes and strips out standard sql comments "--".

36--

41--

@@ -52,13 +57,10 @@ import Data.String

53sql :: QuasiQuoter

58sql :: QuasiQuoter

54sql = QuasiQuoter

59sql = QuasiQuoter

55− { quotePat = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

60+ { quotePat = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in pattern context"

56− \ quasiquoter used in pattern context"

57− , quoteType = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

61+ , quoteType = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in type context"

58− \ quasiquoter used in type context"

59 , quoteExp = sqlExp

62 , quoteExp = sqlExp

60− , quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

63+ , quoteDec = error "Database.PostgreSQL.Simple.SqlQQ.sql: quasiquoter used in declaration context"

61− \ quasiquoter used in declaration context"

62 }

64 }

64sqlExp :: String -> Q Exp

66sqlExp :: String -> Q Exp

@@ -85,5 +87,4 @@ minimizeSpace = drop 1 . reduceSpace

85 instring ('\'':'\'':xs) = '\'':'\'': instring xs

87 instring ('\'':'\'':xs) = '\'':'\'': instring xs

86 instring ('\'':xs) = '\'': insql xs

88 instring ('\'':xs) = '\'': insql xs

87 instring (x:xs) = x : instring xs

89 instring (x:xs) = x : instring xs

88− instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

90+ instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql: string literal not terminated"

89− \ string literal not terminated"

src/Database/PostgreSQL/Simple/Time.hs+2

@@ -227,6 +227,7 @@ module Database.PostgreSQL.Simple.Time

227 , parseUTCTimestamp

228 , parseZonedTimestamp

229 , parseLocalTimestamp

230+ , parseCalendarDiffTime

230 , dayToBuilder

231 , dayToBuilder

231 , utcTimeToBuilder

232 , utcTimeToBuilder

232 , zonedTimeToBuilder

233 , zonedTimeToBuilder

@@ -239,6 +240,7 @@ module Database.PostgreSQL.Simple.Time

239 , localTimestampToBuilder

240 , localTimestampToBuilder

240 , unboundedToBuilder

241 , unboundedToBuilder

241 , nominalDiffTimeToBuilder

242 , nominalDiffTimeToBuilder

243+ , calendarDiffTimeToBuilder

242 ) where

244 ) where

243

245

244import Database.PostgreSQL.Simple.Time.Implementation

246import Database.PostgreSQL.Simple.Time.Implementation

src/Database/PostgreSQL/Simple/Time/Implementation.hs+11−1

@@ -18,7 +18,8 @@ import Data.ByteString.Builder.Prim(primBounded)

18import Control.Arrow((***))

19import Control.Applicative

20import qualified Data.ByteString as B

21−import Data.Time hiding (getTimeZone, getZonedTime)

21+import Data.Time.Compat (LocalTime, UTCTime, ZonedTime, Day, TimeOfDay, TimeZone, NominalDiffTime, utc)

22+import Data.Time.LocalTime.Compat (CalendarDiffTime)

22import Data.Typeable

23import Data.Typeable

23import Data.Maybe (fromMaybe)

24import Data.Maybe (fromMaybe)

24import qualified Data.Attoparsec.ByteString.Char8 as A

25import qualified Data.Attoparsec.ByteString.Char8 as A

@@ -77,6 +78,9 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)

77parseDate :: B.ByteString -> Either String Date

78parseDate :: B.ByteString -> Either String Date

78parseDate = A.parseOnly (getDate <* A.endOfInput)

79parseDate = A.parseOnly (getDate <* A.endOfInput)

81+parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime

82+parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)

83+

80getUnbounded :: A.Parser a -> A.Parser (Unbounded a)

84getUnbounded :: A.Parser a -> A.Parser (Unbounded a)

81getUnbounded getFinite

85getUnbounded getFinite

82 = (pure NegInfinity <* A.string "-infinity")

86 = (pure NegInfinity <* A.string "-infinity")

@@ -125,6 +129,9 @@ getUTCTime = TP.utcTime

125getUTCTimestamp :: A.Parser UTCTimestamp

129getUTCTimestamp :: A.Parser UTCTimestamp

126getUTCTimestamp = getUnbounded getUTCTime

130getUTCTimestamp = getUnbounded getUTCTime

127

131

132+getCalendarDiffTime :: A.Parser CalendarDiffTime

133+getCalendarDiffTime = TP.calendarDiffTime

134+

128dayToBuilder :: Day -> Builder

135dayToBuilder :: Day -> Builder

129dayToBuilder = primBounded TPP.day

136dayToBuilder = primBounded TPP.day

130

137

@@ -164,3 +171,6 @@ dateToBuilder = unboundedToBuilder dayToBuilder

164

171

165nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

166nominalDiffTimeToBuilder = TPP.nominalDiffTime

173nominalDiffTimeToBuilder = TPP.nominalDiffTime

174+

175+calendarDiffTimeToBuilder :: CalendarDiffTime -> Builder

176+calendarDiffTimeToBuilder = TPP.calendarDiffTime

src/Database/PostgreSQL/Simple/Time/Internal/Parser.hs+12−3

@@ -21,20 +21,24 @@ module Database.PostgreSQL.Simple.Time.Internal.Parser

21 , localToUTCTimeOfDayHMS

22 , utcTime

23 , zonedTime

24+ , calendarDiffTime

24 ) where

25 ) where

26import Control.Applicative ((<$>), (<*>), (<*), (*>))

27import Control.Applicative ((<$>), (<*>), (<*), (*>))

27import Database.PostgreSQL.Simple.Compat (toPico)

28import Database.PostgreSQL.Simple.Compat (toPico)

28import Data.Attoparsec.ByteString.Char8 as A

29import Data.Attoparsec.ByteString.Char8 as A

29import Data.Bits ((.&.))

30import Data.Bits ((.&.))

31+import Data.ByteString (ByteString)

30import Data.Char (ord)

32import Data.Char (ord)

31import Data.Fixed (Pico)

33import Data.Fixed (Pico)

32import Data.Int (Int64)

34import Data.Int (Int64)

33import Data.Maybe (fromMaybe)

35import Data.Maybe (fromMaybe)

34−import Data.Time.Calendar (Day, fromGregorianValid, addDays)

36+import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)

35−import Data.Time.Clock (UTCTime(..))

37+import Data.Time.Clock.Compat (UTCTime(..))

38+import Data.Time.Format.ISO8601.Compat (iso8601ParseM)

39+import Data.Time.LocalTime.Compat (CalendarDiffTime)

36import qualified Data.ByteString.Char8 as B8

40import qualified Data.ByteString.Char8 as B8

37−import qualified Data.Time.LocalTime as Local

41+import qualified Data.Time.LocalTime.Compat as Local

39-- | Parse a date of the form @YYYY-MM-DD@.

43-- | Parse a date of the form @YYYY-MM-DD@.

40day :: Parser Day

44day :: Parser Day

@@ -193,3 +197,8 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)

193

197

194utc :: Local.TimeZone

198utc :: Local.TimeZone

195utc = Local.TimeZone 0 False ""

199utc = Local.TimeZone 0 False ""

200+

201+calendarDiffTime :: Parser CalendarDiffTime

202+calendarDiffTime = do

203+ contents <- takeByteString

204+ iso8601ParseM $ B8.unpack contents

src/Database/PostgreSQL/Simple/Time/Internal/Printer.hs+14−2

@@ -17,19 +17,23 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer

17 , localTime

18 , zonedTime

19 , nominalDiffTime

20+ , calendarDiffTime

20 ) where

21 ) where

22import Control.Arrow ((>>>))

23import Control.Arrow ((>>>))

23−import Data.ByteString.Builder (Builder, integerDec)

24+import Data.ByteString.Builder (Builder, byteString, integerDec)

24import Data.ByteString.Builder.Prim

25import Data.ByteString.Builder.Prim

25 ( liftFixedToBounded, (>$<), (>*<)

26 ( liftFixedToBounded, (>$<), (>*<)

26 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)

27 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)

27import Data.Char ( chr )

28import Data.Char ( chr )

28import Data.Int ( Int32, Int64 )

29import Data.Int ( Int32, Int64 )

29−import Data.Time

30+import Data.String (fromString)

31+import Data.Time.Compat

30 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime

32 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime

31 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay

33 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay

32 , TimeZone, timeZoneMinutes )

34 , TimeZone, timeZoneMinutes )

35+import Data.Time.Format.ISO8601.Compat (iso8601Show)

36+import Data.Time.LocalTime.Compat (CalendarDiffTime)

33import Database.PostgreSQL.Simple.Compat ((<>), fromPico)

37import Database.PostgreSQL.Simple.Compat ((<>), fromPico)

34import Unsafe.Coerce (unsafeCoerce)

38import Unsafe.Coerce (unsafeCoerce)

@@ -121,3 +125,11 @@ nominalDiffTime :: NominalDiffTime -> Builder

121nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))

125nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))

122 where

126 where

123 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000

127 (x,y) = fromPico (unsafeCoerce xy) `quotRem` 1000000000000

128+

129+calendarDiffTime :: CalendarDiffTime -> Builder

130+calendarDiffTime = byteString

131+ . fromString

132+ -- from the docs: "Beware: fromString truncates multi-byte characters to octets".

133+ -- However, I think this is a safe usage, because ISO8601-encoding seems restricted

134+ -- to ASCII output.

135+ . iso8601Show

src/Database/PostgreSQL/Simple/ToField.hs+22−11

@@ -1,5 +1,6 @@

1{-# LANGUAGE CPP, DeriveDataTypeable, DeriveFunctor #-}

2{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3+{-# LANGUAGE PolyKinds #-}

4------------------------------------------------------------------------------

5------------------------------------------------------------------------------

5-- |

6-- |

@@ -22,6 +23,7 @@ module Database.PostgreSQL.Simple.ToField

22 , inQuotes

23 , inQuotes

23 ) where

24 ) where

26+import Control.Applicative (Const(Const))

25import qualified Data.Aeson as JSON

27import qualified Data.Aeson as JSON

26import Data.ByteString (ByteString)

28import Data.ByteString (ByteString)

27import Data.ByteString.Builder

29import Data.ByteString.Builder

@@ -30,10 +32,12 @@ import Data.ByteString.Builder

30 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

32 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

31 , floatDec, doubleDec

33 , floatDec, doubleDec

32 )

34 )

35+import Data.Functor.Identity (Identity(Identity))

33import Data.Int (Int8, Int16, Int32, Int64)

36import Data.Int (Int8, Int16, Int32, Int64)

34import Data.List (intersperse)

37import Data.List (intersperse)

35import Data.Monoid (mappend)

38import Data.Monoid (mappend)

36−import Data.Time (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)

39+import Data.Time.Compat (Day, TimeOfDay, LocalTime, UTCTime, ZonedTime, NominalDiffTime)

40+import Data.Time.LocalTime.Compat (CalendarDiffTime)

37import Data.Typeable (Typeable)

41import Data.Typeable (Typeable)

38import Data.Word (Word, Word8, Word16, Word32, Word64)

42import Data.Word (Word, Word8, Word16, Word32, Word64)

39import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

43import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

@@ -55,11 +59,7 @@ import qualified Data.Vector as V

55import qualified Database.PostgreSQL.LibPQ as PQ

59import qualified Database.PostgreSQL.LibPQ as PQ

56import Database.PostgreSQL.Simple.Time

60import Database.PostgreSQL.Simple.Time

57import Data.Scientific (Scientific)

61import Data.Scientific (Scientific)

58−#if MIN_VERSION_scientific(0,3,0)

59import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

62import Data.Text.Lazy.Builder.Scientific (scientificBuilder)

60−#else

61−import Data.Scientific (scientificBuilder)

62−#endif

63import Foreign.C.Types (CUInt(..))

65-- | How to render an element when substituting it into a query.

@@ -100,6 +100,14 @@ instance ToField Action where

100 toField a = a

101 {-# INLINE toField #-}

102

103+instance (ToField a) => ToField (Const a b) where

104+ toField (Const a) = toField a

105+ {-# INLINE toField #-}

106+

107+instance (ToField a) => ToField (Identity a) where

108+ toField (Identity a) = toField a

109+ {-# INLINE toField #-}

110+

103instance (ToField a) => ToField (Maybe a) where

111instance (ToField a) => ToField (Maybe a) where

104 toField Nothing = renderNull

112 toField Nothing = renderNull

105 toField (Just a) = toField a

113 toField (Just a) = toField a

@@ -282,6 +290,10 @@ instance ToField NominalDiffTime where

282 toField = Plain . inQuotes . nominalDiffTimeToBuilder

290 toField = Plain . inQuotes . nominalDiffTimeToBuilder

283 {-# INLINE toField #-}

291 {-# INLINE toField #-}

284

292

293+instance ToField CalendarDiffTime where

294+ toField = Plain . inQuotes . calendarDiffTimeToBuilder

295+ {-# INLINE toField #-}

296+

285instance (ToField a) => ToField (PGArray a) where

297instance (ToField a) => ToField (PGArray a) where

286 toField pgArray =

298 toField pgArray =

287 case fromPGArray pgArray of

299 case fromPGArray pgArray of

@@ -302,14 +314,13 @@ instance ToField UUID where

302instance ToField JSON.Value where

314instance ToField JSON.Value where

303 toField = toField . JSON.encode

315 toField = toField . JSON.encode

304

316

305−-- | Convert a Haskell value to a JSON 'JSON.Value' using

317+-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.

306−-- 'JSON.toJSON' and convert that to a field using 'toField'.

307--

318--

308-- This can be used as the default implementation for the 'toField'

319-- This can be used as the default implementation for the 'toField'

309-- method for Haskell types that have a JSON representation in

320-- method for Haskell types that have a JSON representation in

310-- PostgreSQL.

321-- PostgreSQL.

311toJSONField :: JSON.ToJSON a => a -> Action

322toJSONField :: JSON.ToJSON a => a -> Action

312−toJSONField = toField . JSON.toJSON

323+toJSONField = toField . JSON.encode

313

324

314-- | Surround a string with single-quote characters: \"@'@\"

325-- | Surround a string with single-quote characters: \"@'@\"

315--

326--

@@ -319,7 +330,7 @@ inQuotes b = quote `mappend` b `mappend` quote

319 where quote = char8 '\''

330 where quote = char8 '\''

320

331

321interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

332interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

322−interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as

333+interleaveFoldr f b bs' as = foldr (\a bs -> b : f a bs) bs' as

323{-# INLINE interleaveFoldr #-}

334{-# INLINE interleaveFoldr #-}

324

335

325instance ToRow a => ToField (Values a) where

336instance ToRow a => ToField (Values a) where

@@ -366,8 +377,8 @@ instance ToRow a => ToField (Values a) where

366

377

367 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]

378 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]

368 typedRows [] _ _ = error funcname

379 typedRows [] _ _ = error funcname

369− typedRows (val:vals) types rest =

380+ typedRows (val:vals) typs rest =

370− typedRow (toRow val) types (multiRows vals rest)

381+ typedRow (toRow val) typs (multiRows vals rest)

371

382

372 untypedRows :: ToRow a => [a] -> [Action] -> [Action]

383 untypedRows :: ToRow a => [a] -> [Action] -> [Action]

373 untypedRows [] _ = error funcname

384 untypedRows [] _ = error funcname

src/Database/PostgreSQL/Simple/ToRow.hs+16

@@ -30,6 +30,22 @@ import GHC.Generics

30--

31-- Instances should use the 'toField' method of the 'ToField' class

32-- 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.

33class ToRow a where

49class ToRow a where

34 toRow :: a -> [Action]

50 toRow :: a -> [Action]

35 default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]

51 default toRow :: (Generic a, GToRow (Rep a)) => a -> [Action]

src/Database/PostgreSQL/Simple/Transaction.hs+17−13

@@ -17,6 +17,7 @@ module Database.PostgreSQL.Simple.Transaction

17 , withTransactionLevel

18 , withTransactionMode

19 , withTransactionModeRetry

20+ , withTransactionModeRetry'

20 , withTransactionSerializable

21 , withTransactionSerializable

21 , TransactionMode(..)

22 , TransactionMode(..)

22 , IsolationLevel(..)

23 , IsolationLevel(..)

@@ -146,37 +147,40 @@ withTransactionMode mode conn act =

146 commit conn

147 commit conn

147 return r

148 return r

148

149

150+-- | 'withTransactionModeRetry'' but with the exception type pinned to 'SqlError'.

151+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

152+withTransactionModeRetry = withTransactionModeRetry'

153+

149-- | Like 'withTransactionMode', but also takes a custom callback to

154-- | Like 'withTransactionMode', but also takes a custom callback to

150−-- determine if a transaction should be retried if an 'SqlError' occurs.

155+-- determine if a transaction should be retried if an exception occurs.

151−-- If the callback returns True, then the transaction will be retried.

156+-- If the callback returns 'True', then the transaction will be retried.

152−-- If the callback returns False, or an exception other than an 'SqlError'

157+-- If the callback returns 'False', or an exception other than an @e@

153-- occurs then the transaction will be rolled back and the exception rethrown.

158-- occurs then the transaction will be rolled back and the exception rethrown.

154--

159--

155-- This is used to implement 'withTransactionSerializable'.

160-- This is used to implement 'withTransactionSerializable'.

156−withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

161+withTransactionModeRetry' :: forall a e. E.Exception e => TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a

157−withTransactionModeRetry mode shouldRetry conn act =

162+withTransactionModeRetry' mode shouldRetry conn act =

158 mask $ \restore ->

163 mask $ \restore ->

159 retryLoop $ E.try $ do

164 retryLoop $ E.try $ do

160− a <- restore act

165+ a <- restore act `E.onException` rollback_ conn

161 commit conn

166 commit conn

162 return a

167 return a

163 where

168 where

164− retryLoop :: IO (Either E.SomeException a) -> IO a

169+ retryLoop :: IO (Either e a) -> IO a

165 retryLoop act' = do

170 retryLoop act' = do

166 beginMode mode conn

171 beginMode mode conn

167 r <- act'

172 r <- act'

168 case r of

173 case r of

169− Left e -> do

174+ Left e ->

170− rollback_ conn

171− case fmap shouldRetry (E.fromException e) of

175+ case shouldRetry e of

172− Just True -> retryLoop act'

176+ True -> retryLoop act'

173− _ -> E.throwIO e

177+ False -> E.throwIO e

174 Right a ->

178 Right a ->

175 return a

179 return a

176

180

177-- | Rollback a transaction.

181-- | Rollback a transaction.

178rollback :: Connection -> IO ()

182rollback :: Connection -> IO ()

179−rollback conn = execute_ conn "ABORT" >> return ()

183+rollback conn = execute_ conn "ROLLBACK" >> return ()

180

184

181-- | Rollback a transaction, ignoring any @IOErrors@

185-- | Rollback a transaction, ignoring any @IOErrors@

182rollback_ :: Connection -> IO ()

186rollback_ :: Connection -> IO ()

src/Database/PostgreSQL/Simple/TypeInfo.hs+9−9

@@ -50,21 +50,21 @@ import Database.PostgreSQL.Simple.TypeInfo.Static

50-- in the connections's cache.

52getTypeInfo :: Connection -> PQ.Oid -> IO TypeInfo

53−getTypeInfo conn@Connection{..} oid =

53+getTypeInfo conn@Connection{..} oid' =

54− case staticTypeInfo oid of

54+ case staticTypeInfo oid' of

55− Just name -> return name

55+ Just name' -> return name'

56− Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid

56+ Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid'

58getTypeInfo' :: Connection -> PQ.Oid -> TypeInfoCache

59 -> IO (TypeInfoCache, TypeInfo)

60−getTypeInfo' conn oid oidmap =

60+getTypeInfo' conn oid' oidmap =

61− case IntMap.lookup (oid2int oid) oidmap of

61+ case IntMap.lookup (oid2int oid') oidmap of

62 Just typeinfo -> return (oidmap, typeinfo)

63 Nothing -> do

64 names <- query conn "SELECT oid, typcategory, typdelim, typname,\

65 \ typelem, typrelid\

66 \ FROM pg_type WHERE oid = ?"

67− (Only oid)

67+ (Only oid')

68 (oidmap', typeInfo) <-

69 case names of

70 [] -> return $ throw (fatalError "invalid type oid")

@@ -78,7 +78,7 @@ getTypeInfo' conn oid oidmap =

78 rngsubtypeOids <- query conn "SELECT rngsubtype\

79 \ FROM pg_range\

80 \ WHERE rngtypid = ?"

81− (Only oid)

81+ (Only oid')

82 case rngsubtypeOids of

83 [Only rngsubtype_] -> do

84 (oidmap', rngsubtype) <-

@@ -104,7 +104,7 @@ getTypeInfo' conn oid oidmap =

104 _ -> fail "typename query returned more than one result"

105 -- oid is a primary key, so the query should

106 -- never return more than one result

107− let !oidmap'' = IntMap.insert (oid2int oid) typeInfo oidmap'

107+ let !oidmap'' = IntMap.insert (oid2int oid') typeInfo oidmap'

108 return $! (oidmap'', typeInfo)

109

110getAttInfos :: Connection -> [(B.ByteString, PQ.Oid)] -> TypeInfoCache

src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs+9−3

@@ -1,4 +1,9 @@

1+{-# LANGUAGE CPP #-}

2+#if __GLASGOW_HASKELL__ >= 800

3+{-# LANGUAGE TemplateHaskellQuotes #-}

4+#else

1{-# LANGUAGE TemplateHaskell #-}

5{-# LANGUAGE TemplateHaskell #-}

6+#endif

3------------------------------------------------------------------------------

8------------------------------------------------------------------------------

4-- |

9-- |

@@ -22,11 +27,12 @@ import Database.PostgreSQL.Simple.TypeInfo.Static

22import Database.PostgreSQL.Simple.Types (Oid(..))

27import Database.PostgreSQL.Simple.Types (Oid(..))

23import Language.Haskell.TH

28import Language.Haskell.TH

25−

26-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the

30-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the

27-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.

31-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.

28mkCompats :: [TypeInfo] -> ExpQ

32mkCompats :: [TypeInfo] -> ExpQ

33+mkCompats tys = do

34+ x <- newName "x"

29−mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]

35+ lamE [conP 'Oid [varP x]] $ caseE (varE x) (map alt tys ++ [catchAll])

30 where

36 where

31 alt :: TypeInfo -> MatchQ

37 alt :: TypeInfo -> MatchQ

32 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []

38 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []

@@ -38,7 +44,7 @@ mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]

38-- Returns an expression of type 'Oid'. Useful because GHC tends

44-- Returns an expression of type 'Oid'. Useful because GHC tends

39-- not to fold constants.

45-- not to fold constants.

40inlineTypoid :: TypeInfo -> ExpQ

46inlineTypoid :: TypeInfo -> ExpQ

41−inlineTypoid ty = [| Oid $(litE (getTypoid ty)) |]

47+inlineTypoid ty = conE 'Oid `appE` litE (getTypoid ty)

43inlineTypoidP :: TypeInfo -> PatQ

49inlineTypoidP :: TypeInfo -> PatQ

44inlineTypoidP ty = litP (getTypoid ty)

50inlineTypoidP ty = litP (getTypoid ty)

src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+683−134

@@ -19,121 +19,233 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

19 ( TypeInfo(..)

20 , staticTypeInfo

21 , bool

22+ , boolOid

22 , bytea

23 , bytea

24+ , byteaOid

23 , char

25 , char

26+ , charOid

24 , name

27 , name

28+ , nameOid

25 , int8

29 , int8

30+ , int8Oid

26 , int2

31 , int2

32+ , int2Oid

27 , int4

33 , int4

34+ , int4Oid

28 , regproc

35 , regproc

36+ , regprocOid

29 , text

37 , text

38+ , textOid

30 , oid

39 , oid

40+ , oidOid

31 , tid

41 , tid

42+ , tidOid

32 , xid

43 , xid

44+ , xidOid

33 , cid

45 , cid

46+ , cidOid

34 , xml

47 , xml

48+ , xmlOid

35 , point

49 , point

50+ , pointOid

36 , lseg

51 , lseg

52+ , lsegOid

37 , path

53 , path

54+ , pathOid

38 , box

55 , box

56+ , boxOid

39 , polygon

57 , polygon

58+ , polygonOid

40 , line

59 , line

60+ , lineOid

41 , cidr

61 , cidr

62+ , cidrOid

42 , float4

63 , float4

64+ , float4Oid

43 , float8

65 , float8

66+ , float8Oid

44 , unknown

67 , unknown

68+ , unknownOid

45 , circle

69 , circle

70+ , circleOid

46 , money

71 , money

72+ , moneyOid

47 , macaddr

73 , macaddr

74+ , macaddrOid

48 , inet

75 , inet

76+ , inetOid

49 , bpchar

77 , bpchar

78+ , bpcharOid

50 , varchar

79 , varchar

80+ , varcharOid

51 , date

81 , date

82+ , dateOid

52 , time

83 , time

84+ , timeOid

53 , timestamp

85 , timestamp

86+ , timestampOid

54 , timestamptz

87 , timestamptz

88+ , timestamptzOid

55 , interval

89 , interval

90+ , intervalOid

56 , timetz

91 , timetz

92+ , timetzOid

57 , bit

93 , bit

94+ , bitOid

58 , varbit

95 , varbit

96+ , varbitOid

59 , numeric

97 , numeric

98+ , numericOid

60 , refcursor

99 , refcursor

100+ , refcursorOid

61 , record

101 , record

102+ , recordOid

62 , void

103 , void

104+ , voidOid

63 , array_record

105 , array_record

106+ , array_recordOid

64 , regprocedure

107 , regprocedure

108+ , regprocedureOid

65 , regoper

109 , regoper

110+ , regoperOid

66 , regoperator

111 , regoperator

112+ , regoperatorOid

67 , regclass

113 , regclass

114+ , regclassOid

68 , regtype

115 , regtype

116+ , regtypeOid

69 , uuid

117 , uuid

118+ , uuidOid

70 , json

119 , json

120+ , jsonOid

71 , jsonb

121 , jsonb

122+ , jsonbOid

72 , int2vector

123 , int2vector

124+ , int2vectorOid

73 , oidvector

125 , oidvector

126+ , oidvectorOid

74 , array_xml

127 , array_xml

128+ , array_xmlOid

75 , array_json

129 , array_json

130+ , array_jsonOid

76 , array_line

131 , array_line

132+ , array_lineOid

77 , array_cidr

133 , array_cidr

134+ , array_cidrOid

78 , array_circle

135 , array_circle

136+ , array_circleOid

79 , array_money

137 , array_money

138+ , array_moneyOid

80 , array_bool

139 , array_bool

140+ , array_boolOid

81 , array_bytea

141 , array_bytea

142+ , array_byteaOid

82 , array_char

143 , array_char

144+ , array_charOid

83 , array_name

145 , array_name

146+ , array_nameOid

84 , array_int2

147 , array_int2

148+ , array_int2Oid

85 , array_int2vector

149 , array_int2vector

150+ , array_int2vectorOid

86 , array_int4

151 , array_int4

152+ , array_int4Oid

87 , array_regproc

153 , array_regproc

154+ , array_regprocOid

88 , array_text

155 , array_text

156+ , array_textOid

89 , array_tid

157 , array_tid

158+ , array_tidOid

90 , array_xid

159 , array_xid

160+ , array_xidOid

91 , array_cid

161 , array_cid

162+ , array_cidOid

92 , array_oidvector

163 , array_oidvector

164+ , array_oidvectorOid

93 , array_bpchar

165 , array_bpchar

166+ , array_bpcharOid

94 , array_varchar

167 , array_varchar

168+ , array_varcharOid

95 , array_int8

169 , array_int8

170+ , array_int8Oid

96 , array_point

171 , array_point

172+ , array_pointOid

97 , array_lseg

173 , array_lseg

174+ , array_lsegOid

98 , array_path

175 , array_path

176+ , array_pathOid

99 , array_box

177 , array_box

178+ , array_boxOid

100 , array_float4

179 , array_float4

180+ , array_float4Oid

101 , array_float8

181 , array_float8

182+ , array_float8Oid

102 , array_polygon

183 , array_polygon

184+ , array_polygonOid

103 , array_oid

185 , array_oid

186+ , array_oidOid

104 , array_macaddr

187 , array_macaddr

188+ , array_macaddrOid

105 , array_inet

189 , array_inet

190+ , array_inetOid

106 , array_timestamp

191 , array_timestamp

192+ , array_timestampOid

107 , array_date

193 , array_date

194+ , array_dateOid

108 , array_time

195 , array_time

196+ , array_timeOid

109 , array_timestamptz

197 , array_timestamptz

198+ , array_timestamptzOid

110 , array_interval

199 , array_interval

200+ , array_intervalOid

111 , array_numeric

201 , array_numeric

202+ , array_numericOid

112 , array_timetz

203 , array_timetz

204+ , array_timetzOid

113 , array_bit

205 , array_bit

206+ , array_bitOid

114 , array_varbit

207 , array_varbit

208+ , array_varbitOid

115 , array_refcursor

209 , array_refcursor

210+ , array_refcursorOid

116 , array_regprocedure

211 , array_regprocedure

212+ , array_regprocedureOid

117 , array_regoper

213 , array_regoper

214+ , array_regoperOid

118 , array_regoperator

215 , array_regoperator

216+ , array_regoperatorOid

119 , array_regclass

217 , array_regclass

218+ , array_regclassOid

120 , array_regtype

219 , array_regtype

220+ , array_regtypeOid

121 , array_uuid

221 , array_uuid

222+ , array_uuidOid

122 , array_jsonb

223 , array_jsonb

224+ , array_jsonbOid

123 , int4range

225 , int4range

226+ , int4rangeOid

124 , _int4range

227 , _int4range

228+ , _int4rangeOid

125 , numrange

229 , numrange

230+ , numrangeOid

126 , _numrange

231 , _numrange

232+ , _numrangeOid

127 , tsrange

233 , tsrange

234+ , tsrangeOid

128 , _tsrange

235 , _tsrange

236+ , _tsrangeOid

129 , tstzrange

237 , tstzrange

238+ , tstzrangeOid

130 , _tstzrange

239 , _tstzrange

240+ , _tstzrangeOid

131 , daterange

241 , daterange

242+ , daterangeOid

132 , _daterange

243 , _daterange

244+ , _daterangeOid

133 , int8range

245 , int8range

246+ , int8rangeOid

134 , _int8range

247 , _int8range

135− , citext

248+ , _int8rangeOid

136− , array_citext

137 ) where

249 ) where

138

250

139import Database.PostgreSQL.LibPQ (Oid(..))

251import Database.PostgreSQL.LibPQ (Oid(..))

@@ -255,999 +367,1436 @@ staticTypeInfo (Oid x) = case x of

255 3913 -> Just _daterange

367 3913 -> Just _daterange

256 3926 -> Just int8range

368 3926 -> Just int8range

257 3927 -> Just _int8range

369 3927 -> Just _int8range

258− 60129 -> Just citext

259− 60134 -> Just array_citext

260 _ -> Nothing

370 _ -> Nothing

261

371

262bool :: TypeInfo

372bool :: TypeInfo

263bool = Basic {

373bool = Basic {

264− typoid = Oid 16,

374+ typoid = boolOid,

265 typcategory = 'B',

375 typcategory = 'B',

266 typdelim = ',',

376 typdelim = ',',

267 typname = "bool"

377 typname = "bool"

268 }

378 }

269

379

380+boolOid :: Oid

381+boolOid = Oid 16

382+{-# INLINE boolOid #-}

383+

270bytea :: TypeInfo

384bytea :: TypeInfo

271bytea = Basic {

385bytea = Basic {

272− typoid = Oid 17,

386+ typoid = byteaOid,

273 typcategory = 'U',

387 typcategory = 'U',

274 typdelim = ',',

388 typdelim = ',',

275 typname = "bytea"

389 typname = "bytea"

276 }

390 }

277

391

392+byteaOid :: Oid

393+byteaOid = Oid 17

394+{-# INLINE byteaOid #-}

395+

278char :: TypeInfo

396char :: TypeInfo

279char = Basic {

397char = Basic {

280− typoid = Oid 18,

398+ typoid = charOid,

281 typcategory = 'S',

399 typcategory = 'S',

282 typdelim = ',',

400 typdelim = ',',

283 typname = "char"

401 typname = "char"

284 }

402 }

285

403

404+charOid :: Oid

405+charOid = Oid 18

406+{-# INLINE charOid #-}

407+

286name :: TypeInfo

408name :: TypeInfo

287name = Basic {

409name = Basic {

288− typoid = Oid 19,

410+ typoid = nameOid,

289 typcategory = 'S',

411 typcategory = 'S',

290 typdelim = ',',

412 typdelim = ',',

291 typname = "name"

413 typname = "name"

292 }

414 }

293

415

416+nameOid :: Oid

417+nameOid = Oid 19

418+{-# INLINE nameOid #-}

419+

294int8 :: TypeInfo

420int8 :: TypeInfo

295int8 = Basic {

421int8 = Basic {

296− typoid = Oid 20,

422+ typoid = int8Oid,

297 typcategory = 'N',

423 typcategory = 'N',

298 typdelim = ',',

424 typdelim = ',',

299 typname = "int8"

425 typname = "int8"

300 }

426 }

301

427

428+int8Oid :: Oid

429+int8Oid = Oid 20

430+{-# INLINE int8Oid #-}

431+

302int2 :: TypeInfo

432int2 :: TypeInfo

303int2 = Basic {

433int2 = Basic {

304− typoid = Oid 21,

434+ typoid = int2Oid,

305 typcategory = 'N',

435 typcategory = 'N',

306 typdelim = ',',

436 typdelim = ',',

307 typname = "int2"

437 typname = "int2"

308 }

438 }

309

439

440+int2Oid :: Oid

441+int2Oid = Oid 21

442+{-# INLINE int2Oid #-}

443+

310int4 :: TypeInfo

444int4 :: TypeInfo

311int4 = Basic {

445int4 = Basic {

312− typoid = Oid 23,

446+ typoid = int4Oid,

313 typcategory = 'N',

447 typcategory = 'N',

314 typdelim = ',',

448 typdelim = ',',

315 typname = "int4"

449 typname = "int4"

316 }

450 }

317

451

452+int4Oid :: Oid

453+int4Oid = Oid 23

454+{-# INLINE int4Oid #-}

455+

318regproc :: TypeInfo

456regproc :: TypeInfo

319regproc = Basic {

457regproc = Basic {

320− typoid = Oid 24,

458+ typoid = regprocOid,

321 typcategory = 'N',

459 typcategory = 'N',

322 typdelim = ',',

460 typdelim = ',',

323 typname = "regproc"

461 typname = "regproc"

324 }

462 }

325

463

464+regprocOid :: Oid

465+regprocOid = Oid 24

466+{-# INLINE regprocOid #-}

467+

326text :: TypeInfo

468text :: TypeInfo

327text = Basic {

469text = Basic {

328− typoid = Oid 25,

470+ typoid = textOid,

329 typcategory = 'S',

471 typcategory = 'S',

330 typdelim = ',',

472 typdelim = ',',

331 typname = "text"

473 typname = "text"

332 }

474 }

333

475

476+textOid :: Oid

477+textOid = Oid 25

478+{-# INLINE textOid #-}

479+

334oid :: TypeInfo

480oid :: TypeInfo

335oid = Basic {

481oid = Basic {

336− typoid = Oid 26,

482+ typoid = oidOid,

337 typcategory = 'N',

483 typcategory = 'N',

338 typdelim = ',',

484 typdelim = ',',

339 typname = "oid"

485 typname = "oid"

340 }

486 }

341

487

488+oidOid :: Oid

489+oidOid = Oid 26

490+{-# INLINE oidOid #-}

491+

342tid :: TypeInfo

492tid :: TypeInfo

343tid = Basic {

493tid = Basic {

344− typoid = Oid 27,

494+ typoid = tidOid,

345 typcategory = 'U',

495 typcategory = 'U',

346 typdelim = ',',

496 typdelim = ',',

347 typname = "tid"

497 typname = "tid"

348 }

498 }

349

499

500+tidOid :: Oid

501+tidOid = Oid 27

502+{-# INLINE tidOid #-}

503+

350xid :: TypeInfo

504xid :: TypeInfo

351xid = Basic {

505xid = Basic {

352− typoid = Oid 28,

506+ typoid = xidOid,

353 typcategory = 'U',

507 typcategory = 'U',

354 typdelim = ',',

508 typdelim = ',',

355 typname = "xid"

509 typname = "xid"

356 }

510 }

357

511

512+xidOid :: Oid

513+xidOid = Oid 28

514+{-# INLINE xidOid #-}

515+

358cid :: TypeInfo

516cid :: TypeInfo

359cid = Basic {

517cid = Basic {

360− typoid = Oid 29,

518+ typoid = cidOid,

361 typcategory = 'U',

519 typcategory = 'U',

362 typdelim = ',',

520 typdelim = ',',

363 typname = "cid"

521 typname = "cid"

364 }

522 }

365

523

524+cidOid :: Oid

525+cidOid = Oid 29

526+{-# INLINE cidOid #-}

527+

366xml :: TypeInfo

528xml :: TypeInfo

367xml = Basic {

529xml = Basic {

368− typoid = Oid 142,

530+ typoid = xmlOid,

369 typcategory = 'U',

531 typcategory = 'U',

370 typdelim = ',',

532 typdelim = ',',

371 typname = "xml"

533 typname = "xml"

372 }

534 }

373

535

536+xmlOid :: Oid

537+xmlOid = Oid 142

538+{-# INLINE xmlOid #-}

539+

374point :: TypeInfo

540point :: TypeInfo

375point = Basic {

541point = Basic {

376− typoid = Oid 600,

542+ typoid = pointOid,

377 typcategory = 'G',

543 typcategory = 'G',

378 typdelim = ',',

544 typdelim = ',',

379 typname = "point"

545 typname = "point"

380 }

546 }

381

547

548+pointOid :: Oid

549+pointOid = Oid 600

550+{-# INLINE pointOid #-}

551+

382lseg :: TypeInfo

552lseg :: TypeInfo

383lseg = Basic {

553lseg = Basic {

384− typoid = Oid 601,

554+ typoid = lsegOid,

385 typcategory = 'G',

555 typcategory = 'G',

386 typdelim = ',',

556 typdelim = ',',

387 typname = "lseg"

557 typname = "lseg"

388 }

558 }

389

559

560+lsegOid :: Oid

561+lsegOid = Oid 601

562+{-# INLINE lsegOid #-}

563+

390path :: TypeInfo

564path :: TypeInfo

391path = Basic {

565path = Basic {

392− typoid = Oid 602,

566+ typoid = pathOid,

393 typcategory = 'G',

567 typcategory = 'G',

394 typdelim = ',',

568 typdelim = ',',

395 typname = "path"

569 typname = "path"

396 }

570 }

397

571

572+pathOid :: Oid

573+pathOid = Oid 602

574+{-# INLINE pathOid #-}

575+

398box :: TypeInfo

576box :: TypeInfo

399box = Basic {

577box = Basic {

400− typoid = Oid 603,

578+ typoid = boxOid,

401 typcategory = 'G',

579 typcategory = 'G',

402 typdelim = ';',

580 typdelim = ';',

403 typname = "box"

581 typname = "box"

404 }

582 }

405

583

584+boxOid :: Oid

585+boxOid = Oid 603

586+{-# INLINE boxOid #-}

587+

406polygon :: TypeInfo

588polygon :: TypeInfo

407polygon = Basic {

589polygon = Basic {

408− typoid = Oid 604,

590+ typoid = polygonOid,

409 typcategory = 'G',

591 typcategory = 'G',

410 typdelim = ',',

592 typdelim = ',',

411 typname = "polygon"

593 typname = "polygon"

412 }

594 }

413

595

596+polygonOid :: Oid

597+polygonOid = Oid 604

598+{-# INLINE polygonOid #-}

599+

414line :: TypeInfo

600line :: TypeInfo

415line = Basic {

601line = Basic {

416− typoid = Oid 628,

602+ typoid = lineOid,

417 typcategory = 'G',

603 typcategory = 'G',

418 typdelim = ',',

604 typdelim = ',',

419 typname = "line"

605 typname = "line"

420 }

606 }

421

607

608+lineOid :: Oid

609+lineOid = Oid 628

610+{-# INLINE lineOid #-}

611+

422cidr :: TypeInfo

612cidr :: TypeInfo

423cidr = Basic {

613cidr = Basic {

424− typoid = Oid 650,

614+ typoid = cidrOid,

425 typcategory = 'I',

615 typcategory = 'I',

426 typdelim = ',',

616 typdelim = ',',

427 typname = "cidr"

617 typname = "cidr"

428 }

618 }

429

619

620+cidrOid :: Oid

621+cidrOid = Oid 650

622+{-# INLINE cidrOid #-}

623+

430float4 :: TypeInfo

624float4 :: TypeInfo

431float4 = Basic {

625float4 = Basic {

432− typoid = Oid 700,

626+ typoid = float4Oid,

433 typcategory = 'N',

627 typcategory = 'N',

434 typdelim = ',',

628 typdelim = ',',

435 typname = "float4"

629 typname = "float4"

436 }

630 }

437

631

632+float4Oid :: Oid

633+float4Oid = Oid 700

634+{-# INLINE float4Oid #-}

635+

438float8 :: TypeInfo

636float8 :: TypeInfo

439float8 = Basic {

637float8 = Basic {

440− typoid = Oid 701,

638+ typoid = float8Oid,

441 typcategory = 'N',

639 typcategory = 'N',

442 typdelim = ',',

640 typdelim = ',',

443 typname = "float8"

641 typname = "float8"

444 }

642 }

445

643

644+float8Oid :: Oid

645+float8Oid = Oid 701

646+{-# INLINE float8Oid #-}

647+

446unknown :: TypeInfo

648unknown :: TypeInfo

447unknown = Basic {

649unknown = Basic {

448− typoid = Oid 705,

650+ typoid = unknownOid,

449 typcategory = 'X',

651 typcategory = 'X',

450 typdelim = ',',

652 typdelim = ',',

451 typname = "unknown"

653 typname = "unknown"

452 }

654 }

453

655

656+unknownOid :: Oid

657+unknownOid = Oid 705

658+{-# INLINE unknownOid #-}

659+

454circle :: TypeInfo

660circle :: TypeInfo

455circle = Basic {

661circle = Basic {

456− typoid = Oid 718,

662+ typoid = circleOid,

457 typcategory = 'G',

663 typcategory = 'G',

458 typdelim = ',',

664 typdelim = ',',

459 typname = "circle"

665 typname = "circle"

460 }

666 }

461

667

668+circleOid :: Oid

669+circleOid = Oid 718

670+{-# INLINE circleOid #-}

671+

462money :: TypeInfo

672money :: TypeInfo

463money = Basic {

673money = Basic {

464− typoid = Oid 790,

674+ typoid = moneyOid,

465 typcategory = 'N',

675 typcategory = 'N',

466 typdelim = ',',

676 typdelim = ',',

467 typname = "money"

677 typname = "money"

468 }

678 }

469

679

680+moneyOid :: Oid

681+moneyOid = Oid 790

682+{-# INLINE moneyOid #-}

683+

470macaddr :: TypeInfo

684macaddr :: TypeInfo

471macaddr = Basic {

685macaddr = Basic {

472− typoid = Oid 829,

686+ typoid = macaddrOid,

473 typcategory = 'U',

687 typcategory = 'U',

474 typdelim = ',',

688 typdelim = ',',

475 typname = "macaddr"

689 typname = "macaddr"

476 }

690 }

477

691

692+macaddrOid :: Oid

693+macaddrOid = Oid 829

694+{-# INLINE macaddrOid #-}

695+

478inet :: TypeInfo

696inet :: TypeInfo

479inet = Basic {

697inet = Basic {

480− typoid = Oid 869,

698+ typoid = inetOid,

481 typcategory = 'I',

699 typcategory = 'I',

482 typdelim = ',',

700 typdelim = ',',

483 typname = "inet"

701 typname = "inet"

484 }

702 }

485

703

704+inetOid :: Oid

705+inetOid = Oid 869

706+{-# INLINE inetOid #-}

707+

486bpchar :: TypeInfo

708bpchar :: TypeInfo

487bpchar = Basic {

709bpchar = Basic {

488− typoid = Oid 1042,

710+ typoid = bpcharOid,

489 typcategory = 'S',

711 typcategory = 'S',

490 typdelim = ',',

712 typdelim = ',',

491 typname = "bpchar"

713 typname = "bpchar"

492 }

714 }

493

715

716+bpcharOid :: Oid

717+bpcharOid = Oid 1042

718+{-# INLINE bpcharOid #-}

719+

494varchar :: TypeInfo

720varchar :: TypeInfo

495varchar = Basic {

721varchar = Basic {

496− typoid = Oid 1043,

722+ typoid = varcharOid,

497 typcategory = 'S',

723 typcategory = 'S',

498 typdelim = ',',

724 typdelim = ',',

499 typname = "varchar"

725 typname = "varchar"

500 }

726 }

501

727

728+varcharOid :: Oid

729+varcharOid = Oid 1043

730+{-# INLINE varcharOid #-}

731+

502date :: TypeInfo

732date :: TypeInfo

503date = Basic {

733date = Basic {

504− typoid = Oid 1082,

734+ typoid = dateOid,

505 typcategory = 'D',

735 typcategory = 'D',

506 typdelim = ',',

736 typdelim = ',',

507 typname = "date"

737 typname = "date"

508 }

738 }

509

739

740+dateOid :: Oid

741+dateOid = Oid 1082

742+{-# INLINE dateOid #-}

743+

510time :: TypeInfo

744time :: TypeInfo

511time = Basic {

745time = Basic {

512− typoid = Oid 1083,

746+ typoid = timeOid,

513 typcategory = 'D',

747 typcategory = 'D',

514 typdelim = ',',

748 typdelim = ',',

515 typname = "time"

749 typname = "time"

516 }

750 }

517

751

752+timeOid :: Oid

753+timeOid = Oid 1083

754+{-# INLINE timeOid #-}

755+

518timestamp :: TypeInfo

756timestamp :: TypeInfo

519timestamp = Basic {

757timestamp = Basic {

520− typoid = Oid 1114,

758+ typoid = timestampOid,

521 typcategory = 'D',

759 typcategory = 'D',

522 typdelim = ',',

760 typdelim = ',',

523 typname = "timestamp"

761 typname = "timestamp"

524 }

762 }

525

763

764+timestampOid :: Oid

765+timestampOid = Oid 1114

766+{-# INLINE timestampOid #-}

767+

526timestamptz :: TypeInfo

768timestamptz :: TypeInfo

527timestamptz = Basic {

769timestamptz = Basic {

528− typoid = Oid 1184,

770+ typoid = timestamptzOid,

529 typcategory = 'D',

771 typcategory = 'D',

530 typdelim = ',',

772 typdelim = ',',

531 typname = "timestamptz"

773 typname = "timestamptz"

532 }

774 }

533

775

776+timestamptzOid :: Oid

777+timestamptzOid = Oid 1184

778+{-# INLINE timestamptzOid #-}

779+

534interval :: TypeInfo

780interval :: TypeInfo

535interval = Basic {

781interval = Basic {

536− typoid = Oid 1186,

782+ typoid = intervalOid,

537 typcategory = 'T',

783 typcategory = 'T',

538 typdelim = ',',

784 typdelim = ',',

539 typname = "interval"

785 typname = "interval"

540 }

786 }

541

787

788+intervalOid :: Oid

789+intervalOid = Oid 1186

790+{-# INLINE intervalOid #-}

791+

542timetz :: TypeInfo

792timetz :: TypeInfo

543timetz = Basic {

793timetz = Basic {

544− typoid = Oid 1266,

794+ typoid = timetzOid,

545 typcategory = 'D',

795 typcategory = 'D',

546 typdelim = ',',

796 typdelim = ',',

547 typname = "timetz"

797 typname = "timetz"

548 }

798 }

549

799

800+timetzOid :: Oid

801+timetzOid = Oid 1266

802+{-# INLINE timetzOid #-}

803+

550bit :: TypeInfo

804bit :: TypeInfo

551bit = Basic {

805bit = Basic {

552− typoid = Oid 1560,

806+ typoid = bitOid,

553 typcategory = 'V',

807 typcategory = 'V',

554 typdelim = ',',

808 typdelim = ',',

555 typname = "bit"

809 typname = "bit"

556 }

810 }

557

811

812+bitOid :: Oid

813+bitOid = Oid 1560

814+{-# INLINE bitOid #-}

815+

558varbit :: TypeInfo

816varbit :: TypeInfo

559varbit = Basic {

817varbit = Basic {

560− typoid = Oid 1562,

818+ typoid = varbitOid,

561 typcategory = 'V',

819 typcategory = 'V',

562 typdelim = ',',

820 typdelim = ',',

563 typname = "varbit"

821 typname = "varbit"

564 }

822 }

565

823

824+varbitOid :: Oid

825+varbitOid = Oid 1562

826+{-# INLINE varbitOid #-}

827+

566numeric :: TypeInfo

828numeric :: TypeInfo

567numeric = Basic {

829numeric = Basic {

568− typoid = Oid 1700,

830+ typoid = numericOid,

569 typcategory = 'N',

831 typcategory = 'N',

570 typdelim = ',',

832 typdelim = ',',

571 typname = "numeric"

833 typname = "numeric"

572 }

834 }

573

835

836+numericOid :: Oid

837+numericOid = Oid 1700

838+{-# INLINE numericOid #-}

839+

574refcursor :: TypeInfo

840refcursor :: TypeInfo

575refcursor = Basic {

841refcursor = Basic {

576− typoid = Oid 1790,

842+ typoid = refcursorOid,

577 typcategory = 'U',

843 typcategory = 'U',

578 typdelim = ',',

844 typdelim = ',',

579 typname = "refcursor"

845 typname = "refcursor"

580 }

846 }

581

847

848+refcursorOid :: Oid

849+refcursorOid = Oid 1790

850+{-# INLINE refcursorOid #-}

851+

582record :: TypeInfo

852record :: TypeInfo

583record = Basic {

853record = Basic {

584− typoid = Oid 2249,

854+ typoid = recordOid,

585 typcategory = 'P',

855 typcategory = 'P',

586 typdelim = ',',

856 typdelim = ',',

587 typname = "record"

857 typname = "record"

588 }

858 }

589

859

860+recordOid :: Oid

861+recordOid = Oid 2249

862+{-# INLINE recordOid #-}

863+

590void :: TypeInfo

864void :: TypeInfo

591void = Basic {

865void = Basic {

592− typoid = Oid 2278,

866+ typoid = voidOid,

593 typcategory = 'P',

867 typcategory = 'P',

594 typdelim = ',',

868 typdelim = ',',

595 typname = "void"

869 typname = "void"

596 }

870 }

597

871

872+voidOid :: Oid

873+voidOid = Oid 2278

874+{-# INLINE voidOid #-}

875+

598array_record :: TypeInfo

876array_record :: TypeInfo

599array_record = Array {

877array_record = Array {

600− typoid = Oid 2287,

878+ typoid = array_recordOid,

601 typcategory = 'P',

879 typcategory = 'P',

602 typdelim = ',',

880 typdelim = ',',

603 typname = "_record",

881 typname = "_record",

604 typelem = record

882 typelem = record

605 }

883 }

606

884

885+array_recordOid :: Oid

886+array_recordOid = Oid 2287

887+{-# INLINE array_recordOid #-}

888+

607regprocedure :: TypeInfo

889regprocedure :: TypeInfo

608regprocedure = Basic {

890regprocedure = Basic {

609− typoid = Oid 2202,

891+ typoid = regprocedureOid,

610 typcategory = 'N',

892 typcategory = 'N',

611 typdelim = ',',

893 typdelim = ',',

612 typname = "regprocedure"

894 typname = "regprocedure"

613 }

895 }

614

896

897+regprocedureOid :: Oid

898+regprocedureOid = Oid 2202

899+{-# INLINE regprocedureOid #-}

900+

615regoper :: TypeInfo

901regoper :: TypeInfo

616regoper = Basic {

902regoper = Basic {

617− typoid = Oid 2203,

903+ typoid = regoperOid,

618 typcategory = 'N',

904 typcategory = 'N',

619 typdelim = ',',

905 typdelim = ',',

620 typname = "regoper"

906 typname = "regoper"

621 }

907 }

622

908

909+regoperOid :: Oid

910+regoperOid = Oid 2203

911+{-# INLINE regoperOid #-}

912+

623regoperator :: TypeInfo

913regoperator :: TypeInfo

624regoperator = Basic {

914regoperator = Basic {

625− typoid = Oid 2204,

915+ typoid = regoperatorOid,

626 typcategory = 'N',

916 typcategory = 'N',

627 typdelim = ',',

917 typdelim = ',',

628 typname = "regoperator"

918 typname = "regoperator"

629 }

919 }

630

920

921+regoperatorOid :: Oid

922+regoperatorOid = Oid 2204

923+{-# INLINE regoperatorOid #-}

924+

631regclass :: TypeInfo

925regclass :: TypeInfo

632regclass = Basic {

926regclass = Basic {

633− typoid = Oid 2205,

927+ typoid = regclassOid,

634 typcategory = 'N',

928 typcategory = 'N',

635 typdelim = ',',

929 typdelim = ',',

636 typname = "regclass"

930 typname = "regclass"

637 }

931 }

638

932

933+regclassOid :: Oid

934+regclassOid = Oid 2205

935+{-# INLINE regclassOid #-}

936+

639regtype :: TypeInfo

937regtype :: TypeInfo

640regtype = Basic {

938regtype = Basic {

641− typoid = Oid 2206,

939+ typoid = regtypeOid,

642 typcategory = 'N',

940 typcategory = 'N',

643 typdelim = ',',

941 typdelim = ',',

644 typname = "regtype"

942 typname = "regtype"

645 }

943 }

646

944

945+regtypeOid :: Oid

946+regtypeOid = Oid 2206

947+{-# INLINE regtypeOid #-}

948+

647uuid :: TypeInfo

949uuid :: TypeInfo

648uuid = Basic {

950uuid = Basic {

649− typoid = Oid 2950,

951+ typoid = uuidOid,

650 typcategory = 'U',

952 typcategory = 'U',

651 typdelim = ',',

953 typdelim = ',',

652 typname = "uuid"

954 typname = "uuid"

653 }

955 }

654

956

957+uuidOid :: Oid

958+uuidOid = Oid 2950

959+{-# INLINE uuidOid #-}

960+

655json :: TypeInfo

961json :: TypeInfo

656json = Basic {

962json = Basic {

657− typoid = Oid 114,

963+ typoid = jsonOid,

658 typcategory = 'U',

964 typcategory = 'U',

659 typdelim = ',',

965 typdelim = ',',

660 typname = "json"

966 typname = "json"

661 }

967 }

662

968

969+jsonOid :: Oid

970+jsonOid = Oid 114

971+{-# INLINE jsonOid #-}

972+

663jsonb :: TypeInfo

973jsonb :: TypeInfo

664jsonb = Basic {

974jsonb = Basic {

665− typoid = Oid 3802,

975+ typoid = jsonbOid,

666 typcategory = 'U',

976 typcategory = 'U',

667 typdelim = ',',

977 typdelim = ',',

668 typname = "jsonb"

978 typname = "jsonb"

669 }

979 }

670

980

981+jsonbOid :: Oid

982+jsonbOid = Oid 3802

983+{-# INLINE jsonbOid #-}

984+

671int2vector :: TypeInfo

985int2vector :: TypeInfo

672int2vector = Array {

986int2vector = Array {

673− typoid = Oid 22,

987+ typoid = int2vectorOid,

674 typcategory = 'A',

988 typcategory = 'A',

675 typdelim = ',',

989 typdelim = ',',

676 typname = "int2vector",

990 typname = "int2vector",

677 typelem = int2

991 typelem = int2

678 }

992 }

679

993

994+int2vectorOid :: Oid

995+int2vectorOid = Oid 22

996+{-# INLINE int2vectorOid #-}

997+

680oidvector :: TypeInfo

998oidvector :: TypeInfo

681oidvector = Array {

999oidvector = Array {

682− typoid = Oid 30,

1000+ typoid = oidvectorOid,

683 typcategory = 'A',

1001 typcategory = 'A',

684 typdelim = ',',

1002 typdelim = ',',

685 typname = "oidvector",

1003 typname = "oidvector",

686 typelem = oid

1004 typelem = oid

687 }

1005 }

688

1006

1007+oidvectorOid :: Oid

1008+oidvectorOid = Oid 30

1009+{-# INLINE oidvectorOid #-}

1010+

689array_xml :: TypeInfo

1011array_xml :: TypeInfo

690array_xml = Array {

1012array_xml = Array {

691− typoid = Oid 143,

1013+ typoid = array_xmlOid,

692 typcategory = 'A',

1014 typcategory = 'A',

693 typdelim = ',',

1015 typdelim = ',',

694 typname = "_xml",

1016 typname = "_xml",

695 typelem = xml

1017 typelem = xml

696 }

1018 }

697

1019

1020+array_xmlOid :: Oid

1021+array_xmlOid = Oid 143

1022+{-# INLINE array_xmlOid #-}

1023+

698array_json :: TypeInfo

1024array_json :: TypeInfo

699array_json = Array {

1025array_json = Array {

700− typoid = Oid 199,

1026+ typoid = array_jsonOid,

701 typcategory = 'A',

1027 typcategory = 'A',

702 typdelim = ',',

1028 typdelim = ',',

703 typname = "_json",

1029 typname = "_json",

704 typelem = json

1030 typelem = json

705 }

1031 }

706

1032

1033+array_jsonOid :: Oid

1034+array_jsonOid = Oid 199

1035+{-# INLINE array_jsonOid #-}

1036+

707array_line :: TypeInfo

1037array_line :: TypeInfo

708array_line = Array {

1038array_line = Array {

709− typoid = Oid 629,

1039+ typoid = array_lineOid,

710 typcategory = 'A',

1040 typcategory = 'A',

711 typdelim = ',',

1041 typdelim = ',',

712 typname = "_line",

1042 typname = "_line",

713 typelem = line

1043 typelem = line

714 }

1044 }

715

1045

1046+array_lineOid :: Oid

1047+array_lineOid = Oid 629

1048+{-# INLINE array_lineOid #-}

1049+

716array_cidr :: TypeInfo

1050array_cidr :: TypeInfo

717array_cidr = Array {

1051array_cidr = Array {

718− typoid = Oid 651,

1052+ typoid = array_cidrOid,

719 typcategory = 'A',

1053 typcategory = 'A',

720 typdelim = ',',

1054 typdelim = ',',

721 typname = "_cidr",

1055 typname = "_cidr",

722 typelem = cidr

1056 typelem = cidr

723 }

1057 }

724

1058

1059+array_cidrOid :: Oid

1060+array_cidrOid = Oid 651

1061+{-# INLINE array_cidrOid #-}

1062+

725array_circle :: TypeInfo

1063array_circle :: TypeInfo

726array_circle = Array {

1064array_circle = Array {

727− typoid = Oid 719,

1065+ typoid = array_circleOid,

728 typcategory = 'A',

1066 typcategory = 'A',

729 typdelim = ',',

1067 typdelim = ',',

730 typname = "_circle",

1068 typname = "_circle",

731 typelem = circle

1069 typelem = circle

732 }

1070 }

733

1071

1072+array_circleOid :: Oid

1073+array_circleOid = Oid 719

1074+{-# INLINE array_circleOid #-}

1075+

734array_money :: TypeInfo

1076array_money :: TypeInfo

735array_money = Array {

1077array_money = Array {

736− typoid = Oid 791,

1078+ typoid = array_moneyOid,

737 typcategory = 'A',

1079 typcategory = 'A',

738 typdelim = ',',

1080 typdelim = ',',

739 typname = "_money",

1081 typname = "_money",

740 typelem = money

1082 typelem = money

741 }

1083 }

742

1084

1085+array_moneyOid :: Oid

1086+array_moneyOid = Oid 791

1087+{-# INLINE array_moneyOid #-}

1088+

743array_bool :: TypeInfo

1089array_bool :: TypeInfo

744array_bool = Array {

1090array_bool = Array {

745− typoid = Oid 1000,

1091+ typoid = array_boolOid,

746 typcategory = 'A',

1092 typcategory = 'A',

747 typdelim = ',',

1093 typdelim = ',',

748 typname = "_bool",

1094 typname = "_bool",

749 typelem = bool

1095 typelem = bool

750 }

1096 }

751

1097

1098+array_boolOid :: Oid

1099+array_boolOid = Oid 1000

1100+{-# INLINE array_boolOid #-}

1101+

752array_bytea :: TypeInfo

1102array_bytea :: TypeInfo

753array_bytea = Array {

1103array_bytea = Array {

754− typoid = Oid 1001,

1104+ typoid = array_byteaOid,

755 typcategory = 'A',

1105 typcategory = 'A',

756 typdelim = ',',

1106 typdelim = ',',

757 typname = "_bytea",

1107 typname = "_bytea",

758 typelem = bytea

1108 typelem = bytea

759 }

1109 }

760

1110

1111+array_byteaOid :: Oid

1112+array_byteaOid = Oid 1001

1113+{-# INLINE array_byteaOid #-}

1114+

761array_char :: TypeInfo

1115array_char :: TypeInfo

762array_char = Array {

1116array_char = Array {

763− typoid = Oid 1002,

1117+ typoid = array_charOid,

764 typcategory = 'A',

1118 typcategory = 'A',

765 typdelim = ',',

1119 typdelim = ',',

766 typname = "_char",

1120 typname = "_char",

767 typelem = char

1121 typelem = char

768 }

1122 }

769

1123

1124+array_charOid :: Oid

1125+array_charOid = Oid 1002

1126+{-# INLINE array_charOid #-}

1127+

770array_name :: TypeInfo

1128array_name :: TypeInfo

771array_name = Array {

1129array_name = Array {

772− typoid = Oid 1003,

1130+ typoid = array_nameOid,

773 typcategory = 'A',

1131 typcategory = 'A',

774 typdelim = ',',

1132 typdelim = ',',

775 typname = "_name",

1133 typname = "_name",

776 typelem = name

1134 typelem = name

777 }

1135 }

778

1136

1137+array_nameOid :: Oid

1138+array_nameOid = Oid 1003

1139+{-# INLINE array_nameOid #-}

1140+

779array_int2 :: TypeInfo

1141array_int2 :: TypeInfo

780array_int2 = Array {

1142array_int2 = Array {

781− typoid = Oid 1005,

1143+ typoid = array_int2Oid,

782 typcategory = 'A',

1144 typcategory = 'A',

783 typdelim = ',',

1145 typdelim = ',',

784 typname = "_int2",

1146 typname = "_int2",

785 typelem = int2

1147 typelem = int2

786 }

1148 }

787

1149

1150+array_int2Oid :: Oid

1151+array_int2Oid = Oid 1005

1152+{-# INLINE array_int2Oid #-}

1153+

788array_int2vector :: TypeInfo

1154array_int2vector :: TypeInfo

789array_int2vector = Array {

1155array_int2vector = Array {

790− typoid = Oid 1006,

1156+ typoid = array_int2vectorOid,

791 typcategory = 'A',

1157 typcategory = 'A',

792 typdelim = ',',

1158 typdelim = ',',

793 typname = "_int2vector",

1159 typname = "_int2vector",

794 typelem = int2vector

1160 typelem = int2vector

795 }

1161 }

796

1162

1163+array_int2vectorOid :: Oid

1164+array_int2vectorOid = Oid 1006

1165+{-# INLINE array_int2vectorOid #-}

1166+

797array_int4 :: TypeInfo

1167array_int4 :: TypeInfo

798array_int4 = Array {

1168array_int4 = Array {

799− typoid = Oid 1007,

1169+ typoid = array_int4Oid,

800 typcategory = 'A',

1170 typcategory = 'A',

801 typdelim = ',',

1171 typdelim = ',',

802 typname = "_int4",

1172 typname = "_int4",

803 typelem = int4

1173 typelem = int4

804 }

1174 }

805

1175

1176+array_int4Oid :: Oid

1177+array_int4Oid = Oid 1007

1178+{-# INLINE array_int4Oid #-}

1179+

806array_regproc :: TypeInfo

1180array_regproc :: TypeInfo

807array_regproc = Array {

1181array_regproc = Array {

808− typoid = Oid 1008,

1182+ typoid = array_regprocOid,

809 typcategory = 'A',

1183 typcategory = 'A',

810 typdelim = ',',

1184 typdelim = ',',

811 typname = "_regproc",

1185 typname = "_regproc",

812 typelem = regproc

1186 typelem = regproc

813 }

1187 }

814

1188

1189+array_regprocOid :: Oid

1190+array_regprocOid = Oid 1008

1191+{-# INLINE array_regprocOid #-}

1192+

815array_text :: TypeInfo

1193array_text :: TypeInfo

816array_text = Array {

1194array_text = Array {

817− typoid = Oid 1009,

1195+ typoid = array_textOid,

818 typcategory = 'A',

1196 typcategory = 'A',

819 typdelim = ',',

1197 typdelim = ',',

820 typname = "_text",

1198 typname = "_text",

821 typelem = text

1199 typelem = text

822 }

1200 }

823

1201

1202+array_textOid :: Oid

1203+array_textOid = Oid 1009

1204+{-# INLINE array_textOid #-}

1205+

824array_tid :: TypeInfo

1206array_tid :: TypeInfo

825array_tid = Array {

1207array_tid = Array {

826− typoid = Oid 1010,

1208+ typoid = array_tidOid,

827 typcategory = 'A',

1209 typcategory = 'A',

828 typdelim = ',',

1210 typdelim = ',',

829 typname = "_tid",

1211 typname = "_tid",

830 typelem = tid

1212 typelem = tid

831 }

1213 }

832

1214

1215+array_tidOid :: Oid

1216+array_tidOid = Oid 1010

1217+{-# INLINE array_tidOid #-}

1218+

833array_xid :: TypeInfo

1219array_xid :: TypeInfo

834array_xid = Array {

1220array_xid = Array {

835− typoid = Oid 1011,

1221+ typoid = array_xidOid,

836 typcategory = 'A',

1222 typcategory = 'A',

837 typdelim = ',',

1223 typdelim = ',',

838 typname = "_xid",

1224 typname = "_xid",

839 typelem = xid

1225 typelem = xid

840 }

1226 }

841

1227

1228+array_xidOid :: Oid

1229+array_xidOid = Oid 1011

1230+{-# INLINE array_xidOid #-}

1231+

842array_cid :: TypeInfo

1232array_cid :: TypeInfo

843array_cid = Array {

1233array_cid = Array {

844− typoid = Oid 1012,

1234+ typoid = array_cidOid,

845 typcategory = 'A',

1235 typcategory = 'A',

846 typdelim = ',',

1236 typdelim = ',',

847 typname = "_cid",

1237 typname = "_cid",

848 typelem = cid

1238 typelem = cid

849 }

1239 }

850

1240

1241+array_cidOid :: Oid

1242+array_cidOid = Oid 1012

1243+{-# INLINE array_cidOid #-}

1244+

851array_oidvector :: TypeInfo

1245array_oidvector :: TypeInfo

852array_oidvector = Array {

1246array_oidvector = Array {

853− typoid = Oid 1013,

1247+ typoid = array_oidvectorOid,

854 typcategory = 'A',

1248 typcategory = 'A',

855 typdelim = ',',

1249 typdelim = ',',

856 typname = "_oidvector",

1250 typname = "_oidvector",

857 typelem = oidvector

1251 typelem = oidvector

858 }

1252 }

859

1253

1254+array_oidvectorOid :: Oid

1255+array_oidvectorOid = Oid 1013

1256+{-# INLINE array_oidvectorOid #-}

1257+

860array_bpchar :: TypeInfo

1258array_bpchar :: TypeInfo

861array_bpchar = Array {

1259array_bpchar = Array {

862− typoid = Oid 1014,

1260+ typoid = array_bpcharOid,

863 typcategory = 'A',

1261 typcategory = 'A',

864 typdelim = ',',

1262 typdelim = ',',

865 typname = "_bpchar",

1263 typname = "_bpchar",

866 typelem = bpchar

1264 typelem = bpchar

867 }

1265 }

868

1266

1267+array_bpcharOid :: Oid

1268+array_bpcharOid = Oid 1014

1269+{-# INLINE array_bpcharOid #-}

1270+

869array_varchar :: TypeInfo

1271array_varchar :: TypeInfo

870array_varchar = Array {

1272array_varchar = Array {

871− typoid = Oid 1015,

1273+ typoid = array_varcharOid,

872 typcategory = 'A',

1274 typcategory = 'A',

873 typdelim = ',',

1275 typdelim = ',',

874 typname = "_varchar",

1276 typname = "_varchar",

875 typelem = varchar

1277 typelem = varchar

876 }

1278 }

877

1279

1280+array_varcharOid :: Oid

1281+array_varcharOid = Oid 1015

1282+{-# INLINE array_varcharOid #-}

1283+

878array_int8 :: TypeInfo

1284array_int8 :: TypeInfo

879array_int8 = Array {

1285array_int8 = Array {

880− typoid = Oid 1016,

1286+ typoid = array_int8Oid,

881 typcategory = 'A',

1287 typcategory = 'A',

882 typdelim = ',',

1288 typdelim = ',',

883 typname = "_int8",

1289 typname = "_int8",

884 typelem = int8

1290 typelem = int8

885 }

1291 }

886

1292

1293+array_int8Oid :: Oid

1294+array_int8Oid = Oid 1016

1295+{-# INLINE array_int8Oid #-}

1296+

887array_point :: TypeInfo

1297array_point :: TypeInfo

888array_point = Array {

1298array_point = Array {

889− typoid = Oid 1017,

1299+ typoid = array_pointOid,

890 typcategory = 'A',

1300 typcategory = 'A',

891 typdelim = ',',

1301 typdelim = ',',

892 typname = "_point",

1302 typname = "_point",

893 typelem = point

1303 typelem = point

894 }

1304 }

895

1305

1306+array_pointOid :: Oid

1307+array_pointOid = Oid 1017

1308+{-# INLINE array_pointOid #-}

1309+

896array_lseg :: TypeInfo

1310array_lseg :: TypeInfo

897array_lseg = Array {

1311array_lseg = Array {

898− typoid = Oid 1018,

1312+ typoid = array_lsegOid,

899 typcategory = 'A',

1313 typcategory = 'A',

900 typdelim = ',',

1314 typdelim = ',',

901 typname = "_lseg",

1315 typname = "_lseg",

902 typelem = lseg

1316 typelem = lseg

903 }

1317 }

904

1318

1319+array_lsegOid :: Oid

1320+array_lsegOid = Oid 1018

1321+{-# INLINE array_lsegOid #-}

1322+

905array_path :: TypeInfo

1323array_path :: TypeInfo

906array_path = Array {

1324array_path = Array {

907− typoid = Oid 1019,

1325+ typoid = array_pathOid,

908 typcategory = 'A',

1326 typcategory = 'A',

909 typdelim = ',',

1327 typdelim = ',',

910 typname = "_path",

1328 typname = "_path",

911 typelem = path

1329 typelem = path

912 }

1330 }

913

1331

1332+array_pathOid :: Oid

1333+array_pathOid = Oid 1019

1334+{-# INLINE array_pathOid #-}

1335+

914array_box :: TypeInfo

1336array_box :: TypeInfo

915array_box = Array {

1337array_box = Array {

916− typoid = Oid 1020,

1338+ typoid = array_boxOid,

917 typcategory = 'A',

1339 typcategory = 'A',

918 typdelim = ';',

1340 typdelim = ';',

919 typname = "_box",

1341 typname = "_box",

920 typelem = box

1342 typelem = box

921 }

1343 }

922

1344

1345+array_boxOid :: Oid

1346+array_boxOid = Oid 1020

1347+{-# INLINE array_boxOid #-}

1348+

923array_float4 :: TypeInfo

1349array_float4 :: TypeInfo

924array_float4 = Array {

1350array_float4 = Array {

925− typoid = Oid 1021,

1351+ typoid = array_float4Oid,

926 typcategory = 'A',

1352 typcategory = 'A',

927 typdelim = ',',

1353 typdelim = ',',

928 typname = "_float4",

1354 typname = "_float4",

929 typelem = float4

1355 typelem = float4

930 }

1356 }

931

1357

1358+array_float4Oid :: Oid

1359+array_float4Oid = Oid 1021

1360+{-# INLINE array_float4Oid #-}

1361+

932array_float8 :: TypeInfo

1362array_float8 :: TypeInfo

933array_float8 = Array {

1363array_float8 = Array {

934− typoid = Oid 1022,

1364+ typoid = array_float8Oid,

935 typcategory = 'A',

1365 typcategory = 'A',

936 typdelim = ',',

1366 typdelim = ',',

937 typname = "_float8",

1367 typname = "_float8",

938 typelem = float8

1368 typelem = float8

939 }

1369 }

940

1370

1371+array_float8Oid :: Oid

1372+array_float8Oid = Oid 1022

1373+{-# INLINE array_float8Oid #-}

1374+

941array_polygon :: TypeInfo

1375array_polygon :: TypeInfo

942array_polygon = Array {

1376array_polygon = Array {

943− typoid = Oid 1027,

1377+ typoid = array_polygonOid,

944 typcategory = 'A',

1378 typcategory = 'A',

945 typdelim = ',',

1379 typdelim = ',',

946 typname = "_polygon",

1380 typname = "_polygon",

947 typelem = polygon

1381 typelem = polygon

948 }

1382 }

949

1383

1384+array_polygonOid :: Oid

1385+array_polygonOid = Oid 1027

1386+{-# INLINE array_polygonOid #-}

1387+

950array_oid :: TypeInfo

1388array_oid :: TypeInfo

951array_oid = Array {

1389array_oid = Array {

952− typoid = Oid 1028,

1390+ typoid = array_oidOid,

953 typcategory = 'A',

1391 typcategory = 'A',

954 typdelim = ',',

1392 typdelim = ',',

955 typname = "_oid",

1393 typname = "_oid",

956 typelem = oid

1394 typelem = oid

957 }

1395 }

958

1396

1397+array_oidOid :: Oid

1398+array_oidOid = Oid 1028

1399+{-# INLINE array_oidOid #-}

1400+

959array_macaddr :: TypeInfo

1401array_macaddr :: TypeInfo

960array_macaddr = Array {

1402array_macaddr = Array {

961− typoid = Oid 1040,

1403+ typoid = array_macaddrOid,

962 typcategory = 'A',

1404 typcategory = 'A',

963 typdelim = ',',

1405 typdelim = ',',

964 typname = "_macaddr",

1406 typname = "_macaddr",

965 typelem = macaddr

1407 typelem = macaddr

966 }

1408 }

967

1409

1410+array_macaddrOid :: Oid

1411+array_macaddrOid = Oid 1040

1412+{-# INLINE array_macaddrOid #-}

1413+

968array_inet :: TypeInfo

1414array_inet :: TypeInfo

969array_inet = Array {

1415array_inet = Array {

970− typoid = Oid 1041,

1416+ typoid = array_inetOid,

971 typcategory = 'A',

1417 typcategory = 'A',

972 typdelim = ',',

1418 typdelim = ',',

973 typname = "_inet",

1419 typname = "_inet",

974 typelem = inet

1420 typelem = inet

975 }

1421 }

976

1422

1423+array_inetOid :: Oid

1424+array_inetOid = Oid 1041

1425+{-# INLINE array_inetOid #-}

1426+

977array_timestamp :: TypeInfo

1427array_timestamp :: TypeInfo

978array_timestamp = Array {

1428array_timestamp = Array {

979− typoid = Oid 1115,

1429+ typoid = array_timestampOid,

980 typcategory = 'A',

1430 typcategory = 'A',

981 typdelim = ',',

1431 typdelim = ',',

982 typname = "_timestamp",

1432 typname = "_timestamp",

983 typelem = timestamp

1433 typelem = timestamp

984 }

1434 }

985

1435

1436+array_timestampOid :: Oid

1437+array_timestampOid = Oid 1115

1438+{-# INLINE array_timestampOid #-}

1439+

986array_date :: TypeInfo

1440array_date :: TypeInfo

987array_date = Array {

1441array_date = Array {

988− typoid = Oid 1182,

1442+ typoid = array_dateOid,

989 typcategory = 'A',

1443 typcategory = 'A',

990 typdelim = ',',

1444 typdelim = ',',

991 typname = "_date",

1445 typname = "_date",

992 typelem = date

1446 typelem = date

993 }

1447 }

994

1448

1449+array_dateOid :: Oid

1450+array_dateOid = Oid 1182

1451+{-# INLINE array_dateOid #-}

1452+

995array_time :: TypeInfo

1453array_time :: TypeInfo

996array_time = Array {

1454array_time = Array {

997− typoid = Oid 1183,

1455+ typoid = array_timeOid,

998 typcategory = 'A',

1456 typcategory = 'A',

999 typdelim = ',',

1457 typdelim = ',',

1000 typname = "_time",

1458 typname = "_time",

1001 typelem = time

1459 typelem = time

1002 }

1460 }

1003

1461

1462+array_timeOid :: Oid

1463+array_timeOid = Oid 1183

1464+{-# INLINE array_timeOid #-}

1465+

1004array_timestamptz :: TypeInfo

1466array_timestamptz :: TypeInfo

1005array_timestamptz = Array {

1467array_timestamptz = Array {

1006− typoid = Oid 1185,

1468+ typoid = array_timestamptzOid,

1007 typcategory = 'A',

1469 typcategory = 'A',

1008 typdelim = ',',

1470 typdelim = ',',

1009 typname = "_timestamptz",

1471 typname = "_timestamptz",

1010 typelem = timestamptz

1472 typelem = timestamptz

1011 }

1473 }

1012

1474

1475+array_timestamptzOid :: Oid

1476+array_timestamptzOid = Oid 1185

1477+{-# INLINE array_timestamptzOid #-}

1478+

1013array_interval :: TypeInfo

1479array_interval :: TypeInfo

1014array_interval = Array {

1480array_interval = Array {

1015− typoid = Oid 1187,

1481+ typoid = array_intervalOid,

1016 typcategory = 'A',

1482 typcategory = 'A',

1017 typdelim = ',',

1483 typdelim = ',',

1018 typname = "_interval",

1484 typname = "_interval",

1019 typelem = interval

1485 typelem = interval

1020 }

1486 }

1021

1487

1488+array_intervalOid :: Oid

1489+array_intervalOid = Oid 1187

1490+{-# INLINE array_intervalOid #-}

1491+

1022array_numeric :: TypeInfo

1492array_numeric :: TypeInfo

1023array_numeric = Array {

1493array_numeric = Array {

1024− typoid = Oid 1231,

1494+ typoid = array_numericOid,

1025 typcategory = 'A',

1495 typcategory = 'A',

1026 typdelim = ',',

1496 typdelim = ',',

1027 typname = "_numeric",

1497 typname = "_numeric",

1028 typelem = numeric

1498 typelem = numeric

1029 }

1499 }

1030

1500

1501+array_numericOid :: Oid

1502+array_numericOid = Oid 1231

1503+{-# INLINE array_numericOid #-}

1504+

1031array_timetz :: TypeInfo

1505array_timetz :: TypeInfo

1032array_timetz = Array {

1506array_timetz = Array {

1033− typoid = Oid 1270,

1507+ typoid = array_timetzOid,

1034 typcategory = 'A',

1508 typcategory = 'A',

1035 typdelim = ',',

1509 typdelim = ',',

1036 typname = "_timetz",

1510 typname = "_timetz",

1037 typelem = timetz

1511 typelem = timetz

1038 }

1512 }

1039

1513

1514+array_timetzOid :: Oid

1515+array_timetzOid = Oid 1270

1516+{-# INLINE array_timetzOid #-}

1517+

1040array_bit :: TypeInfo

1518array_bit :: TypeInfo

1041array_bit = Array {

1519array_bit = Array {

1042− typoid = Oid 1561,

1520+ typoid = array_bitOid,

1043 typcategory = 'A',

1521 typcategory = 'A',

1044 typdelim = ',',

1522 typdelim = ',',

1045 typname = "_bit",

1523 typname = "_bit",

1046 typelem = bit

1524 typelem = bit

1047 }

1525 }

1048

1526

1527+array_bitOid :: Oid

1528+array_bitOid = Oid 1561

1529+{-# INLINE array_bitOid #-}

1530+

1049array_varbit :: TypeInfo

1531array_varbit :: TypeInfo

1050array_varbit = Array {

1532array_varbit = Array {

1051− typoid = Oid 1563,

1533+ typoid = array_varbitOid,

1052 typcategory = 'A',

1534 typcategory = 'A',

1053 typdelim = ',',

1535 typdelim = ',',

1054 typname = "_varbit",

1536 typname = "_varbit",

1055 typelem = varbit

1537 typelem = varbit

1056 }

1538 }

1057

1539

1540+array_varbitOid :: Oid

1541+array_varbitOid = Oid 1563

1542+{-# INLINE array_varbitOid #-}

1543+

1058array_refcursor :: TypeInfo

1544array_refcursor :: TypeInfo

1059array_refcursor = Array {

1545array_refcursor = Array {

1060− typoid = Oid 2201,

1546+ typoid = array_refcursorOid,

1061 typcategory = 'A',

1547 typcategory = 'A',

1062 typdelim = ',',

1548 typdelim = ',',

1063 typname = "_refcursor",

1549 typname = "_refcursor",

1064 typelem = refcursor

1550 typelem = refcursor

1065 }

1551 }

1066

1552

1553+array_refcursorOid :: Oid

1554+array_refcursorOid = Oid 2201

1555+{-# INLINE array_refcursorOid #-}

1556+

1067array_regprocedure :: TypeInfo

1557array_regprocedure :: TypeInfo

1068array_regprocedure = Array {

1558array_regprocedure = Array {

1069− typoid = Oid 2207,

1559+ typoid = array_regprocedureOid,

1070 typcategory = 'A',

1560 typcategory = 'A',

1071 typdelim = ',',

1561 typdelim = ',',

1072 typname = "_regprocedure",

1562 typname = "_regprocedure",

1073 typelem = regprocedure

1563 typelem = regprocedure

1074 }

1564 }

1075

1565

1566+array_regprocedureOid :: Oid

1567+array_regprocedureOid = Oid 2207

1568+{-# INLINE array_regprocedureOid #-}

1569+

1076array_regoper :: TypeInfo

1570array_regoper :: TypeInfo

1077array_regoper = Array {

1571array_regoper = Array {

1078− typoid = Oid 2208,

1572+ typoid = array_regoperOid,

1079 typcategory = 'A',

1573 typcategory = 'A',

1080 typdelim = ',',

1574 typdelim = ',',

1081 typname = "_regoper",

1575 typname = "_regoper",

1082 typelem = regoper

1576 typelem = regoper

1083 }

1577 }

1084

1578

1579+array_regoperOid :: Oid

1580+array_regoperOid = Oid 2208

1581+{-# INLINE array_regoperOid #-}

1582+

1085array_regoperator :: TypeInfo

1583array_regoperator :: TypeInfo

1086array_regoperator = Array {

1584array_regoperator = Array {

1087− typoid = Oid 2209,

1585+ typoid = array_regoperatorOid,

1088 typcategory = 'A',

1586 typcategory = 'A',

1089 typdelim = ',',

1587 typdelim = ',',

1090 typname = "_regoperator",

1588 typname = "_regoperator",

1091 typelem = regoperator

1589 typelem = regoperator

1092 }

1590 }

1093

1591

1592+array_regoperatorOid :: Oid

1593+array_regoperatorOid = Oid 2209

1594+{-# INLINE array_regoperatorOid #-}

1595+

1094array_regclass :: TypeInfo

1596array_regclass :: TypeInfo

1095array_regclass = Array {

1597array_regclass = Array {

1096− typoid = Oid 2210,

1598+ typoid = array_regclassOid,

1097 typcategory = 'A',

1599 typcategory = 'A',

1098 typdelim = ',',

1600 typdelim = ',',

1099 typname = "_regclass",

1601 typname = "_regclass",

1100 typelem = regclass

1602 typelem = regclass

1101 }

1603 }

1102

1604

1605+array_regclassOid :: Oid

1606+array_regclassOid = Oid 2210

1607+{-# INLINE array_regclassOid #-}

1608+

1103array_regtype :: TypeInfo

1609array_regtype :: TypeInfo

1104array_regtype = Array {

1610array_regtype = Array {

1105− typoid = Oid 2211,

1611+ typoid = array_regtypeOid,

1106 typcategory = 'A',

1612 typcategory = 'A',

1107 typdelim = ',',

1613 typdelim = ',',

1108 typname = "_regtype",

1614 typname = "_regtype",

1109 typelem = regtype

1615 typelem = regtype

1110 }

1616 }

1111

1617

1618+array_regtypeOid :: Oid

1619+array_regtypeOid = Oid 2211

1620+{-# INLINE array_regtypeOid #-}

1621+

1112array_uuid :: TypeInfo

1622array_uuid :: TypeInfo

1113array_uuid = Array {

1623array_uuid = Array {

1114− typoid = Oid 2951,

1624+ typoid = array_uuidOid,

1115 typcategory = 'A',

1625 typcategory = 'A',

1116 typdelim = ',',

1626 typdelim = ',',

1117 typname = "_uuid",

1627 typname = "_uuid",

1118 typelem = uuid

1628 typelem = uuid

1119 }

1629 }

1120

1630

1631+array_uuidOid :: Oid

1632+array_uuidOid = Oid 2951

1633+{-# INLINE array_uuidOid #-}

1634+

1121array_jsonb :: TypeInfo

1635array_jsonb :: TypeInfo

1122array_jsonb = Array {

1636array_jsonb = Array {

1123− typoid = Oid 3807,

1637+ typoid = array_jsonbOid,

1124 typcategory = 'A',

1638 typcategory = 'A',

1125 typdelim = ',',

1639 typdelim = ',',

1126 typname = "_jsonb",

1640 typname = "_jsonb",

1127 typelem = jsonb

1641 typelem = jsonb

1128 }

1642 }

1129

1643

1644+array_jsonbOid :: Oid

1645+array_jsonbOid = Oid 3807

1646+{-# INLINE array_jsonbOid #-}

1647+

1130int4range :: TypeInfo

1648int4range :: TypeInfo

1131int4range = Range {

1649int4range = Range {

1132− typoid = Oid 3904,

1650+ typoid = int4rangeOid,

1133 typcategory = 'R',

1651 typcategory = 'R',

1134 typdelim = ',',

1652 typdelim = ',',

1135 typname = "int4range",

1653 typname = "int4range",

1136 rngsubtype = int4

1654 rngsubtype = int4

1137 }

1655 }

1138

1656

1657+int4rangeOid :: Oid

1658+int4rangeOid = Oid 3904

1659+{-# INLINE int4rangeOid #-}

1660+

1139_int4range :: TypeInfo

1661_int4range :: TypeInfo

1140_int4range = Array {

1662_int4range = Array {

1141− typoid = Oid 3905,

1663+ typoid = _int4rangeOid,

1142 typcategory = 'A',

1664 typcategory = 'A',

1143 typdelim = ',',

1665 typdelim = ',',

1144 typname = "_int4range",

1666 typname = "_int4range",

1145 typelem = int4range

1667 typelem = int4range

1146 }

1668 }

1147

1669

1670+_int4rangeOid :: Oid

1671+_int4rangeOid = Oid 3905

1672+{-# INLINE _int4rangeOid #-}

1673+

1148numrange :: TypeInfo

1674numrange :: TypeInfo

1149numrange = Range {

1675numrange = Range {

1150− typoid = Oid 3906,

1676+ typoid = numrangeOid,

1151 typcategory = 'R',

1677 typcategory = 'R',

1152 typdelim = ',',

1678 typdelim = ',',

1153 typname = "numrange",

1679 typname = "numrange",

1154 rngsubtype = numeric

1680 rngsubtype = numeric

1155 }

1681 }

1156

1682

1683+numrangeOid :: Oid

1684+numrangeOid = Oid 3906

1685+{-# INLINE numrangeOid #-}

1686+

1157_numrange :: TypeInfo

1687_numrange :: TypeInfo

1158_numrange = Array {

1688_numrange = Array {

1159− typoid = Oid 3907,

1689+ typoid = _numrangeOid,

1160 typcategory = 'A',

1690 typcategory = 'A',

1161 typdelim = ',',

1691 typdelim = ',',

1162 typname = "_numrange",

1692 typname = "_numrange",

1163 typelem = numrange

1693 typelem = numrange

1164 }

1694 }

1165

1695

1696+_numrangeOid :: Oid

1697+_numrangeOid = Oid 3907

1698+{-# INLINE _numrangeOid #-}

1699+

1166tsrange :: TypeInfo

1700tsrange :: TypeInfo

1167tsrange = Range {

1701tsrange = Range {

1168− typoid = Oid 3908,

1702+ typoid = tsrangeOid,

1169 typcategory = 'R',

1703 typcategory = 'R',

1170 typdelim = ',',

1704 typdelim = ',',

1171 typname = "tsrange",

1705 typname = "tsrange",

1172 rngsubtype = timestamp

1706 rngsubtype = timestamp

1173 }

1707 }

1174

1708

1709+tsrangeOid :: Oid

1710+tsrangeOid = Oid 3908

1711+{-# INLINE tsrangeOid #-}

1712+

1175_tsrange :: TypeInfo

1713_tsrange :: TypeInfo

1176_tsrange = Array {

1714_tsrange = Array {

1177− typoid = Oid 3909,

1715+ typoid = _tsrangeOid,

1178 typcategory = 'A',

1716 typcategory = 'A',

1179 typdelim = ',',

1717 typdelim = ',',

1180 typname = "_tsrange",

1718 typname = "_tsrange",

1181 typelem = tsrange

1719 typelem = tsrange

1182 }

1720 }

1183

1721

1722+_tsrangeOid :: Oid

1723+_tsrangeOid = Oid 3909

1724+{-# INLINE _tsrangeOid #-}

1725+

1184tstzrange :: TypeInfo

1726tstzrange :: TypeInfo

1185tstzrange = Range {

1727tstzrange = Range {

1186− typoid = Oid 3910,

1728+ typoid = tstzrangeOid,

1187 typcategory = 'R',

1729 typcategory = 'R',

1188 typdelim = ',',

1730 typdelim = ',',

1189 typname = "tstzrange",

1731 typname = "tstzrange",

1190 rngsubtype = timestamptz

1732 rngsubtype = timestamptz

1191 }

1733 }

1192

1734

1735+tstzrangeOid :: Oid

1736+tstzrangeOid = Oid 3910

1737+{-# INLINE tstzrangeOid #-}

1738+

1193_tstzrange :: TypeInfo

1739_tstzrange :: TypeInfo

1194_tstzrange = Array {

1740_tstzrange = Array {

1195− typoid = Oid 3911,

1741+ typoid = _tstzrangeOid,

1196 typcategory = 'A',

1742 typcategory = 'A',

1197 typdelim = ',',

1743 typdelim = ',',

1198 typname = "_tstzrange",

1744 typname = "_tstzrange",

1199 typelem = tstzrange

1745 typelem = tstzrange

1200 }

1746 }

1201

1747

1748+_tstzrangeOid :: Oid

1749+_tstzrangeOid = Oid 3911

1750+{-# INLINE _tstzrangeOid #-}

1751+

1202daterange :: TypeInfo

1752daterange :: TypeInfo

1203daterange = Range {

1753daterange = Range {

1204− typoid = Oid 3912,

1754+ typoid = daterangeOid,

1205 typcategory = 'R',

1755 typcategory = 'R',

1206 typdelim = ',',

1756 typdelim = ',',

1207 typname = "daterange",

1757 typname = "daterange",

1208 rngsubtype = date

1758 rngsubtype = date

1209 }

1759 }

1210

1760

1761+daterangeOid :: Oid

1762+daterangeOid = Oid 3912

1763+{-# INLINE daterangeOid #-}

1764+

1211_daterange :: TypeInfo

1765_daterange :: TypeInfo

1212_daterange = Array {

1766_daterange = Array {

1213− typoid = Oid 3913,

1767+ typoid = _daterangeOid,

1214 typcategory = 'A',

1768 typcategory = 'A',

1215 typdelim = ',',

1769 typdelim = ',',

1216 typname = "_daterange",

1770 typname = "_daterange",

1217 typelem = daterange

1771 typelem = daterange

1218 }

1772 }

1219

1773

1774+_daterangeOid :: Oid

1775+_daterangeOid = Oid 3913

1776+{-# INLINE _daterangeOid #-}

1777+

1220int8range :: TypeInfo

1778int8range :: TypeInfo

1221int8range = Range {

1779int8range = Range {

1222− typoid = Oid 3926,

1780+ typoid = int8rangeOid,

1223 typcategory = 'R',

1781 typcategory = 'R',

1224 typdelim = ',',

1782 typdelim = ',',

1225 typname = "int8range",

1783 typname = "int8range",

1226 rngsubtype = int8

1784 rngsubtype = int8

1227 }

1785 }

1228

1786

1787+int8rangeOid :: Oid

1788+int8rangeOid = Oid 3926

1789+{-# INLINE int8rangeOid #-}

1790+

1229_int8range :: TypeInfo

1791_int8range :: TypeInfo

1230_int8range = Array {

1792_int8range = Array {

1231− typoid = Oid 3927,

1793+ typoid = _int8rangeOid,

1232 typcategory = 'A',

1794 typcategory = 'A',

1233 typdelim = ',',

1795 typdelim = ',',

1234 typname = "_int8range",

1796 typname = "_int8range",

1235 typelem = int8range

1797 typelem = int8range

1236 }

1798 }

1237

1799

1238−citext :: TypeInfo

1800+_int8rangeOid :: Oid

1239−citext = Basic {

1801+_int8rangeOid = Oid 3927

1240− typoid = Oid 60129,

1802+{-# INLINE _int8rangeOid #-}

1241− typcategory = 'S',

1242− typdelim = ',',

1243− typname = "citext"

1244− }

1245−

1246−array_citext :: TypeInfo

1247−array_citext = Array {

1248− typoid = Oid 60134,

1249− typcategory = 'A',

1250− typdelim = ',',

1251− typname = "_citext",

1252− typelem = citext

1253− }

src/Database/PostgreSQL/Simple/Types.hs−7

@@ -50,10 +50,6 @@ import Database.PostgreSQL.Simple.Compat (toByteString)

50data Null = Null

51 deriving (Read, Show, Typeable)

53−instance Eq Null where

54− _ == _ = False

55− _ /= _ = False

56−

57-- | A placeholder for the PostgreSQL @DEFAULT@ value.

53-- | A placeholder for the PostgreSQL @DEFAULT@ value.

58data Default = Default

54data Default = Default

59 deriving (Read, Show, Typeable)

55 deriving (Read, Show, Typeable)

@@ -97,9 +93,6 @@ instance Semigroup Query where

98instance Monoid Query where

94instance Monoid Query where

99 mempty = Query B.empty

95 mempty = Query B.empty

100−#if !(MIN_VERSION_base(4,11,0))

101− mappend = (<>)

102−#endif

103

104-- | Wrap a list of values for use in an @IN@ clause. Replaces a

97-- | Wrap a list of values for use in an @IN@ clause. Replaces a

105-- single \"@?@\" character with a parenthesized list of rendered

98-- single \"@?@\" character with a parenthesized list of rendered

src/Database/PostgreSQL/Simple/Vector.hsnew file+45

@@ -0,0 +1,45 @@

1+-- | 'query' variants returning 'V.Vector'.

2+module Database.PostgreSQL.Simple.Vector where

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.hsnew file+44

@@ -0,0 +1,44 @@

1+module Database.PostgreSQL.Simple.Vector.Unboxed where

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 (..) )

10+import qualified Data.Vector.Unboxed as VU

11+

12+-- | Perform a @SELECT@ or other SQL query that is expected to return

13+-- results. All results are retrieved and converted before this

14+-- function returns.

15+query :: (ToRow q, FromRow r, VU.Unbox r) => Connection -> Query -> q -> IO (VU.Vector r)

16+query = queryWith fromRow

17+

18+-- | A version of 'query' that does not perform query substitution.

19+query_ :: (FromRow r, VU.Unbox r) => Connection -> Query -> IO (VU.Vector r)

20+query_ = queryWith_ fromRow

21+

22+-- | A version of 'query' taking parser as argument

23+queryWith :: (ToRow q, VU.Unbox r) => RowParser r -> Connection -> Query -> q -> IO (VU.Vector r)

24+queryWith parser conn template qs = do

25+ result <- exec conn =<< formatQuery conn template qs

26+ finishQueryWithVU parser conn template result

27+

28+-- | A version of 'query_' taking parser as argument

29+queryWith_ :: VU.Unbox r => RowParser r -> Connection -> Query -> IO (VU.Vector r)

30+queryWith_ parser conn q@(Query que) = do

31+ result <- exec conn que

32+ finishQueryWithVU parser conn q result

33+

34+-- | Execute @INSERT ... RETURNING@, @UPDATE ... RETURNING@, or other SQL

35+-- query that accepts multi-row input and is expected to return results.

36+returning :: (ToRow q, FromRow r, VU.Unbox r) => Connection -> Query -> [q] -> IO (VU.Vector r)

37+returning = returningWith fromRow

38+

39+-- | A version of 'returning' taking parser as argument

40+returningWith :: (ToRow q, VU.Unbox r) => RowParser r -> Connection -> Query -> [q] -> IO (VU.Vector r)

41+returningWith _ _ _ [] = return VU.empty

42+returningWith parser conn q qs = do

43+ result <- exec conn =<< formatMany conn q qs

44+ finishQueryWithVU parser conn q result

test/Exception.hsnew file+70

@@ -0,0 +1,70 @@

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE OverloadedStrings #-}

3+{-# LANGUAGE ScopedTypeVariables #-}

5+module Exception (testExceptions) where

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.hsnew file+79

@@ -0,0 +1,79 @@

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

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.hsnew file+176

@@ -0,0 +1,176 @@

1+{-# LANGUAGE QuasiQuotes #-}

3+{-

5+Testing strategies:

7+fromString . toString == id ** Todo?

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+179−32

@@ -3,25 +3,39 @@

3{-# LANGUAGE DeriveDataTypeable #-}

4{-# LANGUAGE DoAndIfThenElse #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6+#if __GLASGOW_HASKELL__ >= 806

7+{-# LANGUAGE DerivingStrategies #-}

8+{-# LANGUAGE DerivingVia #-}

9+{-# LANGUAGE DeriveAnyClass #-}

10+#endif

11+module Main (main) where

12+

6import Common

13import Common

14+import Database.PostgreSQL.Simple.Copy

15+import Database.PostgreSQL.Simple.ToField (ToField)

7import Database.PostgreSQL.Simple.FromField (FromField)

16import Database.PostgreSQL.Simple.FromField (FromField)

8−import Database.PostgreSQL.Simple.Types(Query(..),Values(..))

9import Database.PostgreSQL.Simple.HStore

17import Database.PostgreSQL.Simple.HStore

10−import Database.PostgreSQL.Simple.Copy

18+import Database.PostgreSQL.Simple.Newtypes

19+import Database.PostgreSQL.Simple.Internal (breakOnSingleQuestionMark)

20+import Database.PostgreSQL.Simple.Types(Query(..),Values(..), PGArray(..))

11import qualified Database.PostgreSQL.Simple.Transaction as ST

21import qualified Database.PostgreSQL.Simple.Transaction as ST

13import Control.Applicative

23import Control.Applicative

14import Control.Exception as E

24import Control.Exception as E

15import Control.Monad

25import Control.Monad

16import Data.Char

26import Data.Char

17−import Data.List (sort)

27+import Data.Foldable (toList)

28+import Data.List (concat, sort)

18import Data.IORef

29import Data.IORef

30+import Data.Monoid ((<>))

31+import Data.String (fromString)

19import Data.Typeable

32import Data.Typeable

20import GHC.Generics (Generic)

33import GHC.Generics (Generic)

22import Data.Aeson

35import Data.Aeson

23import Data.ByteString (ByteString)

36import Data.ByteString (ByteString)

24import qualified Data.ByteString as B

37import qualified Data.ByteString as B

38+import qualified Data.ByteString.Char8 as BS8

25import qualified Data.ByteString.Lazy.Char8 as BL

39import qualified Data.ByteString.Lazy.Char8 as BL

26import Data.CaseInsensitive (CI)

40import Data.CaseInsensitive (CI)

27import qualified Data.CaseInsensitive as CI

41import qualified Data.CaseInsensitive as CI

@@ -32,38 +46,46 @@ import qualified Data.Text.Encoding as T

32import qualified Data.Vector as V

46import qualified Data.Vector as V

33import System.FilePath

47import System.FilePath

34import System.Timeout(timeout)

48import System.Timeout(timeout)

35−import Data.Time(getCurrentTime, diffUTCTime)

49+import Data.Time.Compat (getCurrentTime, diffUTCTime)

50+import System.Environment (getEnvironment)

37import Test.Tasty

52import Test.Tasty

38import Test.Tasty.Golden

53import Test.Tasty.Golden

39import Notify

54import Notify

40import Serializable

55import Serializable

41import Time

56import Time

57+import Interval

58+import Exception (testExceptions)

43tests :: TestEnv -> TestTree

60tests :: TestEnv -> TestTree

44tests env = testGroup "tests"

61tests env = testGroup "tests"

45 $ map ($ env)

62 $ map ($ env)

46 [ testBytea

63 [ testBytea

47− , testCase "ExecuteMany" . testExecuteMany

64+ , testCase "ExecuteMany" . testExecuteMany

48− , testCase "Fold" . testFold

65+ , testCase "Fold" . testFold

49− , testCase "Notify" . testNotify

66+ , testCase "Notify" . testNotify

50− , testCase "Serializable" . testSerializable

67+ , testCase "Serializable" . testSerializable

51− , testCase "Time" . testTime

68+ , testCase "Time" . testTime

69+ , testCase "Interval" . testInterval

52− , testCase "Array" . testArray

70+ , testCase "Array" . testArray

53− , testCase "Array of nullables" . testNullableArray

71+ , testCase "Array of nullables" . testNullableArray

54− , testCase "HStore" . testHStore

72+ , testCase "HStore" . testHStore

55− , testCase "citext" . testCIText

73+ , testCase "citext" . testCIText

56− , testCase "JSON" . testJSON

74+ , testCase "JSON" . testJSON

75+ , testCase "Aeson newtype" . testAeson

76+ , testCase "DerivingVia" . testDerivingVia

77+ , testCase "Question mark escape" . testQM

57− , testCase "Savepoint" . testSavepoint

78+ , testCase "Savepoint" . testSavepoint

58− , testCase "Unicode" . testUnicode

79+ , testCase "Unicode" . testUnicode

59− , testCase "Values" . testValues

80+ , testCase "Values" . testValues

60− , testCase "Copy" . testCopy

81+ , testCase "Copy" . testCopy

61 , testCopyFailures

82 , testCopyFailures

62− , testCase "Double" . testDouble

83+ , testCase "Double" . testDouble

63− , testCase "1-ary generic" . testGeneric1

84+ , testCase "1-ary generic" . testGeneric1

64− , testCase "2-ary generic" . testGeneric2

85+ , testCase "2-ary generic" . testGeneric2

65− , testCase "3-ary generic" . testGeneric3

86+ , testCase "3-ary generic" . testGeneric3

66− , testCase "Timeout" . testTimeout

87+ , testCase "Timeout" . testTimeout

88+ , testCase "Exceptions" . testExceptions

67 ]

89 ]

69testBytea :: TestEnv -> TestTree

91testBytea :: TestEnv -> TestTree

@@ -117,7 +139,7 @@ testFold TestEnv{..} = do

117 xs <- readIORef ref

139 xs <- readIORef ref

118 writeIORef ref $! (a,b):xs

140 writeIORef ref $! (a,b):xs

119 xs <- readIORef ref

141 xs <- readIORef ref

120− reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]

142+ reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]

121

143

122 -- Make sure fold propagates our exception.

144 -- Make sure fold propagates our exception.

123 ref <- newIORef []

145 ref <- newIORef []

@@ -234,6 +256,90 @@ testJSON TestEnv{..} = do

234 js' <- query conn "SELECT ?::json" js

256 js' <- query conn "SELECT ?::json" js

235 [js] @?= js'

257 [js] @?= js'

236

258

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+

237testSavepoint :: TestEnv -> Assertion

343testSavepoint :: TestEnv -> Assertion

238testSavepoint TestEnv{..} = do

344testSavepoint TestEnv{..} = do

239 True <- expectError ST.isNoActiveTransactionError $

345 True <- expectError ST.isNoActiveTransactionError $

@@ -341,6 +447,14 @@ testCopy TestEnv{..} = do

341 -- so that we can issue more queries:

447 -- so that we can issue more queries:

342 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"

448 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"

343 x @?= 4

449 x @?= 4

450+ -- foldCopyData

451+ copy_ conn "COPY copy_test TO STDOUT (FORMAT CSV)"

452+ (acc, count) <- foldCopyData conn

453+ (\acc row -> return (row:acc))

454+ (\acc count -> return (acc, count))

455+ []

456+ sort acc @?= sort copyRows

457+ count @?= 2

344 where

458 where

345 copyRows = ["1,foo\n"

459 copyRows = ["1,foo\n"

346 ,"2,bar\n"]

460 ,"2,bar\n"]

@@ -360,12 +474,13 @@ testCopyFailures env = testGroup "Copy failures"

360

474

361goldenTest :: TestName -> IO BL.ByteString -> TestTree

475goldenTest :: TestName -> IO BL.ByteString -> TestTree

362goldenTest testName =

476goldenTest testName =

363− goldenVsString testName (resultsDir </> fileName<.>"expected")

477+ goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")

364 where

478 where

365 resultsDir = "test" </> "results"

479 resultsDir = "test" </> "results"

366 fileName = map normalize testName

480 fileName = map normalize testName

367 normalize c | not (isAlpha c) = '-'

481 normalize c | not (isAlpha c) = '-'

368 | otherwise = c

482 | otherwise = c

483+ diff ref new = ["diff", "-u", ref, new]

369

484

370-- | Test that we provide a sensible error message on failure

485-- | Test that we provide a sensible error message on failure

371testCopyUniqueConstraintError :: TestEnv -> TestTree

486testCopyUniqueConstraintError :: TestEnv -> TestTree

@@ -478,24 +593,56 @@ isUniqueViolation SqlError{..} = sqlState == "23505"

478isSyntaxError :: SqlError -> Bool

593isSyntaxError :: SqlError -> Bool

479isSyntaxError SqlError{..} = sqlState == "42601"

594isSyntaxError SqlError{..} = sqlState == "42601"

480

595

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+ ]

481------------------------------------------------------------------------

604------------------------------------------------------------------------

482

605

483-- | Action for connecting to the database that will be used for testing.

606-- | Action for connecting to the database that will be used for testing.

484--

607--

485-- Note that some tests, such as Notify, use multiple connections, and assume

608-- Note that some tests, such as Notify, use multiple connections, and assume

486-- that 'testConnect' connects to the same database every time it is called.

609-- that 'testConnect' connects to the same database every time it is called.

487−testConnect :: IO Connection

610+withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a

488−testConnect = connectPostgreSQL ""

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'"

489

616

490−withTestEnv :: (TestEnv -> IO a) -> IO a

491−withTestEnv cb =

492− withConn $ \conn ->

493 cb TestEnv

617 cb TestEnv

494 { conn = conn

618 { conn = conn

495 , withConn = withConn

619 , withConn = withConn

496 }

620 }

497 where

621 where

498− withConn = bracket testConnect close

622+ withConn = bracket (connectPostgreSQL connstr) close

499

623

500main :: IO ()

624main :: IO ()

625+main = withConnstring $ \connstring -> do

501−main = withTestEnv $ defaultMain . tests

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+ ]

test/Time.hs+1−1

@@ -36,7 +36,7 @@ module Time (testTime) where

37import Common

38import Control.Monad(forM_, replicateM_)

39−import Data.Time

39+import Data.Time.Compat

40import Data.ByteString(ByteString)

41import Database.PostgreSQL.Simple.SqlQQ

test/results/malformed-input.expected+1−1

@@ -1,4 +1,4 @@

1user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2−Connection error: ERROR: invalid input syntax for integer: "z"

2+Connection error: ERROR: invalid input syntax for type integer: "z"

3CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"

tools/GenTypeInfo.hs+40−28

@@ -21,6 +21,9 @@

21-- know about. It then constructs a TypeInfo record and stores it in

22-- a per-connection cache for later use.

23--

24+-- @

25+-- runghc -itools tools/GenTypeInfo.hs

26+-- @

24------------------------------------------------------------------------------

27------------------------------------------------------------------------------

26{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}

29{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}

@@ -38,12 +41,10 @@ import Database.PostgreSQL.Simple.FromRow

38import Database.PostgreSQL.Simple.Ok

41import Database.PostgreSQL.Simple.Ok

39import Database.PostgreSQL.Simple.Types(Oid(..))

42import Database.PostgreSQL.Simple.Types(Oid(..))

40import Database.PostgreSQL.Simple.SqlQQ

43import Database.PostgreSQL.Simple.SqlQQ

41−import qualified Data.ByteString.Char8 as B

44+import qualified Data.ByteString.Char8 as B8

42import Data.ByteString(ByteString)

45import Data.ByteString(ByteString)

43import qualified Data.ByteString.Lazy as L

46import qualified Data.ByteString.Lazy as L

44−import qualified Blaze.ByteString.Builder as Blaze

47+import qualified Data.ByteString.Builder as Blaze

45−import qualified Blaze.ByteString.Builder.ByteString as Blaze

46−import qualified Blaze.ByteString.Builder.Char8 as Blaze

47import Data.String

48import Data.String

48import Data.List ( sort, intersperse )

49import Data.List ( sort, intersperse )

49import qualified Data.Map as Map

50import qualified Data.Map as Map

@@ -69,11 +70,11 @@ data TypeInfo = TypeInfo

69instance FromRow TypeInfo where

70instance FromRow TypeInfo where

70 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

71 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

72−type NameMap = Map.Map B.ByteString TypeInfo

73+type NameMap = Map.Map B8.ByteString TypeInfo

74type OidMap = Map.Map Oid TypeInfo

75type OidMap = Map.Map Oid TypeInfo

76−type TypeName = (B.ByteString, B.ByteString)

77+type TypeName = (B8.ByteString, B8.ByteString)

78type TypeNames = [TypeName]

79type TypeNames = [TypeName]

@@ -195,12 +196,7 @@ daterange

195_daterange

196_daterange

196int8range

197int8range

197_int8range

198_int8range

198−citext

199+|]

199−_citext array_citext

200−|] -- Note: You must enable the citext extension (CREATE EXTENSION IF NOT EXISTS citext) to generate the citext values

201−

202−instance IsString Blaze.Builder where

203− fromString = Blaze.fromByteString . fromString

204

200

205connectionString = "dbname=postgres"

201connectionString = "dbname=postgres"

206

202

@@ -239,7 +235,7 @@ getTypeInfos typnames = withPostgreSQL $ \conn -> do

239

235

240main = do

236main = do

241 (oidmap, namemap) <- getTypeInfos typeNames

237 (oidmap, namemap) <- getTypeInfos typeNames

242− L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

238+ L.writeFile "src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

243 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))

239 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))

244

240

245

241

@@ -248,7 +244,7 @@ showOid (Oid n) = show n

248renderOid :: NameMap -> TypeName -> Blaze.Builder

244renderOid :: NameMap -> TypeName -> Blaze.Builder

249renderOid byName name

245renderOid byName name

250 = case Map.lookup (pg name) byName of

246 = case Map.lookup (pg name) byName of

251− Nothing -> error (B.unpack (pg name))

247+ Nothing -> error (B8.unpack (pg name))

252 Just (showOid . typoid -> n) -> fromString n

248 Just (showOid . typoid -> n) -> fromString n

253 ++ fromString (replicate (4 - length n) ' ')

249 ++ fromString (replicate (4 - length n) ' ')

254

250

@@ -266,20 +262,25 @@ renderTypeInfo byOid info name

266 typelem_hs_name =

262 typelem_hs_name =

267 case lookup (typname typelem_info) typeNames of

263 case lookup (typname typelem_info) typeNames of

268 Nothing -> error ( "type not found: "

264 Nothing -> error ( "type not found: "

269− ++ B.unpack( typname typelem_info)

265+ ++ B8.unpack( typname typelem_info)

270− ++ " (typelem of " ++ B.unpack (typname info)

266+ ++ " (typelem of " ++ B8.unpack (typname info)

271 ++ ")")

267 ++ ")")

272 Just x -> x

268 Just x -> x

273 in concat

269 in concat

274 [ "\n"

270 [ "\n"

275 , bs (hs name), " :: TypeInfo\n"

271 , bs (hs name), " :: TypeInfo\n"

276 , bs (hs name), " = Array {\n"

272 , bs (hs name), " = Array {\n"

277− , " typoid = ", fromString (show (typoid info)), ",\n"

273+ , " typoid = ", bs (hs name), "Oid,\n"

278− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

274+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

279− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

275+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

280 , " typname = \"", bs (typname info), "\",\n"

276 , " typname = \"", bs (typname info), "\",\n"

281 , " typelem = ", bs typelem_hs_name, "\n"

277 , " typelem = ", bs typelem_hs_name, "\n"

282 , " }\n"

278 , " }\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"

283 ]

284 ]

284 | typcategory info == 'R' =

285 | typcategory info == 'R' =

285 let (Just rngsubtype_oid) = rngsubtype info

286 let (Just rngsubtype_oid) = rngsubtype info

@@ -287,31 +288,41 @@ renderTypeInfo byOid info name

287 rngsubtype_hs_name =

288 rngsubtype_hs_name =

288 case lookup (typname rngsubtype_info) typeNames of

289 case lookup (typname rngsubtype_info) typeNames of

289 Nothing -> error ( "type not found: "

290 Nothing -> error ( "type not found: "

290− ++ B.unpack (typname rngsubtype_info)

291+ ++ B8.unpack (typname rngsubtype_info)

291 ++ " (rngsubtype of "

292 ++ " (rngsubtype of "

292− ++ B.unpack (typname info) ++ ")")

293+ ++ B8.unpack (typname info) ++ ")")

293 Just x -> x

294 Just x -> x

294 in concat

295 in concat

295 [ "\n"

296 [ "\n"

296 , bs (hs name), " :: TypeInfo\n"

297 , bs (hs name), " :: TypeInfo\n"

297 , bs (hs name), " = Range {\n"

298 , bs (hs name), " = Range {\n"

298− , " typoid = ", fromString (show (typoid info)), ",\n"

299+ , " typoid = ", bs (hs name), "Oid,\n"

299− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

300+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

300− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

301+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

301 , " typname = \"", bs (typname info), "\",\n"

302 , " typname = \"", bs (typname info), "\",\n"

302 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

303 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

303 , " }\n"

304 , " }\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"

304 ]

310 ]

305 | otherwise =

311 | otherwise =

306 concat

312 concat

307 [ "\n"

313 [ "\n"

308 , bs (hs name), " :: TypeInfo\n"

314 , bs (hs name), " :: TypeInfo\n"

309 , bs (hs name), " = Basic {\n"

315 , bs (hs name), " = Basic {\n"

310− , " typoid = ", fromString (show (typoid info)), ",\n"

316+ , " typoid = ", bs (hs name), "Oid,\n"

311− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

317+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

312− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

318+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

313 , " typname = \"", bs (typname info), "\"\n"

319 , " typname = \"", bs (typname info), "\"\n"

314 , " }\n"

320 , " }\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"

315 ]

326 ]

316

327

317-- FIXME: add in any names that we need that we didn't specify, (i.e.

328-- FIXME: add in any names that we need that we didn't specify, (i.e.

@@ -320,7 +331,7 @@ renderTypeInfo byOid info name

320getNames :: NameMap -> TypeNames -> TypeNames

331getNames :: NameMap -> TypeNames -> TypeNames

321getNames _ x = x

332getNames _ x = x

322

333

323−bs = Blaze.fromByteString

334+bs = Blaze.byteString

324

335

325pg = fst

336pg = fst

326

337

@@ -349,6 +360,7 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

349 ( TypeInfo(..)

360 ( TypeInfo(..)

350 , staticTypeInfo

361 , staticTypeInfo

351|] ++ concat [ " , " ++ bs (hs name) ++ "\n"

362|] ++ concat [ " , " ++ bs (hs name) ++ "\n"

363+ ++ " , " ++ bs (hs name) ++ "Oid\n"

352 | name <- names ] ++ [longstring|

364 | name <- names ] ++ [longstring|

353 ) where

365 ) where

354

366