bd8a12b...master · typeable/postgresql-simple

git.iko.soy/typeable/postgresql-simple

49 files changed+2531−673

since splitsnapshots

unifiedsplit

.ghcideleted−16

@@ -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/

1111.cabal-sandbox/

1212.stack-work/

1313cabal.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+141−5

@@ -1,3 +1,139 @@

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)

52+

53+ * Define `MonadFail Ok`.

54+

55+### Version 0.6.1 (2019-03-04)

56+

57+ * Escape double '??' to a literal '?

58+ Thanks to Felix Paulusma for the implementation.

59+ https://github.com/phadej/postgresql-simple/pull/5

60+

61+ * Mention GHC Generics support in the documentation.

62+ Thanks to Gabriel Gonzalez for the implementation.

63+ https://github.com/phadej/postgresql-simple/pull/6

64+

65+ * Better error message for "Query resulted in a command response

66+ Thanks to Max Amanshauser for the implementation.

67+ https://github.com/phadej/postgresql-simple/pull/7

68+

69+ * fromJSONField: Include JSONPath on JSON parse errors

70+ Thanks to Simon Hengel for the implementation.

71+ https://github.com/phadej/postgresql-simple/pull/2

72+

73+ * No TH in implementation

74+ https://github.com/phadej/postgresql-simple/pull/4

75+

76+### Version 0.6 (2018-10-16)

77+

78+ * *Breaking change*: Use `Only` package's `Only` for a common 1-tuple.

79+

80+ Consider a downstream library depending already both on

81+ `Only` and `postgresql-simple` package. This library my define

82+ a `MyClass` with instances for `Only.Only` and `PostgreSQL.Only`.

83+ As now these types are the same, a library would break.

84+ Therefore I consider "merging" types a breaking change.

85+

86+ There are two ways for adopting this change in that scenario:

87+

88+ - Either CPP-guard `PostgreSQL.Only` instance with

89+

90+ ```haskell

91+ #if !MIN_VERSION_postgresql_simple(0,6,0)

92+ instance MyClass (PostgreSQL.Only a) where ...

93+ #endif

94+ ```

95+

96+ - or simply remove it and add `postgresql-simple >=0.6` lower bound,

97+ making sure that there's only single `Only`.

98+

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

100+ Thanks to Max Tagher for the implementation.

101+ https://github.com/lpsmith/postgresql-simple/pull/232

102+

103+ * Add support to CockroachDB.

104+ Thanks to Georte Steel.

105+ https://github.com/lpsmith/postgresql-simple/pull/245

106+

107+ * Add Generic ConnectInfo instance

108+ Thanks to Dmitry Dzhus.

109+ https://github.com/lpsmith/postgresql-simple/pull/235

110+

111+ * Add `fromFieldRange :: Typeable a => FieldParser a -> FieldParser (PGRange a)`

112+ https://github.com/lpsmith/postgresql-simple/pull/221

113+

114+ * Add `fromFieldJSONByteString :: FieldParser ByteString`

115+ https://github.com/lpsmith/postgresql-simple/pull/222/files

116+

117+ * Fix off-by-one error in year builder.

118+ Thanks to Nathan Ferris Hunter.

119+ https://github.com/lpsmith/postgresql-simple/pull/230

120+

121+ * Extend ToRow and FromRow to tuples of size 18

122+ Thanks to Bardur Arantsson.

123+ https://github.com/lpsmith/postgresql-simple/pull/229

124+

125+ * Add `Vector` and `Vector.Unboxed` `query` variants.

126+ These are more memory efficient

127+ (especially, if you anyway will convert to some vector)

128+ https://github.com/phadej/1

129+

130+ * Documentation improvements

131+ https://github.com/lpsmith/postgresql-simple/pull/227

132+ https://github.com/lpsmith/postgresql-simple/pull/236

133+

134+### Version 0.5.4.0 (2018-05-23)

135+ * Support GHC-8.4 (Semigroup/Monoid)

136+

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

2138 * Refactored some rudimentary cursor handling code out of the

3139 implementation of the fold operators, into a new

@@ -135,7 +271,7 @@

135271 support UTF8 except for Mule Internal Code, the Multilingual

136272 Extensions for Emacs. An exception should be raised upon

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

138− accomodate this requirement.

274+ accommodate this requirement.

139275

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

141277

@@ -255,7 +391,7 @@

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

256392

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

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

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

259395

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

261397 foldWithOptions, executeMany, and returning operators.

@@ -273,7 +409,7 @@

273409

274410 * Changed the Identifier and QualifiedIdentifier to use Text in

275411 order to avoid encoding errors. Technically this requires a

276− 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.

277413

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

279415 and tweaked error messages.

@@ -433,7 +569,7 @@

433569

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

435571 convenient and efficient access to the pg_type metatable. This

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

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

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

438574 work on this feature.

439575

@@ -525,7 +661,7 @@

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

526662

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

528− that accomodate PostgreSQL's infinities.

664+ that accommodate PostgreSQL's infinities.

529665

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

531667 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]

