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

git.iko.soy/typeable/postgresql-simple

49 files changed+2500−698

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+138−8

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

1−### Unreleased

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

3+ * Remove Eq Null instance. (Future `base` may break it, we remove it profilacticly).

4+ * Use `postgresql-libpq >=0.10.0.0`. It includes critical fixes,

5+ by using `postgresql-simple >=0.7` you won't get older `postgresql-libpq`.

6+ * Drop support for GHC prior 8.6

7+ * Added a class for `postgresql-simple` exceptions: `SomePostgreSqlException`.

8+ This allows to catch all `postgresql-simple` exceptions at once.

9+ (c.f. `AsyncException` in `base).

10+

11+### Version 0.6.5.1 (2023-07-09)

12+

13+ * Support `aeson-2.2.0.0`

14+

15+### Version 0.6.5 (2022-10-30)

16+

17+ * Add `withConnect`

18+

19+### Version 0.6.4 (2021-01-06)

20+

21+ * Add foldCopyData helper function

22+ Thanks to Sebastián Estrella for the implementation

23+ https://github.com/haskellari/postgresql-simple/pull/56

24+ * Implement support for postgresql 'interval' type

25+ Thanks to Andre Marques Lee for the implementation

26+ https://github.com/haskellari/postgresql-simple/pull/60

27+ * Depend on `time-compat` to provide uniform `time` related interface.

28+

29+### Version 0.6.3 (2020-11-15)

30+

31+ * Add `fromFieldJSONByteString`

32+ Thanks to tomjaguarpaw for the implementation

33+ https://github.com/haskellari/postgresql-simple/pull/47

34+ * Add `attoFieldParser`

35+ Thanks to Victor Nawothnig for the implementation

36+ https://github.com/haskellari/postgresql-simple/pull/45

37+ * Add `Identity` and `Const` instance

38+ Thanks to Cary Robbins for the implementation

39+ https://github.com/haskellari/postgresql-simple/pull/46

40+ * Add `withTransactionModeRetry'`, a variant of `withTransactionModeRetry`

41+ for all exception types.

42+ Thanks to Elliot Cameron for the implementation

43+ https://github.com/haskellari/postgresql-simple/pull/42

44+ * Fix spurious aborts when retrying transactions

45+ Thanks to Elliot Cameron for the implementation

46+ https://github.com/haskellari/postgresql-simple/pull/34

47+ * Add `Database.PostgreSQL.Simple.Newtypes` module

48+ with `Aeson` newtype.

49+ https://github.com/haskellari/postgresql-simple/pull/55

50+

51+### Version 0.6.2 (2019-04-26)

252

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

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

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.

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

6136

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

8138 * Refactored some rudimentary cursor handling code out of the

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

141271 support UTF8 except for Mule Internal Code, the Multilingual

142272 Extensions for Emacs. An exception should be raised upon

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

144− accomodate this requirement.

274+ accommodate this requirement.

145275

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

147277

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

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

262392

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

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

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

265395

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

267397 foldWithOptions, executeMany, and returning operators.

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

279409

280410 * Changed the Identifier and QualifiedIdentifier to use Text in

281411 order to avoid encoding errors. Technically this requires a

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

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

283413

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

285415 and tweaked error messages.

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

439569

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

441571 convenient and efficient access to the pg_type metatable. This

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

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

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

444574 work on this feature.

445575

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

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

532662

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

534− that accomodate PostgreSQL's infinities.

664+ that accommodate PostgreSQL's infinities.

535665

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

537667 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−124

@@ -1,136 +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− , case-insensitive

133−

134− if !impl(ghc >= 7.6)

135− build-depends:

136− 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+19−2

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

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+14−2

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

@@ -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+22−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

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

5559import qualified Database.PostgreSQL.LibPQ as PQ

5660import Database.PostgreSQL.Simple.Time

5761import Data.Scientific (Scientific)

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

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

60−#else

61−import Data.Scientific (scientificBuilder)

62−#endif

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

6464

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

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

100100 toField a = a

101101 {-# INLINE toField #-}

102102

103+instance (ToField a) => ToField (Const a b) where

104+ toField (Const a) = toField a

105+ {-# INLINE toField #-}

106+

107+instance (ToField a) => ToField (Identity a) where

108+ toField (Identity a) = toField a

109+ {-# INLINE toField #-}

110+

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

104112 toField Nothing = renderNull

105113 toField (Just a) = toField a

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

282290 toField = Plain . inQuotes . nominalDiffTimeToBuilder

283291 {-# INLINE toField #-}

284292

293+instance ToField CalendarDiffTime where

294+ toField = Plain . inQuotes . calendarDiffTimeToBuilder

295+ {-# INLINE toField #-}

296+

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

286298 toField pgArray =

287299 case fromPGArray pgArray of

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

302314instance ToField JSON.Value where

303315 toField = toField . JSON.encode

304316

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

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

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

307318--

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

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

310321-- PostgreSQL.

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

312−toJSONField = toField . JSON.toJSON

323+toJSONField = toField . JSON.encode

313324

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

315326--

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

319330 where quote = char8 '\''

320331

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

322−interleaveFoldr f b bs as = foldr (\a bs -> b : f a bs) bs as

333+interleaveFoldr f b bs' as = foldr (\a bs -> b : f a bs) bs' as

323334{-# INLINE interleaveFoldr #-}

324335

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

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

366377

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

368379 typedRows [] _ _ = error funcname

369− typedRows (val:vals) types rest =

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

380+ typedRows (val:vals) typs rest =

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

371382

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

373384 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+683−134

@@ -19,121 +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

135− , citext

136− , array_citext

248+ , _int8rangeOid

137249 ) where

138250

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

@@ -255,999 +367,1436 @@ staticTypeInfo (Oid x) = case x of

255367 3913 -> Just _daterange

256368 3926 -> Just int8range

257369 3927 -> Just _int8range

258− 60129 -> Just citext

259− 60134 -> Just array_citext

260370 _ -> Nothing

261371

262372bool :: TypeInfo

263373bool = Basic {

264− typoid = Oid 16,

374+ typoid = boolOid,

265375 typcategory = 'B',

266376 typdelim = ',',

267377 typname = "bool"

268378 }

269379

380+boolOid :: Oid

381+boolOid = Oid 16

382+{-# INLINE boolOid #-}

383+

270384bytea :: TypeInfo

271385bytea = Basic {

272− typoid = Oid 17,

386+ typoid = byteaOid,

273387 typcategory = 'U',

274388 typdelim = ',',

275389 typname = "bytea"

276390 }

277391

392+byteaOid :: Oid

393+byteaOid = Oid 17

394+{-# INLINE byteaOid #-}

395+

278396char :: TypeInfo

279397char = Basic {

280− typoid = Oid 18,

398+ typoid = charOid,

281399 typcategory = 'S',

282400 typdelim = ',',

283401 typname = "char"

284402 }

285403

404+charOid :: Oid

405+charOid = Oid 18

406+{-# INLINE charOid #-}

407+

286408name :: TypeInfo

287409name = Basic {

288− typoid = Oid 19,

410+ typoid = nameOid,

289411 typcategory = 'S',

290412 typdelim = ',',

291413 typname = "name"

292414 }

293415

416+nameOid :: Oid

417+nameOid = Oid 19

418+{-# INLINE nameOid #-}

419+

294420int8 :: TypeInfo

295421int8 = Basic {

296− typoid = Oid 20,

422+ typoid = int8Oid,

297423 typcategory = 'N',

298424 typdelim = ',',

299425 typname = "int8"

300426 }

301427

428+int8Oid :: Oid

429+int8Oid = Oid 20

430+{-# INLINE int8Oid #-}

431+

302432int2 :: TypeInfo

303433int2 = Basic {

304− typoid = Oid 21,

434+ typoid = int2Oid,

305435 typcategory = 'N',

306436 typdelim = ',',

307437 typname = "int2"

308438 }

309439

440+int2Oid :: Oid

441+int2Oid = Oid 21

442+{-# INLINE int2Oid #-}

443+

310444int4 :: TypeInfo

311445int4 = Basic {

312− typoid = Oid 23,

446+ typoid = int4Oid,

313447 typcategory = 'N',

314448 typdelim = ',',

315449 typname = "int4"

316450 }

317451

452+int4Oid :: Oid

453+int4Oid = Oid 23

454+{-# INLINE int4Oid #-}

455+

318456regproc :: TypeInfo

319457regproc = Basic {

320− typoid = Oid 24,

458+ typoid = regprocOid,

321459 typcategory = 'N',

322460 typdelim = ',',

323461 typname = "regproc"

324462 }

325463

464+regprocOid :: Oid

465+regprocOid = Oid 24

466+{-# INLINE regprocOid #-}

467+

326468text :: TypeInfo

327469text = Basic {

328− typoid = Oid 25,

470+ typoid = textOid,

329471 typcategory = 'S',

330472 typdelim = ',',

331473 typname = "text"

332474 }

333475

476+textOid :: Oid

477+textOid = Oid 25

478+{-# INLINE textOid #-}

479+

334480oid :: TypeInfo

335481oid = Basic {

336− typoid = Oid 26,

482+ typoid = oidOid,

337483 typcategory = 'N',

338484 typdelim = ',',

339485 typname = "oid"

340486 }

341487

488+oidOid :: Oid

489+oidOid = Oid 26

490+{-# INLINE oidOid #-}

491+

342492tid :: TypeInfo

343493tid = Basic {

344− typoid = Oid 27,

494+ typoid = tidOid,

345495 typcategory = 'U',

346496 typdelim = ',',

347497 typname = "tid"

348498 }

349499

500+tidOid :: Oid

501+tidOid = Oid 27

502+{-# INLINE tidOid #-}

503+

350504xid :: TypeInfo

351505xid = Basic {

352− typoid = Oid 28,

506+ typoid = xidOid,

353507 typcategory = 'U',

354508 typdelim = ',',

355509 typname = "xid"

356510 }

357511

512+xidOid :: Oid

513+xidOid = Oid 28

514+{-# INLINE xidOid #-}

515+

358516cid :: TypeInfo

359517cid = Basic {

360− typoid = Oid 29,

518+ typoid = cidOid,

361519 typcategory = 'U',

362520 typdelim = ',',

363521 typname = "cid"

364522 }

365523

524+cidOid :: Oid

525+cidOid = Oid 29

526+{-# INLINE cidOid #-}

527+

366528xml :: TypeInfo

367529xml = Basic {

368− typoid = Oid 142,

530+ typoid = xmlOid,

369531 typcategory = 'U',

370532 typdelim = ',',

371533 typname = "xml"

372534 }

373535

536+xmlOid :: Oid

537+xmlOid = Oid 142

538+{-# INLINE xmlOid #-}

539+

374540point :: TypeInfo

375541point = Basic {

376− typoid = Oid 600,

542+ typoid = pointOid,

377543 typcategory = 'G',

378544 typdelim = ',',

379545 typname = "point"

380546 }

381547

548+pointOid :: Oid

549+pointOid = Oid 600

550+{-# INLINE pointOid #-}

551+

382552lseg :: TypeInfo

383553lseg = Basic {

384− typoid = Oid 601,

554+ typoid = lsegOid,

385555 typcategory = 'G',

386556 typdelim = ',',

387557 typname = "lseg"

388558 }

389559

560+lsegOid :: Oid

561+lsegOid = Oid 601

562+{-# INLINE lsegOid #-}

563+

390564path :: TypeInfo

391565path = Basic {

392− typoid = Oid 602,

566+ typoid = pathOid,

393567 typcategory = 'G',

394568 typdelim = ',',

395569 typname = "path"

396570 }

397571

572+pathOid :: Oid

573+pathOid = Oid 602

574+{-# INLINE pathOid #-}

575+

398576box :: TypeInfo

399577box = Basic {

400− typoid = Oid 603,

578+ typoid = boxOid,

401579 typcategory = 'G',

402580 typdelim = ';',

403581 typname = "box"

404582 }

405583

584+boxOid :: Oid

585+boxOid = Oid 603

586+{-# INLINE boxOid #-}

587+

406588polygon :: TypeInfo

407589polygon = Basic {

408− typoid = Oid 604,

590+ typoid = polygonOid,

409591 typcategory = 'G',

410592 typdelim = ',',

411593 typname = "polygon"

412594 }

413595

596+polygonOid :: Oid

597+polygonOid = Oid 604

598+{-# INLINE polygonOid #-}

599+

414600line :: TypeInfo

415601line = Basic {

416− typoid = Oid 628,

602+ typoid = lineOid,

417603 typcategory = 'G',

418604 typdelim = ',',

419605 typname = "line"

420606 }

421607

608+lineOid :: Oid

609+lineOid = Oid 628

610+{-# INLINE lineOid #-}

611+

422612cidr :: TypeInfo

423613cidr = Basic {

424− typoid = Oid 650,

614+ typoid = cidrOid,

425615 typcategory = 'I',

426616 typdelim = ',',

427617 typname = "cidr"

428618 }

429619

620+cidrOid :: Oid

621+cidrOid = Oid 650

622+{-# INLINE cidrOid #-}

623+

430624float4 :: TypeInfo

431625float4 = Basic {

432− typoid = Oid 700,

626+ typoid = float4Oid,

433627 typcategory = 'N',

434628 typdelim = ',',

435629 typname = "float4"

436630 }

437631

632+float4Oid :: Oid

633+float4Oid = Oid 700

634+{-# INLINE float4Oid #-}

635+

438636float8 :: TypeInfo

439637float8 = Basic {

440− typoid = Oid 701,

638+ typoid = float8Oid,

441639 typcategory = 'N',

442640 typdelim = ',',

443641 typname = "float8"

444642 }

445643

644+float8Oid :: Oid

645+float8Oid = Oid 701

646+{-# INLINE float8Oid #-}

647+

446648unknown :: TypeInfo

447649unknown = Basic {

448− typoid = Oid 705,

650+ typoid = unknownOid,

449651 typcategory = 'X',

450652 typdelim = ',',

451653 typname = "unknown"

452654 }

453655

656+unknownOid :: Oid

657+unknownOid = Oid 705

658+{-# INLINE unknownOid #-}

659+

454660circle :: TypeInfo

455661circle = Basic {

456− typoid = Oid 718,

662+ typoid = circleOid,

457663 typcategory = 'G',

458664 typdelim = ',',

459665 typname = "circle"

460666 }

461667

668+circleOid :: Oid

669+circleOid = Oid 718

670+{-# INLINE circleOid #-}

671+

462672money :: TypeInfo

463673money = Basic {

464− typoid = Oid 790,

674+ typoid = moneyOid,

465675 typcategory = 'N',

466676 typdelim = ',',

467677 typname = "money"

468678 }

469679

680+moneyOid :: Oid

681+moneyOid = Oid 790

682+{-# INLINE moneyOid #-}

683+

470684macaddr :: TypeInfo

471685macaddr = Basic {

472− typoid = Oid 829,

686+ typoid = macaddrOid,

473687 typcategory = 'U',

474688 typdelim = ',',

475689 typname = "macaddr"

476690 }

477691

692+macaddrOid :: Oid

693+macaddrOid = Oid 829

694+{-# INLINE macaddrOid #-}

695+

478696inet :: TypeInfo

479697inet = Basic {

480− typoid = Oid 869,

698+ typoid = inetOid,

481699 typcategory = 'I',

482700 typdelim = ',',

483701 typname = "inet"

484702 }

485703

704+inetOid :: Oid

705+inetOid = Oid 869

706+{-# INLINE inetOid #-}

707+

486708bpchar :: TypeInfo

487709bpchar = Basic {

488− typoid = Oid 1042,

710+ typoid = bpcharOid,

489711 typcategory = 'S',

490712 typdelim = ',',

491713 typname = "bpchar"

492714 }

493715

716+bpcharOid :: Oid

717+bpcharOid = Oid 1042

718+{-# INLINE bpcharOid #-}

719+

494720varchar :: TypeInfo

495721varchar = Basic {

496− typoid = Oid 1043,

722+ typoid = varcharOid,

497723 typcategory = 'S',

498724 typdelim = ',',

499725 typname = "varchar"

500726 }

501727

728+varcharOid :: Oid

729+varcharOid = Oid 1043

730+{-# INLINE varcharOid #-}

731+

502732date :: TypeInfo

503733date = Basic {

504− typoid = Oid 1082,

734+ typoid = dateOid,

505735 typcategory = 'D',

506736 typdelim = ',',

507737 typname = "date"

508738 }

509739

740+dateOid :: Oid

741+dateOid = Oid 1082

742+{-# INLINE dateOid #-}

743+

510744time :: TypeInfo

511745time = Basic {

512− typoid = Oid 1083,

746+ typoid = timeOid,

513747 typcategory = 'D',

514748 typdelim = ',',

515749 typname = "time"

516750 }

517751

752+timeOid :: Oid

753+timeOid = Oid 1083

754+{-# INLINE timeOid #-}

755+

518756timestamp :: TypeInfo

519757timestamp = Basic {

520− typoid = Oid 1114,

758+ typoid = timestampOid,

521759 typcategory = 'D',

522760 typdelim = ',',

523761 typname = "timestamp"

524762 }

525763

764+timestampOid :: Oid

765+timestampOid = Oid 1114

766+{-# INLINE timestampOid #-}

767+

526768timestamptz :: TypeInfo

527769timestamptz = Basic {

528− typoid = Oid 1184,

770+ typoid = timestamptzOid,

529771 typcategory = 'D',

530772 typdelim = ',',

531773 typname = "timestamptz"

532774 }

533775

776+timestamptzOid :: Oid

777+timestamptzOid = Oid 1184

778+{-# INLINE timestamptzOid #-}

779+

534780interval :: TypeInfo

535781interval = Basic {

536− typoid = Oid 1186,

782+ typoid = intervalOid,

537783 typcategory = 'T',

538784 typdelim = ',',

539785 typname = "interval"

540786 }

541787

788+intervalOid :: Oid

789+intervalOid = Oid 1186

790+{-# INLINE intervalOid #-}

791+

542792timetz :: TypeInfo

543793timetz = Basic {

544− typoid = Oid 1266,

794+ typoid = timetzOid,

545795 typcategory = 'D',

546796 typdelim = ',',

547797 typname = "timetz"

548798 }

549799

800+timetzOid :: Oid

801+timetzOid = Oid 1266

802+{-# INLINE timetzOid #-}

803+

550804bit :: TypeInfo

551805bit = Basic {

552− typoid = Oid 1560,

806+ typoid = bitOid,

553807 typcategory = 'V',

554808 typdelim = ',',

555809 typname = "bit"

556810 }

557811

812+bitOid :: Oid

813+bitOid = Oid 1560

814+{-# INLINE bitOid #-}

815+

558816varbit :: TypeInfo

559817varbit = Basic {

560− typoid = Oid 1562,

818+ typoid = varbitOid,

561819 typcategory = 'V',

562820 typdelim = ',',

563821 typname = "varbit"

564822 }

565823

824+varbitOid :: Oid

825+varbitOid = Oid 1562

826+{-# INLINE varbitOid #-}

827+

566828numeric :: TypeInfo

567829numeric = Basic {

568− typoid = Oid 1700,

830+ typoid = numericOid,

569831 typcategory = 'N',

570832 typdelim = ',',

571833 typname = "numeric"

572834 }

573835

836+numericOid :: Oid

837+numericOid = Oid 1700

838+{-# INLINE numericOid #-}

839+

574840refcursor :: TypeInfo

575841refcursor = Basic {

576− typoid = Oid 1790,

842+ typoid = refcursorOid,

577843 typcategory = 'U',

578844 typdelim = ',',

579845 typname = "refcursor"

580846 }

581847

848+refcursorOid :: Oid

849+refcursorOid = Oid 1790

850+{-# INLINE refcursorOid #-}

851+

582852record :: TypeInfo

583853record = Basic {

584− typoid = Oid 2249,

854+ typoid = recordOid,

585855 typcategory = 'P',

586856 typdelim = ',',

587857 typname = "record"

588858 }

589859

860+recordOid :: Oid

861+recordOid = Oid 2249

862+{-# INLINE recordOid #-}

863+

590864void :: TypeInfo

591865void = Basic {

592− typoid = Oid 2278,

866+ typoid = voidOid,

593867 typcategory = 'P',

594868 typdelim = ',',

595869 typname = "void"

596870 }

597871

872+voidOid :: Oid

873+voidOid = Oid 2278

874+{-# INLINE voidOid #-}

875+

598876array_record :: TypeInfo

599877array_record = Array {

600− typoid = Oid 2287,

878+ typoid = array_recordOid,

601879 typcategory = 'P',

602880 typdelim = ',',

603881 typname = "_record",

604882 typelem = record

605883 }

606884

885+array_recordOid :: Oid

886+array_recordOid = Oid 2287

887+{-# INLINE array_recordOid #-}

888+

607889regprocedure :: TypeInfo

608890regprocedure = Basic {

609− typoid = Oid 2202,

891+ typoid = regprocedureOid,

610892 typcategory = 'N',

611893 typdelim = ',',

612894 typname = "regprocedure"

613895 }

614896

897+regprocedureOid :: Oid

898+regprocedureOid = Oid 2202

899+{-# INLINE regprocedureOid #-}

900+

615901regoper :: TypeInfo

616902regoper = Basic {

617− typoid = Oid 2203,

903+ typoid = regoperOid,

618904 typcategory = 'N',

619905 typdelim = ',',

620906 typname = "regoper"

621907 }

622908

909+regoperOid :: Oid

910+regoperOid = Oid 2203

911+{-# INLINE regoperOid #-}

912+

623913regoperator :: TypeInfo

624914regoperator = Basic {

625− typoid = Oid 2204,

915+ typoid = regoperatorOid,

626916 typcategory = 'N',

627917 typdelim = ',',

628918 typname = "regoperator"

629919 }

630920

921+regoperatorOid :: Oid

922+regoperatorOid = Oid 2204

923+{-# INLINE regoperatorOid #-}

924+

631925regclass :: TypeInfo

632926regclass = Basic {

633− typoid = Oid 2205,

927+ typoid = regclassOid,

634928 typcategory = 'N',

635929 typdelim = ',',

636930 typname = "regclass"

637931 }

638932

933+regclassOid :: Oid

934+regclassOid = Oid 2205

935+{-# INLINE regclassOid #-}

936+

639937regtype :: TypeInfo

640938regtype = Basic {

641− typoid = Oid 2206,

939+ typoid = regtypeOid,

642940 typcategory = 'N',

643941 typdelim = ',',

644942 typname = "regtype"

645943 }

646944

945+regtypeOid :: Oid

946+regtypeOid = Oid 2206

947+{-# INLINE regtypeOid #-}

948+

647949uuid :: TypeInfo

648950uuid = Basic {

649− typoid = Oid 2950,

951+ typoid = uuidOid,

650952 typcategory = 'U',

651953 typdelim = ',',

652954 typname = "uuid"

653955 }

654956

957+uuidOid :: Oid

958+uuidOid = Oid 2950

959+{-# INLINE uuidOid #-}

960+

655961json :: TypeInfo

656962json = Basic {

657− typoid = Oid 114,

963+ typoid = jsonOid,

658964 typcategory = 'U',

659965 typdelim = ',',

660966 typname = "json"

661967 }

662968

969+jsonOid :: Oid

970+jsonOid = Oid 114

971+{-# INLINE jsonOid #-}

972+

663973jsonb :: TypeInfo

664974jsonb = Basic {

665− typoid = Oid 3802,

975+ typoid = jsonbOid,

666976 typcategory = 'U',

667977 typdelim = ',',

668978 typname = "jsonb"

669979 }

670980

981+jsonbOid :: Oid

982+jsonbOid = Oid 3802

983+{-# INLINE jsonbOid #-}

984+

671985int2vector :: TypeInfo

672986int2vector = Array {

673− typoid = Oid 22,

987+ typoid = int2vectorOid,

674988 typcategory = 'A',

675989 typdelim = ',',

676990 typname = "int2vector",

677991 typelem = int2

678992 }

679993

994+int2vectorOid :: Oid

995+int2vectorOid = Oid 22

996+{-# INLINE int2vectorOid #-}

997+

680998oidvector :: TypeInfo

681999oidvector = Array {

682− typoid = Oid 30,

1000+ typoid = oidvectorOid,

6831001 typcategory = 'A',

6841002 typdelim = ',',

6851003 typname = "oidvector",

6861004 typelem = oid

6871005 }

6881006

1007+oidvectorOid :: Oid

1008+oidvectorOid = Oid 30

1009+{-# INLINE oidvectorOid #-}

1010+

6891011array_xml :: TypeInfo

6901012array_xml = Array {

691− typoid = Oid 143,

1013+ typoid = array_xmlOid,

6921014 typcategory = 'A',

6931015 typdelim = ',',

6941016 typname = "_xml",

6951017 typelem = xml

6961018 }

6971019

1020+array_xmlOid :: Oid

1021+array_xmlOid = Oid 143

1022+{-# INLINE array_xmlOid #-}

1023+

6981024array_json :: TypeInfo

6991025array_json = Array {

700− typoid = Oid 199,

1026+ typoid = array_jsonOid,

7011027 typcategory = 'A',

7021028 typdelim = ',',

7031029 typname = "_json",

7041030 typelem = json

7051031 }

7061032

1033+array_jsonOid :: Oid

1034+array_jsonOid = Oid 199

1035+{-# INLINE array_jsonOid #-}

1036+

7071037array_line :: TypeInfo

7081038array_line = Array {

709− typoid = Oid 629,

1039+ typoid = array_lineOid,

7101040 typcategory = 'A',

7111041 typdelim = ',',

7121042 typname = "_line",

7131043 typelem = line

7141044 }

7151045

1046+array_lineOid :: Oid

1047+array_lineOid = Oid 629

1048+{-# INLINE array_lineOid #-}

1049+

7161050array_cidr :: TypeInfo

7171051array_cidr = Array {

718− typoid = Oid 651,

1052+ typoid = array_cidrOid,

7191053 typcategory = 'A',

7201054 typdelim = ',',

7211055 typname = "_cidr",

7221056 typelem = cidr

7231057 }

7241058

1059+array_cidrOid :: Oid

1060+array_cidrOid = Oid 651

1061+{-# INLINE array_cidrOid #-}

1062+

7251063array_circle :: TypeInfo

7261064array_circle = Array {

727− typoid = Oid 719,

1065+ typoid = array_circleOid,

7281066 typcategory = 'A',

7291067 typdelim = ',',

7301068 typname = "_circle",

7311069 typelem = circle

7321070 }

7331071

1072+array_circleOid :: Oid

1073+array_circleOid = Oid 719

1074+{-# INLINE array_circleOid #-}

1075+

7341076array_money :: TypeInfo

7351077array_money = Array {

736− typoid = Oid 791,

1078+ typoid = array_moneyOid,

7371079 typcategory = 'A',

7381080 typdelim = ',',

7391081 typname = "_money",

7401082 typelem = money

7411083 }

7421084

1085+array_moneyOid :: Oid

1086+array_moneyOid = Oid 791

1087+{-# INLINE array_moneyOid #-}

1088+

7431089array_bool :: TypeInfo

7441090array_bool = Array {

745− typoid = Oid 1000,

1091+ typoid = array_boolOid,

7461092 typcategory = 'A',

7471093 typdelim = ',',

7481094 typname = "_bool",

7491095 typelem = bool

7501096 }

7511097

1098+array_boolOid :: Oid

1099+array_boolOid = Oid 1000

1100+{-# INLINE array_boolOid #-}

1101+

7521102array_bytea :: TypeInfo

7531103array_bytea = Array {

754− typoid = Oid 1001,

1104+ typoid = array_byteaOid,

7551105 typcategory = 'A',

7561106 typdelim = ',',

7571107 typname = "_bytea",

7581108 typelem = bytea

7591109 }

7601110

1111+array_byteaOid :: Oid

1112+array_byteaOid = Oid 1001

1113+{-# INLINE array_byteaOid #-}

1114+

7611115array_char :: TypeInfo

7621116array_char = Array {

763− typoid = Oid 1002,

1117+ typoid = array_charOid,

7641118 typcategory = 'A',

7651119 typdelim = ',',

7661120 typname = "_char",

7671121 typelem = char

7681122 }

7691123

1124+array_charOid :: Oid

1125+array_charOid = Oid 1002

1126+{-# INLINE array_charOid #-}

1127+

7701128array_name :: TypeInfo

7711129array_name = Array {

772− typoid = Oid 1003,

1130+ typoid = array_nameOid,

7731131 typcategory = 'A',

7741132 typdelim = ',',

7751133 typname = "_name",

7761134 typelem = name

7771135 }

7781136

1137+array_nameOid :: Oid

1138+array_nameOid = Oid 1003

1139+{-# INLINE array_nameOid #-}

1140+

7791141array_int2 :: TypeInfo

7801142array_int2 = Array {

781− typoid = Oid 1005,

1143+ typoid = array_int2Oid,

7821144 typcategory = 'A',

7831145 typdelim = ',',

7841146 typname = "_int2",

7851147 typelem = int2

7861148 }

7871149

1150+array_int2Oid :: Oid

1151+array_int2Oid = Oid 1005

1152+{-# INLINE array_int2Oid #-}

1153+

7881154array_int2vector :: TypeInfo

7891155array_int2vector = Array {

790− typoid = Oid 1006,

1156+ typoid = array_int2vectorOid,

7911157 typcategory = 'A',

7921158 typdelim = ',',

7931159 typname = "_int2vector",

7941160 typelem = int2vector

7951161 }

7961162

1163+array_int2vectorOid :: Oid

1164+array_int2vectorOid = Oid 1006

1165+{-# INLINE array_int2vectorOid #-}

1166+

7971167array_int4 :: TypeInfo

7981168array_int4 = Array {

799− typoid = Oid 1007,

1169+ typoid = array_int4Oid,

8001170 typcategory = 'A',

8011171 typdelim = ',',

8021172 typname = "_int4",

8031173 typelem = int4

8041174 }

8051175

1176+array_int4Oid :: Oid

1177+array_int4Oid = Oid 1007

1178+{-# INLINE array_int4Oid #-}

1179+

8061180array_regproc :: TypeInfo

8071181array_regproc = Array {

808− typoid = Oid 1008,

1182+ typoid = array_regprocOid,

8091183 typcategory = 'A',

8101184 typdelim = ',',

8111185 typname = "_regproc",

8121186 typelem = regproc

8131187 }

8141188

1189+array_regprocOid :: Oid

1190+array_regprocOid = Oid 1008

1191+{-# INLINE array_regprocOid #-}

1192+

8151193array_text :: TypeInfo

8161194array_text = Array {

817− typoid = Oid 1009,

1195+ typoid = array_textOid,

8181196 typcategory = 'A',

8191197 typdelim = ',',

8201198 typname = "_text",

8211199 typelem = text

8221200 }

8231201

1202+array_textOid :: Oid

1203+array_textOid = Oid 1009

1204+{-# INLINE array_textOid #-}

1205+

8241206array_tid :: TypeInfo

8251207array_tid = Array {

826− typoid = Oid 1010,

1208+ typoid = array_tidOid,

8271209 typcategory = 'A',

8281210 typdelim = ',',

8291211 typname = "_tid",

8301212 typelem = tid

8311213 }

8321214

1215+array_tidOid :: Oid

1216+array_tidOid = Oid 1010

1217+{-# INLINE array_tidOid #-}

1218+

8331219array_xid :: TypeInfo

8341220array_xid = Array {

835− typoid = Oid 1011,

1221+ typoid = array_xidOid,

8361222 typcategory = 'A',

8371223 typdelim = ',',

8381224 typname = "_xid",

8391225 typelem = xid

8401226 }

8411227

1228+array_xidOid :: Oid

1229+array_xidOid = Oid 1011

1230+{-# INLINE array_xidOid #-}

1231+

8421232array_cid :: TypeInfo

8431233array_cid = Array {

844− typoid = Oid 1012,

1234+ typoid = array_cidOid,

8451235 typcategory = 'A',

8461236 typdelim = ',',

8471237 typname = "_cid",

8481238 typelem = cid

8491239 }

8501240

1241+array_cidOid :: Oid

1242+array_cidOid = Oid 1012

1243+{-# INLINE array_cidOid #-}

1244+

8511245array_oidvector :: TypeInfo

8521246array_oidvector = Array {

853− typoid = Oid 1013,

1247+ typoid = array_oidvectorOid,

8541248 typcategory = 'A',

8551249 typdelim = ',',

8561250 typname = "_oidvector",

8571251 typelem = oidvector

8581252 }

8591253

1254+array_oidvectorOid :: Oid

1255+array_oidvectorOid = Oid 1013

1256+{-# INLINE array_oidvectorOid #-}

1257+

8601258array_bpchar :: TypeInfo

8611259array_bpchar = Array {

862− typoid = Oid 1014,

1260+ typoid = array_bpcharOid,

8631261 typcategory = 'A',

8641262 typdelim = ',',

8651263 typname = "_bpchar",

8661264 typelem = bpchar

8671265 }

8681266

1267+array_bpcharOid :: Oid

1268+array_bpcharOid = Oid 1014

1269+{-# INLINE array_bpcharOid #-}

1270+

8691271array_varchar :: TypeInfo

8701272array_varchar = Array {

871− typoid = Oid 1015,

1273+ typoid = array_varcharOid,

8721274 typcategory = 'A',

8731275 typdelim = ',',

8741276 typname = "_varchar",

8751277 typelem = varchar

8761278 }

8771279

1280+array_varcharOid :: Oid

1281+array_varcharOid = Oid 1015

1282+{-# INLINE array_varcharOid #-}

1283+

8781284array_int8 :: TypeInfo

8791285array_int8 = Array {

880− typoid = Oid 1016,

1286+ typoid = array_int8Oid,

8811287 typcategory = 'A',

8821288 typdelim = ',',

8831289 typname = "_int8",

8841290 typelem = int8

8851291 }

8861292

1293+array_int8Oid :: Oid

1294+array_int8Oid = Oid 1016

1295+{-# INLINE array_int8Oid #-}

1296+

8871297array_point :: TypeInfo

8881298array_point = Array {

889− typoid = Oid 1017,

1299+ typoid = array_pointOid,

8901300 typcategory = 'A',

8911301 typdelim = ',',

8921302 typname = "_point",

8931303 typelem = point

8941304 }

8951305

1306+array_pointOid :: Oid

1307+array_pointOid = Oid 1017

1308+{-# INLINE array_pointOid #-}

1309+

8961310array_lseg :: TypeInfo

8971311array_lseg = Array {

898− typoid = Oid 1018,

1312+ typoid = array_lsegOid,

8991313 typcategory = 'A',

9001314 typdelim = ',',

9011315 typname = "_lseg",

9021316 typelem = lseg

9031317 }

9041318

1319+array_lsegOid :: Oid

1320+array_lsegOid = Oid 1018

1321+{-# INLINE array_lsegOid #-}

1322+

9051323array_path :: TypeInfo

9061324array_path = Array {

907− typoid = Oid 1019,

1325+ typoid = array_pathOid,

9081326 typcategory = 'A',

9091327 typdelim = ',',

9101328 typname = "_path",

9111329 typelem = path

9121330 }

9131331

1332+array_pathOid :: Oid

1333+array_pathOid = Oid 1019

1334+{-# INLINE array_pathOid #-}

1335+

9141336array_box :: TypeInfo

9151337array_box = Array {

916− typoid = Oid 1020,

1338+ typoid = array_boxOid,

9171339 typcategory = 'A',

9181340 typdelim = ';',

9191341 typname = "_box",

9201342 typelem = box

9211343 }

9221344

1345+array_boxOid :: Oid

1346+array_boxOid = Oid 1020

1347+{-# INLINE array_boxOid #-}

1348+

9231349array_float4 :: TypeInfo

9241350array_float4 = Array {

925− typoid = Oid 1021,

1351+ typoid = array_float4Oid,

9261352 typcategory = 'A',

9271353 typdelim = ',',

9281354 typname = "_float4",

9291355 typelem = float4

9301356 }

9311357

1358+array_float4Oid :: Oid

1359+array_float4Oid = Oid 1021

1360+{-# INLINE array_float4Oid #-}

1361+

9321362array_float8 :: TypeInfo

9331363array_float8 = Array {

934− typoid = Oid 1022,

1364+ typoid = array_float8Oid,

9351365 typcategory = 'A',

9361366 typdelim = ',',

9371367 typname = "_float8",

9381368 typelem = float8

9391369 }

9401370

1371+array_float8Oid :: Oid

1372+array_float8Oid = Oid 1022

1373+{-# INLINE array_float8Oid #-}

1374+

9411375array_polygon :: TypeInfo

9421376array_polygon = Array {

943− typoid = Oid 1027,

1377+ typoid = array_polygonOid,

9441378 typcategory = 'A',

9451379 typdelim = ',',

9461380 typname = "_polygon",

9471381 typelem = polygon

9481382 }

9491383

1384+array_polygonOid :: Oid

1385+array_polygonOid = Oid 1027

1386+{-# INLINE array_polygonOid #-}

1387+

9501388array_oid :: TypeInfo

9511389array_oid = Array {

952− typoid = Oid 1028,

1390+ typoid = array_oidOid,

9531391 typcategory = 'A',

9541392 typdelim = ',',

9551393 typname = "_oid",

9561394 typelem = oid

9571395 }

9581396

1397+array_oidOid :: Oid

1398+array_oidOid = Oid 1028

1399+{-# INLINE array_oidOid #-}

1400+

9591401array_macaddr :: TypeInfo

9601402array_macaddr = Array {

961− typoid = Oid 1040,

1403+ typoid = array_macaddrOid,

9621404 typcategory = 'A',

9631405 typdelim = ',',

9641406 typname = "_macaddr",

9651407 typelem = macaddr

9661408 }

9671409

1410+array_macaddrOid :: Oid

1411+array_macaddrOid = Oid 1040

1412+{-# INLINE array_macaddrOid #-}

1413+

9681414array_inet :: TypeInfo

9691415array_inet = Array {

970− typoid = Oid 1041,

1416+ typoid = array_inetOid,

9711417 typcategory = 'A',

9721418 typdelim = ',',

9731419 typname = "_inet",

9741420 typelem = inet

9751421 }

9761422

1423+array_inetOid :: Oid

1424+array_inetOid = Oid 1041

1425+{-# INLINE array_inetOid #-}

1426+

9771427array_timestamp :: TypeInfo

9781428array_timestamp = Array {

979− typoid = Oid 1115,

1429+ typoid = array_timestampOid,

9801430 typcategory = 'A',

9811431 typdelim = ',',

9821432 typname = "_timestamp",

9831433 typelem = timestamp

9841434 }

9851435

1436+array_timestampOid :: Oid

1437+array_timestampOid = Oid 1115

1438+{-# INLINE array_timestampOid #-}

1439+

9861440array_date :: TypeInfo

9871441array_date = Array {

988− typoid = Oid 1182,

1442+ typoid = array_dateOid,

9891443 typcategory = 'A',

9901444 typdelim = ',',

9911445 typname = "_date",

9921446 typelem = date

9931447 }

9941448

1449+array_dateOid :: Oid

1450+array_dateOid = Oid 1182

1451+{-# INLINE array_dateOid #-}

1452+

9951453array_time :: TypeInfo

9961454array_time = Array {

997− typoid = Oid 1183,

1455+ typoid = array_timeOid,

9981456 typcategory = 'A',

9991457 typdelim = ',',

10001458 typname = "_time",

10011459 typelem = time

10021460 }

10031461

1462+array_timeOid :: Oid

1463+array_timeOid = Oid 1183

1464+{-# INLINE array_timeOid #-}

1465+

10041466array_timestamptz :: TypeInfo

10051467array_timestamptz = Array {

1006− typoid = Oid 1185,

1468+ typoid = array_timestamptzOid,

10071469 typcategory = 'A',

10081470 typdelim = ',',

10091471 typname = "_timestamptz",

10101472 typelem = timestamptz

10111473 }

10121474

1475+array_timestamptzOid :: Oid

1476+array_timestamptzOid = Oid 1185

1477+{-# INLINE array_timestamptzOid #-}

1478+

10131479array_interval :: TypeInfo

10141480array_interval = Array {

1015− typoid = Oid 1187,

1481+ typoid = array_intervalOid,

10161482 typcategory = 'A',

10171483 typdelim = ',',

10181484 typname = "_interval",

10191485 typelem = interval

10201486 }

10211487

1488+array_intervalOid :: Oid

1489+array_intervalOid = Oid 1187

1490+{-# INLINE array_intervalOid #-}

1491+

10221492array_numeric :: TypeInfo

10231493array_numeric = Array {

1024− typoid = Oid 1231,

1494+ typoid = array_numericOid,

10251495 typcategory = 'A',

10261496 typdelim = ',',

10271497 typname = "_numeric",

10281498 typelem = numeric

10291499 }

10301500

1501+array_numericOid :: Oid

1502+array_numericOid = Oid 1231

1503+{-# INLINE array_numericOid #-}

1504+

10311505array_timetz :: TypeInfo

10321506array_timetz = Array {

1033− typoid = Oid 1270,

1507+ typoid = array_timetzOid,

10341508 typcategory = 'A',

10351509 typdelim = ',',

10361510 typname = "_timetz",

10371511 typelem = timetz

10381512 }

10391513

1514+array_timetzOid :: Oid

1515+array_timetzOid = Oid 1270

1516+{-# INLINE array_timetzOid #-}

1517+

10401518array_bit :: TypeInfo

10411519array_bit = Array {

1042− typoid = Oid 1561,

1520+ typoid = array_bitOid,

10431521 typcategory = 'A',

10441522 typdelim = ',',

10451523 typname = "_bit",

10461524 typelem = bit

10471525 }

10481526

1527+array_bitOid :: Oid

1528+array_bitOid = Oid 1561

1529+{-# INLINE array_bitOid #-}

1530+

10491531array_varbit :: TypeInfo

10501532array_varbit = Array {

1051− typoid = Oid 1563,

1533+ typoid = array_varbitOid,

10521534 typcategory = 'A',

10531535 typdelim = ',',

10541536 typname = "_varbit",

10551537 typelem = varbit

10561538 }

10571539

1540+array_varbitOid :: Oid

1541+array_varbitOid = Oid 1563

1542+{-# INLINE array_varbitOid #-}

1543+

10581544array_refcursor :: TypeInfo

10591545array_refcursor = Array {

1060− typoid = Oid 2201,

1546+ typoid = array_refcursorOid,

10611547 typcategory = 'A',

10621548 typdelim = ',',

10631549 typname = "_refcursor",

10641550 typelem = refcursor

10651551 }

10661552

1553+array_refcursorOid :: Oid

1554+array_refcursorOid = Oid 2201

1555+{-# INLINE array_refcursorOid #-}

1556+

10671557array_regprocedure :: TypeInfo

10681558array_regprocedure = Array {

1069− typoid = Oid 2207,

1559+ typoid = array_regprocedureOid,

10701560 typcategory = 'A',

10711561 typdelim = ',',

10721562 typname = "_regprocedure",

10731563 typelem = regprocedure

10741564 }

10751565

1566+array_regprocedureOid :: Oid

1567+array_regprocedureOid = Oid 2207

1568+{-# INLINE array_regprocedureOid #-}

1569+

10761570array_regoper :: TypeInfo

10771571array_regoper = Array {

1078− typoid = Oid 2208,

1572+ typoid = array_regoperOid,

10791573 typcategory = 'A',

10801574 typdelim = ',',

10811575 typname = "_regoper",

10821576 typelem = regoper

10831577 }

10841578

1579+array_regoperOid :: Oid

1580+array_regoperOid = Oid 2208

1581+{-# INLINE array_regoperOid #-}

1582+

10851583array_regoperator :: TypeInfo

10861584array_regoperator = Array {

1087− typoid = Oid 2209,

1585+ typoid = array_regoperatorOid,

10881586 typcategory = 'A',

10891587 typdelim = ',',

10901588 typname = "_regoperator",

10911589 typelem = regoperator

10921590 }

10931591

1592+array_regoperatorOid :: Oid

1593+array_regoperatorOid = Oid 2209

1594+{-# INLINE array_regoperatorOid #-}

1595+

10941596array_regclass :: TypeInfo

10951597array_regclass = Array {

1096− typoid = Oid 2210,

1598+ typoid = array_regclassOid,

10971599 typcategory = 'A',

10981600 typdelim = ',',

10991601 typname = "_regclass",

11001602 typelem = regclass

11011603 }

11021604

1605+array_regclassOid :: Oid

1606+array_regclassOid = Oid 2210

1607+{-# INLINE array_regclassOid #-}

1608+

11031609array_regtype :: TypeInfo

11041610array_regtype = Array {

1105− typoid = Oid 2211,

1611+ typoid = array_regtypeOid,

11061612 typcategory = 'A',

11071613 typdelim = ',',

11081614 typname = "_regtype",

11091615 typelem = regtype

11101616 }

11111617

1618+array_regtypeOid :: Oid

1619+array_regtypeOid = Oid 2211

1620+{-# INLINE array_regtypeOid #-}

1621+

11121622array_uuid :: TypeInfo

11131623array_uuid = Array {

1114− typoid = Oid 2951,

1624+ typoid = array_uuidOid,

11151625 typcategory = 'A',

11161626 typdelim = ',',

11171627 typname = "_uuid",

11181628 typelem = uuid

11191629 }

11201630

1631+array_uuidOid :: Oid

1632+array_uuidOid = Oid 2951

1633+{-# INLINE array_uuidOid #-}

1634+

11211635array_jsonb :: TypeInfo

11221636array_jsonb = Array {

1123− typoid = Oid 3807,

1637+ typoid = array_jsonbOid,

11241638 typcategory = 'A',

11251639 typdelim = ',',

11261640 typname = "_jsonb",

11271641 typelem = jsonb

11281642 }

11291643

1644+array_jsonbOid :: Oid

1645+array_jsonbOid = Oid 3807

1646+{-# INLINE array_jsonbOid #-}

1647+

11301648int4range :: TypeInfo

11311649int4range = Range {

1132− typoid = Oid 3904,

1650+ typoid = int4rangeOid,

11331651 typcategory = 'R',

11341652 typdelim = ',',

11351653 typname = "int4range",

11361654 rngsubtype = int4

11371655 }

11381656

1657+int4rangeOid :: Oid

1658+int4rangeOid = Oid 3904

1659+{-# INLINE int4rangeOid #-}

1660+

11391661_int4range :: TypeInfo

11401662_int4range = Array {

1141− typoid = Oid 3905,

1663+ typoid = _int4rangeOid,

11421664 typcategory = 'A',

11431665 typdelim = ',',

11441666 typname = "_int4range",

11451667 typelem = int4range

11461668 }

11471669

1670+_int4rangeOid :: Oid

1671+_int4rangeOid = Oid 3905

1672+{-# INLINE _int4rangeOid #-}

1673+

11481674numrange :: TypeInfo

11491675numrange = Range {

1150− typoid = Oid 3906,

1676+ typoid = numrangeOid,

11511677 typcategory = 'R',

11521678 typdelim = ',',

11531679 typname = "numrange",

11541680 rngsubtype = numeric

11551681 }

11561682

1683+numrangeOid :: Oid

1684+numrangeOid = Oid 3906

1685+{-# INLINE numrangeOid #-}

1686+

11571687_numrange :: TypeInfo

11581688_numrange = Array {

1159− typoid = Oid 3907,

1689+ typoid = _numrangeOid,

11601690 typcategory = 'A',

11611691 typdelim = ',',

11621692 typname = "_numrange",

11631693 typelem = numrange

11641694 }

11651695

1696+_numrangeOid :: Oid

1697+_numrangeOid = Oid 3907

1698+{-# INLINE _numrangeOid #-}

1699+

11661700tsrange :: TypeInfo

11671701tsrange = Range {

1168− typoid = Oid 3908,

1702+ typoid = tsrangeOid,

11691703 typcategory = 'R',

11701704 typdelim = ',',

11711705 typname = "tsrange",

11721706 rngsubtype = timestamp

11731707 }

11741708

1709+tsrangeOid :: Oid

1710+tsrangeOid = Oid 3908

1711+{-# INLINE tsrangeOid #-}

1712+

11751713_tsrange :: TypeInfo

11761714_tsrange = Array {

1177− typoid = Oid 3909,

1715+ typoid = _tsrangeOid,

11781716 typcategory = 'A',

11791717 typdelim = ',',

11801718 typname = "_tsrange",

11811719 typelem = tsrange

11821720 }

11831721

1722+_tsrangeOid :: Oid

1723+_tsrangeOid = Oid 3909

1724+{-# INLINE _tsrangeOid #-}

1725+

11841726tstzrange :: TypeInfo

11851727tstzrange = Range {

1186− typoid = Oid 3910,

1728+ typoid = tstzrangeOid,

11871729 typcategory = 'R',

11881730 typdelim = ',',

11891731 typname = "tstzrange",

11901732 rngsubtype = timestamptz

11911733 }

11921734

1735+tstzrangeOid :: Oid

1736+tstzrangeOid = Oid 3910

1737+{-# INLINE tstzrangeOid #-}

1738+

11931739_tstzrange :: TypeInfo

11941740_tstzrange = Array {

1195− typoid = Oid 3911,

1741+ typoid = _tstzrangeOid,

11961742 typcategory = 'A',

11971743 typdelim = ',',

11981744 typname = "_tstzrange",

11991745 typelem = tstzrange

12001746 }

12011747

1748+_tstzrangeOid :: Oid

1749+_tstzrangeOid = Oid 3911

1750+{-# INLINE _tstzrangeOid #-}

1751+

12021752daterange :: TypeInfo

12031753daterange = Range {

1204− typoid = Oid 3912,

1754+ typoid = daterangeOid,

12051755 typcategory = 'R',

12061756 typdelim = ',',

12071757 typname = "daterange",

12081758 rngsubtype = date

12091759 }

12101760

1761+daterangeOid :: Oid

1762+daterangeOid = Oid 3912

1763+{-# INLINE daterangeOid #-}

1764+

12111765_daterange :: TypeInfo

12121766_daterange = Array {

1213− typoid = Oid 3913,

1767+ typoid = _daterangeOid,

12141768 typcategory = 'A',

12151769 typdelim = ',',

12161770 typname = "_daterange",

12171771 typelem = daterange

12181772 }

12191773

1774+_daterangeOid :: Oid

1775+_daterangeOid = Oid 3913

1776+{-# INLINE _daterangeOid #-}

1777+

12201778int8range :: TypeInfo

12211779int8range = Range {

1222− typoid = Oid 3926,

1780+ typoid = int8rangeOid,

12231781 typcategory = 'R',

12241782 typdelim = ',',

12251783 typname = "int8range",

12261784 rngsubtype = int8

12271785 }

12281786

1787+int8rangeOid :: Oid

1788+int8rangeOid = Oid 3926

1789+{-# INLINE int8rangeOid #-}

1790+

12291791_int8range :: TypeInfo

12301792_int8range = Array {

1231− typoid = Oid 3927,

1793+ typoid = _int8rangeOid,

12321794 typcategory = 'A',

12331795 typdelim = ',',

12341796 typname = "_int8range",

12351797 typelem = int8range

12361798 }

12371799

1238−citext :: TypeInfo

1239−citext = Basic {

1240− typoid = Oid 60129,

1241− typcategory = 'S',

1242− typdelim = ',',

1243− typname = "citext"

1244− }

1245−

1246−array_citext :: TypeInfo

1247−array_citext = Array {

1248− typoid = Oid 60134,

1249− typcategory = 'A',

1250− typdelim = ',',

1251− typname = "_citext",

1252− typelem = citext

1253− }

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+179−32

@@ -3,25 +3,39 @@

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

2640import Data.CaseInsensitive (CI)

2741import qualified Data.CaseInsensitive as CI

@@ -32,38 +46,46 @@ import qualified Data.Text.Encoding as T

3246import qualified Data.Vector as V

3347import System.FilePath

3448import System.Timeout(timeout)

35−import Data.Time(getCurrentTime, diffUTCTime)

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

50+import System.Environment (getEnvironment)

3651

3752import Test.Tasty

3853import Test.Tasty.Golden

3954import Notify

4055import Serializable

4156import Time

57+import Interval

58+import Exception (testExceptions)

4259

4360tests :: TestEnv -> TestTree

4461tests env = testGroup "tests"

4562 $ map ($ env)

4663 [ testBytea

47− , testCase "ExecuteMany" . testExecuteMany

48− , testCase "Fold" . testFold

49− , testCase "Notify" . testNotify

50− , testCase "Serializable" . testSerializable

51− , testCase "Time" . testTime

52− , testCase "Array" . testArray

53− , testCase "Array of nullables" . testNullableArray

54− , testCase "HStore" . testHStore

55− , testCase "citext" . testCIText

56− , testCase "JSON" . testJSON

57− , testCase "Savepoint" . testSavepoint

58− , testCase "Unicode" . testUnicode

59− , testCase "Values" . testValues

60− , testCase "Copy" . testCopy

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

6182 , testCopyFailures

62− , testCase "Double" . testDouble

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

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

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

66− , testCase "Timeout" . testTimeout

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

6789 ]

6890

6991testBytea :: TestEnv -> TestTree

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

117139 xs <- readIORef ref

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

119141 xs <- readIORef ref

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

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

121143

122144 -- Make sure fold propagates our exception.

123145 ref <- newIORef []

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

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

235257 [js] @?= js'

236258

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+

237343testSavepoint :: TestEnv -> Assertion

238344testSavepoint TestEnv{..} = do

239345 True <- expectError ST.isNoActiveTransactionError $

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

341447 -- so that we can issue more queries:

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

343449 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

344458 where

345459 copyRows = ["1,foo\n"

346460 ,"2,bar\n"]

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

360474

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

362476goldenTest testName =

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

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

364478 where

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

366480 fileName = map normalize testName

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

368482 | otherwise = c

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

369484

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

371486testCopyUniqueConstraintError :: TestEnv -> TestTree

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

478593isSyntaxError :: SqlError -> Bool

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

480595

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

481604------------------------------------------------------------------------

482605

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

484607--

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

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

487−testConnect :: IO Connection

488−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'"

489616

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

491−withTestEnv cb =

492− withConn $ \conn ->

493617 cb TestEnv

494618 { conn = conn

495619 , withConn = withConn

496620 }

497621 where

498− withConn = bracket testConnect close

622+ withConn = bracket (connectPostgreSQL connstr) close

499623

500624main :: IO ()

501−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+40−28

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

@@ -195,12 +196,7 @@ daterange

195196_daterange

196197int8range

197198_int8range

198−citext

199−_citext array_citext

200−|] -- Note: You must enable the citext extension (CREATE EXTENSION IF NOT EXISTS citext) to generate the citext values

201−

202−instance IsString Blaze.Builder where

203− fromString = Blaze.fromByteString . fromString

199+|]

204200

205201connectionString = "dbname=postgres"

206202

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

239235

240236main = do

241237 (oidmap, namemap) <- getTypeInfos typeNames

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

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

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

244240

245241

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

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

249245renderOid byName name

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

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

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

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

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

254250

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

266262 typelem_hs_name =

267263 case lookup (typname typelem_info) typeNames of

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

269− ++ B.unpack( typname typelem_info)

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

265+ ++ B8.unpack( typname typelem_info)

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

271267 ++ ")")

272268 Just x -> x

273269 in concat

274270 [ "\n"

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

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

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

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

279− , " 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"

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

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

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

283284 ]

284285 | typcategory info == 'R' =

285286 let (Just rngsubtype_oid) = rngsubtype info

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

287288 rngsubtype_hs_name =

288289 case lookup (typname rngsubtype_info) typeNames of

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

290− ++ B.unpack (typname rngsubtype_info)

291+ ++ B8.unpack (typname rngsubtype_info)

291292 ++ " (rngsubtype of "

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

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

293294 Just x -> x

294295 in concat

295296 [ "\n"

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

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

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

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

300− , " 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"

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

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

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

304310 ]

305311 | otherwise =

306312 concat

307313 [ "\n"

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

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

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

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

312− , " 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"

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

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

315326 ]

316327

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

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

320331getNames :: NameMap -> TypeNames -> TypeNames

321332getNames _ x = x

322333

323−bs = Blaze.fromByteString

334+bs = Blaze.byteString

324335

325336pg = fst

326337

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

349360 ( TypeInfo(..)

350361 , staticTypeInfo

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

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

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

353365 ) where

354366