21[![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

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

74 [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 @@

11packages: .

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−123

@@ -1,135 +1,175 @@

1−Name: postgresql-simple

2−Version: 0.5.3.0

3−Synopsis: Mid-Level PostgreSQL client library

4−Description:

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

6−License: BSD3

7−License-file: LICENSE

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

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

12−Category: Database

13−Build-type: Simple

14−

15−Cabal-version: >= 1.9.2

16−

1+cabal-version: 1.12

2+name: postgresql-simple

3+version: 0.7.0.0

4+x-revision: 1

5+synopsis: Mid-Level PostgreSQL client library

6+description:

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

9+license: BSD3

10+license-file: LICENSE

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

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

13+copyright:

17+

18+category: Database

19+build-type: Simple

1720extra-source-files:

18− CONTRIBUTORS

19− CHANGELOG.md

20−

21−Library

22− hs-source-dirs: src

23− Exposed-modules:

24− Database.PostgreSQL.Simple

25− Database.PostgreSQL.Simple.Arrays

26− Database.PostgreSQL.Simple.Copy

27− Database.PostgreSQL.Simple.Cursor

28− Database.PostgreSQL.Simple.FromField

29− Database.PostgreSQL.Simple.FromRow

30− Database.PostgreSQL.Simple.LargeObjects

31− Database.PostgreSQL.Simple.HStore

32− Database.PostgreSQL.Simple.HStore.Internal

33− Database.PostgreSQL.Simple.Notification

34− Database.PostgreSQL.Simple.Ok

35− Database.PostgreSQL.Simple.Range

36− Database.PostgreSQL.Simple.SqlQQ

37− Database.PostgreSQL.Simple.Time

38− Database.PostgreSQL.Simple.Time.Internal

39− Database.PostgreSQL.Simple.ToField

40− Database.PostgreSQL.Simple.ToRow

41− Database.PostgreSQL.Simple.Transaction

42− Database.PostgreSQL.Simple.TypeInfo

43− Database.PostgreSQL.Simple.TypeInfo.Macro

44− Database.PostgreSQL.Simple.TypeInfo.Static

45− Database.PostgreSQL.Simple.Types

46− Database.PostgreSQL.Simple.Errors

47−-- Other-modules:

48− Database.PostgreSQL.Simple.Internal

49−

50− Other-modules:

51− Database.PostgreSQL.Simple.Compat

52− Database.PostgreSQL.Simple.HStore.Implementation

53− Database.PostgreSQL.Simple.Internal.PQResultUtils

54− Database.PostgreSQL.Simple.Time.Implementation

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

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

57− Database.PostgreSQL.Simple.TypeInfo.Types

58−

59− Build-depends:

60− aeson >= 0.6,

61− attoparsec >= 0.10.3,

62− base >= 4.6 && < 5,

63− bytestring >= 0.9,

64− bytestring-builder,

65− case-insensitive,

66− containers,

67− hashable,

68− Only,

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

70− template-haskell,

71− text >= 0.11.1,

72− time,

73− transformers,

74− uuid-types >= 1.0.0,

75− scientific,

76− semigroups,

77− vector

78−

79− if !impl(ghc >= 7.6)

80− Build-depends:

81− ghc-prim

82−

83− extensions: DoAndIfThenElse, OverloadedStrings, BangPatterns, ViewPatterns

84− TypeOperators

85−

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

21+ CHANGES.md

22+ CONTRIBUTORS

23+ test/results/malformed-input.expected

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

25+

26+tested-with:

27+ GHC ==8.6.5

28+ || ==8.8.4

29+ || ==8.10.7

30+ || ==9.0.2

31+ || ==9.2.8

32+ || ==9.4.8

33+ || ==9.6.3

34+ || ==9.8.1

35+

36+library

37+ default-language: Haskell2010

38+ hs-source-dirs: src

39+ exposed-modules:

40+ Database.PostgreSQL.Simple

41+ Database.PostgreSQL.Simple.Arrays

42+ Database.PostgreSQL.Simple.Copy

43+ Database.PostgreSQL.Simple.Cursor

44+ Database.PostgreSQL.Simple.Errors

45+ Database.PostgreSQL.Simple.FromField

46+ Database.PostgreSQL.Simple.FromRow

47+ Database.PostgreSQL.Simple.HStore

48+ Database.PostgreSQL.Simple.HStore.Internal

49+ Database.PostgreSQL.Simple.Internal

50+ Database.PostgreSQL.Simple.LargeObjects

51+ Database.PostgreSQL.Simple.Newtypes

52+ Database.PostgreSQL.Simple.Notification

53+ Database.PostgreSQL.Simple.Ok

54+ Database.PostgreSQL.Simple.Range

55+ Database.PostgreSQL.Simple.SqlQQ

56+ Database.PostgreSQL.Simple.Time

57+ Database.PostgreSQL.Simple.Time.Internal

58+ Database.PostgreSQL.Simple.ToField

59+ Database.PostgreSQL.Simple.ToRow

60+ Database.PostgreSQL.Simple.Transaction

61+ Database.PostgreSQL.Simple.TypeInfo

62+ Database.PostgreSQL.Simple.TypeInfo.Macro

63+ Database.PostgreSQL.Simple.TypeInfo.Static

64+ Database.PostgreSQL.Simple.Types

65+ Database.PostgreSQL.Simple.Vector

66+ Database.PostgreSQL.Simple.Vector.Unboxed

67+

68+ -- Other-modules:

69+ other-modules:

70+ Database.PostgreSQL.Simple.Compat

71+ Database.PostgreSQL.Simple.HStore.Implementation

72+ Database.PostgreSQL.Simple.Internal.PQResultUtils

73+ Database.PostgreSQL.Simple.Time.Implementation

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

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

76+ Database.PostgreSQL.Simple.TypeInfo.Types

77+

78+ -- GHC bundled libs

79+ build-depends:

80+ base >=4.12.0.0 && <4.20

81+ , bytestring >=0.10.8.2 && <0.13

82+ , containers >=0.6.0.1 && <0.7

83+ , template-haskell >=2.14.0.0 && <2.22

84+ , text >=1.2.3.0 && <1.3 || >=2.0 && <2.2

85+ , time-compat >=1.9.5 && <1.12

86+ , transformers >=0.5.6.2 && <0.7

87+

88+ -- Other dependencies

89+ build-depends:

90+ aeson >=2.1.2.1 && <2.3

91+ , attoparsec >=0.14.4 && <0.15

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

93+ , hashable >=1.4.3.0 && <1.5

94+ , Only >=0.1 && <0.1.1

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

96+ , scientific >=0.3.7.0 && <0.4

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

98+ , vector >=0.13.0.0 && <0.14

99+

100+ default-extensions:

101+ BangPatterns

102+ DoAndIfThenElse

103+ OverloadedStrings

104+ TypeOperators

105+ ViewPatterns

106+

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

87108

88109source-repository head

89110 type: git

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

91−

92−source-repository this

93− type: git

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

95− tag: v0.5.3.0

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

112+

113+test-suite inspection

114+ default-language: Haskell2010

115+ type: exitcode-stdio-1.0

116+ hs-source-dirs: test

117+ main-is: Inspection.hs

118+ build-depends:

119+ base

120+ , inspection-testing >=0.4.1.1 && <0.6

121+ , postgresql-libpq

122+ , postgresql-simple

123+ , tasty

124+ , tasty-hunit

96125

97126test-suite test

98− type: exitcode-stdio-1.0

99−

100− hs-source-dirs: test

101− main-is: Main.hs

127+ default-language: Haskell2010

128+ type: exitcode-stdio-1.0

129+ hs-source-dirs: test

130+ main-is: Main.hs

102131 other-modules:

103132 Common

133+ Exception

134+ Interval

104135 Notify

105136 Serializable

106137 Time

107138

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

109−

110− extensions: NamedFieldPuns

111− , OverloadedStrings

112− , Rank2Types

113− , RecordWildCards

114− , PatternGuards

115− , ScopedTypeVariables

116−

117− build-depends: base

118− , aeson

119− , base16-bytestring

120− , bytestring

121− , containers

122− , cryptohash

123− , filepath

124− , tasty

125− , tasty-hunit

126− , tasty-golden

127− , HUnit

128− , postgresql-simple

129− , text

130− , time

131− , vector

132−

133− if !impl(ghc >= 7.6)

134− build-depends:

135− ghc-prim

139+ ghc-options: -threaded

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

141+ default-extensions:

142+ NamedFieldPuns

143+ OverloadedStrings

144+ PatternGuards

145+ Rank2Types

146+ RecordWildCards

147+ ScopedTypeVariables

148+

149+ build-depends:

150+ aeson

151+ , base

152+ , base16-bytestring

153+ , bytestring

154+ , case-insensitive

155+ , containers

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

157+ , filepath

158+ , HUnit

159+ , postgresql-simple

160+ , tasty

161+ , tasty-golden

162+ , tasty-hunit

163+ , text

164+ , time-compat

165+ , vector

166+

167+benchmark select

168+ default-language: Haskell2010

169+ type: exitcode-stdio-1.0

170+ hs-source-dirs: bench

171+ main-is: Select.hs

172+ build-depends:

173+ base

174+ , postgresql-simple

175+ , vector

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

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

6464 , Only(..)

6565 , (:.)(..)

6666 -- ** Exceptions

67+ , SomePostgreSqlException(..)

6768 , SqlError(..)

6869 , PQ.ExecStatus(..)

6970 , FormatError(..)

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

7374 , Base.connectPostgreSQL

7475 , Base.close

7576 , Base.connect

77+ , Base.withConnect

7678 , Base.ConnectInfo(..)

7779 , Base.defaultConnectInfo

7880 , Base.postgreSQLConnectionString

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

276278 skipSpace = B.dropWhile isSpace_ascii

277279

278280

279−

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

281282buildQuery conn q template xs =

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

283284 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

285288 in byteString h

286289 : if B.null t

287290 then []

288291 else split (B.tail t)

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

290293 zipParams [t] [] = t

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

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

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

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

293296 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

294306

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

296308-- expected to return results.

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

328340-- @

329341-- executeMany c [sql|

330342-- UPDATE sometable

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

343+-- SET y = upd.y

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

333345-- WHERE sometable.x = upd.x

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

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

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

356368returning = returningWith fromRow

357369

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

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

359372returningWith _ _ _ [] = return []

360373returningWith parser conn q qs = do

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

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

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

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

524537

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

526539foldWithOptionsAndParser_ :: FoldOptions

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

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

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

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

534547

535548doFold :: FoldOptions

536549 -> RowParser row

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

566579 go = bracket declare closeCursor $ \cursor ->

567580 let loop a = fetch cursor a >>=

568581 \r -> case r of

569− Left a -> return a

570− Right a -> loop a

582+ Left x -> return x

583+ Right x -> loop x

571584 in loop a0

572585

573586-- FIXME: choose the Automatic chunkSize more intelligently

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

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

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

891904-- 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.

893906--

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

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

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

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

4242quoted :: Parser ByteString

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

4444 where

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

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

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

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

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

4848

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

5050-- not containing the delimiter character.

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

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

1212 ) where

1313

1414import qualified Control.Exception as E

15−import Data.Monoid

1615import Data.ByteString (ByteString)

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

1816import Data.ByteString.Lazy (toStrict)

19−#else

20−import qualified Data.ByteString as B

21−import Data.ByteString.Lazy (toChunks)

22−#endif

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

24−

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

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

27−#else

28−import Data.Scientific (scientificBuilder)

29−#endif

30−

31−#if __GLASGOW_HASKELL__ >= 702

3219import System.IO.Unsafe (unsafeDupablePerformIO)

33−#elif __GLASGOW_HASKELL__ >= 611

34−import GHC.IO (unsafeDupablePerformIO)

35−#else

36−import GHC.IOBase (unsafeDupablePerformIO)

37−#endif

38−

3920import Data.Fixed (Pico)

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

4121import Data.Fixed (Fixed(MkFixed))

42−#else

43−import Unsafe.Coerce (unsafeCoerce)

44−#endif

4522

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

4724--

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

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

5229-- don't need that polymorphism.

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

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

5531mask 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

6132{-# INLINE mask #-}

6233

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−

7134toByteString :: Builder -> ByteString

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

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

7936

8037toPico :: Integer -> Pico

8138toPico = MkFixed

8239

8340fromPico :: Pico -> Integer

8441fromPico (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

3232 ( copy

3333 , copy_

3434 , CopyOutResult(..)

35+ , foldCopyData

3536 , getCopyData

3637 , putCopyData

3738 , putCopyEnd

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

4849import qualified Database.PostgreSQL.LibPQ as PQ

4950import Database.PostgreSQL.Simple

5051import Database.PostgreSQL.Simple.Types

51−import Database.PostgreSQL.Simple.Internal

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

5253

5354

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

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

5657-- @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.

5859

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

6061copy conn template qs = do

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

8586 PQ.TuplesOk -> err

8687 PQ.CopyOut -> return ()

8788 PQ.CopyIn -> return ()

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

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

90−#endif

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

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

93−#endif

9491 PQ.BadResponse -> throwResultError funcName result status

9592 PQ.NonfatalError -> throwResultError funcName result status

9693 PQ.FatalError -> throwResultError funcName result status

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

104101 deriving (Eq, Typeable, Show)

105102

106103

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+

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

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

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

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

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

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

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

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

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

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

3434import Database.PostgreSQL.Simple.Internal.PQResultUtils

3535import Database.PostgreSQL.Simple.Transaction

3636import qualified Database.PostgreSQL.LibPQ as PQ

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

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

9191foldM' f a lo hi = loop a lo

9292 where

93− loop a !n

94− | n > hi = return a

93+ loop x !n

94+ | n > hi = return x

9595 | otherwise = do

96− a' <- f a n

97− loop a' (n+1)

96+ x' <- f x n

97+ loop x' (n+1)

9898{-# INLINE foldM' #-}

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

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

2525 )

2626 where

2727

28−import Control.Applicative

2928import Control.Exception as E

3029

3130import Data.Attoparsec.ByteString.Char8

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

6059 deriving (Show, Eq, Ord, Typeable)

6160

6261-- Default instance should be enough

63−instance Exception ConstraintViolation

62+instance Exception ConstraintViolation where

63+ toException = postgresqlExceptionToException

64+ fromException = postgresqlExceptionFromException

6465

6566

6667-- | 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.

6869--

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

7071-- > where

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

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

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

22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

33{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}

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

4+{-# LANGUAGE RecordWildCards #-}

5+{-# LANGUAGE PolyKinds #-}

67{- |

78Module: Database.PostgreSQL.Simple.FromField

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

106107 , PQ.Oid(..)

107108 , PQ.Format(..)

108109 , pgArrayFieldParser

110+ , attoFieldParser

109111

110112 , optionalField

111113 , fromJSONField

114+ , fromFieldJSONByteString

112115 ) where

113116

114117#include "MachDeps.h"

115118

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

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

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

118−import Control.Exception (Exception)

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

119122import qualified Data.Aeson as JSON

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

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

122124import Data.ByteString (ByteString)

123125import qualified Data.ByteString.Char8 as B

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

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

125128import Data.IORef (IORef, newIORef)

126129import Data.Ratio (Ratio)

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

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

128131import Data.Typeable (Typeable, typeOf)

129132import Data.Vector (Vector)

130133import Data.Vector.Mutable (IOVector)

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

135138import Database.PostgreSQL.Simple.Types

136139import Database.PostgreSQL.Simple.TypeInfo as TI

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

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

139141import Database.PostgreSQL.Simple.Time

140142import Database.PostgreSQL.Simple.Arrays as Arrays

141143import qualified Database.PostgreSQL.LibPQ as PQ

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

152154import Data.Scientific (Scientific)

153155import GHC.Real (infinity, notANumber)

154156

157+import qualified Data.Aeson.Types as JSON

158+

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

156160-- value fails.

157161data ResultError = Incompatible { errSQLType :: String

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

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

179183 deriving (Eq, Show, Typeable)

180184

181−instance Exception ResultError

185+instance Exception ResultError where

186+ toException = postgresqlExceptionToException

187+ fromException = postgresqlExceptionFromException

182188

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

184190left = conversionError

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

244250 then Nothing

245251 else Just x

246252

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

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

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

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

254+-- number of the associated table column. Table columns have

255+-- nonzero numbers. Zero is returned if the specified column is not

256+-- a simple reference to a table column, or when using pre-3.0

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

250258

251259tableColumn :: Field -> Int

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

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

262270-- | void

263271instance FromField () where

264272 fromField f _bs

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

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

266274 | otherwise = pure ()

267275

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+

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

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

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

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

292306-- | bool

293307instance FromField Bool where

294308 fromField f bs

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

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

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

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

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

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

300314

301315-- | \"char\", bpchar

302316instance FromField Char where

303− fromField f bs =

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

305− then case bs of

317+ fromField f bs0 =

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

319+ then case bs0 of

306320 Nothing -> returnError UnexpectedNull f ""

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

308322 then returnError ConversionFailed f "length not 1"

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

311325

312326-- | int2

313327instance FromField Int16 where

314− fromField = atto ok16 $ signed decimal

328+ fromField = attoFieldParser ok16 $ signed decimal

315329

316330-- | int2, int4

317331instance FromField Int32 where

318− fromField = atto ok32 $ signed decimal

332+ fromField = attoFieldParser ok32 $ signed decimal

319333

320334#if WORD_SIZE_IN_BITS < 64

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

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

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

326340#endif

327341instance FromField Int where

328− fromField = atto okInt $ signed decimal

342+ fromField = attoFieldParser okInt $ signed decimal

329343

330344-- | int2, int4, int8

331345instance FromField Int64 where

332− fromField = atto ok64 $ signed decimal

346+ fromField = attoFieldParser ok64 $ signed decimal

333347

334348-- | int2, int4, int8

335349instance FromField Integer where

336− fromField = atto ok64 $ signed decimal

350+ fromField = attoFieldParser ok64 $ signed decimal

337351

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

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

340354instance FromField Float where

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

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

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

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

343357

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

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

346360instance FromField Double where

347− fromField = atto ok pg_double

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

361+ fromField = attoFieldParser ok pg_double

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

349363

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

351365instance FromField (Ratio Integer) where

352− fromField = atto ok pg_rational

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

366+ fromField = attoFieldParser ok pg_rational

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

354368

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

356370instance FromField Scientific where

357− fromField = atto ok rational

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

371+ fromField = attoFieldParser ok rational

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

359373

360374unBinary :: Binary t -> t

361375unBinary (Binary x) = x

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

376390

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

378392instance FromField SB.ByteString where

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

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

380394 then unBinary <$> fromField f dat

381395 else doFromField f okText' pure dat

382396

383397-- | oid

384398instance 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

386400

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

388402instance FromField LB.ByteString where

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

390404

391405unescapeBytea :: Field -> SB.ByteString

392406 -> Conversion (Binary SB.ByteString)

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

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

394408 Nothing -> returnError ConversionFailed f "unescapeBytea failed"

395409 Just str -> pure (Binary str)

396410

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

441455

442456-- | timestamptz

443457instance FromField UTCTime where

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

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

445459

446460-- | timestamptz

447461instance FromField ZonedTime where

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

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

449463

450464-- | timestamp

451465instance FromField LocalTime where

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

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

453467

454468-- | date

455469instance FromField Day where

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

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

457471

458472-- | time

459473instance FromField TimeOfDay where

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

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

461475

462476-- | timestamptz

463477instance FromField UTCTimestamp where

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

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

465479

466480-- | timestamptz

467481instance FromField ZonedTimestamp where

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

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

469483

470484-- | timestamp

471485instance FromField LocalTimestamp where

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

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

473487

474488-- | date

475489instance 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

477500

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

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

480−ff compatOid hsType parse f mstr =

503+ff compatOid hsType parseBS f mstr =

481504 if typeOid f /= compatOid

482505 then err Incompatible ""

483506 else case mstr of

484507 Nothing -> err UnexpectedNull ""

485− Just str -> case parse str of

508+ Just str -> case parseBS str of

486509 Left msg -> err ConversionFailed msg

487510 Right val -> return val

488511 where

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

520543 _ -> returnError Incompatible f ""

521544

522545fromArray :: 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

524547 where

525− delim = typdelim (typelem typeInfo)

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

548+ delim = typdelim (typelem typInfo)

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

527550

528551 parseIt item =

529552 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

541564-- | uuid

542565instance FromField UUID where

543566 fromField f mbs =

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

567+ if typeOid f /= TI.uuidOid

545568 then returnError Incompatible f ""

546569 else case mbs of

547570 Nothing -> returnError UnexpectedNull f ""

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

550573 Nothing -> returnError ConversionFailed f "Invalid UUID"

551574 Just uuid -> pure uuid

552575

553−-- | json

576+-- | json, jsonb

554577instance FromField JSON.Value where

555− fromField f mbs =

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

578+ fromField f mbs = parseBS =<< fromFieldJSONByteString f mbs

579+ where parseBS bs = case JSON.eitherDecodeStrict' bs of

580+ Left err -> returnError ConversionFailed f err

581+ Right val -> pure val

582+

583+-- | Return the JSON ByteString directly

584+--

585+-- @since 0.6.3

586+fromFieldJSONByteString :: Field -> Maybe ByteString -> Conversion ByteString

587+fromFieldJSONByteString f mbs =

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

557589 then returnError Incompatible f ""

558590 else case mbs of

559591 Nothing -> returnError UnexpectedNull f ""

560− Just bs ->

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

562− Left err -> returnError ConversionFailed f err

563− Right val -> pure val

592+ Just bs -> pure bs

564593

565594-- | 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.

567596--

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

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

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

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

585614fromJSONField f mbBs = do

586615 value <- fromField f mbBs

587− case JSON.fromJSON value of

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

589− "JSON decoding error: " ++ err

590− JSON.Success x -> pure x

616+ case JSON.ifromJSON value of

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

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

619+ JSON.ISuccess x -> pure x

591620

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

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

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

604633type Compat = PQ.Oid -> Bool

605634

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

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

608− TI.bpchar, TI.varchar ] )

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

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

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

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

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

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

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

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

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

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

640+okBinary = eq TI.byteaOid

641+ok16 = eq TI.int2Oid

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

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

615644#if WORD_SIZE_IN_BITS < 64

616645okInt = ok32

617646#else

618647okInt = ok64

619648#endif

620649

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+

621663doFromField :: forall a . (Typeable a)

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

623665 -> Maybe ByteString -> Conversion a

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

642684 (show (typeOf (undefined :: a)))

643685 msg

644686

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

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

647− -> Conversion a

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

687+-- | Construct a field parser from an attoparsec parser. An 'Incompatible' error is thrown if the

688+-- PostgreSQL oid does not match the specified predicate.

689+--

690+-- @

691+-- instance FromField Int16 where

692+-- fromField = attoFieldParser ok16 (signed decimal)

693+-- @

694+--

695+-- @since 0.6.3

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

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

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

699+ -> Parser a

700+ -- ^ An attoparsec parser.

701+ -> FieldParser a

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

649703 where

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

651705 go p s =

src/Database/PostgreSQL/Simple/FromRow.hs+20−4

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

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

6868-- exception will be thrown.

6969--

70+-- You can also derive 'FromRow' for your data type using GHC generics, like

71+-- this:

72+--

73+-- @

74+-- \{-# LANGUAGE DeriveAnyClass \#-}

75+-- \{-# LANGUAGE DeriveGeneric \#-}

76+--

77+-- import "GHC.Generics" ('GHC.Generics.Generic')

78+-- import "Database.PostgreSQL.Simple" ('FromRow')

79+--

80+-- data User = User { name :: String, fileQuota :: Int }

81+-- deriving ('GHC.Generics.Generic', 'FromRow')

82+-- @

83+--

84+-- Note that this only works for product types (e.g. records) and does not

85+-- support sum types or recursive types.

86+--

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

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

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

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

114131 else do

115132 let !result = rowresult

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

117− !field = Field{..}

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

134+ !field' = Field{..}

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

119136

120137field :: FromField a => RowParser a

121138field = fieldWith fromField

@@ -420,8 +437,7 @@ instance (FromField a, FromField b, FromField c, FromField d, FromField e,

420437instance (FromField a, FromField b, FromField c, FromField d, FromField e,

421438 FromField f, FromField g, FromField h, FromField i, FromField j,

422439 FromField k, FromField l, FromField m, FromField n, FromField o,

423− FromField p, FromField q, FromField q, FromField r, FromField s,

424− FromField t) =>

440+ FromField p, FromField q, FromField r, FromField s, FromField t) =>

425441 FromRow (Maybe (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t)) where

426442 fromRow = (null *> null *> null *> null *> null *>

427443 null *> null *> null *> null *> null *>

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

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

2222import qualified Data.ByteString.Builder as BU

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

2424import qualified Data.ByteString.Lazy as BL

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

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

27−#endif

2825import Data.Map(Map)

2926import qualified Data.Map as Map

3027import Data.Text(Text)

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

5350toBuilder :: HStoreBuilder -> Builder

5451toBuilder x = case x of

5552 Empty -> mempty

56− Comma x -> x

53+ Comma c -> c

5754

5855toLazyByteString :: HStoreBuilder -> BL.ByteString

5956toLazyByteString x = case x of

6057 Empty -> BL.empty

61− Comma x -> BU.toLazyByteString x

58+ Comma c -> BU.toLazyByteString c

6259

6360instance Semigroup HStoreBuilder where

6461 Empty <> x = x

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

6966

7067instance Monoid HStoreBuilder where

7168 mempty = Empty

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

73− mappend = (<>)

74−#endif

7569

7670class ToHStoreText a where

7771 toHStoreText :: a -> HStoreText

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

150144

151145instance ToHStore HStoreMap where

152146 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'

154148

155149instance ToField HStoreMap where

156150 toField xs = toField (toHStore xs)

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

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

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

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

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

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+{-# LANGUAGE ExistentialQuantification #-}

5+{-# LANGUAGE InstanceSigs #-}

47------------------------------------------------------------------------------

58-- |

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

3336import qualified Data.IntMap as IntMap

3437import Data.IORef

3538import Data.Maybe(fromMaybe)

36−import Data.Monoid

3739import Data.String

3840import qualified Data.Text as T

3941import qualified Data.Text.Encoding as TE

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

5052import Control.Monad.Trans.State.Strict

5153import Control.Monad.Trans.Reader

5254import Control.Monad.Trans.Class

55+import GHC.Generics

5356import GHC.IO.Exception

5457#if !defined(mingw32_HOST_OS)

5558import Control.Concurrent(threadWaitRead, threadWaitWrite)

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

8083instance Eq Connection where

8184 x == y = connectionHandle x == connectionHandle y

8285

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+

83105data SqlError = SqlError {

84106 sqlState :: ByteString

85107 , sqlExecStatus :: ExecStatus

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

91113fatalError :: ByteString -> SqlError

92114fatalError msg = SqlError "" FatalError msg "" ""

93115

94−instance Exception SqlError

116+instance Exception SqlError where

117+ toException = postgresqlExceptionToException

118+ fromException = postgresqlExceptionFromException

119+

95120

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

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

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

100125 , qeQuery :: Query

101126 } deriving (Eq, Show, Typeable)

102127

103−instance Exception QueryError

128+instance Exception QueryError where

129+ toException = postgresqlExceptionToException

130+ fromException = postgresqlExceptionFromException

104131

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

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

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

111138 , fmtParams :: [ByteString]

112139 } deriving (Eq, Show, Typeable)

113140

114−instance Exception FormatError

141+instance Exception FormatError where

142+ toException = postgresqlExceptionToException

143+ fromException = postgresqlExceptionFromException

115144

116145data ConnectInfo = ConnectInfo {

117146 connectHost :: String

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

119148 , connectUser :: String

120149 , connectPassword :: String

121150 , connectDatabase :: String

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

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

123152

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

125154--

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

153182connect :: ConnectInfo -> IO Connection

154183connect = connectPostgreSQL . postgreSQLConnectionString

155184

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+

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

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

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

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

188223--

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

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

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

193229-- more information regarding this file.

194230--

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

287323

288324 str name field

289325 | null value = id

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

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

291327 where value = field connectInfo

292328

293329 num name field

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

295331 | otherwise = showString name . shows value . space

296332 where value = field connectInfo

297333

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

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

299335 where

300336 delta c cs = case c of

301337 '\\' -> '\\' : '\\' : cs

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

383419 nstr <- PQ.cmdTuples result

384420 return $ case nstr of

385421 Nothing -> 0 -- is this appropriate?

386− Just str -> toInteger str

422+ Just str -> mkInteger str

387423 PQ.TuplesOk -> do

388424 ncols <- PQ.nfields result

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

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

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

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

398434 where

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

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

400436 where

401437 delta acc c =

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

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

411447 PQ.resultErrorField result PQ.DiagMessageDetail

412448 hint <- fromMaybe "" <$>

413449 PQ.resultErrorField result PQ.DiagMessageHint

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

415− throwIO $ SqlError { sqlState = state

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

451+ throwIO $ SqlError { sqlState = state'

416452 , sqlExecStatus = status

417453 , sqlErrorMsg = errormsg

418454 , sqlErrorDetail = detail

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

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

482518

483519instance Monad Conversion where

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

485− return = pure

486−#endif

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

488521 oka <- runConversion m conn

489522 case oka of

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

586619

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

588621escapeByteaConn = 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 @@

1414

1515module Database.PostgreSQL.Simple.Internal.PQResultUtils

1616 ( finishQueryWith

17+ , finishQueryWithV

18+ , finishQueryWithVU

1719 , getRowWith

1820 ) where

1921

2022import Control.Exception as E

2123import Data.ByteString (ByteString)

24+import Data.Foldable (for_)

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

2326import Database.PostgreSQL.Simple.Ok

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

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

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

2629import Database.PostgreSQL.Simple.TypeInfo

2730import qualified Database.PostgreSQL.LibPQ as PQ

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

2936import Control.Monad.Trans.Reader

3037import Control.Monad.Trans.State.Strict

3138

3239finishQueryWith :: 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

3472 status <- PQ.resultStatus result

3573 case status of

36− PQ.TuplesOk -> do

37− nrows <- PQ.ntuples result

38− ncols <- PQ.nfields result

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

40− getRowWith parser row ncols conn result

74+ PQ.TuplesOk -> k

4175 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?)"

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

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

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

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

47−#endif

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

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

50−#endif

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

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

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

4747

4848#if defined(mingw32_HOST_OS)

4949import Control.Concurrent ( threadDelay )

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

51−import Control.Concurrent ( threadWaitRead )

5250#else

5351import GHC.Conc ( atomically )

5452import Control.Concurrent ( threadWaitReadSTM )

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

9492 -- with async exceptions, whereas threadDelay can.

9593 Just _fd -> do

9694 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

11295#else

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

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

3737import Control.Monad(MonadPlus(..))

3838import Data.Typeable

3939

40+import qualified Control.Monad.Fail as Fail

41+

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

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

4244

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

7072 mplus = (<|>)

7173

7274instance Monad Ok where

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

74− return = pure

75−#endif

76−

7775 Errors es >>= _ = Errors es

7876 Ok a >>= f = f a

7977

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

79+ fail = Fail.fail

80+#endif

81+

82+instance Fail.MonadFail Ok where

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

8184

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

1919 , empty

2020 , isEmpty, isEmptyBy

2121 , contains, containsBy

22+ , fromFieldRange

2223 ) where

2324

2425import Control.Applicative hiding (empty)

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

3738import Data.Scientific (Scientific)

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

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

40−import Data.Time (Day, LocalTime,

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

4142 NominalDiffTime,

4243 TimeOfDay, UTCTime,

4344 ZonedTime,

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

109110 PGRange _lb NegInfinity -> False

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

111112 where

112− checkLB lb x =

113+ checkLB lb y =

113114 case lb of

114115 NegInfinity -> True

115116 PosInfinity -> False

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

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

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

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

118119

119− checkUB ub x =

120+ checkUB ub y =

120121 case ub of

121122 NegInfinity -> False

122123 PosInfinity -> True

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

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

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

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

125126

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

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

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

189190

190191

191192instance (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

193197 info <- typeInfo f

194198 case info of

195199 Range{} ->

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

199203 Just "empty" -> pure $ empty

200204 Just bs ->

201205 let parseIt NegInfinity = pure NegInfinity

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

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

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

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

204208 parseIt PosInfinity = pure PosInfinity

205209 in case parseOnly pgrange bs of

206210 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

15{-# LANGUAGE TemplateHaskell #-}

6+#endif

27------------------------------------------------------------------------------

38-- |

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

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

3035-- > (beginTime,endTime,string)

3136--

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

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

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

3641--

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

5257

5358sql :: QuasiQuoter

5459sql = QuasiQuoter

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

56− \ quasiquoter used in pattern context"

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

58− \ quasiquoter used in type context"

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

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

5962 , quoteExp = sqlExp

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

61− \ quasiquoter used in declaration context"

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

6264 }

6365

6466sqlExp :: String -> Q Exp

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

8587 instring ('\'':'\'':xs) = '\'':'\'': instring xs

8688 instring ('\'':xs) = '\'': insql xs

8789 instring (x:xs) = x : instring xs

88− instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql:\

89− \ string literal not terminated"

90+ instring [] = error "Database.PostgreSQL.Simple.SqlQQ.sql: string literal not terminated"

src/Database/PostgreSQL/Simple/Time.hs+2

@@ -227,6 +227,7 @@ module Database.PostgreSQL.Simple.Time

227227 , parseUTCTimestamp

228228 , parseZonedTimestamp

229229 , parseLocalTimestamp

230+ , parseCalendarDiffTime

230231 , dayToBuilder

231232 , utcTimeToBuilder

232233 , zonedTimeToBuilder

@@ -239,6 +240,7 @@ module Database.PostgreSQL.Simple.Time

239240 , localTimestampToBuilder

240241 , unboundedToBuilder

241242 , nominalDiffTimeToBuilder

243+ , calendarDiffTimeToBuilder

242244 ) where

243245

244246import Database.PostgreSQL.Simple.Time.Implementation

src/Database/PostgreSQL/Simple/Time/Implementation.hs+11−1

@@ -18,7 +18,8 @@ import Data.ByteString.Builder.Prim(primBounded)

1818import Control.Arrow((***))

1919import Control.Applicative

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

2223import Data.Typeable

2324import Data.Maybe (fromMaybe)

2425import qualified Data.Attoparsec.ByteString.Char8 as A

@@ -77,6 +78,9 @@ parseLocalTimestamp = A.parseOnly (getLocalTimestamp <* A.endOfInput)

7778parseDate :: B.ByteString -> Either String Date

7879parseDate = A.parseOnly (getDate <* A.endOfInput)

7980

81+parseCalendarDiffTime :: B.ByteString -> Either String CalendarDiffTime

82+parseCalendarDiffTime = A.parseOnly (getCalendarDiffTime <* A.endOfInput)

83+

8084getUnbounded :: A.Parser a -> A.Parser (Unbounded a)

8185getUnbounded getFinite

8286 = (pure NegInfinity <* A.string "-infinity")

@@ -125,6 +129,9 @@ getUTCTime = TP.utcTime

125129getUTCTimestamp :: A.Parser UTCTimestamp

126130getUTCTimestamp = getUnbounded getUTCTime

127131

132+getCalendarDiffTime :: A.Parser CalendarDiffTime

133+getCalendarDiffTime = TP.calendarDiffTime

134+

128135dayToBuilder :: Day -> Builder

129136dayToBuilder = primBounded TPP.day

130137

@@ -164,3 +171,6 @@ dateToBuilder = unboundedToBuilder dayToBuilder

164171

165172nominalDiffTimeToBuilder :: NominalDiffTime -> Builder

166173nominalDiffTimeToBuilder = 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

2121 , localToUTCTimeOfDayHMS

2222 , utcTime

2323 , zonedTime

24+ , calendarDiffTime

2425 ) where

2526

2627import Control.Applicative ((<$>), (<*>), (<*), (*>))

2728import Database.PostgreSQL.Simple.Compat (toPico)

2829import Data.Attoparsec.ByteString.Char8 as A

2930import Data.Bits ((.&.))

31+import Data.ByteString (ByteString)

3032import Data.Char (ord)

3133import Data.Fixed (Pico)

3234import Data.Int (Int64)

3335import Data.Maybe (fromMaybe)

34−import Data.Time.Calendar (Day, fromGregorianValid, addDays)

35−import Data.Time.Clock (UTCTime(..))

36+import Data.Time.Calendar.Compat (Day, fromGregorianValid, addDays)

37+import Data.Time.Clock.Compat (UTCTime(..))

38+import Data.Time.Format.ISO8601.Compat (iso8601ParseM)

39+import Data.Time.LocalTime.Compat (CalendarDiffTime)

3640import qualified Data.ByteString.Char8 as B8

37−import qualified Data.Time.LocalTime as Local

41+import qualified Data.Time.LocalTime.Compat as Local

3842

3943-- | Parse a date of the form @YYYY-MM-DD@.

4044day :: Parser Day

@@ -193,3 +197,8 @@ zonedTime = Local.ZonedTime <$> localTime <*> (fromMaybe utc <$> timeZone)

193197

194198utc :: Local.TimeZone

195199utc = 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+15−3

@@ -17,19 +17,23 @@ module Database.PostgreSQL.Simple.Time.Internal.Printer

1717 , localTime

1818 , zonedTime

1919 , nominalDiffTime

20+ , calendarDiffTime

2021 ) where

2122

2223import Control.Arrow ((>>>))

23−import Data.ByteString.Builder (Builder, integerDec)

24+import Data.ByteString.Builder (Builder, byteString, integerDec)

2425import Data.ByteString.Builder.Prim

2526 ( liftFixedToBounded, (>$<), (>*<)

2627 , BoundedPrim, primBounded, condB, emptyB, FixedPrim, char8, int32Dec)

2728import Data.Char ( chr )

2829import Data.Int ( Int32, Int64 )

29−import Data.Time

30+import Data.String (fromString)

31+import Data.Time.Compat

3032 ( UTCTime(..), ZonedTime(..), LocalTime(..), NominalDiffTime

3133 , Day, toGregorian, TimeOfDay(..), timeToTimeOfDay

3234 , TimeZone, timeZoneMinutes )

35+import Data.Time.Format.ISO8601.Compat (iso8601Show)

36+import Data.Time.LocalTime.Compat (CalendarDiffTime)

3337import Database.PostgreSQL.Simple.Compat ((<>), fromPico)

3438import Unsafe.Coerce (unsafeCoerce)

3539

@@ -71,7 +75,7 @@ frac = condB (== 0) emptyB ((,) '.' >$< (liftB char8 >*< trunc12))

7175

7276

7377year :: BoundedPrim Int32

74−year = condB (> 10000) int32Dec (checkBCE >$< liftB digits4)

78+year = condB (>= 10000) int32Dec (checkBCE >$< liftB digits4)

7579 where

7680 checkBCE :: Int32 -> Int

7781 checkBCE y

@@ -121,3 +125,11 @@ nominalDiffTime :: NominalDiffTime -> Builder

121125nominalDiffTime xy = integerDec x <> primBounded frac (abs (fromIntegral y))

122126 where

123127 (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+33−11

@@ -1,5 +1,6 @@

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

22{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}

3+{-# LANGUAGE PolyKinds #-}

45------------------------------------------------------------------------------

56-- |

@@ -22,6 +23,7 @@ module Database.PostgreSQL.Simple.ToField

2223 , inQuotes

2324 ) where

2425

26+import Control.Applicative (Const(Const))

2527import qualified Data.Aeson as JSON

2628import Data.ByteString (ByteString)

2729import Data.ByteString.Builder

@@ -30,10 +32,12 @@ import Data.ByteString.Builder

3032 , wordDec, word8Dec, word16Dec, word32Dec, word64Dec

3133 , floatDec, doubleDec

3234 )

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

3336import Data.Int (Int8, Int16, Int32, Int64)

3437import Data.List (intersperse)

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

3741import Data.Typeable (Typeable)

3842import Data.Word (Word, Word8, Word16, Word32, Word64)

3943import {-# SOURCE #-} Database.PostgreSQL.Simple.ToRow

@@ -42,6 +46,8 @@ import Database.PostgreSQL.Simple.Compat (toByteString)

4246

4347import qualified Data.ByteString as SB

4448import qualified Data.ByteString.Lazy as LB

49+import Data.CaseInsensitive (CI)

50+import qualified Data.CaseInsensitive as CI

4551import qualified Data.Text as ST

4652import qualified Data.Text.Encoding as ST

4753import qualified Data.Text.Lazy as LT

@@ -53,11 +59,7 @@ import qualified Data.Vector as V

5359import qualified Database.PostgreSQL.LibPQ as PQ

5460import Database.PostgreSQL.Simple.Time

5561import Data.Scientific (Scientific)

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

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

58−#else

59−import Data.Scientific (scientificBuilder)

60−#endif

6163import Foreign.C.Types (CUInt(..))

6264

6365-- | How to render an element when substituting it into a query.

@@ -98,6 +100,14 @@ instance ToField Action where

98100 toField a = a

99101 {-# INLINE toField #-}

100102

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+

101111instance (ToField a) => ToField (Maybe a) where

102112 toField Nothing = renderNull

103113 toField (Just a) = toField a

@@ -230,6 +240,15 @@ instance ToField LT.Text where

230240 toField = toField . LT.toStrict

231241 {-# INLINE toField #-}

232242

243+-- | citext

244+instance ToField (CI ST.Text) where

245+ toField = toField . CI.original

246+ {-# INLINE toField #-}

247+

248+-- | citext

249+instance ToField (CI LT.Text) where

250+ toField = toField . LT.toStrict . CI.original

251+ {-# INLINE toField #-}

233252

234253instance ToField UTCTime where

235254 toField = Plain . inQuotes . utcTimeToBuilder

@@ -271,6 +290,10 @@ instance ToField NominalDiffTime where

271290 toField = Plain . inQuotes . nominalDiffTimeToBuilder

272291 {-# INLINE toField #-}

273292

293+instance ToField CalendarDiffTime where

294+ toField = Plain . inQuotes . calendarDiffTimeToBuilder

295+ {-# INLINE toField #-}

296+

274297instance (ToField a) => ToField (PGArray a) where

275298 toField pgArray =

276299 case fromPGArray pgArray of

@@ -291,14 +314,13 @@ instance ToField UUID where

291314instance ToField JSON.Value where

292315 toField = toField . JSON.encode

293316

294−-- | Convert a Haskell value to a JSON 'JSON.Value' using

295−-- 'JSON.toJSON' and convert that to a field using 'toField'.

317+-- | Convert a Haskell value to JSON using 'JSON.toEncoding'.

296318--

297319-- This can be used as the default implementation for the 'toField'

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

299321-- PostgreSQL.

300322toJSONField :: JSON.ToJSON a => a -> Action

301−toJSONField = toField . JSON.toJSON

323+toJSONField = toField . JSON.encode

302324

303325-- | Surround a string with single-quote characters: \"@'@\"

304326--

@@ -308,7 +330,7 @@ inQuotes b = quote `mappend` b `mappend` quote

308330 where quote = char8 '\''

309331

310332interleaveFoldr :: (a -> [b] -> [b]) -> b -> [b] -> [a] -> [b]

311−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

312334{-# INLINE interleaveFoldr #-}

313335

314336instance ToRow a => ToField (Values a) where

@@ -355,8 +377,8 @@ instance ToRow a => ToField (Values a) where

355377

356378 typedRows :: ToRow a => [a] -> [QualifiedIdentifier] -> [Action] -> [Action]

357379 typedRows [] _ _ = error funcname

358− typedRows (val:vals) types rest =

359− typedRow (toRow val) types (multiRows vals rest)

380+ typedRows (val:vals) typs rest =

381+ typedRow (toRow val) typs (multiRows vals rest)

360382

361383 untypedRows :: ToRow a => [a] -> [Action] -> [Action]

362384 untypedRows [] _ = error funcname

src/Database/PostgreSQL/Simple/ToRow.hs+16

@@ -30,6 +30,22 @@ import GHC.Generics

3030--

3131-- Instances should use the 'toField' method of the 'ToField' class

3232-- to perform conversion of each element of the collection.

33+--

34+-- You can derive 'ToRow' for your data type using GHC generics, like this:

35+--

36+-- @

37+-- \{-# LANGUAGE DeriveAnyClass \#-}

38+-- \{-# LANGUAGE DeriveGeneric \#-}

39+--

40+-- import "GHC.Generics" ('GHC.Generics.Generic')

41+-- import "Database.PostgreSQL.Simple" ('ToRow')

42+--

43+-- data User = User { name :: String, fileQuota :: Int }

44+-- deriving ('GHC.Generics.Generic', 'ToRow')

45+-- @

46+--

47+-- Note that this only works for product types (e.g. records) and does not

48+-- support sum types or recursive types.

3349class ToRow a where

3450 toRow :: a -> [Action]

3551 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

1717 , withTransactionLevel

1818 , withTransactionMode

1919 , withTransactionModeRetry

20+ , withTransactionModeRetry'

2021 , withTransactionSerializable

2122 , TransactionMode(..)

2223 , IsolationLevel(..)

@@ -146,37 +147,40 @@ withTransactionMode mode conn act =

146147 commit conn

147148 return r

148149

150+-- | 'withTransactionModeRetry'' but with the exception type pinned to 'SqlError'.

151+withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

152+withTransactionModeRetry = withTransactionModeRetry'

153+

149154-- | Like 'withTransactionMode', but also takes a custom callback to

150−-- determine if a transaction should be retried if an 'SqlError' occurs.

151−-- If the callback returns True, then the transaction will be retried.

152−-- If the callback returns False, or an exception other than an 'SqlError'

155+-- determine if a transaction should be retried if an exception occurs.

156+-- If the callback returns 'True', then the transaction will be retried.

157+-- If the callback returns 'False', or an exception other than an @e@

153158-- occurs then the transaction will be rolled back and the exception rethrown.

154159--

155160-- This is used to implement 'withTransactionSerializable'.

156−withTransactionModeRetry :: TransactionMode -> (SqlError -> Bool) -> Connection -> IO a -> IO a

157−withTransactionModeRetry mode shouldRetry conn act =

161+withTransactionModeRetry' :: forall a e. E.Exception e => TransactionMode -> (e -> Bool) -> Connection -> IO a -> IO a

162+withTransactionModeRetry' mode shouldRetry conn act =

158163 mask $ \restore ->

159164 retryLoop $ E.try $ do

160− a <- restore act

165+ a <- restore act `E.onException` rollback_ conn

161166 commit conn

162167 return a

163168 where

164− retryLoop :: IO (Either E.SomeException a) -> IO a

169+ retryLoop :: IO (Either e a) -> IO a

165170 retryLoop act' = do

166171 beginMode mode conn

167172 r <- act'

168173 case r of

169− Left e -> do

170− rollback_ conn

171− case fmap shouldRetry (E.fromException e) of

172− Just True -> retryLoop act'

173− _ -> E.throwIO e

174+ Left e ->

175+ case shouldRetry e of

176+ True -> retryLoop act'

177+ False -> E.throwIO e

174178 Right a ->

175179 return a

176180

177181-- | Rollback a transaction.

178182rollback :: Connection -> IO ()

179−rollback conn = execute_ conn "ABORT" >> return ()

183+rollback conn = execute_ conn "ROLLBACK" >> return ()

180184

181185-- | Rollback a transaction, ignoring any @IOErrors@

182186rollback_ :: Connection -> IO ()

src/Database/PostgreSQL/Simple/TypeInfo.hs+9−9

@@ -50,21 +50,21 @@ import Database.PostgreSQL.Simple.TypeInfo.Static

5050-- in the connections's cache.

5151

5252getTypeInfo :: Connection -> PQ.Oid -> IO TypeInfo

53−getTypeInfo conn@Connection{..} oid =

54− case staticTypeInfo oid of

55− Just name -> return name

56− Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid

53+getTypeInfo conn@Connection{..} oid' =

54+ case staticTypeInfo oid' of

55+ Just name' -> return name'

56+ Nothing -> modifyMVar connectionObjects $ getTypeInfo' conn oid'

5757

5858getTypeInfo' :: Connection -> PQ.Oid -> TypeInfoCache

5959 -> IO (TypeInfoCache, TypeInfo)

60−getTypeInfo' conn oid oidmap =

61− case IntMap.lookup (oid2int oid) oidmap of

60+getTypeInfo' conn oid' oidmap =

61+ case IntMap.lookup (oid2int oid') oidmap of

6262 Just typeinfo -> return (oidmap, typeinfo)

6363 Nothing -> do

6464 names <- query conn "SELECT oid, typcategory, typdelim, typname,\

6565 \ typelem, typrelid\

6666 \ FROM pg_type WHERE oid = ?"

67− (Only oid)

67+ (Only oid')

6868 (oidmap', typeInfo) <-

6969 case names of

7070 [] -> return $ throw (fatalError "invalid type oid")

@@ -78,7 +78,7 @@ getTypeInfo' conn oid oidmap =

7878 rngsubtypeOids <- query conn "SELECT rngsubtype\

7979 \ FROM pg_range\

8080 \ WHERE rngtypid = ?"

81− (Only oid)

81+ (Only oid')

8282 case rngsubtypeOids of

8383 [Only rngsubtype_] -> do

8484 (oidmap', rngsubtype) <-

@@ -104,7 +104,7 @@ getTypeInfo' conn oid oidmap =

104104 _ -> fail "typename query returned more than one result"

105105 -- oid is a primary key, so the query should

106106 -- never return more than one result

107− let !oidmap'' = IntMap.insert (oid2int oid) typeInfo oidmap'

107+ let !oidmap'' = IntMap.insert (oid2int oid') typeInfo oidmap'

108108 return $! (oidmap'', typeInfo)

109109

110110getAttInfos :: Connection -> [(B.ByteString, PQ.Oid)] -> TypeInfoCache

src/Database/PostgreSQL/Simple/TypeInfo/Macro.hs+9−3

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

1+{-# LANGUAGE CPP #-}

2+#if __GLASGOW_HASKELL__ >= 800

3+{-# LANGUAGE TemplateHaskellQuotes #-}

4+#else

15{-# LANGUAGE TemplateHaskell #-}

6+#endif

38------------------------------------------------------------------------------

49-- |

@@ -22,11 +27,12 @@ import Database.PostgreSQL.Simple.TypeInfo.Static

2227import Database.PostgreSQL.Simple.Types (Oid(..))

2328import Language.Haskell.TH

2429

25−

2630-- | Returns an expression that has type @'Oid' -> 'Bool'@, true if the

2731-- oid is equal to any one of the 'typoid's of the given 'TypeInfo's.

2832mkCompats :: [TypeInfo] -> ExpQ

29−mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]

33+mkCompats tys = do

34+ x <- newName "x"

35+ lamE [conP 'Oid [varP x]] $ caseE (varE x) (map alt tys ++ [catchAll])

3036 where

3137 alt :: TypeInfo -> MatchQ

3238 alt ty = match (inlineTypoidP ty) (normalB [| True |]) []

@@ -38,7 +44,7 @@ mkCompats tys = [| \(Oid x) -> $(caseE [| x |] (map alt tys ++ [catchAll])) |]

3844-- Returns an expression of type 'Oid'. Useful because GHC tends

3945-- not to fold constants.

4046inlineTypoid :: TypeInfo -> ExpQ

41−inlineTypoid ty = [| Oid $(litE (getTypoid ty)) |]

47+inlineTypoid ty = conE 'Oid `appE` litE (getTypoid ty)

4248

4349inlineTypoidP :: TypeInfo -> PatQ

4450inlineTypoidP ty = litP (getTypoid ty)

src/Database/PostgreSQL/Simple/TypeInfo/Static.hs+684−114

@@ -19,119 +19,233 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

1919 ( TypeInfo(..)

2020 , staticTypeInfo

2121 , bool

22+ , boolOid

2223 , bytea

24+ , byteaOid

2325 , char

26+ , charOid

2427 , name

28+ , nameOid

2529 , int8

30+ , int8Oid

2631 , int2

32+ , int2Oid

2733 , int4

34+ , int4Oid

2835 , regproc

36+ , regprocOid

2937 , text

38+ , textOid

3039 , oid

40+ , oidOid

3141 , tid

42+ , tidOid

3243 , xid

44+ , xidOid

3345 , cid

46+ , cidOid

3447 , xml

48+ , xmlOid

3549 , point

50+ , pointOid

3651 , lseg

52+ , lsegOid

3753 , path

54+ , pathOid

3855 , box

56+ , boxOid

3957 , polygon

58+ , polygonOid

4059 , line

60+ , lineOid

4161 , cidr

62+ , cidrOid

4263 , float4

64+ , float4Oid

4365 , float8

66+ , float8Oid

4467 , unknown

68+ , unknownOid

4569 , circle

70+ , circleOid

4671 , money

72+ , moneyOid

4773 , macaddr

74+ , macaddrOid

4875 , inet

76+ , inetOid

4977 , bpchar

78+ , bpcharOid

5079 , varchar

80+ , varcharOid

5181 , date

82+ , dateOid

5283 , time

84+ , timeOid

5385 , timestamp

86+ , timestampOid

5487 , timestamptz

88+ , timestamptzOid

5589 , interval

90+ , intervalOid

5691 , timetz

92+ , timetzOid

5793 , bit

94+ , bitOid

5895 , varbit

96+ , varbitOid

5997 , numeric

98+ , numericOid

6099 , refcursor

100+ , refcursorOid

61101 , record

102+ , recordOid

62103 , void

104+ , voidOid

63105 , array_record

106+ , array_recordOid

64107 , regprocedure

108+ , regprocedureOid

65109 , regoper

110+ , regoperOid

66111 , regoperator

112+ , regoperatorOid

67113 , regclass

114+ , regclassOid

68115 , regtype

116+ , regtypeOid

69117 , uuid

118+ , uuidOid

70119 , json

120+ , jsonOid

71121 , jsonb

122+ , jsonbOid

72123 , int2vector

124+ , int2vectorOid

73125 , oidvector

126+ , oidvectorOid

74127 , array_xml

128+ , array_xmlOid

75129 , array_json

130+ , array_jsonOid

76131 , array_line

132+ , array_lineOid

77133 , array_cidr

134+ , array_cidrOid

78135 , array_circle

136+ , array_circleOid

79137 , array_money

138+ , array_moneyOid

80139 , array_bool

140+ , array_boolOid

81141 , array_bytea

142+ , array_byteaOid

82143 , array_char

144+ , array_charOid

83145 , array_name

146+ , array_nameOid

84147 , array_int2

148+ , array_int2Oid

85149 , array_int2vector

150+ , array_int2vectorOid

86151 , array_int4

152+ , array_int4Oid

87153 , array_regproc

154+ , array_regprocOid

88155 , array_text

156+ , array_textOid

89157 , array_tid

158+ , array_tidOid

90159 , array_xid

160+ , array_xidOid

91161 , array_cid

162+ , array_cidOid

92163 , array_oidvector

164+ , array_oidvectorOid

93165 , array_bpchar

166+ , array_bpcharOid

94167 , array_varchar

168+ , array_varcharOid

95169 , array_int8

170+ , array_int8Oid

96171 , array_point

172+ , array_pointOid

97173 , array_lseg

174+ , array_lsegOid

98175 , array_path

176+ , array_pathOid

99177 , array_box

178+ , array_boxOid

100179 , array_float4

180+ , array_float4Oid

101181 , array_float8

182+ , array_float8Oid

102183 , array_polygon

184+ , array_polygonOid

103185 , array_oid

186+ , array_oidOid

104187 , array_macaddr

188+ , array_macaddrOid

105189 , array_inet

190+ , array_inetOid

106191 , array_timestamp

192+ , array_timestampOid

107193 , array_date

194+ , array_dateOid

108195 , array_time

196+ , array_timeOid

109197 , array_timestamptz

198+ , array_timestamptzOid

110199 , array_interval

200+ , array_intervalOid

111201 , array_numeric

202+ , array_numericOid

112203 , array_timetz

204+ , array_timetzOid

113205 , array_bit

206+ , array_bitOid

114207 , array_varbit

208+ , array_varbitOid

115209 , array_refcursor

210+ , array_refcursorOid

116211 , array_regprocedure

212+ , array_regprocedureOid

117213 , array_regoper

214+ , array_regoperOid

118215 , array_regoperator

216+ , array_regoperatorOid

119217 , array_regclass

218+ , array_regclassOid

120219 , array_regtype

220+ , array_regtypeOid

121221 , array_uuid

222+ , array_uuidOid

122223 , array_jsonb

224+ , array_jsonbOid

123225 , int4range

226+ , int4rangeOid

124227 , _int4range

228+ , _int4rangeOid

125229 , numrange

230+ , numrangeOid

126231 , _numrange

232+ , _numrangeOid

127233 , tsrange

234+ , tsrangeOid

128235 , _tsrange

236+ , _tsrangeOid

129237 , tstzrange

238+ , tstzrangeOid

130239 , _tstzrange

240+ , _tstzrangeOid

131241 , daterange

242+ , daterangeOid

132243 , _daterange

244+ , _daterangeOid

133245 , int8range

246+ , int8rangeOid

134247 , _int8range

248+ , _int8rangeOid

135249 ) where

136250

137251import Database.PostgreSQL.LibPQ (Oid(..))

@@ -257,976 +371,1432 @@ staticTypeInfo (Oid x) = case x of

257371

258372bool :: TypeInfo

259373bool = Basic {

260− typoid = Oid 16,

374+ typoid = boolOid,

261375 typcategory = 'B',

262376 typdelim = ',',

263377 typname = "bool"

264378 }

265379

380+boolOid :: Oid

381+boolOid = Oid 16

382+{-# INLINE boolOid #-}

383+

266384bytea :: TypeInfo

267385bytea = Basic {

268− typoid = Oid 17,

386+ typoid = byteaOid,

269387 typcategory = 'U',

270388 typdelim = ',',

271389 typname = "bytea"

272390 }

273391

392+byteaOid :: Oid

393+byteaOid = Oid 17

394+{-# INLINE byteaOid #-}

395+

274396char :: TypeInfo

275397char = Basic {

276− typoid = Oid 18,

398+ typoid = charOid,

277399 typcategory = 'S',

278400 typdelim = ',',

279401 typname = "char"

280402 }

281403

404+charOid :: Oid

405+charOid = Oid 18

406+{-# INLINE charOid #-}

407+

282408name :: TypeInfo

283409name = Basic {

284− typoid = Oid 19,

410+ typoid = nameOid,

285411 typcategory = 'S',

286412 typdelim = ',',

287413 typname = "name"

288414 }

289415

416+nameOid :: Oid

417+nameOid = Oid 19

418+{-# INLINE nameOid #-}

419+

290420int8 :: TypeInfo

291421int8 = Basic {

292− typoid = Oid 20,

422+ typoid = int8Oid,

293423 typcategory = 'N',

294424 typdelim = ',',

295425 typname = "int8"

296426 }

297427

428+int8Oid :: Oid

429+int8Oid = Oid 20

430+{-# INLINE int8Oid #-}

431+

298432int2 :: TypeInfo

299433int2 = Basic {

300− typoid = Oid 21,

434+ typoid = int2Oid,

301435 typcategory = 'N',

302436 typdelim = ',',

303437 typname = "int2"

304438 }

305439

440+int2Oid :: Oid

441+int2Oid = Oid 21

442+{-# INLINE int2Oid #-}

443+

306444int4 :: TypeInfo

307445int4 = Basic {

308− typoid = Oid 23,

446+ typoid = int4Oid,

309447 typcategory = 'N',

310448 typdelim = ',',

311449 typname = "int4"

312450 }

313451

452+int4Oid :: Oid

453+int4Oid = Oid 23

454+{-# INLINE int4Oid #-}

455+

314456regproc :: TypeInfo

315457regproc = Basic {

316− typoid = Oid 24,

458+ typoid = regprocOid,

317459 typcategory = 'N',

318460 typdelim = ',',

319461 typname = "regproc"

320462 }

321463

464+regprocOid :: Oid

465+regprocOid = Oid 24

466+{-# INLINE regprocOid #-}

467+

322468text :: TypeInfo

323469text = Basic {

324− typoid = Oid 25,

470+ typoid = textOid,

325471 typcategory = 'S',

326472 typdelim = ',',

327473 typname = "text"

328474 }

329475

476+textOid :: Oid

477+textOid = Oid 25

478+{-# INLINE textOid #-}

479+

330480oid :: TypeInfo

331481oid = Basic {

332− typoid = Oid 26,

482+ typoid = oidOid,

333483 typcategory = 'N',

334484 typdelim = ',',

335485 typname = "oid"

336486 }

337487

488+oidOid :: Oid

489+oidOid = Oid 26

490+{-# INLINE oidOid #-}

491+

338492tid :: TypeInfo

339493tid = Basic {

340− typoid = Oid 27,

494+ typoid = tidOid,

341495 typcategory = 'U',

342496 typdelim = ',',

343497 typname = "tid"

344498 }

345499

500+tidOid :: Oid

501+tidOid = Oid 27

502+{-# INLINE tidOid #-}

503+

346504xid :: TypeInfo

347505xid = Basic {

348− typoid = Oid 28,

506+ typoid = xidOid,

349507 typcategory = 'U',

350508 typdelim = ',',

351509 typname = "xid"

352510 }

353511

512+xidOid :: Oid

513+xidOid = Oid 28

514+{-# INLINE xidOid #-}

515+

354516cid :: TypeInfo

355517cid = Basic {

356− typoid = Oid 29,

518+ typoid = cidOid,

357519 typcategory = 'U',

358520 typdelim = ',',

359521 typname = "cid"

360522 }

361523

524+cidOid :: Oid

525+cidOid = Oid 29

526+{-# INLINE cidOid #-}

527+

362528xml :: TypeInfo

363529xml = Basic {

364− typoid = Oid 142,

530+ typoid = xmlOid,

365531 typcategory = 'U',

366532 typdelim = ',',

367533 typname = "xml"

368534 }

369535

536+xmlOid :: Oid

537+xmlOid = Oid 142

538+{-# INLINE xmlOid #-}

539+

370540point :: TypeInfo

371541point = Basic {

372− typoid = Oid 600,

542+ typoid = pointOid,

373543 typcategory = 'G',

374544 typdelim = ',',

375545 typname = "point"

376546 }

377547

548+pointOid :: Oid

549+pointOid = Oid 600

550+{-# INLINE pointOid #-}

551+

378552lseg :: TypeInfo

379553lseg = Basic {

380− typoid = Oid 601,

554+ typoid = lsegOid,

381555 typcategory = 'G',

382556 typdelim = ',',

383557 typname = "lseg"

384558 }

385559

560+lsegOid :: Oid

561+lsegOid = Oid 601

562+{-# INLINE lsegOid #-}

563+

386564path :: TypeInfo

387565path = Basic {

388− typoid = Oid 602,

566+ typoid = pathOid,

389567 typcategory = 'G',

390568 typdelim = ',',

391569 typname = "path"

392570 }

393571

572+pathOid :: Oid

573+pathOid = Oid 602

574+{-# INLINE pathOid #-}

575+

394576box :: TypeInfo

395577box = Basic {

396− typoid = Oid 603,

578+ typoid = boxOid,

397579 typcategory = 'G',

398580 typdelim = ';',

399581 typname = "box"

400582 }

401583

584+boxOid :: Oid

585+boxOid = Oid 603

586+{-# INLINE boxOid #-}

587+

402588polygon :: TypeInfo

403589polygon = Basic {

404− typoid = Oid 604,

590+ typoid = polygonOid,

405591 typcategory = 'G',

406592 typdelim = ',',

407593 typname = "polygon"

408594 }

409595

596+polygonOid :: Oid

597+polygonOid = Oid 604

598+{-# INLINE polygonOid #-}

599+

410600line :: TypeInfo

411601line = Basic {

412− typoid = Oid 628,

602+ typoid = lineOid,

413603 typcategory = 'G',

414604 typdelim = ',',

415605 typname = "line"

416606 }

417607

608+lineOid :: Oid

609+lineOid = Oid 628

610+{-# INLINE lineOid #-}

611+

418612cidr :: TypeInfo

419613cidr = Basic {

420− typoid = Oid 650,

614+ typoid = cidrOid,

421615 typcategory = 'I',

422616 typdelim = ',',

423617 typname = "cidr"

424618 }

425619

620+cidrOid :: Oid

621+cidrOid = Oid 650

622+{-# INLINE cidrOid #-}

623+

426624float4 :: TypeInfo

427625float4 = Basic {

428− typoid = Oid 700,

626+ typoid = float4Oid,

429627 typcategory = 'N',

430628 typdelim = ',',

431629 typname = "float4"

432630 }

433631

632+float4Oid :: Oid

633+float4Oid = Oid 700

634+{-# INLINE float4Oid #-}

635+

434636float8 :: TypeInfo

435637float8 = Basic {

436− typoid = Oid 701,

638+ typoid = float8Oid,

437639 typcategory = 'N',

438640 typdelim = ',',

439641 typname = "float8"

440642 }

441643

644+float8Oid :: Oid

645+float8Oid = Oid 701

646+{-# INLINE float8Oid #-}

647+

442648unknown :: TypeInfo

443649unknown = Basic {

444− typoid = Oid 705,

650+ typoid = unknownOid,

445651 typcategory = 'X',

446652 typdelim = ',',

447653 typname = "unknown"

448654 }

449655

656+unknownOid :: Oid

657+unknownOid = Oid 705

658+{-# INLINE unknownOid #-}

659+

450660circle :: TypeInfo

451661circle = Basic {

452− typoid = Oid 718,

662+ typoid = circleOid,

453663 typcategory = 'G',

454664 typdelim = ',',

455665 typname = "circle"

456666 }

457667

668+circleOid :: Oid

669+circleOid = Oid 718

670+{-# INLINE circleOid #-}

671+

458672money :: TypeInfo

459673money = Basic {

460− typoid = Oid 790,

674+ typoid = moneyOid,

461675 typcategory = 'N',

462676 typdelim = ',',

463677 typname = "money"

464678 }

465679

680+moneyOid :: Oid

681+moneyOid = Oid 790

682+{-# INLINE moneyOid #-}

683+

466684macaddr :: TypeInfo

467685macaddr = Basic {

468− typoid = Oid 829,

686+ typoid = macaddrOid,

469687 typcategory = 'U',

470688 typdelim = ',',

471689 typname = "macaddr"

472690 }

473691

692+macaddrOid :: Oid

693+macaddrOid = Oid 829

694+{-# INLINE macaddrOid #-}

695+

474696inet :: TypeInfo

475697inet = Basic {

476− typoid = Oid 869,

698+ typoid = inetOid,

477699 typcategory = 'I',

478700 typdelim = ',',

479701 typname = "inet"

480702 }

481703

704+inetOid :: Oid

705+inetOid = Oid 869

706+{-# INLINE inetOid #-}

707+

482708bpchar :: TypeInfo

483709bpchar = Basic {

484− typoid = Oid 1042,

710+ typoid = bpcharOid,

485711 typcategory = 'S',

486712 typdelim = ',',

487713 typname = "bpchar"

488714 }

489715

716+bpcharOid :: Oid

717+bpcharOid = Oid 1042

718+{-# INLINE bpcharOid #-}

719+

490720varchar :: TypeInfo

491721varchar = Basic {

492− typoid = Oid 1043,

722+ typoid = varcharOid,

493723 typcategory = 'S',

494724 typdelim = ',',

495725 typname = "varchar"

496726 }

497727

728+varcharOid :: Oid

729+varcharOid = Oid 1043

730+{-# INLINE varcharOid #-}

731+

498732date :: TypeInfo

499733date = Basic {

500− typoid = Oid 1082,

734+ typoid = dateOid,

501735 typcategory = 'D',

502736 typdelim = ',',

503737 typname = "date"

504738 }

505739

740+dateOid :: Oid

741+dateOid = Oid 1082

742+{-# INLINE dateOid #-}

743+

506744time :: TypeInfo

507745time = Basic {

508− typoid = Oid 1083,

746+ typoid = timeOid,

509747 typcategory = 'D',

510748 typdelim = ',',

511749 typname = "time"

512750 }

513751

752+timeOid :: Oid

753+timeOid = Oid 1083

754+{-# INLINE timeOid #-}

755+

514756timestamp :: TypeInfo

515757timestamp = Basic {

516− typoid = Oid 1114,

758+ typoid = timestampOid,

517759 typcategory = 'D',

518760 typdelim = ',',

519761 typname = "timestamp"

520762 }

521763

764+timestampOid :: Oid

765+timestampOid = Oid 1114

766+{-# INLINE timestampOid #-}

767+

522768timestamptz :: TypeInfo

523769timestamptz = Basic {

524− typoid = Oid 1184,

770+ typoid = timestamptzOid,

525771 typcategory = 'D',

526772 typdelim = ',',

527773 typname = "timestamptz"

528774 }

529775

776+timestamptzOid :: Oid

777+timestamptzOid = Oid 1184

778+{-# INLINE timestamptzOid #-}

779+

530780interval :: TypeInfo

531781interval = Basic {

532− typoid = Oid 1186,

782+ typoid = intervalOid,

533783 typcategory = 'T',

534784 typdelim = ',',

535785 typname = "interval"

536786 }

537787

788+intervalOid :: Oid

789+intervalOid = Oid 1186

790+{-# INLINE intervalOid #-}

791+

538792timetz :: TypeInfo

539793timetz = Basic {

540− typoid = Oid 1266,

794+ typoid = timetzOid,

541795 typcategory = 'D',

542796 typdelim = ',',

543797 typname = "timetz"

544798 }

545799

800+timetzOid :: Oid

801+timetzOid = Oid 1266

802+{-# INLINE timetzOid #-}

803+

546804bit :: TypeInfo

547805bit = Basic {

548− typoid = Oid 1560,

806+ typoid = bitOid,

549807 typcategory = 'V',

550808 typdelim = ',',

551809 typname = "bit"

552810 }

553811

812+bitOid :: Oid

813+bitOid = Oid 1560

814+{-# INLINE bitOid #-}

815+

554816varbit :: TypeInfo

555817varbit = Basic {

556− typoid = Oid 1562,

818+ typoid = varbitOid,

557819 typcategory = 'V',

558820 typdelim = ',',

559821 typname = "varbit"

560822 }

561823

824+varbitOid :: Oid

825+varbitOid = Oid 1562

826+{-# INLINE varbitOid #-}

827+

562828numeric :: TypeInfo

563829numeric = Basic {

564− typoid = Oid 1700,

830+ typoid = numericOid,

565831 typcategory = 'N',

566832 typdelim = ',',

567833 typname = "numeric"

568834 }

569835

836+numericOid :: Oid

837+numericOid = Oid 1700

838+{-# INLINE numericOid #-}

839+

570840refcursor :: TypeInfo

571841refcursor = Basic {

572− typoid = Oid 1790,

842+ typoid = refcursorOid,

573843 typcategory = 'U',

574844 typdelim = ',',

575845 typname = "refcursor"

576846 }

577847

848+refcursorOid :: Oid

849+refcursorOid = Oid 1790

850+{-# INLINE refcursorOid #-}

851+

578852record :: TypeInfo

579853record = Basic {

580− typoid = Oid 2249,

854+ typoid = recordOid,

581855 typcategory = 'P',

582856 typdelim = ',',

583857 typname = "record"

584858 }

585859

860+recordOid :: Oid

861+recordOid = Oid 2249

862+{-# INLINE recordOid #-}

863+

586864void :: TypeInfo

587865void = Basic {

588− typoid = Oid 2278,

866+ typoid = voidOid,

589867 typcategory = 'P',

590868 typdelim = ',',

591869 typname = "void"

592870 }

593871

872+voidOid :: Oid

873+voidOid = Oid 2278

874+{-# INLINE voidOid #-}

875+

594876array_record :: TypeInfo

595877array_record = Array {

596− typoid = Oid 2287,

878+ typoid = array_recordOid,

597879 typcategory = 'P',

598880 typdelim = ',',

599881 typname = "_record",

600882 typelem = record

601883 }

602884

885+array_recordOid :: Oid

886+array_recordOid = Oid 2287

887+{-# INLINE array_recordOid #-}

888+

603889regprocedure :: TypeInfo

604890regprocedure = Basic {

605− typoid = Oid 2202,

891+ typoid = regprocedureOid,

606892 typcategory = 'N',

607893 typdelim = ',',

608894 typname = "regprocedure"

609895 }

610896

897+regprocedureOid :: Oid

898+regprocedureOid = Oid 2202

899+{-# INLINE regprocedureOid #-}

900+

611901regoper :: TypeInfo

612902regoper = Basic {

613− typoid = Oid 2203,

903+ typoid = regoperOid,

614904 typcategory = 'N',

615905 typdelim = ',',

616906 typname = "regoper"

617907 }

618908

909+regoperOid :: Oid

910+regoperOid = Oid 2203

911+{-# INLINE regoperOid #-}

912+

619913regoperator :: TypeInfo

620914regoperator = Basic {

621− typoid = Oid 2204,

915+ typoid = regoperatorOid,

622916 typcategory = 'N',

623917 typdelim = ',',

624918 typname = "regoperator"

625919 }

626920

921+regoperatorOid :: Oid

922+regoperatorOid = Oid 2204

923+{-# INLINE regoperatorOid #-}

924+

627925regclass :: TypeInfo

628926regclass = Basic {

629− typoid = Oid 2205,

927+ typoid = regclassOid,

630928 typcategory = 'N',

631929 typdelim = ',',

632930 typname = "regclass"

633931 }

634932

933+regclassOid :: Oid

934+regclassOid = Oid 2205

935+{-# INLINE regclassOid #-}

936+

635937regtype :: TypeInfo

636938regtype = Basic {

637− typoid = Oid 2206,

939+ typoid = regtypeOid,

638940 typcategory = 'N',

639941 typdelim = ',',

640942 typname = "regtype"

641943 }

642944

945+regtypeOid :: Oid

946+regtypeOid = Oid 2206

947+{-# INLINE regtypeOid #-}

948+

643949uuid :: TypeInfo

644950uuid = Basic {

645− typoid = Oid 2950,

951+ typoid = uuidOid,

646952 typcategory = 'U',

647953 typdelim = ',',

648954 typname = "uuid"

649955 }

650956

957+uuidOid :: Oid

958+uuidOid = Oid 2950

959+{-# INLINE uuidOid #-}

960+

651961json :: TypeInfo

652962json = Basic {

653− typoid = Oid 114,

963+ typoid = jsonOid,

654964 typcategory = 'U',

655965 typdelim = ',',

656966 typname = "json"

657967 }

658968

969+jsonOid :: Oid

970+jsonOid = Oid 114

971+{-# INLINE jsonOid #-}

972+

659973jsonb :: TypeInfo

660974jsonb = Basic {

661− typoid = Oid 3802,

975+ typoid = jsonbOid,

662976 typcategory = 'U',

663977 typdelim = ',',

664978 typname = "jsonb"

665979 }

666980

981+jsonbOid :: Oid

982+jsonbOid = Oid 3802

983+{-# INLINE jsonbOid #-}

984+

667985int2vector :: TypeInfo

668986int2vector = Array {

669− typoid = Oid 22,

987+ typoid = int2vectorOid,

670988 typcategory = 'A',

671989 typdelim = ',',

672990 typname = "int2vector",

673991 typelem = int2

674992 }

675993

994+int2vectorOid :: Oid

995+int2vectorOid = Oid 22

996+{-# INLINE int2vectorOid #-}

997+

676998oidvector :: TypeInfo

677999oidvector = Array {

678− typoid = Oid 30,

1000+ typoid = oidvectorOid,

6791001 typcategory = 'A',

6801002 typdelim = ',',

6811003 typname = "oidvector",

6821004 typelem = oid

6831005 }

6841006

1007+oidvectorOid :: Oid

1008+oidvectorOid = Oid 30

1009+{-# INLINE oidvectorOid #-}

1010+

6851011array_xml :: TypeInfo

6861012array_xml = Array {

687− typoid = Oid 143,

1013+ typoid = array_xmlOid,

6881014 typcategory = 'A',

6891015 typdelim = ',',

6901016 typname = "_xml",

6911017 typelem = xml

6921018 }

6931019

1020+array_xmlOid :: Oid

1021+array_xmlOid = Oid 143

1022+{-# INLINE array_xmlOid #-}

1023+

6941024array_json :: TypeInfo

6951025array_json = Array {

696− typoid = Oid 199,

1026+ typoid = array_jsonOid,

6971027 typcategory = 'A',

6981028 typdelim = ',',

6991029 typname = "_json",

7001030 typelem = json

7011031 }

7021032

1033+array_jsonOid :: Oid

1034+array_jsonOid = Oid 199

1035+{-# INLINE array_jsonOid #-}

1036+

7031037array_line :: TypeInfo

7041038array_line = Array {

705− typoid = Oid 629,

1039+ typoid = array_lineOid,

7061040 typcategory = 'A',

7071041 typdelim = ',',

7081042 typname = "_line",

7091043 typelem = line

7101044 }

7111045

1046+array_lineOid :: Oid

1047+array_lineOid = Oid 629

1048+{-# INLINE array_lineOid #-}

1049+

7121050array_cidr :: TypeInfo

7131051array_cidr = Array {

714− typoid = Oid 651,

1052+ typoid = array_cidrOid,

7151053 typcategory = 'A',

7161054 typdelim = ',',

7171055 typname = "_cidr",

7181056 typelem = cidr

7191057 }

7201058

1059+array_cidrOid :: Oid

1060+array_cidrOid = Oid 651

1061+{-# INLINE array_cidrOid #-}

1062+

7211063array_circle :: TypeInfo

7221064array_circle = Array {

723− typoid = Oid 719,

1065+ typoid = array_circleOid,

7241066 typcategory = 'A',

7251067 typdelim = ',',

7261068 typname = "_circle",

7271069 typelem = circle

7281070 }

7291071

1072+array_circleOid :: Oid

1073+array_circleOid = Oid 719

1074+{-# INLINE array_circleOid #-}

1075+

7301076array_money :: TypeInfo

7311077array_money = Array {

732− typoid = Oid 791,

1078+ typoid = array_moneyOid,

7331079 typcategory = 'A',

7341080 typdelim = ',',

7351081 typname = "_money",

7361082 typelem = money

7371083 }

7381084

1085+array_moneyOid :: Oid

1086+array_moneyOid = Oid 791

1087+{-# INLINE array_moneyOid #-}

1088+

7391089array_bool :: TypeInfo

7401090array_bool = Array {

741− typoid = Oid 1000,

1091+ typoid = array_boolOid,

7421092 typcategory = 'A',

7431093 typdelim = ',',

7441094 typname = "_bool",

7451095 typelem = bool

7461096 }

7471097

1098+array_boolOid :: Oid

1099+array_boolOid = Oid 1000

1100+{-# INLINE array_boolOid #-}

1101+

7481102array_bytea :: TypeInfo

7491103array_bytea = Array {

750− typoid = Oid 1001,

1104+ typoid = array_byteaOid,

7511105 typcategory = 'A',

7521106 typdelim = ',',

7531107 typname = "_bytea",

7541108 typelem = bytea

7551109 }

7561110

1111+array_byteaOid :: Oid

1112+array_byteaOid = Oid 1001

1113+{-# INLINE array_byteaOid #-}

1114+

7571115array_char :: TypeInfo

7581116array_char = Array {

759− typoid = Oid 1002,

1117+ typoid = array_charOid,

7601118 typcategory = 'A',

7611119 typdelim = ',',

7621120 typname = "_char",

7631121 typelem = char

7641122 }

7651123

1124+array_charOid :: Oid

1125+array_charOid = Oid 1002

1126+{-# INLINE array_charOid #-}

1127+

7661128array_name :: TypeInfo

7671129array_name = Array {

768− typoid = Oid 1003,

1130+ typoid = array_nameOid,

7691131 typcategory = 'A',

7701132 typdelim = ',',

7711133 typname = "_name",

7721134 typelem = name

7731135 }

7741136

1137+array_nameOid :: Oid

1138+array_nameOid = Oid 1003

1139+{-# INLINE array_nameOid #-}

1140+

7751141array_int2 :: TypeInfo

7761142array_int2 = Array {

777− typoid = Oid 1005,

1143+ typoid = array_int2Oid,

7781144 typcategory = 'A',

7791145 typdelim = ',',

7801146 typname = "_int2",

7811147 typelem = int2

7821148 }

7831149

1150+array_int2Oid :: Oid

1151+array_int2Oid = Oid 1005

1152+{-# INLINE array_int2Oid #-}

1153+

7841154array_int2vector :: TypeInfo

7851155array_int2vector = Array {

786− typoid = Oid 1006,

1156+ typoid = array_int2vectorOid,

7871157 typcategory = 'A',

7881158 typdelim = ',',

7891159 typname = "_int2vector",

7901160 typelem = int2vector

7911161 }

7921162

1163+array_int2vectorOid :: Oid

1164+array_int2vectorOid = Oid 1006

1165+{-# INLINE array_int2vectorOid #-}

1166+

7931167array_int4 :: TypeInfo

7941168array_int4 = Array {

795− typoid = Oid 1007,

1169+ typoid = array_int4Oid,

7961170 typcategory = 'A',

7971171 typdelim = ',',

7981172 typname = "_int4",

7991173 typelem = int4

8001174 }

8011175

1176+array_int4Oid :: Oid

1177+array_int4Oid = Oid 1007

1178+{-# INLINE array_int4Oid #-}

1179+

8021180array_regproc :: TypeInfo

8031181array_regproc = Array {

804− typoid = Oid 1008,

1182+ typoid = array_regprocOid,

8051183 typcategory = 'A',

8061184 typdelim = ',',

8071185 typname = "_regproc",

8081186 typelem = regproc

8091187 }

8101188

1189+array_regprocOid :: Oid

1190+array_regprocOid = Oid 1008

1191+{-# INLINE array_regprocOid #-}

1192+

8111193array_text :: TypeInfo

8121194array_text = Array {

813− typoid = Oid 1009,

1195+ typoid = array_textOid,

8141196 typcategory = 'A',

8151197 typdelim = ',',

8161198 typname = "_text",

8171199 typelem = text

8181200 }

8191201

1202+array_textOid :: Oid

1203+array_textOid = Oid 1009

1204+{-# INLINE array_textOid #-}

1205+

8201206array_tid :: TypeInfo

8211207array_tid = Array {

822− typoid = Oid 1010,

1208+ typoid = array_tidOid,

8231209 typcategory = 'A',

8241210 typdelim = ',',

8251211 typname = "_tid",

8261212 typelem = tid

8271213 }

8281214

1215+array_tidOid :: Oid

1216+array_tidOid = Oid 1010

1217+{-# INLINE array_tidOid #-}

1218+

8291219array_xid :: TypeInfo

8301220array_xid = Array {

831− typoid = Oid 1011,

1221+ typoid = array_xidOid,

8321222 typcategory = 'A',

8331223 typdelim = ',',

8341224 typname = "_xid",

8351225 typelem = xid

8361226 }

8371227

1228+array_xidOid :: Oid

1229+array_xidOid = Oid 1011

1230+{-# INLINE array_xidOid #-}

1231+

8381232array_cid :: TypeInfo

8391233array_cid = Array {

840− typoid = Oid 1012,

1234+ typoid = array_cidOid,

8411235 typcategory = 'A',

8421236 typdelim = ',',

8431237 typname = "_cid",

8441238 typelem = cid

8451239 }

8461240

1241+array_cidOid :: Oid

1242+array_cidOid = Oid 1012

1243+{-# INLINE array_cidOid #-}

1244+

8471245array_oidvector :: TypeInfo

8481246array_oidvector = Array {

849− typoid = Oid 1013,

1247+ typoid = array_oidvectorOid,

8501248 typcategory = 'A',

8511249 typdelim = ',',

8521250 typname = "_oidvector",

8531251 typelem = oidvector

8541252 }

8551253

1254+array_oidvectorOid :: Oid

1255+array_oidvectorOid = Oid 1013

1256+{-# INLINE array_oidvectorOid #-}

1257+

8561258array_bpchar :: TypeInfo

8571259array_bpchar = Array {

858− typoid = Oid 1014,

1260+ typoid = array_bpcharOid,

8591261 typcategory = 'A',

8601262 typdelim = ',',

8611263 typname = "_bpchar",

8621264 typelem = bpchar

8631265 }

8641266

1267+array_bpcharOid :: Oid

1268+array_bpcharOid = Oid 1014

1269+{-# INLINE array_bpcharOid #-}

1270+

8651271array_varchar :: TypeInfo

8661272array_varchar = Array {

867− typoid = Oid 1015,

1273+ typoid = array_varcharOid,

8681274 typcategory = 'A',

8691275 typdelim = ',',

8701276 typname = "_varchar",

8711277 typelem = varchar

8721278 }

8731279

1280+array_varcharOid :: Oid

1281+array_varcharOid = Oid 1015

1282+{-# INLINE array_varcharOid #-}

1283+

8741284array_int8 :: TypeInfo

8751285array_int8 = Array {

876− typoid = Oid 1016,

1286+ typoid = array_int8Oid,

8771287 typcategory = 'A',

8781288 typdelim = ',',

8791289 typname = "_int8",

8801290 typelem = int8

8811291 }

8821292

1293+array_int8Oid :: Oid

1294+array_int8Oid = Oid 1016

1295+{-# INLINE array_int8Oid #-}

1296+

8831297array_point :: TypeInfo

8841298array_point = Array {

885− typoid = Oid 1017,

1299+ typoid = array_pointOid,

8861300 typcategory = 'A',

8871301 typdelim = ',',

8881302 typname = "_point",

8891303 typelem = point

8901304 }

8911305

1306+array_pointOid :: Oid

1307+array_pointOid = Oid 1017

1308+{-# INLINE array_pointOid #-}

1309+

8921310array_lseg :: TypeInfo

8931311array_lseg = Array {

894− typoid = Oid 1018,

1312+ typoid = array_lsegOid,

8951313 typcategory = 'A',

8961314 typdelim = ',',

8971315 typname = "_lseg",

8981316 typelem = lseg

8991317 }

9001318

1319+array_lsegOid :: Oid

1320+array_lsegOid = Oid 1018

1321+{-# INLINE array_lsegOid #-}

1322+

9011323array_path :: TypeInfo

9021324array_path = Array {

903− typoid = Oid 1019,

1325+ typoid = array_pathOid,

9041326 typcategory = 'A',

9051327 typdelim = ',',

9061328 typname = "_path",

9071329 typelem = path

9081330 }

9091331

1332+array_pathOid :: Oid

1333+array_pathOid = Oid 1019

1334+{-# INLINE array_pathOid #-}

1335+

9101336array_box :: TypeInfo

9111337array_box = Array {

912− typoid = Oid 1020,

1338+ typoid = array_boxOid,

9131339 typcategory = 'A',

9141340 typdelim = ';',

9151341 typname = "_box",

9161342 typelem = box

9171343 }

9181344

1345+array_boxOid :: Oid

1346+array_boxOid = Oid 1020

1347+{-# INLINE array_boxOid #-}

1348+

9191349array_float4 :: TypeInfo

9201350array_float4 = Array {

921− typoid = Oid 1021,

1351+ typoid = array_float4Oid,

9221352 typcategory = 'A',

9231353 typdelim = ',',

9241354 typname = "_float4",

9251355 typelem = float4

9261356 }

9271357

1358+array_float4Oid :: Oid

1359+array_float4Oid = Oid 1021

1360+{-# INLINE array_float4Oid #-}

1361+

9281362array_float8 :: TypeInfo

9291363array_float8 = Array {

930− typoid = Oid 1022,

1364+ typoid = array_float8Oid,

9311365 typcategory = 'A',

9321366 typdelim = ',',

9331367 typname = "_float8",

9341368 typelem = float8

9351369 }

9361370

1371+array_float8Oid :: Oid

1372+array_float8Oid = Oid 1022

1373+{-# INLINE array_float8Oid #-}

1374+

9371375array_polygon :: TypeInfo

9381376array_polygon = Array {

939− typoid = Oid 1027,

1377+ typoid = array_polygonOid,

9401378 typcategory = 'A',

9411379 typdelim = ',',

9421380 typname = "_polygon",

9431381 typelem = polygon

9441382 }

9451383

1384+array_polygonOid :: Oid

1385+array_polygonOid = Oid 1027

1386+{-# INLINE array_polygonOid #-}

1387+

9461388array_oid :: TypeInfo

9471389array_oid = Array {

948− typoid = Oid 1028,

1390+ typoid = array_oidOid,

9491391 typcategory = 'A',

9501392 typdelim = ',',

9511393 typname = "_oid",

9521394 typelem = oid

9531395 }

9541396

1397+array_oidOid :: Oid

1398+array_oidOid = Oid 1028

1399+{-# INLINE array_oidOid #-}

1400+

9551401array_macaddr :: TypeInfo

9561402array_macaddr = Array {

957− typoid = Oid 1040,

1403+ typoid = array_macaddrOid,

9581404 typcategory = 'A',

9591405 typdelim = ',',

9601406 typname = "_macaddr",

9611407 typelem = macaddr

9621408 }

9631409

1410+array_macaddrOid :: Oid

1411+array_macaddrOid = Oid 1040

1412+{-# INLINE array_macaddrOid #-}

1413+

9641414array_inet :: TypeInfo

9651415array_inet = Array {

966− typoid = Oid 1041,

1416+ typoid = array_inetOid,

9671417 typcategory = 'A',

9681418 typdelim = ',',

9691419 typname = "_inet",

9701420 typelem = inet

9711421 }

9721422

1423+array_inetOid :: Oid

1424+array_inetOid = Oid 1041

1425+{-# INLINE array_inetOid #-}

1426+

9731427array_timestamp :: TypeInfo

9741428array_timestamp = Array {

975− typoid = Oid 1115,

1429+ typoid = array_timestampOid,

9761430 typcategory = 'A',

9771431 typdelim = ',',

9781432 typname = "_timestamp",

9791433 typelem = timestamp

9801434 }

9811435

1436+array_timestampOid :: Oid

1437+array_timestampOid = Oid 1115

1438+{-# INLINE array_timestampOid #-}

1439+

9821440array_date :: TypeInfo

9831441array_date = Array {

984− typoid = Oid 1182,

1442+ typoid = array_dateOid,

9851443 typcategory = 'A',

9861444 typdelim = ',',

9871445 typname = "_date",

9881446 typelem = date

9891447 }

9901448

1449+array_dateOid :: Oid

1450+array_dateOid = Oid 1182

1451+{-# INLINE array_dateOid #-}

1452+

9911453array_time :: TypeInfo

9921454array_time = Array {

993− typoid = Oid 1183,

1455+ typoid = array_timeOid,

9941456 typcategory = 'A',

9951457 typdelim = ',',

9961458 typname = "_time",

9971459 typelem = time

9981460 }

9991461

1462+array_timeOid :: Oid

1463+array_timeOid = Oid 1183

1464+{-# INLINE array_timeOid #-}

1465+

10001466array_timestamptz :: TypeInfo

10011467array_timestamptz = Array {

1002− typoid = Oid 1185,

1468+ typoid = array_timestamptzOid,

10031469 typcategory = 'A',

10041470 typdelim = ',',

10051471 typname = "_timestamptz",

10061472 typelem = timestamptz

10071473 }

10081474

1475+array_timestamptzOid :: Oid

1476+array_timestamptzOid = Oid 1185

1477+{-# INLINE array_timestamptzOid #-}

1478+

10091479array_interval :: TypeInfo

10101480array_interval = Array {

1011− typoid = Oid 1187,

1481+ typoid = array_intervalOid,

10121482 typcategory = 'A',

10131483 typdelim = ',',

10141484 typname = "_interval",

10151485 typelem = interval

10161486 }

10171487

1488+array_intervalOid :: Oid

1489+array_intervalOid = Oid 1187

1490+{-# INLINE array_intervalOid #-}

1491+

10181492array_numeric :: TypeInfo

10191493array_numeric = Array {

1020− typoid = Oid 1231,

1494+ typoid = array_numericOid,

10211495 typcategory = 'A',

10221496 typdelim = ',',

10231497 typname = "_numeric",

10241498 typelem = numeric

10251499 }

10261500

1501+array_numericOid :: Oid

1502+array_numericOid = Oid 1231

1503+{-# INLINE array_numericOid #-}

1504+

10271505array_timetz :: TypeInfo

10281506array_timetz = Array {

1029− typoid = Oid 1270,

1507+ typoid = array_timetzOid,

10301508 typcategory = 'A',

10311509 typdelim = ',',

10321510 typname = "_timetz",

10331511 typelem = timetz

10341512 }

10351513

1514+array_timetzOid :: Oid

1515+array_timetzOid = Oid 1270

1516+{-# INLINE array_timetzOid #-}

1517+

10361518array_bit :: TypeInfo

10371519array_bit = Array {

1038− typoid = Oid 1561,

1520+ typoid = array_bitOid,

10391521 typcategory = 'A',

10401522 typdelim = ',',

10411523 typname = "_bit",

10421524 typelem = bit

10431525 }

10441526

1527+array_bitOid :: Oid

1528+array_bitOid = Oid 1561

1529+{-# INLINE array_bitOid #-}

1530+

10451531array_varbit :: TypeInfo

10461532array_varbit = Array {

1047− typoid = Oid 1563,

1533+ typoid = array_varbitOid,

10481534 typcategory = 'A',

10491535 typdelim = ',',

10501536 typname = "_varbit",

10511537 typelem = varbit

10521538 }

10531539

1540+array_varbitOid :: Oid

1541+array_varbitOid = Oid 1563

1542+{-# INLINE array_varbitOid #-}

1543+

10541544array_refcursor :: TypeInfo

10551545array_refcursor = Array {

1056− typoid = Oid 2201,

1546+ typoid = array_refcursorOid,

10571547 typcategory = 'A',

10581548 typdelim = ',',

10591549 typname = "_refcursor",

10601550 typelem = refcursor

10611551 }

10621552

1553+array_refcursorOid :: Oid

1554+array_refcursorOid = Oid 2201

1555+{-# INLINE array_refcursorOid #-}

1556+

10631557array_regprocedure :: TypeInfo

10641558array_regprocedure = Array {

1065− typoid = Oid 2207,

1559+ typoid = array_regprocedureOid,

10661560 typcategory = 'A',

10671561 typdelim = ',',

10681562 typname = "_regprocedure",

10691563 typelem = regprocedure

10701564 }

10711565

1566+array_regprocedureOid :: Oid

1567+array_regprocedureOid = Oid 2207

1568+{-# INLINE array_regprocedureOid #-}

1569+

10721570array_regoper :: TypeInfo

10731571array_regoper = Array {

1074− typoid = Oid 2208,

1572+ typoid = array_regoperOid,

10751573 typcategory = 'A',

10761574 typdelim = ',',

10771575 typname = "_regoper",

10781576 typelem = regoper

10791577 }

10801578

1579+array_regoperOid :: Oid

1580+array_regoperOid = Oid 2208

1581+{-# INLINE array_regoperOid #-}

1582+

10811583array_regoperator :: TypeInfo

10821584array_regoperator = Array {

1083− typoid = Oid 2209,

1585+ typoid = array_regoperatorOid,

10841586 typcategory = 'A',

10851587 typdelim = ',',

10861588 typname = "_regoperator",

10871589 typelem = regoperator

10881590 }

10891591

1592+array_regoperatorOid :: Oid

1593+array_regoperatorOid = Oid 2209

1594+{-# INLINE array_regoperatorOid #-}

1595+

10901596array_regclass :: TypeInfo

10911597array_regclass = Array {

1092− typoid = Oid 2210,

1598+ typoid = array_regclassOid,

10931599 typcategory = 'A',

10941600 typdelim = ',',

10951601 typname = "_regclass",

10961602 typelem = regclass

10971603 }

10981604

1605+array_regclassOid :: Oid

1606+array_regclassOid = Oid 2210

1607+{-# INLINE array_regclassOid #-}

1608+

10991609array_regtype :: TypeInfo

11001610array_regtype = Array {

1101− typoid = Oid 2211,

1611+ typoid = array_regtypeOid,

11021612 typcategory = 'A',

11031613 typdelim = ',',

11041614 typname = "_regtype",

11051615 typelem = regtype

11061616 }

11071617

1618+array_regtypeOid :: Oid

1619+array_regtypeOid = Oid 2211

1620+{-# INLINE array_regtypeOid #-}

1621+

11081622array_uuid :: TypeInfo

11091623array_uuid = Array {

1110− typoid = Oid 2951,

1624+ typoid = array_uuidOid,

11111625 typcategory = 'A',

11121626 typdelim = ',',

11131627 typname = "_uuid",

11141628 typelem = uuid

11151629 }

11161630

1631+array_uuidOid :: Oid

1632+array_uuidOid = Oid 2951

1633+{-# INLINE array_uuidOid #-}

1634+

11171635array_jsonb :: TypeInfo

11181636array_jsonb = Array {

1119− typoid = Oid 3807,

1637+ typoid = array_jsonbOid,

11201638 typcategory = 'A',

11211639 typdelim = ',',

11221640 typname = "_jsonb",

11231641 typelem = jsonb

11241642 }

11251643

1644+array_jsonbOid :: Oid

1645+array_jsonbOid = Oid 3807

1646+{-# INLINE array_jsonbOid #-}

1647+

11261648int4range :: TypeInfo

11271649int4range = Range {

1128− typoid = Oid 3904,

1650+ typoid = int4rangeOid,

11291651 typcategory = 'R',

11301652 typdelim = ',',

11311653 typname = "int4range",

11321654 rngsubtype = int4

11331655 }

11341656

1657+int4rangeOid :: Oid

1658+int4rangeOid = Oid 3904

1659+{-# INLINE int4rangeOid #-}

1660+

11351661_int4range :: TypeInfo

11361662_int4range = Array {

1137− typoid = Oid 3905,

1663+ typoid = _int4rangeOid,

11381664 typcategory = 'A',

11391665 typdelim = ',',

11401666 typname = "_int4range",

11411667 typelem = int4range

11421668 }

11431669

1670+_int4rangeOid :: Oid

1671+_int4rangeOid = Oid 3905

1672+{-# INLINE _int4rangeOid #-}

1673+

11441674numrange :: TypeInfo

11451675numrange = Range {

1146− typoid = Oid 3906,

1676+ typoid = numrangeOid,

11471677 typcategory = 'R',

11481678 typdelim = ',',

11491679 typname = "numrange",

11501680 rngsubtype = numeric

11511681 }

11521682

1683+numrangeOid :: Oid

1684+numrangeOid = Oid 3906

1685+{-# INLINE numrangeOid #-}

1686+

11531687_numrange :: TypeInfo

11541688_numrange = Array {

1155− typoid = Oid 3907,

1689+ typoid = _numrangeOid,

11561690 typcategory = 'A',

11571691 typdelim = ',',

11581692 typname = "_numrange",

11591693 typelem = numrange

11601694 }

11611695

1696+_numrangeOid :: Oid

1697+_numrangeOid = Oid 3907

1698+{-# INLINE _numrangeOid #-}

1699+

11621700tsrange :: TypeInfo

11631701tsrange = Range {

1164− typoid = Oid 3908,

1702+ typoid = tsrangeOid,

11651703 typcategory = 'R',

11661704 typdelim = ',',

11671705 typname = "tsrange",

11681706 rngsubtype = timestamp

11691707 }

11701708

1709+tsrangeOid :: Oid

1710+tsrangeOid = Oid 3908

1711+{-# INLINE tsrangeOid #-}

1712+

11711713_tsrange :: TypeInfo

11721714_tsrange = Array {

1173− typoid = Oid 3909,

1715+ typoid = _tsrangeOid,

11741716 typcategory = 'A',

11751717 typdelim = ',',

11761718 typname = "_tsrange",

11771719 typelem = tsrange

11781720 }

11791721

1722+_tsrangeOid :: Oid

1723+_tsrangeOid = Oid 3909

1724+{-# INLINE _tsrangeOid #-}

1725+

11801726tstzrange :: TypeInfo

11811727tstzrange = Range {

1182− typoid = Oid 3910,

1728+ typoid = tstzrangeOid,

11831729 typcategory = 'R',

11841730 typdelim = ',',

11851731 typname = "tstzrange",

11861732 rngsubtype = timestamptz

11871733 }

11881734

1735+tstzrangeOid :: Oid

1736+tstzrangeOid = Oid 3910

1737+{-# INLINE tstzrangeOid #-}

1738+

11891739_tstzrange :: TypeInfo

11901740_tstzrange = Array {

1191− typoid = Oid 3911,

1741+ typoid = _tstzrangeOid,

11921742 typcategory = 'A',

11931743 typdelim = ',',

11941744 typname = "_tstzrange",

11951745 typelem = tstzrange

11961746 }

11971747

1748+_tstzrangeOid :: Oid

1749+_tstzrangeOid = Oid 3911

1750+{-# INLINE _tstzrangeOid #-}

1751+

11981752daterange :: TypeInfo

11991753daterange = Range {

1200− typoid = Oid 3912,

1754+ typoid = daterangeOid,

12011755 typcategory = 'R',

12021756 typdelim = ',',

12031757 typname = "daterange",

12041758 rngsubtype = date

12051759 }

12061760

1761+daterangeOid :: Oid

1762+daterangeOid = Oid 3912

1763+{-# INLINE daterangeOid #-}

1764+

12071765_daterange :: TypeInfo

12081766_daterange = Array {

1209− typoid = Oid 3913,

1767+ typoid = _daterangeOid,

12101768 typcategory = 'A',

12111769 typdelim = ',',

12121770 typname = "_daterange",

12131771 typelem = daterange

12141772 }

12151773

1774+_daterangeOid :: Oid

1775+_daterangeOid = Oid 3913

1776+{-# INLINE _daterangeOid #-}

1777+

12161778int8range :: TypeInfo

12171779int8range = Range {

1218− typoid = Oid 3926,

1780+ typoid = int8rangeOid,

12191781 typcategory = 'R',

12201782 typdelim = ',',

12211783 typname = "int8range",

12221784 rngsubtype = int8

12231785 }

12241786

1787+int8rangeOid :: Oid

1788+int8rangeOid = Oid 3926

1789+{-# INLINE int8rangeOid #-}

1790+

12251791_int8range :: TypeInfo

12261792_int8range = Array {

1227− typoid = Oid 3927,

1793+ typoid = _int8rangeOid,

12281794 typcategory = 'A',

12291795 typdelim = ',',

12301796 typname = "_int8range",

12311797 typelem = int8range

12321798 }

1799+

1800+_int8rangeOid :: Oid

1801+_int8rangeOid = Oid 3927

1802+{-# INLINE _int8rangeOid #-}

src/Database/PostgreSQL/Simple/Types.hs−7

@@ -50,10 +50,6 @@ import Database.PostgreSQL.Simple.Compat (toByteString)

5050data Null = Null

5151 deriving (Read, Show, Typeable)

5252

53−instance Eq Null where

54− _ == _ = False

55− _ /= _ = False

56−

5753-- | A placeholder for the PostgreSQL @DEFAULT@ value.

5854data Default = Default

5955 deriving (Read, Show, Typeable)

@@ -97,9 +93,6 @@ instance Semigroup Query where

9793

9894instance Monoid Query where

9995 mempty = Query B.empty

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

101− mappend = (<>)

102−#endif

10396

10497-- | Wrap a list of values for use in an @IN@ clause. Replaces a

10598-- 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+194−31

@@ -3,26 +3,42 @@

33{-# LANGUAGE DeriveDataTypeable #-}

44{-# LANGUAGE DoAndIfThenElse #-}

55{-# LANGUAGE ScopedTypeVariables #-}

6+#if __GLASGOW_HASKELL__ >= 806

7+{-# LANGUAGE DerivingStrategies #-}

8+{-# LANGUAGE DerivingVia #-}

9+{-# LANGUAGE DeriveAnyClass #-}

10+#endif

11+module Main (main) where

12+

613import Common

14+import Database.PostgreSQL.Simple.Copy

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

716import Database.PostgreSQL.Simple.FromField (FromField)

8−import Database.PostgreSQL.Simple.Types(Query(..),Values(..))

917import 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(..))

1121import qualified Database.PostgreSQL.Simple.Transaction as ST

1222

1323import Control.Applicative

1424import Control.Exception as E

1525import Control.Monad

1626import Data.Char

17−import Data.List (sort)

27+import Data.Foldable (toList)

28+import Data.List (concat, sort)

1829import Data.IORef

30+import Data.Monoid ((<>))

31+import Data.String (fromString)

1932import Data.Typeable

2033import GHC.Generics (Generic)

2134

2235import Data.Aeson

2336import Data.ByteString (ByteString)

2437import qualified Data.ByteString as B

38+import qualified Data.ByteString.Char8 as BS8

2539import qualified Data.ByteString.Lazy.Char8 as BL

40+import Data.CaseInsensitive (CI)

41+import qualified Data.CaseInsensitive as CI

2642import Data.Map (Map)

2743import qualified Data.Map as Map

2844import Data.Text(Text)

@@ -30,37 +46,46 @@ import qualified Data.Text.Encoding as T

3046import qualified Data.Vector as V

3147import System.FilePath

3248import System.Timeout(timeout)

33−import Data.Time(getCurrentTime, diffUTCTime)

49+import Data.Time.Compat (getCurrentTime, diffUTCTime)

50+import System.Environment (getEnvironment)

3451

3552import Test.Tasty

3653import Test.Tasty.Golden

3754import Notify

3855import Serializable

3956import Time

57+import Interval

58+import Exception (testExceptions)

4059

4160tests :: TestEnv -> TestTree

4261tests env = testGroup "tests"

4362 $ map ($ env)

4463 [ testBytea

45− , testCase "ExecuteMany" . testExecuteMany

46− , testCase "Fold" . testFold

47− , testCase "Notify" . testNotify

48− , testCase "Serializable" . testSerializable

49− , testCase "Time" . testTime

50− , testCase "Array" . testArray

51− , testCase "Array of nullables" . testNullableArray

52− , testCase "HStore" . testHStore

53− , testCase "JSON" . testJSON

54− , testCase "Savepoint" . testSavepoint

55− , testCase "Unicode" . testUnicode

56− , testCase "Values" . testValues

57− , testCase "Copy" . testCopy

64+ , testCase "ExecuteMany" . testExecuteMany

65+ , testCase "Fold" . testFold

66+ , testCase "Notify" . testNotify

67+ , testCase "Serializable" . testSerializable

68+ , testCase "Time" . testTime

69+ , testCase "Interval" . testInterval

70+ , testCase "Array" . testArray

71+ , testCase "Array of nullables" . testNullableArray

72+ , testCase "HStore" . testHStore

73+ , testCase "citext" . testCIText

74+ , testCase "JSON" . testJSON

75+ , testCase "Aeson newtype" . testAeson

76+ , testCase "DerivingVia" . testDerivingVia

77+ , testCase "Question mark escape" . testQM

78+ , testCase "Savepoint" . testSavepoint

79+ , testCase "Unicode" . testUnicode

80+ , testCase "Values" . testValues

81+ , testCase "Copy" . testCopy

5882 , testCopyFailures

59− , testCase "Double" . testDouble

60− , testCase "1-ary generic" . testGeneric1

61− , testCase "2-ary generic" . testGeneric2

62− , testCase "3-ary generic" . testGeneric3

63− , testCase "Timeout" . testTimeout

83+ , testCase "Double" . testDouble

84+ , testCase "1-ary generic" . testGeneric1

85+ , testCase "2-ary generic" . testGeneric2

86+ , testCase "3-ary generic" . testGeneric3

87+ , testCase "Timeout" . testTimeout

88+ , testCase "Exceptions" . testExceptions

6489 ]

6590

6691testBytea :: TestEnv -> TestTree

@@ -114,7 +139,7 @@ testFold TestEnv{..} = do

114139 xs <- readIORef ref

115140 writeIORef ref $! (a,b):xs

116141 xs <- readIORef ref

117− reverse xs @?= [(a,b) | a <- [1..100], b <- [1..50]]

142+ reverse xs @?= [(a,b) | b <- [1..50], a <- [1..100]]

118143

119144 -- Make sure fold propagates our exception.

120145 ref <- newIORef []

@@ -203,6 +228,19 @@ testHStore TestEnv{..} = do

203228 m' <- query conn "SELECT ?::hstore" m

204229 [m] @?= m'

205230

231+testCIText :: TestEnv -> Assertion

232+testCIText TestEnv{..} = do

233+ execute_ conn "CREATE EXTENSION IF NOT EXISTS citext"

234+ roundTrip (CI.mk "")

235+ roundTrip (CI.mk "UPPERCASE")

236+ roundTrip (CI.mk "lowercase")

237+ where

238+ roundTrip :: (CI Text) -> Assertion

239+ roundTrip cit = do

240+ let toPostgres = Only cit

241+ fromPostgres <- query conn "SELECT ?::citext" toPostgres

242+ [toPostgres] @?= fromPostgres

243+

206244testJSON :: TestEnv -> Assertion

207245testJSON TestEnv{..} = do

208246 roundTrip (Map.fromList [] :: Map Text Text)

@@ -218,6 +256,90 @@ testJSON TestEnv{..} = do

218256 js' <- query conn "SELECT ?::json" js

219257 [js] @?= js'

220258

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+

221343testSavepoint :: TestEnv -> Assertion

222344testSavepoint TestEnv{..} = do

223345 True <- expectError ST.isNoActiveTransactionError $

@@ -325,6 +447,14 @@ testCopy TestEnv{..} = do

325447 -- so that we can issue more queries:

326448 [Only (x::Int)] <- query_ conn "SELECT 2 + 2"

327449 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

328458 where

329459 copyRows = ["1,foo\n"

330460 ,"2,bar\n"]

@@ -344,12 +474,13 @@ testCopyFailures env = testGroup "Copy failures"

344474

345475goldenTest :: TestName -> IO BL.ByteString -> TestTree

346476goldenTest testName =

347− goldenVsString testName (resultsDir </> fileName<.>"expected")

477+ goldenVsStringDiff testName diff (resultsDir </> fileName<.>"expected")

348478 where

349479 resultsDir = "test" </> "results"

350480 fileName = map normalize testName

351481 normalize c | not (isAlpha c) = '-'

352482 | otherwise = c

483+ diff ref new = ["diff", "-u", ref, new]

353484

354485-- | Test that we provide a sensible error message on failure

355486testCopyUniqueConstraintError :: TestEnv -> TestTree

@@ -462,24 +593,56 @@ isUniqueViolation SqlError{..} = sqlState == "23505"

462593isSyntaxError :: SqlError -> Bool

463594isSyntaxError SqlError{..} = sqlState == "42601"

464595

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

465604------------------------------------------------------------------------

466605

467606-- | Action for connecting to the database that will be used for testing.

468607--

469608-- Note that some tests, such as Notify, use multiple connections, and assume

470609-- that 'testConnect' connects to the same database every time it is called.

471−testConnect :: IO Connection

472−testConnect = connectPostgreSQL ""

610+withTestEnv :: ByteString -> (TestEnv -> IO a) -> IO a

611+withTestEnv connstr cb =

612+ withConn $ \conn -> do

613+ -- currently required for interval to work.

614+ -- we also test that this doesn't interfere with anything else

615+ execute_ conn "SET intervalstyle TO 'iso_8601'"

473616

474−withTestEnv :: (TestEnv -> IO a) -> IO a

475−withTestEnv cb =

476− withConn $ \conn ->

477617 cb TestEnv

478618 { conn = conn

479619 , withConn = withConn

480620 }

481621 where

482− withConn = bracket testConnect close

622+ withConn = bracket (connectPostgreSQL connstr) close

483623

484624main :: IO ()

485−main = withTestEnv $ defaultMain . tests

625+main = withConnstring $ \connstring -> do

626+ withTestEnv connstring (defaultMain . tests)

627+

628+withConnstring :: (BS8.ByteString -> IO ()) -> IO ()

629+withConnstring kont = do

630+ env <- getEnvironment

631+ case lookup "DATABASE_CONNSTRING" env of

632+ Just s -> kont (BS8.pack (special s))

633+ Nothing -> case lookup "GITHUB_ACTIONS" env of

634+ Just "true" -> kont (BS8.pack gha)

635+ _ -> putStrLn "Set DATABASE_CONNSTRING environment variable"

636+ where

637+ -- https://www.appveyor.com/docs/services-databases/

638+ special "appveyor" = "dbname='TestDb' user='postgres' password='Password12!'"

639+ special "travis" = ""

640+ special s = s

641+

642+ gha = unwords

643+ [ "dbname='postgres'"

644+ , "user='postgres'"

645+ , "password='postgres'"

646+ , "host='postgres'"

647+ , "port=5432"

648+ ]

test/Time.hs+1−1

@@ -36,7 +36,7 @@ module Time (testTime) where

3636

3737import Common

3838import Control.Monad(forM_, replicateM_)

39−import Data.Time

39+import Data.Time.Compat

4040import Data.ByteString(ByteString)

4141import Database.PostgreSQL.Simple.SqlQQ

4242

test/results/malformed-input.expected+1−1

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

11user error (Database.PostgreSQL.Simple.Copy.putCopyEnd: failed to parse command status

2−Connection error: ERROR: invalid input syntax for integer: "z"

2+Connection error: ERROR: invalid input syntax for type integer: "z"

33CONTEXT: COPY copy_unique_constraint_error_test, line 3, column x: "z"

44)

tools/GenTypeInfo.hs+39−25

@@ -21,6 +21,9 @@

2121-- know about. It then constructs a TypeInfo record and stores it in

2222-- a per-connection cache for later use.

2323--

24+-- @

25+-- runghc -itools tools/GenTypeInfo.hs

26+-- @

2427------------------------------------------------------------------------------

2528

2629{-# LANGUAGE OverloadedStrings, QuasiQuotes, ViewPatterns, RecordWildCards #-}

@@ -38,12 +41,10 @@ import Database.PostgreSQL.Simple.FromRow

3841import Database.PostgreSQL.Simple.Ok

3942import Database.PostgreSQL.Simple.Types(Oid(..))

4043import Database.PostgreSQL.Simple.SqlQQ

41−import qualified Data.ByteString.Char8 as B

44+import qualified Data.ByteString.Char8 as B8

4245import Data.ByteString(ByteString)

4346import qualified Data.ByteString.Lazy as L

44−import qualified Blaze.ByteString.Builder as Blaze

45−import qualified Blaze.ByteString.Builder.ByteString as Blaze

46−import qualified Blaze.ByteString.Builder.Char8 as Blaze

47+import qualified Data.ByteString.Builder as Blaze

4748import Data.String

4849import Data.List ( sort, intersperse )

4950import qualified Data.Map as Map

@@ -69,11 +70,11 @@ data TypeInfo = TypeInfo

6970instance FromRow TypeInfo where

7071 fromRow = TypeInfo <$> field <*> field <*> field <*> field <*> field <*> field

7172

72−type NameMap = Map.Map B.ByteString TypeInfo

73+type NameMap = Map.Map B8.ByteString TypeInfo

7374

7475type OidMap = Map.Map Oid TypeInfo

7576

76−type TypeName = (B.ByteString, B.ByteString)

77+type TypeName = (B8.ByteString, B8.ByteString)

7778

7879type TypeNames = [TypeName]

7980

@@ -197,9 +198,6 @@ int8range

197198_int8range

198199|]

199200

200−instance IsString Blaze.Builder where

201− fromString = Blaze.fromByteString . fromString

202−

203201connectionString = "dbname=postgres"

204202

205203withPostgreSQL = bracket (connectPostgreSQL connectionString) close

@@ -237,7 +235,7 @@ getTypeInfos typnames = withPostgreSQL $ \conn -> do

237235

238236main = do

239237 (oidmap, namemap) <- getTypeInfos typeNames

240− L.writeFile "../src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

238+ L.writeFile "src/Database/PostgreSQL/Simple/TypeInfo/Static.hs"

241239 (Blaze.toLazyByteString (renderFile oidmap namemap typeNames))

242240

243241

@@ -246,7 +244,7 @@ showOid (Oid n) = show n

246244renderOid :: NameMap -> TypeName -> Blaze.Builder

247245renderOid byName name

248246 = case Map.lookup (pg name) byName of

249− Nothing -> error (B.unpack (pg name))

247+ Nothing -> error (B8.unpack (pg name))

250248 Just (showOid . typoid -> n) -> fromString n

251249 ++ fromString (replicate (4 - length n) ' ')

252250

@@ -264,20 +262,25 @@ renderTypeInfo byOid info name

264262 typelem_hs_name =

265263 case lookup (typname typelem_info) typeNames of

266264 Nothing -> error ( "type not found: "

267− ++ B.unpack( typname typelem_info)

268− ++ " (typelem of " ++ B.unpack (typname info)

265+ ++ B8.unpack( typname typelem_info)

266+ ++ " (typelem of " ++ B8.unpack (typname info)

269267 ++ ")")

270268 Just x -> x

271269 in concat

272270 [ "\n"

273271 , bs (hs name), " :: TypeInfo\n"

274272 , bs (hs name), " = Array {\n"

275− , " typoid = ", fromString (show (typoid info)), ",\n"

276− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

277− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

273+ , " typoid = ", bs (hs name), "Oid,\n"

274+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

275+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

278276 , " typname = \"", bs (typname info), "\",\n"

279277 , " typelem = ", bs typelem_hs_name, "\n"

280278 , " }\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"

281284 ]

282285 | typcategory info == 'R' =

283286 let (Just rngsubtype_oid) = rngsubtype info

@@ -285,31 +288,41 @@ renderTypeInfo byOid info name

285288 rngsubtype_hs_name =

286289 case lookup (typname rngsubtype_info) typeNames of

287290 Nothing -> error ( "type not found: "

288− ++ B.unpack (typname rngsubtype_info)

291+ ++ B8.unpack (typname rngsubtype_info)

289292 ++ " (rngsubtype of "

290− ++ B.unpack (typname info) ++ ")")

293+ ++ B8.unpack (typname info) ++ ")")

291294 Just x -> x

292295 in concat

293296 [ "\n"

294297 , bs (hs name), " :: TypeInfo\n"

295298 , bs (hs name), " = Range {\n"

296− , " typoid = ", fromString (show (typoid info)), ",\n"

297− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

298− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

299+ , " typoid = ", bs (hs name), "Oid,\n"

300+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

301+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

299302 , " typname = \"", bs (typname info), "\",\n"

300303 , " rngsubtype = ", bs rngsubtype_hs_name, "\n"

301304 , " }\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"

302310 ]

303311 | otherwise =

304312 concat

305313 [ "\n"

306314 , bs (hs name), " :: TypeInfo\n"

307315 , bs (hs name), " = Basic {\n"

308− , " typoid = ", fromString (show (typoid info)), ",\n"

309− , " typcategory = '", Blaze.fromChar (typcategory info), "',\n"

310− , " typdelim = '", Blaze.fromChar (typdelim info), "',\n"

316+ , " typoid = ", bs (hs name), "Oid,\n"

317+ , " typcategory = '", bs $ B8.singleton (typcategory info), "',\n"

318+ , " typdelim = '", bs $ B8.singleton (typdelim info), "',\n"

311319 , " typname = \"", bs (typname info), "\"\n"

312320 , " }\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"

313326 ]

314327

315328-- FIXME: add in any names that we need that we didn't specify, (i.e.

@@ -318,7 +331,7 @@ renderTypeInfo byOid info name

318331getNames :: NameMap -> TypeNames -> TypeNames

319332getNames _ x = x

320333

321−bs = Blaze.fromByteString

334+bs = Blaze.byteString

322335

323336pg = fst

324337

@@ -347,6 +360,7 @@ module Database.PostgreSQL.Simple.TypeInfo.Static

347360 ( TypeInfo(..)

348361 , staticTypeInfo

349362|] ++ concat [ " , " ++ bs (hs name) ++ "\n"

363+ ++ " , " ++ bs (hs name) ++ "Oid\n"

350364 | name <- names ] ++ [longstring|

351365 ) where

352366